Artifact 25cf4e8b76a41d7093f893c09c934a7622869417:
File
tools/fossil_chat.tcl
part of check-in
[aeb2ac781d]
- Fix the menu of fossil_chat.tcl for mac.
by
drh on
2007-09-24 22:23:32.
0000: 23 21 2f 68 6f 6d 65 2f 64 72 68 2f 62 69 6e 2f #!/home/drh/bin/
0010: 74 6f 62 65 0a 23 0a 23 20 53 69 6d 70 6c 65 20 tobe.#.# Simple
0020: 63 68 61 74 20 63 6c 69 65 6e 74 20 66 6f 72 20 chat client for
0030: 54 63 6c 2f 54 6b 2e 0a 23 0a 70 61 63 6b 61 67 Tcl/Tk..#.packag
0040: 65 20 72 65 71 75 69 72 65 20 54 6b 0a 0a 73 65 e require Tk..se
0050: 74 20 53 45 52 56 45 52 48 4f 53 54 20 66 6f 73 t SERVERHOST fos
0060: 73 69 6c 2d 73 63 6d 2e 68 77 61 63 69 2e 63 6f sil-scm.hwaci.co
0070: 6d 0a 23 20 73 65 74 20 53 45 52 56 45 52 48 4f m.# set SERVERHO
0080: 53 54 20 31 32 37 2e 30 2e 30 2e 31 0a 23 73 65 ST 127.0.0.1.#se
0090: 74 20 53 45 52 56 45 52 48 4f 53 54 20 36 34 2e t SERVERHOST 64.
00a0: 35 2e 35 33 2e 31 39 32 0a 73 65 74 20 53 45 52 5.53.192.set SER
00b0: 56 45 52 50 4f 52 54 20 38 36 31 35 0a 0a 23 20 VERPORT 8615..#
00c0: 53 65 74 75 70 20 74 68 65 20 75 73 65 72 20 69 Setup the user i
00d0: 6e 74 65 72 66 61 63 65 0a 77 6d 20 74 69 74 6c nterface.wm titl
00e0: 65 20 2e 20 46 6f 73 73 69 6c 2d 43 68 61 74 0a e . Fossil-Chat.
00f0: 77 6d 20 69 63 6f 6e 6e 61 6d 65 20 2e 20 5b 77 wm iconname . [w
0100: 6d 20 74 69 74 6c 65 20 2e 5d 0a 0a 73 65 74 20 m title .]..set
0110: 3a 3a 50 52 49 56 41 54 45 20 30 0a 0a 6d 65 6e ::PRIVATE 0..men
0120: 75 20 2e 6d 62 20 2d 74 79 70 65 20 6d 65 6e 75 u .mb -type menu
0130: 62 61 72 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 bar.if {$tcl_pla
0140: 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 3d tform(platform)=
0150: 3d 22 75 6e 69 78 22 20 26 26 20 24 74 63 6c 5f ="unix" && $tcl_
0160: 70 6c 61 74 66 6f 72 6d 28 6f 73 29 21 3d 22 44 platform(os)!="D
0170: 61 72 77 69 6e 22 7d 20 7b 0a 20 20 70 61 63 6b arwin"} {. pack
0180: 20 2e 6d 62 20 2d 73 69 64 65 20 74 6f 70 20 2d .mb -side top -
0190: 66 69 6c 6c 20 78 0a 7d 20 65 6c 73 65 20 7b 0a fill x.} else {.
01a0: 20 20 2e 20 63 6f 6e 66 69 67 20 2d 6d 65 6e 75 . config -menu
01b0: 20 2e 6d 62 0a 7d 0a 2e 6d 62 20 61 64 64 20 63 .mb.}..mb add c
01c0: 61 73 63 61 64 65 20 2d 6c 61 62 65 6c 20 46 69 ascade -label Fi
01d0: 6c 65 20 2d 75 6e 64 65 72 6c 69 6e 65 20 30 20 le -underline 0
01e0: 2d 6d 65 6e 75 20 2e 6d 62 2e 66 69 6c 65 0a 6d -menu .mb.file.m
01f0: 65 6e 75 20 2e 6d 62 2e 66 69 6c 65 20 2d 74 65 enu .mb.file -te
0200: 61 72 6f 66 66 20 30 0a 2e 6d 62 2e 66 69 6c 65 aroff 0..mb.file
0210: 20 61 64 64 20 63 6f 6d 6d 61 6e 64 20 2d 6c 61 add command -la
0220: 62 65 6c 20 53 65 6e 64 20 2d 63 6f 6d 6d 61 6e bel Send -comman
0230: 64 20 73 65 6e 64 5f 6d 65 73 73 61 67 65 0a 2e d send_message..
0240: 6d 62 2e 66 69 6c 65 20 61 64 64 20 63 6f 6d 6d mb.file add comm
0250: 61 6e 64 20 2d 6c 61 62 65 6c 20 7b 52 65 6d 6f and -label {Remo
0260: 76 65 20 6f 6c 64 65 72 20 6d 65 73 73 61 67 65 ve older message
0270: 73 7d 20 2d 63 6f 6d 6d 61 6e 64 20 63 6c 65 61 s} -command clea
0280: 6e 75 70 5f 72 65 63 6f 72 64 0a 2e 6d 62 2e 66 nup_record..mb.f
0290: 69 6c 65 20 61 64 64 20 63 68 65 63 6b 62 75 74 ile add checkbut
02a0: 74 6f 6e 20 2d 6c 61 62 65 6c 20 7b 50 72 69 76 ton -label {Priv
02b0: 61 74 65 7d 20 2d 76 61 72 69 61 62 6c 65 20 50 ate} -variable P
02c0: 52 49 56 41 54 45 0a 2e 6d 62 2e 66 69 6c 65 20 RIVATE..mb.file
02d0: 61 64 64 20 73 65 70 61 72 61 74 6f 72 0a 2e 6d add separator..m
02e0: 62 2e 66 69 6c 65 20 61 64 64 20 63 6f 6d 6d 61 b.file add comma
02f0: 6e 64 20 2d 6c 61 62 65 6c 20 7b 45 78 69 74 7d nd -label {Exit}
0300: 20 2d 63 6f 6d 6d 61 6e 64 20 65 78 69 74 0a 0a -command exit..
0310: 66 72 61 6d 65 20 2e 77 68 6f 0a 70 61 63 6b 20 frame .who.pack
0320: 2e 77 68 6f 20 2d 73 69 64 65 20 72 69 67 68 74 .who -side right
0330: 20 2d 61 6e 63 68 6f 72 20 6e 20 2d 66 69 6c 6c -anchor n -fill
0340: 20 79 0a 6c 61 62 65 6c 20 2e 77 68 6f 2e 74 69 y.label .who.ti
0350: 74 6c 65 20 2d 74 65 78 74 20 7b 55 73 65 72 73 tle -text {Users
0360: 3a 20 20 20 20 20 20 7d 0a 70 61 63 6b 20 2e 77 : }.pack .w
0370: 68 6f 2e 74 69 74 6c 65 20 2d 73 69 64 65 20 74 ho.title -side t
0380: 6f 70 20 2d 61 6e 63 68 6f 72 20 6e 77 0a 6c 61 op -anchor nw.la
0390: 62 65 6c 20 2e 77 68 6f 2e 6c 69 73 74 20 2d 61 bel .who.list -a
03a0: 6e 63 68 6f 72 20 77 20 2d 6a 75 73 74 69 66 79 nchor w -justify
03b0: 20 6c 65 66 74 20 2d 74 65 78 74 20 7b 7d 0a 70 left -text {}.p
03c0: 61 63 6b 20 2e 77 68 6f 2e 6c 69 73 74 20 2d 73 ack .who.list -s
03d0: 69 64 65 20 74 6f 70 20 2d 61 6e 63 68 6f 72 20 ide top -anchor
03e0: 6e 77 20 2d 65 78 70 61 6e 64 20 31 20 2d 70 61 nw -expand 1 -pa
03f0: 64 78 20 35 0a 6c 61 62 65 6c 20 2e 77 68 6f 2e dx 5.label .who.
0400: 74 69 6d 65 20 2d 74 65 78 74 20 7b 7d 20 2d 6a time -text {} -j
0410: 75 73 74 69 66 79 20 72 69 67 68 74 0a 70 72 6f ustify right.pro
0420: 63 20 75 70 64 61 74 65 5f 74 69 6d 65 20 7b 7d c update_time {}
0430: 20 7b 0a 20 20 61 66 74 65 72 20 31 30 30 30 20 {. after 1000
0440: 75 70 64 61 74 65 5f 74 69 6d 65 0a 20 20 73 65 update_time. se
0450: 74 20 6e 6f 77 20 5b 63 6c 6f 63 6b 20 73 65 63 t now [clock sec
0460: 6f 6e 64 73 5d 0a 20 20 73 65 74 20 74 69 6d 65 onds]. set time
0470: 31 20 5b 63 6c 6f 63 6b 20 66 6f 72 6d 61 74 20 1 [clock format
0480: 5b 65 78 70 72 20 7b 24 6e 6f 77 2d 34 2a 33 36 [expr {$now-4*36
0490: 30 30 7d 5d 20 2d 66 6f 72 6d 61 74 20 7b 25 48 00}] -format {%H
04a0: 3a 25 4d 7d 20 2d 67 6d 74 20 31 5d 0a 20 20 73 :%M} -gmt 1]. s
04b0: 65 74 20 74 69 6d 65 32 20 5b 63 6c 6f 63 6b 20 et time2 [clock
04c0: 66 6f 72 6d 61 74 20 5b 65 78 70 72 20 7b 24 6e format [expr {$n
04d0: 6f 77 2b 31 30 2a 33 36 30 30 7d 5d 20 2d 66 6f ow+10*3600}] -fo
04e0: 72 6d 61 74 20 7b 25 48 3a 25 4d 7d 20 2d 67 6d rmat {%H:%M} -gm
04f0: 74 20 31 5d 0a 20 20 73 65 74 20 74 69 6d 65 33 t 1]. set time3
0500: 20 5b 63 6c 6f 63 6b 20 66 6f 72 6d 61 74 20 24 [clock format $
0510: 6e 6f 77 20 2d 66 6f 72 6d 61 74 20 25 48 3a 25 now -format %H:%
0520: 4d 20 2d 67 6d 74 20 31 5d 0a 20 20 2e 77 68 6f M -gmt 1]. .who
0530: 2e 74 69 6d 65 20 63 6f 6e 66 69 67 20 2d 74 65 .time config -te
0540: 78 74 20 22 41 45 53 54 3a 20 24 74 69 6d 65 32 xt "AEST: $time2
0550: 5c 6e 55 54 43 3a 20 24 74 69 6d 65 33 5c 6e 45 \nUTC: $time3\nE
0560: 53 54 3a 20 24 74 69 6d 65 31 22 0a 7d 0a 75 70 ST: $time1".}.up
0570: 64 61 74 65 5f 74 69 6d 65 0a 70 61 63 6b 20 2e date_time.pack .
0580: 77 68 6f 2e 74 69 6d 65 20 2d 73 69 64 65 20 62 who.time -side b
0590: 6f 74 74 6f 6d 20 2d 61 6e 63 68 6f 72 20 73 77 ottom -anchor sw
05a0: 0a 0a 66 72 61 6d 65 20 2e 69 6e 70 75 74 0a 70 ..frame .input.p
05b0: 61 63 6b 20 2e 69 6e 70 75 74 20 2d 73 69 64 65 ack .input -side
05c0: 20 62 6f 74 74 6f 6d 20 2d 66 69 6c 6c 20 78 0a bottom -fill x.
05d0: 74 65 78 74 20 2e 69 6e 70 75 74 2e 74 20 2d 62 text .input.t -b
05e0: 64 20 31 20 2d 72 65 6c 69 65 66 20 73 75 6e 6b d 1 -relief sunk
05f0: 65 6e 20 2d 62 67 20 77 68 69 74 65 20 2d 66 67 en -bg white -fg
0600: 20 62 6c 61 63 6b 20 2d 77 69 64 74 68 20 36 30 black -width 60
0610: 20 2d 68 65 69 67 68 74 20 33 20 5c 0a 20 20 20 -height 3 \.
0620: 2d 77 72 61 70 20 77 6f 72 64 20 2d 79 73 63 72 -wrap word -yscr
0630: 6f 6c 6c 63 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 ollcommand [list
0640: 20 2e 69 6e 70 75 74 2e 73 62 20 73 65 74 5d 20 .input.sb set]
0650: 2d 74 61 6b 65 66 6f 63 75 73 20 31 0a 62 69 6e -takefocus 1.bin
0660: 64 20 2e 69 6e 70 75 74 2e 74 20 3c 4b 65 79 2d d .input.t <Key-
0670: 52 65 74 75 72 6e 3e 20 7b 73 65 6e 64 5f 6d 65 Return> {send_me
0680: 73 73 61 67 65 3b 20 62 72 65 61 6b 7d 0a 70 61 ssage; break}.pa
0690: 63 6b 20 2e 69 6e 70 75 74 2e 74 20 2d 73 69 64 ck .input.t -sid
06a0: 65 20 6c 65 66 74 20 2d 66 69 6c 6c 20 62 6f 74 e left -fill bot
06b0: 68 20 2d 65 78 70 61 6e 64 20 31 0a 73 63 72 6f h -expand 1.scro
06c0: 6c 6c 62 61 72 20 2e 69 6e 70 75 74 2e 73 62 20 llbar .input.sb
06d0: 2d 6f 72 69 65 6e 74 20 76 65 72 74 69 63 61 6c -orient vertical
06e0: 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 -command [list
06f0: 2e 69 6e 70 75 74 2e 74 20 79 76 69 65 77 5d 0a .input.t yview].
0700: 70 61 63 6b 20 2e 69 6e 70 75 74 2e 73 62 20 2d pack .input.sb -
0710: 73 69 64 65 20 6c 65 66 74 20 2d 66 69 6c 6c 20 side left -fill
0720: 79 0a 0a 66 72 61 6d 65 20 2e 6d 73 67 0a 70 61 y..frame .msg.pa
0730: 63 6b 20 2e 6d 73 67 20 2d 73 69 64 65 20 74 6f ck .msg -side to
0740: 70 20 2d 66 69 6c 6c 20 62 6f 74 68 20 2d 65 78 p -fill both -ex
0750: 70 61 6e 64 20 31 0a 74 65 78 74 20 2e 6d 73 67 pand 1.text .msg
0760: 2e 74 20 2d 62 64 20 31 20 2d 72 65 6c 69 65 66 .t -bd 1 -relief
0770: 20 73 75 6e 6b 65 6e 20 2d 62 67 20 77 68 69 74 sunken -bg whit
0780: 65 20 2d 66 67 20 62 6c 61 63 6b 20 2d 77 69 64 e -fg black -wid
0790: 74 68 20 36 30 20 2d 68 65 69 67 68 74 20 32 30 th 60 -height 20
07a0: 20 5c 0a 20 20 20 2d 77 72 61 70 20 77 6f 72 64 \. -wrap word
07b0: 20 2d 79 73 63 72 6f 6c 6c 63 6f 6d 6d 61 6e 64 -yscrollcommand
07c0: 20 5b 6c 69 73 74 20 2e 6d 73 67 2e 73 62 20 73 [list .msg.sb s
07d0: 65 74 5d 20 2d 74 61 6b 65 66 6f 63 75 73 20 30 et] -takefocus 0
07e0: 0a 62 69 6e 64 74 61 67 73 20 2e 6d 73 67 2e 74 .bindtags .msg.t
07f0: 20 5b 6c 69 73 74 20 2e 6d 73 67 2e 74 20 2e 20 [list .msg.t .
0800: 61 6c 6c 5d 0a 2e 6d 73 67 2e 74 20 74 61 67 20 all]..msg.t tag
0810: 63 6f 6e 66 69 67 20 65 72 72 6f 72 20 2d 66 6f config error -fo
0820: 72 65 67 72 6f 75 6e 64 20 72 65 64 0a 2e 6d 73 reground red..ms
0830: 67 2e 74 20 74 61 67 20 63 6f 6e 66 69 67 20 6d g.t tag config m
0840: 65 74 61 20 2d 66 6f 72 65 67 72 6f 75 6e 64 20 eta -foreground
0850: 66 6f 72 65 73 74 67 72 65 65 6e 0a 2e 6d 73 67 forestgreen..msg
0860: 2e 74 20 74 61 67 20 63 6f 6e 66 69 67 20 6e 6f .t tag config no
0870: 72 6d 20 2d 66 6f 72 65 67 72 6f 75 6e 64 20 62 rm -foreground b
0880: 6c 61 63 6b 0a 70 61 63 6b 20 2e 6d 73 67 2e 74 lack.pack .msg.t
0890: 20 2d 73 69 64 65 20 6c 65 66 74 20 2d 66 69 6c -side left -fil
08a0: 6c 20 62 6f 74 68 20 2d 65 78 70 61 6e 64 20 31 l both -expand 1
08b0: 0a 73 63 72 6f 6c 6c 62 61 72 20 2e 6d 73 67 2e .scrollbar .msg.
08c0: 73 62 20 2d 6f 72 69 65 6e 74 20 76 65 72 74 69 sb -orient verti
08d0: 63 61 6c 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6c 69 cal -command [li
08e0: 73 74 20 2e 6d 73 67 2e 74 20 79 76 69 65 77 5d st .msg.t yview]
08f0: 0a 70 61 63 6b 20 2e 6d 73 67 2e 73 62 20 2d 73 .pack .msg.sb -s
0900: 69 64 65 20 6c 65 66 74 20 2d 66 69 6c 6c 20 79 ide left -fill y
0910: 0a 0a 75 70 64 61 74 65 0a 0a 23 20 53 65 6e 64 ..update..# Send
0920: 20 70 65 72 69 6f 64 69 63 20 6d 65 73 73 61 67 periodic messag
0930: 65 73 20 74 6f 20 6b 65 65 70 20 74 68 65 20 54 es to keep the T
0940: 43 50 2f 49 50 20 6c 69 6e 6b 20 75 70 0a 23 0a CP/IP link up.#.
0950: 70 72 6f 63 20 6b 65 65 70 5f 61 6c 69 76 65 20 proc keep_alive
0960: 7b 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 54 49 {} {. global TI
0970: 4d 45 52 20 53 4f 43 4b 45 54 0a 20 20 63 61 74 MER SOCKET. cat
0980: 63 68 20 7b 61 66 74 65 72 20 63 61 6e 63 65 6c ch {after cancel
0990: 20 24 54 49 4d 45 52 7d 0a 20 20 73 65 74 20 54 $TIMER}. set T
09a0: 49 4d 45 52 20 5b 61 66 74 65 72 20 33 30 30 30 IMER [after 3000
09b0: 30 30 20 6b 65 65 70 5f 61 6c 69 76 65 5d 0a 20 00 keep_alive].
09c0: 20 63 61 74 63 68 20 7b 70 75 74 73 20 24 53 4f catch {puts $SO
09d0: 43 4b 45 54 20 6e 6f 6f 70 3b 20 66 6c 75 73 68 CKET noop; flush
09e0: 20 24 53 4f 43 4b 45 54 7d 0a 7d 0a 0a 23 20 43 $SOCKET}.}..# C
09f0: 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 onnect to the se
0a00: 72 76 65 72 0a 70 72 6f 63 20 63 6f 6e 6e 65 63 rver.proc connec
0a10: 74 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 t {} {. global
0a20: 53 4f 43 4b 45 54 20 74 63 6c 5f 70 6c 61 74 66 SOCKET tcl_platf
0a30: 6f 72 6d 0a 20 20 63 61 74 63 68 20 7b 63 6c 6f orm. catch {clo
0a40: 73 65 20 24 53 4f 43 4b 45 54 7d 0a 20 20 69 66 se $SOCKET}. if
0a50: 20 7b 5b 63 61 74 63 68 20 7b 0a 20 20 20 20 73 {[catch {. s
0a60: 65 74 20 53 4f 43 4b 45 54 20 5b 73 6f 63 6b 65 et SOCKET [socke
0a70: 74 20 24 3a 3a 53 45 52 56 45 52 48 4f 53 54 20 t $::SERVERHOST
0a80: 24 3a 3a 53 45 52 56 45 52 50 4f 52 54 5d 0a 20 $::SERVERPORT].
0a90: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 53 fconfigure $S
0aa0: 4f 43 4b 45 54 20 2d 74 72 61 6e 73 6c 61 74 69 OCKET -translati
0ab0: 6f 6e 20 62 69 6e 61 72 79 20 2d 62 6c 6f 63 6b on binary -block
0ac0: 69 6e 67 20 30 0a 20 20 20 20 70 75 74 73 20 24 ing 0. puts $
0ad0: 53 4f 43 4b 45 54 20 5b 6c 69 73 74 20 6c 6f 67 SOCKET [list log
0ae0: 69 6e 20 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d in $tcl_platform
0af0: 28 75 73 65 72 29 20 66 61 63 74 2c 66 75 7a 7a (user) fact,fuzz
0b00: 5d 0a 20 20 20 20 66 6c 75 73 68 20 24 53 4f 43 ]. flush $SOC
0b10: 4b 45 54 0a 20 20 20 20 66 69 6c 65 65 76 65 6e KET. fileeven
0b20: 74 20 24 53 4f 43 4b 45 54 20 72 65 61 64 61 62 t $SOCKET readab
0b30: 6c 65 20 68 61 6e 64 6c 65 5f 69 6e 70 75 74 0a le handle_input.
0b40: 20 20 20 20 6b 65 65 70 5f 61 6c 69 76 65 0a 20 keep_alive.
0b50: 20 7d 20 65 72 72 6d 73 67 5d 7d 20 7b 0a 20 20 } errmsg]} {.
0b60: 20 20 69 66 20 7b 5b 74 6b 5f 6d 65 73 73 61 67 if {[tk_messag
0b70: 65 42 6f 78 20 2d 69 63 6f 6e 20 65 72 72 6f 72 eBox -icon error
0b80: 20 2d 74 79 70 65 20 79 65 73 6e 6f 20 2d 70 61 -type yesno -pa
0b90: 72 65 6e 74 20 2e 20 2d 6d 65 73 73 61 67 65 20 rent . -message
0ba0: 5c 0a 20 20 20 20 20 20 20 20 20 20 20 22 55 6e \. "Un
0bb0: 61 62 6c 65 20 74 6f 20 63 6f 6e 6e 65 63 74 20 able to connect
0bc0: 74 6f 20 73 65 72 76 65 72 2e 20 20 24 65 72 72 to server. $err
0bd0: 6d 73 67 2e 5c 6e 5c 6e 54 72 79 20 61 67 61 69 msg.\n\nTry agai
0be0: 6e 3f 22 5d 3d 3d 22 79 65 73 22 7d 20 7b 0a 20 n?"]=="yes"} {.
0bf0: 20 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 after 100 c
0c00: 6f 6e 6e 65 63 74 0a 20 20 20 20 7d 0a 20 20 7d onnect. }. }
0c10: 0a 7d 0a 63 6f 6e 6e 65 63 74 0a 0a 23 20 53 65 .}.connect..# Se
0c20: 6e 64 20 74 68 65 20 6d 65 73 73 61 67 65 20 74 nd the message t
0c30: 65 78 74 20 63 6f 6e 74 61 69 6e 65 64 20 69 6e ext contained in
0c40: 20 74 68 65 20 2e 69 6e 70 75 74 2e 74 20 77 69 the .input.t wi
0c50: 64 67 65 74 20 74 6f 20 74 68 65 20 73 65 72 76 dget to the serv
0c60: 65 72 2e 0a 23 0a 70 72 6f 63 20 73 65 6e 64 5f er..#.proc send_
0c70: 6d 65 73 73 61 67 65 20 7b 7d 20 7b 0a 20 20 73 message {} {. s
0c80: 65 74 20 74 78 74 20 5b 2e 69 6e 70 75 74 2e 74 et txt [.input.t
0c90: 20 67 65 74 20 31 2e 30 20 65 6e 64 5d 0a 20 20 get 1.0 end].
0ca0: 2e 69 6e 70 75 74 2e 74 20 64 65 6c 65 74 65 20 .input.t delete
0cb0: 31 2e 30 20 65 6e 64 0a 20 20 72 65 67 73 75 62 1.0 end. regsub
0cc0: 20 2d 61 6c 6c 20 22 5c 5b 20 5c 74 5c 6e 5c 66 -all "\[ \t\n\f
0cd0: 5c 72 5c 5d 2b 22 20 5b 73 74 72 69 6e 67 20 74 \r\]+" [string t
0ce0: 72 69 6d 20 24 74 78 74 5d 20 7b 20 7d 20 74 78 rim $txt] { } tx
0cf0: 74 0a 20 20 69 66 20 7b 24 74 78 74 3d 3d 22 22 t. if {$txt==""
0d00: 7d 20 72 65 74 75 72 6e 0a 20 20 67 6c 6f 62 61 } return. globa
0d10: 6c 20 53 4f 43 4b 45 54 0a 20 20 69 66 20 7b 24 l SOCKET. if {$
0d20: 3a 3a 50 52 49 56 41 54 45 7d 20 7b 0a 20 20 20 ::PRIVATE} {.
0d30: 20 70 75 74 73 20 24 53 4f 43 4b 45 54 20 5b 6c puts $SOCKET [l
0d40: 69 73 74 20 70 72 69 76 61 74 65 5f 6d 65 73 73 ist private_mess
0d50: 61 67 65 20 24 74 78 74 20 5b 6c 69 73 74 20 64 age $txt [list d
0d60: 61 6e 20 64 72 68 5d 5d 0a 20 20 7d 20 65 6c 73 an drh]]. } els
0d70: 65 20 7b 0a 20 20 20 20 70 75 74 73 20 24 53 4f e {. puts $SO
0d80: 43 4b 45 54 20 5b 6c 69 73 74 20 6d 65 73 73 61 CKET [list messa
0d90: 67 65 20 24 74 78 74 5d 0a 20 20 7d 0a 20 20 66 ge $txt]. }. f
0da0: 6c 75 73 68 20 24 53 4f 43 4b 45 54 0a 7d 0a 0a lush $SOCKET.}..
0db0: 2e 6d 62 20 61 64 64 20 63 61 73 63 61 64 65 20 .mb add cascade
0dc0: 2d 6c 61 62 65 6c 20 22 54 72 61 6e 73 66 65 72 -label "Transfer
0dd0: 22 20 2d 75 6e 64 65 72 6c 69 6e 65 20 30 20 2d " -underline 0 -
0de0: 6d 65 6e 75 20 2e 6d 62 2e 66 69 6c 65 73 0a 6d menu .mb.files.m
0df0: 65 6e 75 20 2e 6d 62 2e 66 69 6c 65 73 20 2d 74 enu .mb.files -t
0e00: 65 61 72 6f 66 66 20 30 0a 2e 6d 62 2e 66 69 6c earoff 0..mb.fil
0e10: 65 73 20 61 64 64 20 63 6f 6d 6d 61 6e 64 20 2d es add command -
0e20: 6c 61 62 65 6c 20 22 53 65 6e 64 20 66 69 6c 65 label "Send file
0e30: 2e 2e 2e 22 20 2d 63 6f 6d 6d 61 6e 64 20 73 65 ..." -command se
0e40: 6e 64 5f 66 69 6c 65 0a 2e 6d 62 2e 66 69 6c 65 nd_file..mb.file
0e50: 73 20 61 64 64 20 63 6f 6d 6d 61 6e 64 20 2d 6c s add command -l
0e60: 61 62 65 6c 20 22 44 65 6c 65 74 65 20 66 69 6c abel "Delete fil
0e70: 65 73 22 20 2d 63 6f 6d 6d 61 6e 64 20 64 65 6c es" -command del
0e80: 65 74 65 5f 66 69 6c 65 73 20 5c 0a 20 20 20 20 ete_files \.
0e90: 2d 73 74 61 74 65 20 64 69 73 61 62 6c 65 64 0a -state disabled.
0ea0: 2e 6d 62 2e 66 69 6c 65 73 20 61 64 64 20 73 65 .mb.files add se
0eb0: 70 61 72 61 74 6f 72 0a 0a 23 20 45 6e 63 6f 64 parator..# Encod
0ec0: 65 20 61 20 73 74 72 69 6e 67 20 28 70 6f 73 73 e a string (poss
0ed0: 69 62 6c 79 20 63 6f 6e 74 61 69 6e 69 6e 67 20 ibly containing
0ee0: 62 69 6e 61 72 79 20 61 6e 64 20 5c 30 30 30 20 binary and \000
0ef0: 63 68 61 72 61 63 74 65 72 73 29 20 69 6e 74 6f characters) into
0f00: 0a 23 20 73 69 6e 67 6c 65 20 6c 69 6e 65 20 6f .# single line o
0f10: 66 20 74 65 78 74 2e 0a 23 0a 70 72 6f 63 20 65 f text..#.proc e
0f20: 6e 63 6f 64 65 20 7b 74 78 74 7d 20 7b 0a 20 20 ncode {txt} {.
0f30: 72 65 74 75 72 6e 20 5b 73 74 72 69 6e 67 20 6d return [string m
0f40: 61 70 20 5b 6c 69 73 74 20 25 20 25 32 35 20 2b ap [list % %25 +
0f50: 20 25 32 62 20 22 20 22 20 2b 20 5c 6e 20 25 30 %2b " " + \n %0
0f60: 61 20 5c 74 20 25 30 39 20 5c 30 30 30 20 25 30 a \t %09 \000 %0
0f70: 30 5d 20 24 74 78 74 5d 0a 7d 0a 0a 23 20 55 6e 0] $txt].}..# Un
0f80: 64 6f 20 74 68 65 20 77 6f 72 6b 20 6f 66 20 65 do the work of e
0f90: 6e 63 6f 64 65 2e 20 20 43 6f 6e 76 65 72 74 20 ncode. Convert
0fa0: 61 6e 20 65 6e 63 6f 64 65 64 20 73 74 72 69 6e an encoded strin
0fb0: 67 20 62 61 63 6b 20 69 6e 74 6f 20 69 74 73 20 g back into its
0fc0: 6f 72 69 67 69 6e 61 6c 0a 23 20 66 6f 72 6d 2e original.# form.
0fd0: 0a 23 0a 70 72 6f 63 20 64 65 63 6f 64 65 20 7b .#.proc decode {
0fe0: 74 78 74 7d 20 7b 0a 20 20 72 65 74 75 72 6e 20 txt} {. return
0ff0: 5b 73 74 72 69 6e 67 20 6d 61 70 20 5b 6c 69 73 [string map [lis
1000: 74 20 25 30 30 20 5c 30 30 30 20 25 30 39 20 5c t %00 \000 %09 \
1010: 74 20 25 30 61 20 5c 6e 20 2b 20 22 20 22 20 25 t %0a \n + " " %
1020: 32 62 20 2b 20 25 32 35 20 25 5d 20 24 74 78 74 2b + %25 %] $txt
1030: 5d 0a 7d 0a 0a 23 20 44 65 6c 65 74 65 20 61 6c ].}..# Delete al
1040: 6c 20 6f 66 20 74 68 65 20 64 6f 77 6e 6c 6f 61 l of the downloa
1050: 64 65 64 20 66 69 6c 65 73 20 77 65 20 61 72 65 ded files we are
1060: 20 63 75 72 72 65 6e 74 6c 79 20 68 6f 6c 64 69 currently holdi
1070: 6e 67 2e 0a 23 0a 70 72 6f 63 20 64 65 6c 65 74 ng..#.proc delet
1080: 65 5f 66 69 6c 65 73 20 7b 7d 20 7b 0a 20 20 67 e_files {} {. g
1090: 6c 6f 62 61 6c 20 46 49 4c 45 53 0a 20 20 2e 6d lobal FILES. .m
10a0: 62 2e 66 69 6c 65 73 20 64 65 6c 65 74 65 20 33 b.files delete 3
10b0: 20 65 6e 64 0a 20 20 61 72 72 61 79 20 75 6e 73 end. array uns
10c0: 65 74 20 46 49 4c 45 53 0a 20 20 2e 6d 62 2e 66 et FILES. .mb.f
10d0: 69 6c 65 73 20 65 6e 74 72 79 63 6f 6e 66 69 67 iles entryconfig
10e0: 75 72 65 20 31 20 2d 73 74 61 74 65 20 64 69 73 ure 1 -state dis
10f0: 61 62 6c 65 64 20 0a 7d 0a 0a 23 20 50 72 6f 6d abled .}..# Prom
1100: 70 74 20 74 68 65 20 75 73 65 72 20 74 6f 20 73 pt the user to s
1110: 65 6c 65 63 74 20 61 20 66 69 6c 65 20 66 72 6f elect a file fro
1120: 6d 20 74 68 65 20 64 69 73 6b 2e 20 20 54 68 65 m the disk. The
1130: 6e 20 73 65 6e 64 20 74 68 61 74 0a 23 20 66 69 n send that.# fi
1140: 6c 65 20 74 6f 20 61 6c 6c 20 63 68 61 74 20 70 le to all chat p
1150: 61 72 74 69 63 69 70 61 6e 74 73 2e 0a 23 0a 70 articipants..#.p
1160: 72 6f 63 20 73 65 6e 64 5f 66 69 6c 65 20 7b 7d roc send_file {}
1170: 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 53 4f 43 4b {. global SOCK
1180: 45 54 0a 20 20 73 65 74 20 6f 70 65 6e 66 69 6c ET. set openfil
1190: 65 20 5b 74 6b 5f 67 65 74 4f 70 65 6e 46 69 6c e [tk_getOpenFil
11a0: 65 5d 0a 20 20 69 66 20 7b 24 6f 70 65 6e 66 69 e]. if {$openfi
11b0: 6c 65 3d 3d 22 22 7d 20 72 65 74 75 72 6e 0a 20 le==""} return.
11c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 24 6f 70 set f [open $op
11d0: 65 6e 66 69 6c 65 5d 0a 20 20 66 63 6f 6e 66 69 enfile]. fconfi
11e0: 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 gure $f -transla
11f0: 74 69 6f 6e 20 62 69 6e 61 72 79 0a 20 20 73 65 tion binary. se
1200: 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 66 5d t data [read $f]
1210: 0a 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 69 66 . close $f. if
1220: 20 7b 24 3a 3a 50 52 49 56 41 54 45 7d 20 7b 0a {$::PRIVATE} {.
1230: 20 20 20 20 70 75 74 73 20 24 53 4f 43 4b 45 54 puts $SOCKET
1240: 20 5b 6c 69 73 74 20 70 72 69 76 61 74 65 5f 66 [list private_f
1250: 69 6c 65 20 5b 66 69 6c 65 20 74 61 69 6c 20 24 ile [file tail $
1260: 6f 70 65 6e 66 69 6c 65 5d 20 5b 65 6e 63 6f 64 openfile] [encod
1270: 65 20 24 64 61 74 61 5d 20 5c 0a 20 20 20 20 20 e $data] \.
1280: 20 20 20 5b 6c 69 73 74 20 64 61 6e 20 64 72 68 [list dan drh
1290: 5d 5d 0a 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 ]]. } else {.
12a0: 20 20 70 75 74 73 20 24 53 4f 43 4b 45 54 20 5b puts $SOCKET [
12b0: 6c 69 73 74 20 66 69 6c 65 20 5b 66 69 6c 65 20 list file [file
12c0: 74 61 69 6c 20 24 6f 70 65 6e 66 69 6c 65 5d 20 tail $openfile]
12d0: 5b 65 6e 63 6f 64 65 20 24 64 61 74 61 5d 5d 0a [encode $data]].
12e0: 20 20 7d 0a 20 20 66 6c 75 73 68 20 24 53 4f 43 }. flush $SOC
12f0: 4b 45 54 0a 20 20 73 65 74 20 74 69 6d 65 20 5b KET. set time [
1300: 63 6c 6f 63 6b 20 66 6f 72 6d 61 74 20 5b 63 6c clock format [cl
1310: 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 20 2d 66 6f ock seconds] -fo
1320: 72 6d 61 74 20 7b 25 48 3a 25 4d 7d 20 2d 67 6d rmat {%H:%M} -gm
1330: 74 20 31 5d 0a 20 20 2e 6d 73 67 2e 74 20 69 6e t 1]. .msg.t in
1340: 73 65 72 74 20 65 6e 64 20 22 5c 5b 24 74 69 6d sert end "\[$tim
1350: 65 5c 5d 20 73 65 6e 74 20 66 69 6c 65 20 5b 66 e\] sent file [f
1360: 69 6c 65 20 74 61 69 6c 20 24 6f 70 65 6e 66 69 ile tail $openfi
1370: 6c 65 5d 5c 0a 20 20 20 20 20 20 20 20 2d 20 5b le]\. - [
1380: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 string length $d
1390: 61 74 61 5d 20 62 79 74 65 73 5c 6e 22 20 6d 65 ata] bytes\n" me
13a0: 74 61 0a 20 20 2e 6d 73 67 2e 74 20 73 65 65 20 ta. .msg.t see
13b0: 65 6e 64 0a 7d 0a 0a 23 20 53 61 76 65 20 74 68 end.}..# Save th
13c0: 65 20 6e 61 6d 65 64 20 66 69 6c 65 20 74 6f 20 e named file to
13d0: 74 68 65 20 64 69 73 6b 2e 0a 23 0a 20 70 72 6f the disk..#. pro
13e0: 63 20 73 61 76 65 5f 66 69 6c 65 20 7b 66 69 6c c save_file {fil
13f0: 65 6e 61 6d 65 7d 20 7b 0a 20 20 67 6c 6f 62 61 ename} {. globa
1400: 6c 20 46 49 4c 45 53 0a 20 20 73 65 74 20 73 61 l FILES. set sa
1410: 76 65 66 69 6c 65 20 5b 74 6b 5f 67 65 74 53 61 vefile [tk_getSa
1420: 76 65 46 69 6c 65 20 2d 69 6e 69 74 69 61 6c 66 veFile -initialf
1430: 69 6c 65 20 24 66 69 6c 65 6e 61 6d 65 5d 0a 20 ile $filename].
1440: 20 69 66 20 7b 24 73 61 76 65 66 69 6c 65 3d 3d if {$savefile==
1450: 22 22 7d 20 72 65 74 75 72 6e 0a 20 20 73 65 74 ""} return. set
1460: 20 66 20 5b 6f 70 65 6e 20 24 73 61 76 65 66 69 f [open $savefi
1470: 6c 65 20 77 5d 0a 20 20 66 63 6f 6e 66 69 67 75 le w]. fconfigu
1480: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
1490: 6f 6e 20 62 69 6e 61 72 79 0a 20 20 70 75 74 73 on binary. puts
14a0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 5b -nonewline $f [
14b0: 64 65 63 6f 64 65 20 24 46 49 4c 45 53 28 24 66 decode $FILES($f
14c0: 69 6c 65 6e 61 6d 65 29 5d 0a 20 20 63 6c 6f 73 ilename)]. clos
14d0: 65 20 24 66 0a 7d 0a 0a 23 20 48 61 6e 64 6c 65 e $f.}..# Handle
14e0: 20 61 20 22 66 69 6c 65 22 20 6d 65 73 73 61 67 a "file" messag
14f0: 65 20 66 72 6f 6d 20 74 68 65 20 63 68 61 74 20 e from the chat
1500: 73 65 72 76 65 72 2e 0a 23 0a 70 72 6f 63 20 68 server..#.proc h
1510: 61 6e 64 6c 65 5f 66 69 6c 65 20 7b 66 72 6f 6d andle_file {from
1520: 20 66 69 6c 65 6e 61 6d 65 20 64 61 74 61 7d 20 filename data}
1530: 7b 0a 20 20 67 6c 6f 62 61 6c 20 46 49 4c 45 53 {. global FILES
1540: 0a 20 20 66 6f 72 65 61 63 68 20 70 72 69 6f 72 . foreach prior
1550: 20 5b 61 72 72 61 79 20 6e 61 6d 65 73 20 46 49 [array names FI
1560: 4c 45 53 5d 20 7b 0a 20 20 20 20 69 66 20 7b 24 LES] {. if {$
1570: 66 69 6c 65 6e 61 6d 65 3d 3d 24 70 72 69 6f 72 filename==$prior
1580: 7d 20 62 72 65 61 6b 0a 20 20 7d 0a 20 20 69 66 } break. }. if
1590: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
15a0: 70 72 69 6f 72 5d 20 7c 7c 20 24 66 69 6c 65 6e prior] || $filen
15b0: 61 6d 65 21 3d 24 70 72 69 6f 72 7d 20 7b 0a 20 ame!=$prior} {.
15c0: 20 20 20 2e 6d 62 2e 66 69 6c 65 73 20 61 64 64 .mb.files add
15d0: 20 63 6f 6d 6d 61 6e 64 20 2d 6c 61 62 65 6c 20 command -label
15e0: 22 53 61 76 65 20 5c 22 24 66 69 6c 65 6e 61 6d "Save \"$filenam
15f0: 65 5c 22 22 20 5c 0a 20 20 20 20 20 20 20 20 2d e\"" \. -
1600: 63 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 73 61 command [list sa
1610: 76 65 5f 66 69 6c 65 20 24 66 69 6c 65 6e 61 6d ve_file $filenam
1620: 65 5d 0a 20 20 7d 0a 20 20 73 65 74 20 46 49 4c e]. }. set FIL
1630: 45 53 28 24 66 69 6c 65 6e 61 6d 65 29 20 24 64 ES($filename) $d
1640: 61 74 61 0a 20 20 2e 6d 62 2e 66 69 6c 65 73 20 ata. .mb.files
1650: 65 6e 74 72 79 63 6f 6e 66 69 67 75 72 65 20 31 entryconfigure 1
1660: 20 2d 73 74 61 74 65 20 61 63 74 69 76 65 20 0a -state active .
1670: 20 20 73 65 74 20 74 69 6d 65 20 5b 63 6c 6f 63 set time [cloc
1680: 6b 20 66 6f 72 6d 61 74 20 5b 63 6c 6f 63 6b 20 k format [clock
1690: 73 65 63 6f 6e 64 73 5d 20 2d 66 6f 72 6d 61 74 seconds] -format
16a0: 20 7b 25 48 3a 25 4d 7d 20 2d 67 6d 74 20 31 5d {%H:%M} -gmt 1]
16b0: 0a 20 20 2e 6d 73 67 2e 74 20 69 6e 73 65 72 74 . .msg.t insert
16c0: 20 65 6e 64 20 22 5c 5b 24 74 69 6d 65 20 24 66 end "\[$time $f
16d0: 72 6f 6d 5c 5d 20 22 20 6d 65 74 61 20 22 46 69 rom\] " meta "Fi
16e0: 6c 65 3a 20 5c 22 24 66 69 6c 65 6e 61 6d 65 5c le: \"$filename\
16f0: 22 5c 6e 22 20 6e 6f 72 6d 0a 20 20 2e 6d 73 67 "\n" norm. .msg
1700: 2e 74 20 73 65 65 20 65 6e 64 0a 7d 0a 0a 23 20 .t see end.}..#
1710: 48 61 6e 64 6c 65 20 69 6e 70 75 74 20 66 72 6f Handle input fro
1720: 6d 20 74 68 65 20 73 65 72 76 65 72 0a 23 0a 70 m the server.#.p
1730: 72 6f 63 20 68 61 6e 64 6c 65 5f 69 6e 70 75 74 roc handle_input
1740: 20 7b 7d 20 7b 0a 20 20 67 6c 6f 62 61 6c 20 53 {} {. global S
1750: 4f 43 4b 45 54 0a 20 20 69 66 20 7b 5b 65 6f 66 OCKET. if {[eof
1760: 20 24 53 4f 43 4b 45 54 5d 7d 20 7b 0a 20 20 20 $SOCKET]} {.
1770: 20 64 69 73 63 6f 6e 6e 65 63 74 0a 20 20 20 20 disconnect.
1780: 72 65 74 75 72 6e 0a 20 20 7d 0a 20 20 73 65 74 return. }. set
1790: 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 53 4f 43 line [gets $SOC
17a0: 4b 45 54 5d 0a 20 20 69 66 20 7b 24 6c 69 6e 65 KET]. if {$line
17b0: 3d 3d 22 22 7d 20 72 65 74 75 72 6e 0a 20 20 73 ==""} return. s
17c0: 65 74 20 63 6d 64 20 5b 6c 69 6e 64 65 78 20 24 et cmd [lindex $
17d0: 6c 69 6e 65 20 30 5d 0a 20 20 69 66 20 7b 24 63 line 0]. if {$c
17e0: 6d 64 3d 3d 22 75 73 65 72 6c 69 73 74 22 7d 20 md=="userlist"}
17f0: 7b 0a 20 20 20 20 73 65 74 20 75 6c 69 73 74 20 {. set ulist
1800: 7b 7d 0a 20 20 20 20 66 6f 72 65 61 63 68 20 75 {}. foreach u
1810: 20 5b 6c 72 61 6e 67 65 20 24 6c 69 6e 65 20 31 [lrange $line 1
1820: 20 65 6e 64 5d 20 7b 0a 20 20 20 20 20 20 61 70 end] {. ap
1830: 70 65 6e 64 20 75 6c 69 73 74 20 24 75 5c 6e 0a pend ulist $u\n.
1840: 20 20 20 20 7d 0a 20 20 20 20 2e 77 68 6f 2e 6c }. .who.l
1850: 69 73 74 20 63 6f 6e 66 69 67 20 2d 74 65 78 74 ist config -text
1860: 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 20 24 75 [string trim $u
1870: 6c 69 73 74 5d 0a 20 20 7d 20 65 6c 73 65 69 66 list]. } elseif
1880: 20 7b 24 63 6d 64 3d 3d 22 6d 65 73 73 61 67 65 {$cmd=="message
1890: 22 7c 7c 24 63 6d 64 3d 3d 22 70 72 69 76 61 74 "||$cmd=="privat
18a0: 65 5f 6d 65 73 73 61 67 65 22 7d 20 7b 0a 20 20 e_message"} {.
18b0: 20 20 73 65 74 20 74 69 6d 65 20 5b 63 6c 6f 63 set time [cloc
18c0: 6b 20 66 6f 72 6d 61 74 20 5b 63 6c 6f 63 6b 20 k format [clock
18d0: 73 65 63 6f 6e 64 73 5d 20 2d 66 6f 72 6d 61 74 seconds] -format
18e0: 20 7b 25 48 3a 25 4d 7d 20 2d 67 6d 74 20 31 5d {%H:%M} -gmt 1]
18f0: 0a 20 20 20 20 73 65 74 20 66 72 6f 6d 20 5b 6c . set from [l
1900: 69 6e 64 65 78 20 24 6c 69 6e 65 20 31 5d 0a 20 index $line 1].
1910: 20 20 20 2e 6d 73 67 2e 74 20 69 6e 73 65 72 74 .msg.t insert
1920: 20 65 6e 64 20 22 5c 5b 24 74 69 6d 65 20 24 66 end "\[$time $f
1930: 72 6f 6d 5c 5d 20 22 20 6d 65 74 61 20 5b 6c 69 rom\] " meta [li
1940: 6e 64 65 78 20 24 6c 69 6e 65 20 32 5d 5c 6e 20 ndex $line 2]\n
1950: 6e 6f 72 6d 0a 20 20 20 20 2e 6d 73 67 2e 74 20 norm. .msg.t
1960: 73 65 65 20 65 6e 64 0a 20 20 20 20 62 65 6c 6c see end. bell
1970: 0a 20 20 20 20 77 6d 20 64 65 69 63 6f 6e 69 66 . wm deiconif
1980: 79 20 2e 0a 20 20 20 20 75 70 64 61 74 65 0a 20 y .. update.
1990: 20 20 20 72 61 69 73 65 20 2e 0a 20 20 7d 20 65 raise .. } e
19a0: 6c 73 65 69 66 20 7b 24 63 6d 64 3d 3d 22 6e 6f lseif {$cmd=="no
19b0: 6f 70 22 7d 20 7b 0a 20 20 20 20 23 20 64 6f 20 op"} {. # do
19c0: 6e 6f 74 68 69 6e 67 0a 20 20 7d 20 65 6c 73 65 nothing. } else
19d0: 69 66 20 7b 24 63 6d 64 3d 3d 22 6d 65 74 61 22 if {$cmd=="meta"
19e0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 6e 6f 77 20 } {. set now
19f0: 5b 63 6c 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 0a [clock seconds].
1a00: 20 20 20 20 73 65 74 20 74 69 6d 65 20 5b 63 6c set time [cl
1a10: 6f 63 6b 20 66 6f 72 6d 61 74 20 24 6e 6f 77 20 ock format $now
1a20: 2d 66 6f 72 6d 61 74 20 7b 25 48 3a 25 4d 7d 20 -format {%H:%M}
1a30: 2d 67 6d 74 20 31 5d 0a 20 20 20 20 2e 6d 73 67 -gmt 1]. .msg
1a40: 2e 74 20 69 6e 73 65 72 74 20 65 6e 64 20 22 5c .t insert end "\
1a50: 5b 24 74 69 6d 65 5c 5d 20 5b 6c 69 6e 64 65 78 [$time\] [lindex
1a60: 20 24 6c 69 6e 65 20 31 5d 5c 6e 22 20 6d 65 74 $line 1]\n" met
1a70: 61 0a 20 20 20 20 2e 6d 73 67 2e 74 20 73 65 65 a. .msg.t see
1a80: 20 65 6e 64 0a 20 20 7d 20 65 6c 73 65 69 66 20 end. } elseif
1a90: 7b 24 63 6d 64 3d 3d 22 66 69 6c 65 22 7c 7c 24 {$cmd=="file"||$
1aa0: 63 6d 64 3d 3d 22 70 72 69 76 61 74 65 5f 66 69 cmd=="private_fi
1ab0: 6c 65 22 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b le"} {. if {[
1ac0: 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 68 61 info commands ha
1ad0: 6e 64 6c 65 5f 66 69 6c 65 5d 3d 3d 22 68 61 6e ndle_file]=="han
1ae0: 64 6c 65 5f 66 69 6c 65 22 7d 20 7b 0a 20 20 20 dle_file"} {.
1af0: 20 20 20 68 61 6e 64 6c 65 5f 66 69 6c 65 20 5b handle_file [
1b00: 6c 69 6e 64 65 78 20 24 6c 69 6e 65 20 31 5d 20 lindex $line 1]
1b10: 5b 6c 69 6e 64 65 78 20 24 6c 69 6e 65 20 32 5d [lindex $line 2]
1b20: 20 5b 6c 69 6e 64 65 78 20 24 6c 69 6e 65 20 33 [lindex $line 3
1b30: 5d 0a 20 20 20 20 7d 0a 20 20 7d 0a 7d 20 20 20 ]. }. }.}
1b40: 20 0a 0a 23 20 48 61 6e 64 6c 65 20 61 20 62 72 ..# Handle a br
1b50: 6f 6b 65 6e 20 73 6f 63 6b 65 74 20 63 6f 6e 6e oken socket conn
1b60: 65 63 74 69 6f 6e 0a 23 0a 70 72 6f 63 20 64 69 ection.#.proc di
1b70: 73 63 6f 6e 6e 65 63 74 20 7b 7d 20 7b 0a 20 20 sconnect {} {.
1b80: 67 6c 6f 62 61 6c 20 53 4f 43 4b 45 54 0a 20 20 global SOCKET.
1b90: 63 6c 6f 73 65 20 24 53 4f 43 4b 45 54 0a 20 20 close $SOCKET.
1ba0: 73 65 74 20 71 20 5b 74 6b 5f 6d 65 73 73 61 67 set q [tk_messag
1bb0: 65 42 6f 78 20 2d 69 63 6f 6e 20 65 72 72 6f 72 eBox -icon error
1bc0: 20 2d 74 79 70 65 20 79 65 73 6e 6f 20 2d 70 61 -type yesno -pa
1bd0: 72 65 6e 74 20 2e 20 2d 6d 65 73 73 61 67 65 20 rent . -message
1be0: 5c 0a 20 20 20 20 20 20 20 20 20 20 20 22 54 43 \. "TC
1bf0: 50 2f 49 50 20 6c 69 6e 6b 20 6c 6f 73 74 2e 20 P/IP link lost.
1c00: 20 54 72 79 20 74 6f 20 72 65 63 6f 6e 6e 65 74 Try to reconnet
1c10: 3f 22 5d 0a 20 20 69 66 20 7b 24 71 3d 3d 22 79 ?"]. if {$q=="y
1c20: 65 73 22 7d 20 7b 0a 20 20 20 20 63 6f 6e 6e 65 es"} {. conne
1c30: 63 74 0a 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 ct. } else {.
1c40: 20 20 65 78 69 74 0a 20 20 7d 0a 7d 0a 0a 23 20 exit. }.}..#
1c50: 52 65 6d 6f 76 65 20 61 6c 6c 20 62 75 74 20 74 Remove all but t
1c60: 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 31 he most recent 1
1c70: 30 30 20 6d 65 73 73 61 67 65 20 66 72 6f 6d 20 00 message from
1c80: 74 68 65 20 6d 65 73 73 61 67 65 20 6c 6f 67 0a the message log.
1c90: 23 0a 70 72 6f 63 20 63 6c 65 61 6e 75 70 5f 72 #.proc cleanup_r
1ca0: 65 63 6f 72 64 20 7b 7d 20 7b 0a 20 20 2e 6d 73 ecord {} {. .ms
1cb0: 67 2e 74 20 64 65 6c 65 74 65 20 31 2e 30 20 7b g.t delete 1.0 {
1cc0: 65 6e 64 20 2d 31 30 30 20 6c 69 6e 65 73 7d 0a end -100 lines}.
1cd0: 7d 0a }.