moontalk/client/moontalk-tcl/moontk.tcl

#!/usr/bin/wish

# Default values.
set host "7ks473deh6ggtwqsvbqdurepv5i6iblpbkx33b6cydon3ajph73sssad.onion"
set port "50000"
set username "anonymous"
set reconnect_max_tries -1
set reconnect_time 10000

set notification_exe   "/usr/bin/aplay"
set notification_file  "./notification.wav"
set notification_delay 1000

# Don't touch these
set identity "Anon ?"
set reconnect_try 0
set sock 0
set notification_cooldown 0

proc window_visibility {w val} {
  if {$val} {
      wm deiconify $w
  } else {
      wm withdraw $w
  }
}

proc on_user_connect {w} {
    global reconnect_try
    set reconnect_try 0
    window_visibility . true
    socket_connect
    window_visibility $w false
}

proc display_connect_dialog {} {
    global reconnect_try
    global host
    global port
    set w .wconnect
    if { [winfo exists $w] } {
        window_visibility $w true
        focus $w
    } else {
        toplevel $w
        wm title $w "MoonTk - Connect to MoonTalk"
        set callback_wrapper "on_user_connect $w"
        pack [label $w.lh -text "Host:"] -anchor w
        pack [entry $w.eh -textvariable host] -fill x
        pack [label $w.lp -text "Port:"] -anchor w
        pack [entry $w.ep -textvariable port] -fill x
        pack [button $w.bc -text "connect" -command $callback_wrapper]
        bind $w.eh <Return> $callback_wrapper
        bind $w.eh <KP_Enter> $callback_wrapper
        bind $w.ep <Return> $callback_wrapper
        bind $w.ep <KP_Enter> $callback_wrapper
        focus $w
    }
}

wm title . "MoonTk"
pack [entry .input] -side bottom -fill x
pack [scrollbar .sy -command {.messages yview}] -side right -fill y
pack [text .messages -wrap none -xscrollcommand {.sx set} -yscrollcommand {.sy set}] -fill both -expand 1
pack [scrollbar .sx -orient horizontal -command {.messages xview}] -fill x

proc socket_connect {} {
    global sock
    global host
    global port
    append_message "Connecting to $host:$port..."
    if {[catch {socket -async $host $port} sock]} {
        on_socket_connection_failed
    } else {
        fconfigure $sock -blocking false
        fconfigure $sock -translation binary
        fileevent $sock readable on_socket_receive
        fileevent $sock writable on_socket_connect
    }
}

proc on_socket_connect {} {
    global reconnect_try
    global sock
    set error [fconfigure $sock -error]
    if {$error ne ""} {
        catch {close $sock}
        on_socket_connection_failed
        return
    }
    append_message "Successfully connected to the server."
    fileevent $sock writable {}
    set reconnect_try 0
}

proc on_socket_connection_failed {} {
    global reconnect_time
    global reconnect_max_tries
    global reconnect_try
    if { $reconnect_max_tries != -1
         && $reconnect_try >= $reconnect_max_tries } {
        tk_messageBox -message "Maximum reconnect tries reached." -type ok
        display_connect_dialog
    } else {
        set reconnect_try [expr {$reconnect_try + 1}]
        append_message "Failed to connect to the server, retrying in [expr {$reconnect_time/1000}] seconds."
        after $reconnect_time socket_connect
    }
}

proc on_socket_disconnect {} {
    append_message "Disconnected from server..."
    socket_connect
}

proc parse_identity {data} {
    global identity
    regexp -all {^Server: You are now known as \"(.+)\"\.} $data whole_match ident
    if {[info exists ident]} {
        set identity $ident
    }
}

proc reset_notification {} {
    global notification_cooldown
    set notification_cooldown 0
}

proc play_notification {} {
    global notification_exe
    global notification_file
    global notification_cooldown
    global notification_delay
    set notification_cooldown 1
    exec $notification_exe $notification_file "&"
    after $notification_delay reset_notification
}

proc on_socket_receive {} {
    global sock
    global identity
    global notification_cooldown
    set error [fconfigure $sock -error]
    # catch gets = read error
    # eof = other side disconnected
    if { $error ne ""
         || [catch {gets $sock} data]
         || [eof $sock]} {
      catch {close $sock}
      on_socket_disconnect
      return
    }
    if {[string match "Server: *" $data]} {
        parse_identity $data
    }
    if { !$notification_cooldown } {
      play_notification
    }
    append_message $data
}

proc send_message {msg} {
    global sock
    global identity
    set formatted_msg [format_message $msg]
    puts $sock $formatted_msg
    flush $sock
    append_message "$identity: $formatted_msg"
}
proc timestamp {} {
    return [clock format [clock seconds] -gmt true -format {%Y/%m/%d %H:%M:XX}]
}
proc format_message {msg} {
    global username
    set ts [timestamp]
    if {[string match "/*" $msg]} {
        return $msg
    } else {
        return "<$ts $username> $msg"
    }
}

proc append_message {msg} {
    .messages insert end "$msg\n"
    .messages see end
}

proc user_enter {} {
    send_message [.input get]
    .input delete 0 end
}
bind .input <Return> user_enter
bind .input <KP_Enter> user_enter

window_visibility . false
display_connect_dialog