home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / local / bin / greyboard < prev    next >
Encoding:
Tcl/Tk script  |  2004-07-23  |  34.9 KB  |  1,085 lines
  1. #!/usr/bin/wish
  2. # edit the line above, if wish is installed somewhere else. BK...
  3. set lib /usr/local/share/greyboard
  4. # edit the line above, if greyboard library is installed somewhere else
  5.  
  6. # greyboard v0.7, copyright (c) A.Grozin, 1995, 1997, 1999
  7. # GNU General Public License
  8.  
  9. global env host_name lib s_cur s_lst screen con_scr from_scr \
  10.     main_x main_y main_Y help_x help_y mode save_file undo undo_info \
  11.     col color bgcolor grey dark l_col r_col font bold italic size msg info \
  12.     obj o_lst o_num o_cur t_lst t_num foc_t x y t0 timeout \
  13.     allow_erase allow_erase_all allow_connect allow_disconnect allow_save \
  14.     text_left text_sig text_time \
  15.     c_allow_erase c_allow_erase_all c_allow_connect c_allow_disconnect c_allow_save \
  16.     c_text_left c_text_sig c_text_time c_board_width c_board_height c_board_number c_timeout
  17.  
  18. # screens
  19. set s_cur 0
  20. set s_lst {}
  21.  
  22. # colors
  23. set color(0) #ff0000
  24. set color(1) #00ff00
  25. set color(2) #0000ff
  26. set color(3) #ffff00
  27. set color(4) #ff00ff
  28. set color(5) #00ffff
  29. set color(6) #ffffff
  30. set color(7) #000000
  31. set bgcolor  #d9d9d9
  32. set grey     #808080
  33. set dark     #606060
  34.  
  35. # main window size
  36. set main_x 480
  37. set main_y 360
  38. set main_Y 720
  39.  
  40. # help window size
  41. set help_x 40
  42. set help_y 20
  43.  
  44. # messages
  45. set msg(0) {{Drag the mouse with left button to draw a curve}}
  46. set msg(1) {{Click the left button to start a broken line}}
  47. set msg(2) {{Click the left button to start a text}}
  48. set msg(3) {{Select an object to delete}}
  49. set msg(4) {{Click the left button for next segment, right - for last one}}
  50. set msg(5) {{Click the left button to delete the selected object}}
  51. set msg(6) {{Click the left button to set the text cursor}}
  52.  
  53. # beep timeout
  54. set timeout 60
  55.  
  56. # objects
  57. set o_num 0
  58. set o_lst {}
  59. set t_num 0
  60. set t_lst {}
  61.  
  62. set save_file "gb.ps"
  63.  
  64. proc win {} {
  65.     global s_cur s_lst env screen con_scr mode col color bgcolor grey dark\
  66.     font bold italic size lib undo main_x main_y main_Y from_scr host_name t0
  67.     set s $s_cur
  68.     if [catch {set host_name greyboard@$env(HOSTNAME)}] {set host_name greyboard}
  69.  
  70.     if {$s==0} {
  71.     wm title . $host_name
  72.     frame .a0
  73.     pack .a0
  74.         set t0 [clock seconds]
  75.     } else {
  76.     if [catch "toplevel .a$s -screen $con_scr"] {Err_con $from_scr; return}
  77.     wm title .a$s $host_name
  78.     }
  79.  
  80.     # menu
  81.     # ----
  82.     frame .a$s.menu
  83.     pack .a$s.menu -side top -fill x
  84.  
  85.     set m .a$s.menu.file.menu
  86.     menubutton .a$s.menu.file -text "File" -underline 0 \
  87.         -menu .a$s.menu.file.menu -bd 4 -relief raised
  88.     menu $m -tearoff 0 -disabledforeground $dark
  89.     $m add command -label "Connect..." -underline 0 -command "Connect $s"
  90.     $m add command -label "Save..." -underline 0 -command "Save $s"
  91.     $m add command -label "List..." -underline 0 -command "List $s"
  92.     $m add command -label "Exit" -underline 1 -command "Exit $s"
  93.  
  94.     set m .a$s.menu.edit.menu
  95.     menubutton .a$s.menu.edit -text "Edit" -underline 0 \
  96.         -menu .a$s.menu.edit.menu -bd 4 -relief raised
  97.     menu $m -tearoff 0 -disabledforeground $dark
  98.     $m add command -label "Undo" -underline 0 -command "Undo $s"
  99.     $m add command -label "More space" -underline 0 -command "More"
  100.     $m add command -label "Beep" -underline 0 -command "Beep $s"
  101.     $m add command -label "Clear all" -underline 6 -command "Clear $s"
  102.  
  103.     set m .a$s.menu.options.menu
  104.     menubutton .a$s.menu.options -text Options -underline 0 \
  105.         -menu .a$s.menu.options.menu -bd 4 -relief raised
  106.     menu $m -tearoff 0 -disabledforeground $dark
  107.     if {$s==0} { $m add command -label "Configuration..." -command "Config"
  108.         $m add separator
  109.     }
  110.     $m add radiobutton -label "Times"     -underline 0 -variable font($s) -value 0
  111.     $m add radiobutton -label "Helvetica" -underline 0 -variable font($s) -value 1
  112.     $m add radiobutton -label "Courier"   -underline 0 -variable font($s) -value 2
  113.     $m add separator
  114.     $m add checkbutton -label "Bold"   -underline 0 -variable bold($s)
  115.     $m add checkbutton -label "Italic" -underline 0 -variable italic($s)
  116.     $m add separator
  117.     $m add radiobutton -label "10" -underline 0 -variable size($s) -value 10
  118.     $m add radiobutton -label "12" -underline 0 -variable size($s) -value 12
  119.     $m add radiobutton -label "14" -underline 0 -variable size($s) -value 14
  120.     $m add radiobutton -label "18" -underline 0 -variable size($s) -value 18
  121.     $m add radiobutton -label "24" -underline 0 -variable size($s) -value 24
  122.     set bold($s) 0
  123.     set italic($s) 0
  124.     if {$s==0} {
  125.         $m invoke 3
  126.         $m invoke 11
  127.     } else {
  128.         $m invoke 1
  129.         $m invoke 9
  130.     }
  131.  
  132.     button .a$s.menu.help -text Help -underline 0 \
  133.         -command "Help $s" -bd 4 -relief raised
  134.     pack .a$s.menu.file .a$s.menu.edit .a$s.menu.options \
  135.         -side left -padx 4 -pady 4
  136.     pack .a$s.menu.help -side right -padx 4 -pady 4
  137.  
  138.     # tool bar
  139.     # --------
  140.     label .a$s.status -anchor w
  141.     frame .a$s.tool
  142.     pack .a$s.status -side bottom -fill x
  143.     pack .a$s.tool -side bottom -fill x
  144.     radiobutton .a$s.tool.curve -bitmap @$lib/curve -underline 0 -disabledforeground $dark \
  145.         -variable mode($s) -value 0 -command "Mode $s" \
  146.         -bd 4 -indicatoron 0 -selectcolor $bgcolor
  147.     radiobutton .a$s.tool.line -bitmap @$lib/line -underline 0 -disabledforeground $dark \
  148.         -variable mode($s) -value 1 -command "Mode $s" \
  149.         -bd 4 -indicatoron 0 -selectcolor $bgcolor
  150.     radiobutton .a$s.tool.text -bitmap @$lib/text -underline 0 -disabledforeground $dark \
  151.         -variable mode($s) -value 2 -command "Mode $s" \
  152.         -bd 4 -indicatoron 0 -selectcolor $bgcolor
  153.     radiobutton .a$s.tool.del -bitmap @$lib/delete -underline 0 -disabledforeground $dark \
  154.         -variable mode($s) -value 3 -command "Mode $s" \
  155.         -bd 4 -indicatoron 0 -selectcolor $bgcolor
  156.     pack .a$s.tool.curve .a$s.tool.line .a$s.tool.text .a$s.tool.del \
  157.         -side left -padx 4 -pady 4
  158.     set mode($s) 0
  159.     bind .a$s.tool.curve <Enter> ".a$s.status configure \
  160.         -text {Draw curves with mouse}"
  161.     bind .a$s.tool.curve <Any-Leave> ".a$s.status configure \
  162.         -text {}"
  163.     bind .a$s.tool.line <Enter> ".a$s.status configure \
  164.         -text {Draw broken straight lines with mouse}"
  165.     bind .a$s.tool.line <Any-Leave> ".a$s.status configure \
  166.         -text {}"
  167.     bind .a$s.tool.text <Enter> ".a$s.status configure \
  168.         -text {Type texts with keyboard}"
  169.     bind .a$s.tool.text <Any-Leave> ".a$s.status configure \
  170.         -text {}"
  171.     bind .a$s.tool.del <Enter> ".a$s.status configure \
  172.         -text {Delete objects with mouse}"
  173.     bind .a$s.tool.del <Any-Leave> ".a$s.status configure \
  174.         -text {}"
  175.  
  176.     # canvas
  177.     # ------
  178.     scrollbar .a$s.scroll -command ".a$s.c yview"
  179.     pack .a$s.scroll -side right -fill y
  180.     frame .a$s.color
  181.     pack .a$s.color -side left -fill y
  182.     for {set c 0} {$c<8} {incr c} {
  183.     radiobutton .a$s.color.c$c -bitmap @$lib/f16x16 \
  184.         -fg $color($c) -activeforeground $color($c) \
  185.         -variable col($s) -value $c -command "Curs $s"\
  186.         -bd 4 -indicatoron 0 -selectcolor $bgcolor
  187.     pack .a$s.color.c$c -side top -padx 4 -pady 4
  188.     }
  189.     set col($s) [expr $s % 8]
  190.     canvas .a$s.c -bd 4 -relief sunken -width $main_x -height $main_y -bg $grey \
  191.         -scrollregion "0 0 $main_x $main_Y" -yscrollcommand ".a$s.scroll set" \
  192.         -yscrollincrement 8
  193.     pack .a$s.c -expand yes -fill both
  194.     bind .a$s.c <Any-Leave> ".a$s.status configure -text {}"
  195.  
  196.     focus .a$s.c
  197.     bind .a$s.c <Prior> ".a$s.c yview scroll -1 page"
  198.     bind .a$s.c <Next>  ".a$s.c yview scroll  1 page"
  199.     bind .a$s.c <Up>    ".a$s.c yview scroll -1 unit"
  200.     bind .a$s.c <Down>  ".a$s.c yview scroll  1 unit"
  201.     bind .a$s.c <Alt-h> "Help $s"
  202.     bind .a$s.c <Alt-c> "Connect $s"
  203.     bind .a$s.c <Alt-s> "Save $s"
  204.     bind .a$s.c <Alt-l> "List $s"
  205.     bind .a$s.c <Alt-x> "after idle Exit $s"
  206.     bind .a$s.c <Alt-u> "Undo $s"
  207.     bind .a$s.c <Alt-m> "More"
  208.     bind .a$s.c <Alt-Return> "More"
  209.     bind .a$s.c <Alt-b> "Beep $s"
  210.     bind .a$s.c <Alt-a> "Clear $s"
  211.     Mode $s
  212.     lappend s_lst $s
  213.     set screen($s) $con_scr
  214.     incr s_cur
  215.     set undo($s) 0
  216. }
  217.  
  218. proc Connect s {
  219.     global screen con_scr from_scr
  220.     set from_scr $s
  221.     catch {destroy .con$s}
  222.     catch {destroy .err$s}
  223.     toplevel .con$s -screen $screen($s)
  224.     wm title .con$s "Connect"
  225.     frame .con$s.up
  226.     frame .con$s.down
  227.     pack .con$s.up -side top
  228.     pack .con$s.down -side bottom -fill x
  229.     label .con$s.up.label -text "Connect to "
  230.     entry .con$s.up.entry -textvar con_scr -bd 4 -relief sunken
  231.     pack .con$s.up.label .con$s.up.entry -side left -padx 4 -pady 4
  232.     button .con$s.down.ok -text "OK" -bd 4 -relief raised \
  233.         -command "win; destroy .con$s; return"
  234.     button .con$s.down.cancel -text "Cancel" -bd 4 -relief raised \
  235.         -command "destroy .con$s; return"
  236.     pack .con$s.down.ok -side left
  237.     pack .con$s.down.cancel -side right
  238.     focus .con$s.up.entry 
  239.     bind .con$s.up.entry <Return> ".con$s.down.ok invoke"
  240.     bind .con$s.up.entry <Escape> ".con$s.down.cancel invoke"
  241. }
  242.  
  243. proc Err_con s {
  244.     global screen con_scr
  245.     catch {destroy .con$s}
  246.     catch {destroy .err$s}
  247.     toplevel .err$s -screen $screen($s)
  248.     wm title .err$s "Error"
  249.     frame .err$s.up
  250.     pack .err$s.up -side top -fill x
  251.     button .err$s.up.ok -text "Close" -bd 4 -relief raised \
  252.         -command "destroy .err$s; return"
  253.     pack .err$s.up.ok -side left
  254.     label .err$s.down -text "Can't connect to $con_scr"
  255.     pack .err$s.down -side bottom
  256.     focus .err$s.up.ok
  257.     bind .err$s.up.ok <Return> ".err$s.up.ok invoke"
  258.     bind .err$s.up.ok <Escape> ".err$s.up.ok invoke"
  259. }
  260.  
  261. proc Help s {
  262.     global screen lib help_x help_y
  263.     catch {destroy .help$s}
  264.     toplevel .help$s -screen $screen($s)
  265.     wm title .help$s "Help"
  266.     frame .help$s.up
  267.     pack .help$s.up -side top -fill x
  268.     button .help$s.up.ok -text "Close" -bd 4 -relief raised \
  269.         -command "destroy .help$s; return"
  270.     pack .help$s.up.ok -side left
  271.     text .help$s.text -bd 4 -relief sunken -height $help_y -width $help_x \
  272.         -yscrollcommand ".help$s.scroll set"
  273.     scrollbar .help$s.scroll -command ".help$s.text yview"
  274.     pack .help$s.scroll -side right -fill y
  275.     pack .help$s.text -expand yes -fill both
  276.     set file [open "$lib/help" r]
  277.     .help$s.text insert 0.0 [read $file]
  278.     close $file
  279.     focus .help$s
  280.     bind .help$s <Return> ".help$s.up.ok invoke"
  281.     bind .help$s <Escape> ".help$s.up.ok invoke"
  282. }
  283.  
  284. proc Save s {
  285.     global screen save_file
  286.     catch {destroy .save$s}
  287.     toplevel .save$s -screen $screen($s)
  288.     wm title .save$s "Save"
  289.     frame .save$s.up
  290.     frame .save$s.down
  291.     pack .save$s.up -side top
  292.     pack .save$s.down -side bottom -fill x
  293.     label .save$s.up.label -text "Save as "
  294.     entry .save$s.up.entry -textvar save_file -bd 4 -relief sunken
  295.     pack .save$s.up.label .save$s.up.entry -side left -padx 4 -pady 4
  296.     button .save$s.down.ok -text "OK" -bd 4 -relief raised \
  297.         -command "Save_file $s"
  298.     button .save$s.down.cancel -text "Cancel" -bd 4 -relief raised \
  299.         -command "destroy .save$s; return"
  300.     pack .save$s.down.ok -side left
  301.     pack .save$s.down.cancel -side right
  302.     focus .save$s.up.entry
  303.     bind .save$s.up.entry <Return> ".save$s.down.ok invoke"
  304.     bind .save$s.up.entry <Escape> ".save$s.down.cancel invoke"
  305. }
  306.  
  307. proc Save_file s {
  308.     global save_file
  309.     .a$s.c postscript -file $save_file
  310.     destroy .save$s
  311. }
  312.  
  313. proc List s {
  314.     global screen s_lst col color grey
  315.     set lmax 0
  316.     foreach s1 $s_lst {
  317.         set l [string length $screen($s1)]
  318.         if {$l > $lmax} {set lmax $l}
  319.     }
  320.     set n [llength $s_lst]
  321.     catch {destroy .lst$s}
  322.     toplevel .lst$s -screen $screen($s)
  323.     wm title .lst$s "List"
  324.     frame .lst$s.up
  325.     pack .lst$s.up -side top -fill x
  326.     button .lst$s.up.ok -text "Close" -bd 4 -relief raised \
  327.         -command "destroy .lst$s; return"
  328.     pack .lst$s.up.ok -side left
  329.     entry .lst$s.inp -bd 4 -relief sunken -bg $grey -fg $color($col($s))
  330.     pack .lst$s.inp -side bottom
  331.     frame .lst$s.txt
  332.     pack .lst$s.txt -side bottom
  333.     label .lst$s.txt.label -text "Send message "
  334.     pack .lst$s.txt.label -side left
  335.     button .lst$s.txt.button -text "To all" -bd 4 -relief raised \
  336.         -command "Send_all $s"
  337.     pack .lst$s.txt.button -side right
  338.     text .lst$s.down -bd 4 -relief sunken -bg $grey -fg $color($col($s)) -height $n -width $lmax
  339.     set delim ""
  340.     foreach s1 $s_lst {
  341.         .lst$s.down insert end $delim l$s1 $screen($s1) l$s1
  342.         .lst$s.down tag configure l$s1 -foreground $color($col($s1))
  343.         .lst$s.down tag bind l$s1 <1> "Send $s $s1"
  344.         .lst$s.down tag bind l$s1 <Return> "Send $s $s1"
  345.         set delim "\n"
  346.     }
  347.     pack .lst$s.down -side left
  348.     focus .lst$s.inp
  349.     bind .lst$s.inp <Return> ".lst$s.txt.button invoke"
  350.     bind .lst$s.inp <Escape> ".lst$s.up.ok invoke"
  351.     bind .lst$s.down <Escape> ".lst$s.up.ok invoke"
  352. }
  353.  
  354. proc Send {s s1} {
  355.     set message [.lst$s.inp get]
  356.     if {$message==""} {
  357.         bell -displayof .a$s1
  358.     } else {
  359.         Msg $s $s1 $message
  360.     }
  361.     set message {}
  362. }
  363.  
  364. proc Send_all s {
  365.     global s_lst
  366.     set message [.lst$s.inp get]
  367.     if {$message==""} {
  368.         Beep $s
  369.     } else {
  370.         foreach s1 $s_lst {if {$s1!=$s} {Msg $s $s1 $message}}
  371.     }
  372.     set message {}
  373. }
  374.  
  375. proc Msg {s s1 message} {
  376.     global screen grey col color
  377.     catch {destroy .msg$s1}
  378.     toplevel .msg$s1 -screen $screen($s1)
  379.     wm title .msg$s1 "Message"
  380.     frame .msg$s1.up
  381.     pack .msg$s1.up -side top
  382.     button .msg$s1.up.button -text "Close" -bd 4 -relief raised \
  383.         -command "destroy .msg$s1; return"
  384.     pack .msg$s1.up.button -side left
  385.     label .msg$s1.up.label -bg red -fg white -text "Message from $screen($s)"
  386.     pack .msg$s1.up.label -side right
  387.     label .msg$s1.down -bg $grey -fg $color($col($s)) -relief sunken -bd 4 \
  388.         -text $message
  389.     pack .msg$s1.down -side left
  390.     focus .msg$s1.up.button
  391.     bind .msg$s1.up.button <Return> ".msg$s1.up.button invoke"
  392.     bind .msg$s1.up.button <Escape> ".msg$s1.up.button invoke"
  393.     bell -displayof .a$s1
  394. }
  395.  
  396. proc Exit s {
  397.     global s_lst
  398.     if {$s==0} {exit} else {
  399.     destroy .a$s
  400.     set i [lsearch -exact $s_lst $s]
  401.     set s_lst [lreplace $s_lst $i $i]
  402.     }
  403. }
  404.  
  405. proc Config {} {
  406.     global screen \
  407.         c_allow_erase c_allow_erase_all c_allow_connect c_allow_disconnect c_allow_save \
  408.         c_text_left c_text_sig c_text_time c_board_width c_board_height c_board_number c_timeout
  409.     catch {destroy .cnf}
  410.     toplevel .cnf -screen $screen(0)
  411.     wm title .cnf "Configuration"
  412.     # buttons
  413.     frame .cnf.down
  414.     pack .cnf.down -side bottom -fill x
  415.     button .cnf.down.close -bd 4 -relief raised -text "Close" \
  416.         -command "destroy .cnf; return"
  417.     button .cnf.down.apply -bd 4 -relief raised -text "Apply" \
  418.         -command "Config_all"
  419.     button .cnf.down.save -bd 4 -relief raised -text "Save" \
  420.         -command "Config_save"
  421.     button .cnf.down.restore -bd 4 -relief raised -text "Restore" \
  422.         -command "Config_restore"
  423.     pack .cnf.down.close .cnf.down.apply -side left -padx 4 -pady 4 -anchor w
  424.     pack .cnf.down.restore .cnf.down.save -side right -padx 4 -pady 4 -anchor e
  425.     # Allow others
  426.     frame .cnf.allow -bd 4 -relief sunken
  427.     pack .cnf.allow -side left -padx 4 -pady 4
  428.     label .cnf.allow.label -anchor w -text "Allow others to"
  429.     checkbutton .cnf.allow.erase -bd 4 -relief raised -text "Erase" \
  430.         -variable c_allow_erase
  431.     checkbutton .cnf.allow.erase_all -bd 4 -relief raised -text "Erase all" \
  432.         -variable c_allow_erase_all
  433.     checkbutton .cnf.allow.connect -bd 4 -relief raised -text "Connect" \
  434.         -variable c_allow_connect
  435.     checkbutton .cnf.allow.disconnect -bd 4 -relief raised -text "Disconnect" \
  436.         -variable c_allow_disconnect
  437.     checkbutton .cnf.allow.save -bd 4 -relief raised -text "Save" \
  438.         -variable c_allow_save
  439.     pack .cnf.allow.label .cnf.allow.erase .cnf.allow.erase_all \
  440.         .cnf.allow.connect .cnf.allow.disconnect .cnf.allow.save \
  441.         -side top -padx 4 -pady 4 -anchor w
  442.     # Texts
  443.     frame .cnf.text -bd 4 -relief sunken
  444.     pack .cnf.text -side left -padx 4 -pady 4 -anchor n
  445.     label .cnf.text.label -anchor w -text "Texts"
  446.     checkbutton .cnf.text.left -bd 4 -relief raised -text "Start at the left" \
  447.         -variable c_text_left
  448.     checkbutton .cnf.text.sig -bd 4 -relief raised -text "Insert signature" \
  449.         -variable c_text_sig
  450.     checkbutton .cnf.text.time -bd 4 -relief raised -text "Insert time" \
  451.         -variable c_text_time
  452.     pack .cnf.text.label .cnf.text.left .cnf.text.sig .cnf.text.time \
  453.         -side top -padx 4 -pady 4 -anchor w
  454.     # Board geometry
  455.     frame .cnf.inp -bd 4 -relief flat
  456.     pack .cnf.inp -side right -padx 4 -pady 4 -anchor n
  457.     entry .cnf.inp.width -bd 4 -relief sunken -width 5 -textvar c_board_width
  458.     entry .cnf.inp.height -bd 4 -relief sunken -width 5 -textvar c_board_height
  459.     entry .cnf.inp.number -bd 4 -relief sunken -width 5 -textvar c_board_number
  460.     entry .cnf.inp.time -bd 4 -relief sunken -width 5 -textvar c_timeout
  461.     pack .cnf.inp.width .cnf.inp.height .cnf.inp.number .cnf.inp.time \
  462.         -side top -padx 4 -pady 4 -anchor w
  463.     frame .cnf.lab -bd 4 -relief flat
  464.     pack .cnf.lab -side right -padx 4 -pady 4 -anchor n
  465.     label .cnf.lab.width -bd 4 -relief flat -text "Board width"
  466.     label .cnf.lab.height -bd 4 -relief flat -text "Board height"
  467.     label .cnf.lab.number -bd 4 -relief flat -text "Board number"
  468.     label .cnf.lab.time -bd 4 -relief flat -text "Beep timeout"
  469.     pack .cnf.lab.width .cnf.lab.height .cnf.lab.number .cnf.lab.time \
  470.         -side top -padx 4 -pady 5 -anchor w
  471.     # keyboard bindings
  472.     focus .cnf.inp.width
  473.     bind .cnf.inp.width <Return> ".cnf.down.apply invoke"
  474.     bind .cnf.inp.width <Escape> ".cnf.down.close invoke"
  475.     bind .cnf.inp.height <Return> ".cnf.down.apply invoke"
  476.     bind .cnf.inp.height <Escape> ".cnf.down.close invoke"
  477.     bind .cnf.inp.number <Return> ".cnf.down.apply invoke"
  478.     bind .cnf.inp.number <Escape> ".cnf.down.close invoke"
  479.     bind .cnf.inp.time <Return> ".cnf.down.apply invoke"
  480.     bind .cnf.inp.time <Escape> ".cnf.down.close invoke"
  481. }
  482.  
  483. proc Config_restore {} {
  484.     global env lib \
  485.         c_allow_erase c_allow_erase_all c_allow_connect c_allow_disconnect c_allow_save \
  486.         c_text_left c_text_sig c_text_time c_board_width c_board_height c_board_number c_timeout
  487.     if [file exists "$env(HOME)/.greyboardrc"] {
  488.         source "$env(HOME)/.greyboardrc"
  489.     } else {
  490.         source "$lib/greyboardrc"
  491.     }
  492. }
  493.  
  494. proc Config_save {} {
  495.     global env \
  496.         c_allow_erase c_allow_erase_all c_allow_connect c_allow_disconnect c_allow_save \
  497.         c_text_left c_text_sig c_text_time c_board_width c_board_height c_board_number c_timeout
  498.     if [Config_check] { bell; return }
  499.     set file [open "$env(HOME)/.greyboardrc" w]
  500.     puts $file "set c_allow_erase $c_allow_erase"
  501.     puts $file "set c_allow_erase_all $c_allow_erase_all"
  502.     puts $file "set c_allow_connect $c_allow_connect"
  503.     puts $file "set c_allow_disconnect $c_allow_disconnect"
  504.     puts $file "set c_allow_save $c_allow_save"
  505.     puts $file "set c_text_left $c_text_left"
  506.     puts $file "set c_text_sig $c_text_sig"
  507.     puts $file "set c_text_time $c_text_time"
  508.     puts $file "set c_board_width $c_board_width"
  509.     puts $file "set c_board_height $c_board_height"
  510.     puts $file "set c_board_number $c_board_number"
  511.     puts $file "set c_timeout $c_timeout"
  512.     close $file
  513. }
  514.  
  515. proc Config_check {} {
  516.     global c_board_width c_board_height c_board_number c_timeout
  517.     if {![regexp {^[0-9]+$} $c_board_width]} {return 1}
  518.     if {![regexp {^[0-9]+$} $c_board_height]} {return 1}
  519.     if {![regexp {^[0-9]+$} $c_board_number]} {return 1}
  520.     if {![regexp {^[0-9]+$} $c_timeout]} {return 1}
  521.     if {[string length $c_board_width]>5} {return 1}
  522.     if {[string length $c_board_height]>5} {return 1}
  523.     if {[string length $c_board_number]>5} {return 1}
  524.     if {[string length $c_timeout]>5} {return 1}
  525.     if {$c_board_number==0} {return 1}
  526.     return 0
  527. }
  528.  
  529. proc Config_all {} {
  530.     global s_lst mode main_x main_y main_Y timeout \
  531.         allow_erase allow_erase_all allow_connect allow_disconnect allow_save \
  532.         text_left text_sig text_time \
  533.         c_allow_erase c_allow_erase_all c_allow_connect c_allow_disconnect c_allow_save \
  534.         c_text_left c_text_sig c_text_time c_board_width c_board_height c_board_number c_timeout
  535.     if [Config_check] { bell; return }
  536.     # has geometry changed?
  537.     set geom 0
  538.     set c_board_Height [expr $c_board_height*$c_board_number]
  539.     if {$c_board_width!=$main_x} {set geom 1}
  540.     if {$c_board_height!=$main_y} {set geom 1}
  541.     if {$c_board_Height!=$main_Y} {set geom 1}
  542.     set main_x $c_board_width
  543.     set main_y $c_board_height
  544.     set main_Y $c_board_Height
  545.     set text_left $c_text_left
  546.     set text_sig $c_text_sig
  547.     set text_time $c_text_time
  548.     set timeout $c_timeout
  549.     set allow_erase $c_allow_erase
  550.     set allow_erase_all $c_allow_erase_all
  551.     set allow_connect $c_allow_connect
  552.     set allow_disconnect $c_allow_disconnect
  553.     set allow_save $c_allow_save
  554.     # configuring all windows
  555.     foreach s1 $s_lst {
  556.         if {$geom} {
  557.             .a$s1.c configure -width $main_x -height $main_y -scrollregion "0 0 $main_x $main_Y"
  558.         }
  559.         if {$s1!=0} {
  560.             set m .a$s1.menu.file.menu
  561.             if {$allow_connect} {
  562.                 $m entryconfigure 0 -state normal
  563.                 bind .a$s1.c <Alt-c> "Connect $s1"
  564.             } else {
  565.                 $m entryconfigure 0 -state disabled
  566.                 bind .a$s1.c <Alt-c> {}
  567.             }
  568.             if {$allow_save} {
  569.                 $m entryconfigure 1 -state normal
  570.                 bind .a$s1.c <Alt-s> "Save $s1"
  571.             } else {
  572.                 $m entryconfigure 1 -state disabled
  573.                 bind .a$s1.c <Alt-s> {}
  574.             }
  575.             if {$allow_disconnect} {
  576.                 $m entryconfigure 3 -state normal
  577.                 bind .a$s1.c <Alt-x> "after idle Exit $s1"
  578.             } else {
  579.                 $m entryconfigure 3 -state disabled
  580.                 bind .a$s1.c <Alt-x> {}
  581.             }
  582.             set m .a$s1.menu.edit.menu
  583.             if {$allow_erase_all} {
  584.                 $m entryconfigure 3 -state normal
  585.                 bind .a$s1.c <Alt-a> "Clear $s1"
  586.             } else {
  587.                 $m entryconfigure 3 -state disabled
  588.                 bind .a$s1.c <Alt-a> {}
  589.             }
  590.             if {$allow_erase} {
  591.                 .a$s1.tool.del configure -state normal
  592.             } else {
  593.                 if {$mode($s1)==3} {
  594.                     set mode($s1) 0
  595.                     Mode $s1
  596.                 }
  597.                 .a$s1.tool.del configure -state disabled
  598.             }
  599.         }
  600.     }
  601. }
  602.  
  603. proc Mode s {
  604.     global mode msg info o_lst t_lst
  605.     set mods $mode($s)
  606.     set info($s) $msg($mods)
  607.     bind .a$s.c <Enter> ".a$s.status configure -text $info($s)"
  608.     Curs $s
  609.     foreach o $o_lst {
  610.     .a$s.c bind o$o <Enter> {}
  611.     .a$s.c bind o$o <Any-Leave> {}
  612.     .a$s.c bind o$o <1> {}
  613.     }
  614.     foreach t $t_lst {
  615.     .a$s.c bind t$t <Enter> {}
  616.     .a$s.c bind t$t <Any-Leave> {}
  617.     .a$s.c bind t$t <1> {}
  618.     }
  619.     set c .a$s.c
  620.     catch {$c delete cur$s}
  621.     bind $c <Motion> {}
  622.     switch $mode($s) \
  623.     0 {bind $c <1> "Curve0 $s %x %y"
  624.            bind $c <B1-Motion> "Curve1 $s %x %y"
  625.            bind $c <ButtonRelease-1> "Curve2 $s %x %y"
  626.            bind $c <3> ""} \
  627.     1 {bind $c <1> "Line0 $s %x %y"
  628.            bind $c <B1-Motion> ""
  629.            bind $c <ButtonRelease-1> {}
  630.            bind $c <3> ""} \
  631.         2 {Text $s} \
  632.         3 {Delete $s}
  633. }
  634.  
  635. proc Curs {s} {
  636.     global mode col color lib
  637.     set mods $mode($s)
  638.     set cols $col($s)
  639.     .a$s.c configure -cursor "@$lib/curs$mods $color($cols)"
  640. }
  641.  
  642. proc Curve0 {s x0 y0} {
  643.     global x y o_num o_cur o_lst obj
  644.     set x($s) $x0
  645.     set y($s) [.a$s.c canvasy $y0]
  646.     set o_cur($s) $o_num
  647.     lappend o_lst $o_num
  648.     set obj($s) $o_num
  649.     incr o_num
  650. }
  651.  
  652. proc Curve1 {s x1 y1} {
  653.     global x y col o_cur
  654.     set y1 [.a$s.c canvasy $y1]
  655.     seg $x($s) $y($s) $x1 $y1 $col($s) $o_cur($s)
  656.     set x($s) $x1
  657.     set y($s) $y1
  658. }
  659.  
  660. proc Curve2 {s x1 y1} {
  661.     global obj s_lst mode undo undo_info t0 timeout
  662.     set o $obj($s)
  663.     set undo($s) 1
  664.     set undo_info($s) $o
  665.     foreach s1 $s_lst {
  666.     if {$mode($s1)==3} {
  667.             .a$s1.c bind o$o <Enter> "o_enter $s1 $o"
  668.         .a$s1.c bind o$o <Any-Leave> "o_leave $s1 $o"
  669.             .a$s1.c bind o$o <1> "o_delete $s1 $o"
  670.         }
  671.     }
  672.     set t1 [clock seconds]
  673.     if {$t1-$t0>$timeout} {Beep $s}
  674.     set t0 $t1
  675. }
  676.  
  677. proc Line0 {s x0 y0} {
  678.     global x y info msg col l_col o_num o_cur o_lst obj
  679.     set x($s) $x0
  680.     set y($s) [.a$s.c canvasy $y0]
  681.     set l_col($s) $col($s)
  682.     bind .a$s.c <1> "Line1 $s %x %y"
  683.     bind .a$s.c <3> "Line2 $s %x %y"
  684.     bind .a$s.c <Motion> "Line3 $s %x %y"
  685.     set info($s) $msg(4)
  686.     eval .a$s.status configure -text $info($s)
  687.     bind .a$s.c <Enter> "Line3 $s %x %y; .a$s.status configure -text $info($s)"
  688.     bind .a$s.c <Any-Leave> "catch {.a$s.c delete cur$s};
  689.         .a$s.status configure -text {}"
  690.     set o_cur($s) $o_num
  691.     lappend o_lst $o_num
  692.     set obj($s) $o_num
  693.     incr o_num
  694. }
  695.  
  696. proc Line1 {s x1 y1} {
  697.     global x y l_col o_cur
  698.     set y1 [.a$s.c canvasy $y1]
  699.     seg $x($s) $y($s) $x1 $y1 $l_col($s) $o_cur($s)
  700.     set x($s) $x1
  701.     set y($s) $y1
  702. }
  703.  
  704. proc Line2 {s x1 y1} {
  705.     global x y l_col msg info o_cur s_lst mode obj undo undo_info t0 timeout
  706.     set y1 [.a$s.c canvasy $y1]
  707.     catch {.a$s.c delete cur$s}
  708.     seg $x($s) $y($s) $x1 $y1 $l_col($s) $o_cur($s)
  709.     bind .a$s.c <1> "Line0 $s %x %y"
  710.     bind .a$s.c <3> ""
  711.     bind .a$s.c <Motion> {}
  712.     set info($s) $msg(1)
  713.     eval .a$s.status configure -text $info($s)
  714.     bind .a$s.c <Enter> ".a$s.status configure -text $info($s)"
  715.     bind .a$s.c <Any-Leave> ".a$s.status configure -text {}"
  716.     set o $obj($s)
  717.     set undo($s) 1
  718.     set undo_info($s) $o
  719.     foreach s1 $s_lst {
  720.     if {$mode($s1)==3} {
  721.             .a$s1.c bind o$o <Enter> "o_enter $s1 $o"
  722.         .a$s1.c bind o$o <Any-Leave> "o_leave $s1 $o"
  723.             .a$s1.c bind o$o <1> "o_delete $s1 $o"
  724.         }
  725.     }
  726.     set t1 [clock seconds]
  727.     if {$t1-$t0>$timeout} {Beep $s}
  728.     set t0 $t1
  729. }
  730.  
  731. proc Line3 {s x1 y1} {
  732.     global x y l_col color
  733.     set y1 [.a$s.c canvasy $y1]
  734.     catch {.a$s.c delete cur$s}
  735.     .a$s.c create line $x($s) $y($s) $x1 $y1 -fill $color($l_col($s)) -tags cur$s
  736. }
  737.  
  738. proc seg {x0 y0 x1 y1 c t} {
  739.     global s_lst color
  740.     foreach s $s_lst {.a$s.c create line $x0 $y0 $x1 $y1 -fill $color($c) -tags o$t}
  741. }
  742.  
  743. proc Delete {s} {
  744.     global o_lst t_lst
  745.     bind .a$s.c <1> {}
  746.     bind .a$s.c <B1-Motion> {}
  747.     bind .a$s.c <ButtonRelease-1> {}
  748.     bind .a$s.c <3> {}
  749.     foreach o $o_lst {
  750.         .a$s.c bind o$o <Enter> "o_enter $s $o"
  751.     .a$s.c bind o$o <Any-Leave> "o_leave $s $o"
  752.         .a$s.c bind o$o <1> "o_delete $s $o"
  753.     }
  754.     foreach t $t_lst {
  755.         .a$s.c bind t$t <Enter> "td_enter $s $t"
  756.     .a$s.c bind t$t <Any-Leave> "td_leave $s $t"
  757.         .a$s.c bind t$t <1> "td_delete $s $t"
  758.     }
  759. }
  760.  
  761. proc o_enter {s o} {
  762.     global r_col msg dark
  763.     set r_col($s) [.a$s.c itemcget o$o -fill]
  764.     .a$s.c itemconfigure o$o -fill $dark
  765.     eval .a$s.status configure -text $msg(5)
  766. }
  767.  
  768. proc o_leave {s o} {
  769.     global r_col info
  770.     .a$s.c itemconfigure o$o -fill $r_col($s)
  771.     eval .a$s.status configure -text $info($s)
  772. }
  773.  
  774. proc o_delete {s o} {
  775.     global s_lst o_lst undo undo_info t0 timeout
  776.     .a$s.c bind o$o <Enter> {}
  777.     .a$s.c bind o$o <Any-Leave> {}
  778.     .a$s.c bind o$o <1> {}
  779.     set undo($s) 2
  780.     set i_lst [.a$s.c find withtag o$o]
  781.     set undo_info($s) {}
  782.     foreach i $i_lst {lappend undo_info($s) [.a$s.c coords $i]}
  783.     foreach s1 $s_lst {catch ".a$s1.c delete o$o"}
  784.     set i [lsearch -exact $o_lst $o]
  785.     set o_lst [lreplace $o_lst $i $i]
  786.     set t1 [clock seconds]
  787.     if {$t1-$t0>$timeout} {Beep $s}
  788.     set t0 $t1
  789. }
  790.  
  791. proc o_redraw s {
  792.     global o_num o_lst col undo_info s_lst mode t0 timeout
  793.     set o $o_num
  794.     incr o_num
  795.     lappend o_lst $o
  796.     foreach i $undo_info($s) {
  797.         seg [lindex $i 0] [lindex $i 1] [lindex $i 2] [lindex $i 3] $col($s) $o
  798.     }
  799.     foreach s1 $s_lst {
  800.     if {$mode($s1)==3} {
  801.             .a$s1.c bind o$o <Enter> "o_enter $s1 $o"
  802.         .a$s1.c bind o$o <Any-Leave> "o_leave $s1 $o"
  803.             .a$s1.c bind o$o <1> "o_delete $s1 $o"
  804.         }
  805.     }
  806.     set t1 [clock seconds]
  807.     if {$t1-$t0>$timeout} {Beep $s}
  808.     set t0 $t1
  809. }
  810.  
  811. proc td_enter {s t} {
  812.     global r_col msg dark
  813.     set r_col($s) [.a$s.c itemcget t$t -fill]
  814.     .a$s.c itemconfigure t$t -fill $dark
  815.     eval .a$s.status configure -text $msg(5)
  816. }
  817.  
  818. proc td_leave {s t} {
  819.     global r_col info
  820.     .a$s.c itemconfigure t$t -fill $r_col($s)
  821.     eval .a$s.status configure -text $info($s)
  822. }
  823.  
  824. proc td_delete {s t} {
  825.     global s_lst t_lst undo undo_info t0 timeout
  826.     .a$s.c bind t$t <Enter> {}
  827.     .a$s.c bind t$t <Any-Leave> {}
  828.     .a$s.c bind t$t <1> {}
  829.     set undo($s) 4
  830.     set undo_info($s) [.a$s.c coords t$t]
  831.     lappend undo_info($s) [.a$s.c itemcget t$t -text]
  832.     foreach s1 $s_lst {catch ".a$s1.c delete t$t"}
  833.     set i [lsearch -exact $t_lst $t]
  834.     set t_lst [lreplace $t_lst $i $i]
  835.     set t1 [clock seconds]
  836.     if {$t1-$t0>$timeout} {Beep $s}
  837.     set t0 $t1
  838. }
  839.  
  840. proc Text {s} {
  841.     global t_lst
  842.     bind .a$s.c <1> "t_new $s %x %y"
  843.     bind .a$s.c <B1-Motion> {}
  844.     bind .a$s.c <ButtonRelease-1> {}
  845.     bind .a$s.c <3> {}
  846.     foreach t $t_lst {
  847.     .a$s.c bind t$t <Enter> "t_enter $s $t"
  848.     .a$s.c bind t$t <Any-Leave> "t_leave $s $t"
  849.     }
  850. }
  851.  
  852. proc t_new {s x y} {
  853.     global s_lst t_num t_lst col color mode font bold italic size main_x \
  854.         text_left text_sig text_time screen
  855.     if {$text_left} {set x 4}
  856.     set y [.a$s.c canvasy $y]
  857.     set w [expr $main_x-$x-1]
  858.     set t $t_num
  859.     lappend t_lst $t
  860.     incr t_num
  861.     set t_col($t) $col($s)
  862.     set c $col($s)
  863.     set c $color($c)
  864.     switch $font($s) \
  865.         0 {set f -*-times} \
  866.     1 {set f -*-helvetica} \
  867.     2 {set f -*-courier}
  868.     if $bold($s) {set f $f-bold} else {set f $f-medium}
  869.     if $italic($s) {
  870.     if $font($s) {set f $f-o} else {set f $f-i}
  871.     } else {
  872.     set f $f-r
  873.     }
  874.     set f $f-*-*-$size($s)-*-*-*-*-*-*-*
  875.     foreach s1 $s_lst {
  876.     .a$s1.c create text $x $y -text "" -width $w -anchor nw \
  877.         -tags t$t -fill $c -font $f
  878.     if {$mode($s1)==2} {
  879.             .a$s1.c bind t$t <Enter> "t_enter $s1 $t"
  880.             .a$s1.c bind t$t <Any-Leave> "t_leave $s1 $t"
  881.     } elseif {$mode($s1)==3} {
  882.         .a$s1.c bind t$t <Enter> "td_enter $s1 $t"
  883.         .a$s1.c bind t$t <Any-Leave> "td_leave $s1 $t"
  884.         .a$s1.c bind t$t <1> "td_delete $s1 $t"
  885.     }
  886.     }
  887.     t_focus $s $t 0 0
  888.     if {$text_time} {t_ins $s [clock format [clock seconds] -format "\[%H:%M:%S\] "]}
  889.     if {$text_sig} {t_ins $s "\[$screen($s)\] "}
  890. }
  891.  
  892. proc t_enter {s t} {
  893.     global msg
  894.     eval .a$s.status configure -text $msg(6)
  895.     bind .a$s.c <1> "t_focus $s $t %x %y"
  896.     bind .a$s.c <B1-Motion> "t_select $s to $t %x %y"
  897.     bind .a$s.c <3> "t_select $s adjust $t %x %y"
  898. }
  899.  
  900. proc t_leave {s t} {
  901.     global info
  902.     eval .a$s.status configure -text $info($s)
  903.     bind .a$s.c <1> "t_new $s %x %y"
  904.     bind .a$s.c <B1-Motion> {}
  905.     bind .a$s.c <3> {}
  906. }
  907.  
  908. proc t_select {s c t x y} {
  909.     set y [.a$s.c canvasy $y]
  910.     .a$s.c select $c t$t @$x,$y
  911. }
  912.  
  913. proc t_focus {s t x y} {
  914.     global foc_t
  915.     set y [.a$s.c canvasy $y]
  916.     set i @$x,$y
  917.     set foc_t($s) $t
  918.     set i [.a$s.c index t$t $i]
  919.     .a$s.c select clear
  920.     .a$s.c select from t$t $i
  921.     .a$s.c icursor t$t $i
  922.     .a$s.c focus t$t
  923.     focus .a$s.c
  924.     .a$s.c bind t$t <Key> "t_key $s %A %s"
  925.     .a$s.c bind t$t <Return> "t_ins $s \\n"
  926.     .a$s.c bind t$t <BackSpace> "t_del $s 0"
  927.     .a$s.c bind t$t <Control-d> "t_del $s 1"
  928.     .a$s.c bind t$t <Left> "t_move $s 0"
  929.     .a$s.c bind t$t <Right> "t_move $s 1"
  930.     bind .a$s.c <2> "t_sel $s"
  931. }
  932.  
  933. proc t_do {s i1 i2 str} {
  934.     global foc_t s_lst undo undo_info t0 timeout
  935.     set t $foc_t($s)
  936.     set txt [.a$s.c itemcget t$t -text]
  937.     set txt [string range $txt $i1 $i2]
  938.     set i3 [expr $i1+[string length $str]-1]
  939.     set undo($s) 3
  940.     set undo_info($s) [list $i1 $i3 $txt]
  941.     foreach s1 $s_lst {
  942.         if {$i2 >= $i1} {catch {.a$s1.c dchars t$t $i1 $i2}}
  943.         catch {.a$s1.c insert t$t $i1 $str}
  944.     }
  945.     set t1 [clock seconds]
  946.     if {$t1-$t0>$timeout} {Beep $s}
  947.     set t0 $t1
  948. }
  949.  
  950. proc t_ins {s str} {
  951.     global foc_t
  952.     set t $foc_t($s)
  953.     if ![catch {set i1 [.a$s.c index t$t sel.first]}] {
  954.         set i2 [.a$s.c index t$t sel.last]
  955.         t_do $s $i1 $i2 $str
  956.         return}
  957.     set i1 [.a$s.c index t$t insert]
  958.     t_do $s $i1 [expr $i1-1] $str
  959. }
  960.  
  961. proc t_key {s a x} {
  962.     if {[string length $a] != 1} return
  963.     if {$x > 1} return
  964.     if {[string compare $a " "] < 0} return
  965.     t_ins $s $a
  966. }
  967.  
  968. proc t_sel s {
  969.     if [catch {selection get} str] {
  970.         if [catch {selection get -selection CLIPBOARD} str] return
  971.     }
  972.     if {$str == ""} return
  973.     t_ins $s $str
  974. }
  975.  
  976. proc t_del {s r} {
  977.     global foc_t
  978.     set t $foc_t($s)
  979.     if ![catch {set i1 [.a$s.c index t$t sel.first]}] {
  980.         set i2 [.a$s.c index t$t sel.last]
  981.         t_do $s $i1 $i2 "" } \
  982.     else {
  983.         set i [.a$s.c index t$t insert]
  984.         if $r {
  985.             set e [.a$s.c index t$t end]
  986.         if {$i<$e} {t_do $s $i $i ""}} \
  987.         else {
  988.             if {$i>0} {
  989.                 set i [expr $i-1]
  990.                 t_do $s $i $i ""}}}
  991. }
  992.  
  993. proc t_move {s r} {
  994.     global foc_t
  995.     set t $foc_t($s)
  996.     set i [.a$s.c index t$t insert]
  997.     if $r {
  998.     set e [.a$s.c index t$t end]
  999.     if {$i<$e} {.a$s.c icursor t$t [expr $i+1]}
  1000.     } else {
  1001.     if {$i>0}  {.a$s.c icursor t$t [expr $i-1]}
  1002.     }
  1003. }
  1004.  
  1005. proc t_redraw s {
  1006.     global undo_info t0 timeout
  1007.     set x [lindex $undo_info($s) 0]
  1008.     set y [lindex $undo_info($s) 1]
  1009.     set str [lindex $undo_info($s) 2]
  1010.     t_new $s $x $y
  1011.     t_ins $s $str
  1012.     set t1 [clock seconds]
  1013.     if {$t1-$t0>$timeout} {Beep $s}
  1014.     set t0 $t1
  1015. }
  1016.  
  1017. proc Undo {s} {
  1018.     global undo undo_info
  1019. # undo($s) :
  1020. # 0 - can't do
  1021. # 1 - delete last line
  1022. # 2 - redraw deleted line
  1023. # 3 - undo text operation
  1024. # 4 - redraw deleted text
  1025.     switch $undo($s) \
  1026.         0 {return} \
  1027.     1 {o_delete $s $undo_info($s)} \
  1028.         2 {o_redraw $s} \
  1029.         3 { set i1 [lindex $undo_info($s) 0]
  1030.             set i2 [lindex $undo_info($s) 1]
  1031.             set st [lindex $undo_info($s) 2]
  1032.             t_do $s $i1 $i2 $st} \
  1033.         4 {t_redraw $s}
  1034.     set undo($s) 0
  1035.     set undo_info($s) {}
  1036. }
  1037.  
  1038. proc More {} {
  1039.     global s_lst main_x main_y main_Y
  1040.     set main_Y [expr $main_Y+$main_y]
  1041.     foreach s1 $s_lst {.a$s1.c configure -scrollregion "0 0 $main_x $main_Y"}
  1042. }
  1043.  
  1044. proc Beep s {
  1045.     global s_lst
  1046.     foreach s1 $s_lst {if {$s1!=$s} {bell -displayof .a$s1}}
  1047. }
  1048.  
  1049. proc Clear s {
  1050.     global screen
  1051.     catch {destroy .c_a$s}
  1052.     toplevel .c_a$s -screen $screen($s)
  1053.     wm title .c_a$s "Clear all"
  1054.     label .c_a$s.up -text \
  1055.         "There is no Undo for Clear all!\nAre you sure you want to delete everything?"
  1056.     frame .c_a$s.down
  1057.     pack .c_a$s.up -side top
  1058.     pack .c_a$s.down -side bottom -fill x
  1059.     button .c_a$s.down.ok -text "OK" -bd 4 -relief raised \
  1060.         -command "destroy .c_a$s; cl_all $s; return"
  1061.     button .c_a$s.down.cancel -text "Cancel" -bd 4 -relief raised \
  1062.         -command "destroy .c_a$s; return"
  1063.     pack .c_a$s.down.ok -side left
  1064.     pack .c_a$s.down.cancel -side right
  1065.     focus .c_a$s
  1066.     bind .c_a$s <Return> ".c_a$s.down.ok invoke"
  1067.     bind .c_a$s <Escape> ".c_a$s.down.cancel invoke"
  1068. }
  1069.  
  1070. proc cl_all s {
  1071.     global s_lst undo t0 timeout
  1072.     foreach s1 $s_lst {.a$s1.c delete all; set undo($s1) 0}
  1073.     set o_num 0
  1074.     set o_lst {}
  1075.     set t_num 0
  1076.     set t_lst {}
  1077.     set t1 [clock seconds]
  1078.     if {$t1-$t0>$timeout} {Beep $s}
  1079.     set t0 $t1
  1080. }
  1081.  
  1082. Config_restore; Config_all
  1083. if [catch {set con_scr $env(DISPLAY)}] {set con_scr :0.0}
  1084. win
  1085.