3 catch {package require Tclx}
4 set noFvwm [catch {package require Fvwm}]
5 set CONFIGDIR "~/.fubar"
6 set LIBRARYDIR [file dirname [info script]]
8 set accessCommand [list rs ssh rsh]
9 set LocaleList {ru_RU.KOI8-R ru_RU.CP1251 ru_RU.UTF-8}
11 option add *Menu.Font -*-times-bold-r-normal--14-* widgetDefault
12 option add *Menubutton.Font -*-times-bold-r-normal--14-* widgetDefault
13 set WindowMenu "Window-Ops2"
14 source [file join $LIBRARYDIR balloonhelp.tcl]
15 option add Foobar.geometry +0+0 widgetDefault
16 # No periodically executed commands by default
17 set scheduled_commands {}
19 # Lays out an application
21 proc myExit {args} {exit}
23 # Just for convinience
24 global CONFIGDIR LIBRARYDIR
25 # First, transform main window into bar
27 # Second, check if our config dir exist. Otherwise
28 if {![file exist $CONFIGDIR] } {
29 uplevel #0 source [file join $LIBRARYDIR setup_userdir]
30 } elseif {![file isdirectory $CONFIGDIR]} {
31 tk_messagebox -type ok -title "Error" -icon error -message "Config directory $CONFIGDIR missing and cannot be created!"
42 after idle load_plugins
43 # Start tasks to be executed each minute
44 bind . <Button-1> {raise .}
48 proc load_plugins {} {
50 foreach plugin [glob -nocomplain $CONFIGDIR/plugins/*] {
51 if {[string match *.txt $plugin]} continue
52 if {[catch {uplevel #0 [list source $plugin]} msg]} {
53 bgerror "Error loading plugin [file tail $plugin]\n$msg"
58 # Sets main window up as horizontal bar
60 proc setup_window {} {
61 . configure -relief raised -bd 3
63 wm overrideredirect . yes
65 ::fvwm::send "Style [tk appname] NoTitle,NoHandles,BorderWidth 0,WindowListSkip, Sticky "
67 regexp {[0-9+]x[0-9+]([+-][0-9]+)([+-][0-9]+)} [wm geometry .] junk xpos ypos
68 wm geometry . [winfo screenwidth .]x30+0$ypos
71 ##############################################################
72 # Reading universal configuration
73 #############################################################
75 # Reads file of known hosts used by run window and term menu
78 proc read_hostfile {} {
79 global HostList CONFIGDIR RunCmd XtermCmd Xterm hostTimeStamp
80 if [catch {open $CONFIGDIR/hosts} f] {
81 #file not found, create default one
82 tk_messageBox -title Warning -type ok -message "Cannot open host list: $f\nCreating default one"
83 set f [open $CONFIGDIR/hosts w]
84 puts $f "#hostname rsh-command locale list"
85 puts $f "localhost - $::env(LANG)"
87 set f [open $CONFIGDIR/hosts]
90 while {[gets $f line]>=0} {
91 if {![string length $line]||[regexp "^ *#" $line]} continue
92 if {[regexp "^\[ \t]*-+" $line]} {
94 } elseif {[regexp "^\[ \t]*>+\[ \t]*(.*)" $line => label]} {
95 lappend HostList ">$label"
96 } elseif {[regexp "^\[ \t]*<" $line]} {
99 set list [regexp -all -inline {[^[:space:]]+} $line]
100 set host [lindex $list 0]
101 set cmd [lindex $list 1]
102 set locales [lrange $list 2 end]
103 if {![llength $locales]} {
104 set locales [list $::env(LANG)]
107 foreach {menu_name connect_name} [split $host ":"] break
108 if {![string length $connect_name]} {
109 set connect_name $menu_name
111 if {[lindex $locales 0]==">"} {
112 set locales [lrange $locales 1 end]
113 set locales_submenu 1
114 lappend HostList ">$menu_name"
116 set locales_submenu 0
118 set loccount [llength $locales]
120 if {$l eq $::env(LANG)} {
123 set lang_prefix "env LANG=$l "
126 catch {unset charset}
127 foreach {lang charset} [split $l "."] break
128 if {[info exists charset]} {
129 set name "$menu_name\([string tolower $charset]\)"
131 set name "$menu_name\($lang\)"
139 set xtermswitch " -e "
141 set rexec "$cmd $connect_name"
142 set xexec "-e $cmd $connect_name"
145 lappend HostList $name
146 set RunCmd($name) [string trim "$lang_prefix$rexec"]
147 set Xterm($name) "$lang_prefix xterm -T \"Shell on $name\" $xexec"
148 set XtermCmd($name) $Xterm($name)$xtermswitch
150 if {$locales_submenu} {
155 set hostTimeStamp [clock seconds]
159 # Checks mtime of hosts file and, if changed, rereads it
161 proc check_hostFile {} {
162 global hostTimeStamp CONFIGDIR
163 if {[file mtime $CONFIGDIR/hosts]>$hostTimeStamp} {
170 proc read_hotkeys {} {
174 proc build_runhostmenu {} {
175 global runHost HostList
176 build_host_menu .runwindow.host.menu radiobutton {-value $host -variable runHost}
179 # Read file of associations
181 proc read_associations {} {
182 global Associations CONFIGDIR noFvwm
183 array set Associations {
187 set Associations(.fvwm) builtin
189 if [file readable $CONFIGDIR/associations] {
190 set f [open $CONFIGDIR/associations]
191 catch {array set Associations [read -nonewline $f]}
195 ######################################################################
197 ######################################################################
200 # Creates start menu (which is actually recreated each time as posted)
202 proc make_startmenu {} {
204 menubutton .start -menu .start.menu -text Start -relief raised -bd 2
205 menu .start.menu -tearoff false -postcommand scan_appdir
206 pack .start -side left -ipady 3
207 balloonhelp .start "Click here to begin ;-)"
208 menu .start.setup -tearoff 0
209 .start.setup add command -label "Open" -command [list exec\
210 $CONFIGDIR/fm [file normalize $CONFIGDIR/menu] &]
211 if {![file executable $CONFIGDIR/fm]} {
212 .start.setup entryconfigure "Open" -state disabled
214 .start.setup add command -label "Reread hotkeys..." -command "read_hotkeys"
215 .start.setup add command -label "Import history..." -command "import_history"
216 bind .start <3> [list tk_popup .start.setup %X %Y]
219 # Deletes all items from menu and all associated submenus
221 proc deleteCascade {menu} {
222 while {[$menu index end]!="none"} {
223 if {[$menu type 0]=="cascade"} {
224 set submenu [$menu entrycget 0 -menu]
225 deleteCascade $submenu
233 # Scans given directory and forms menu
235 proc make_cascade {path menu} {
236 global XtermCmd Associations HostList
237 set runHost [lindex $HostList 0]
239 foreach f [lsort -dictionary [glob -nocomplain $path/*]] {
240 set name [file tail $f]
241 if [file isdirectory $f] {
242 set submenu $menu.$counter
244 $menu add cascade -label [mklabel $name] -menu $submenu
245 menu $submenu -tearoff n
246 make_cascade $f $submenu
249 if [file executable $f] {
250 if {[file extension $f]==".xterm"} {
251 set name [file rootname $name]
252 set command "exec $XtermCmd($runHost) [list $f] >&@ stdout &"
254 set command "exec [list $f] >&@ stdout &"
257 set command "launch [list $f]"
258 if ![info exist Associations([file extension $f])] {
261 set name [file rootname $name]
264 $menu add command -label [mklabel $name] -command $command -state $state
269 # Converts file name to menu label - strips off leading number if any
270 # and casts underscores to spaces
271 proc mklabel {name} {
272 if [regexp {^[0-9]*\.(.*)$} $name tt label] {
275 regsub {_} $name " " label
279 # import_history - creates Start menu items from run menu history
281 proc import_history {} {
282 tk_messageBox -type ok -title "Import history" -message "Not implemented yet"
287 # launch - invokes non-executable file which have associations
291 set ext [file extension $file]
294 uplevel #0 source [list $file]
298 set list [split [read -nonewline $f] "\n"]
300 foreach command $list {
301 if [regexp "\[ \t]*#" $command] continue
302 ::fvwm::send $command
306 exec /bin/sh -c [format $Associations($ext) $file] >&@stdout &
311 proc scan_appdir {} {
313 deleteCascade .start.menu
314 make_cascade $CONFIGDIR/menu .start.menu
316 ######################################################################
317 # Window list hangling - only if invoked as Fvwm Module
318 ######################################################################
320 # Creates window menu which is actually recreated each time as posted
322 proc make_windowmenu {} {
324 menubutton .windows -menu .windows.menu -text Windows -relief raised -bd 2
325 menu .windows.menu -tearoff false -postcommand getwinlist
326 bind .windows.menu <3> {winop_menu [.windows.menu index @%y]}
327 pack .windows -side left
329 .windows configure -state disabled
331 balloonhelp .windows "Click here to list open windows"
332 balloonhelp .windows.menu "Left - raise right- winops menu"
335 # Rescans current windows and forms window menu
339 while {[.windows.menu index 0] != "none"} {
340 .windows.menu delete 0
342 catch {unset WindowIds}
343 ::fvwm::getWindowList list
344 foreach idx [array names list *,iconName] {
345 set id [lindex [split $idx ","] 0 ]
346 if [info exist list($id,iconic)] {
347 set label "<$list($idx)>"
348 if {[string first "\0" $label"]>=0} {
349 regsub -all "\0" $label {} label
350 puts stderr "Problem with window title \"$label\""
354 set label $list($idx)
355 if {$label == "[tk appname]"} continue
356 regsub -all "\0" $label {} label
359 .windows.menu add command -label $label -command \
360 [list ::fvwm::send $cmd $id]
361 #balloonhelp .windows.menu -index [.windows.menu index end] $list($id,title)
362 set WindowIds([.windows.menu index end]) $id
367 # Executes executes fvwm window-ops menu on given command
369 proc winop_menu {index} {
370 if {$index=="none"} return
371 global WindowIds WindowMenu
372 ::fvwm::send "Popup $WindowMenu" $WindowIds($index)
375 # Button which opens a popup window to enter command. Note that window
376 # is created and only shown from this menu. See section about POPUP
379 proc make_runbutton {} {
380 button .run -text Run -relief raised -pady 1 \
381 -command {show_popup .runwindow .run; focus -force .runwindow.command}
383 balloonhelp .run "Click here for single command prompt"
390 proc make_run_window {} {
391 global runHost HostList runInXterm pauseAfterRun
392 set runHost [lindex $HostList 0]
395 popup .runwindow -relief raised -bd 2
396 # Things to have inside run window
397 label .runwindow.l -text "Run:"
398 entry .runwindow.command -width 50 -textvar runCommand
399 bind .runwindow.command <Return> runACommand
400 menubutton .runwindow.history -text "v" -relief raised -bd 2 \
401 -menu .runwindow.history.menu
402 balloonhelp .runwindow.history "Click to choose from list of previous commands"
403 menu .runwindow.history.menu -tearoff no
404 read_history .runwindow.history.menu
405 button .runwindow.browse -text "Browse..." -command browse_file
406 balloonhelp .runwindow.browse "Find a file to substitute in command line"
407 label .runwindow.l2 -text "Run on:"
409 menubutton .runwindow.host -textvar runHost -relief raised -indicatoron y -menu .runwindow.host.menu
410 menu .runwindow.host.menu
412 # eval tk_optionMenu .runwindow.host runHost $HostList
413 trace var runHost w checkHostIsLocal
414 .runwindow.host.menu configure -postcommand check_hostFile
415 balloonhelp .runwindow.host "Select host to run on"
416 checkbutton .runwindow.xterm -text "Run in xterm" -command \
417 pauseButtonState -variable runInXterm -anchor w
418 checkbutton .runwindow.pause -text "Don't close xterm on exit"\
419 -variable pauseAfterRun -state disabled -anchor w
420 button .runwindow.run -command runACommand -text "Run"
421 balloonhelp .runwindow.run "Click here to execute"
422 button .runwindow.cancel -command {hide_popup .runwindow} -text Cancel
423 balloonhelp .runwindow.run "Click to forget about this command"
424 grid .runwindow.l -padx 10 -sticky wns
425 grid .runwindow.command - - - .runwindow.history -sticky news -padx 5
426 grid .runwindow.l2 .runwindow.host -sticky news -padx 10
427 grid x .runwindow.xterm - -sticky news
428 grid x .runwindow.pause - -sticky news
429 grid x .runwindow.browse .runwindow.run .runwindow.cancel -padx 10 -sticky news
430 focus .runwindow.command
433 proc checkHostIsLocal {args} {
435 if {[string match localhost* $runHost]} {
436 .runwindow.browse configure -state normal
438 .runwindow.browse configure -state disabled
442 # Reads history file (invoked once on startup)
445 proc read_history {menu} {
447 if [catch {open $CONFIGDIR/history} f] return
448 while {[gets $f line]>=0} {
449 if {[regexp {^([^ ]+) +([0-9]+) +([0-9]+) +(.*)$} \
450 $line junk host xt pause cmd]} {
451 $menu add command -label $cmd -command \
452 [list set_command $cmd $host $xt $pause] }
457 # Sets widgets in run window to command got from history
459 proc set_command {cmd host xt pause} {
460 global runCommand runInXterm pauseAfterRun runHost
464 set pauseAfterRun $pause
467 # Adds current command into history and saves history to file
469 proc add_history {} {
470 global CONFIGDIR runHost runCommand runInXterm pauseAfterRun
471 catch {.runwindow.history.menu delete $runCommand}
472 .runwindow.history.menu insert 0 command -label $runCommand \
473 -command [list set_command $runCommand $runHost $runInXterm\
475 while {[.runwindow.history.menu index end]>20} {
476 .runwindow.history.menu delete end
478 set f [open $CONFIGDIR/history w]
479 for {set i 0} "\$i<=[.runwindow.history.menu index end]" {incr i} {
480 set list [.runwindow.history.menu entrycget $i -command]
481 puts $f "[lindex $list 2] [lindex $list 3] [lindex $list 4] [lindex $list 1]"
486 # Pops up file dialog and inserts choosen name in place of selection
489 proc browse_file {} {
490 set name [tk_getOpenFile -parent .runwindow -title Browse]
491 set e .runwindow.command
492 if {"$name"==""} return
493 if [$e selection present] {
494 $e delete sel.first sel.last
495 $e insert selfirst $name
497 $e insert insert $name
501 # Executes command entered in runwindow
503 proc runACommand {} {
504 global RunCmd XtermCmd runCommand runHost runInXterm pauseAfterRun
505 hide_popup .runwindow
510 set command "/bin/sh -c '$runCommand;echo \"Hit <Return>\";read junk'"
512 set command $runCommand
514 exec /bin/sh -c "$XtermCmd($runHost) $command" &>@stdout &
516 if {$RunCmd($runHost)=="*"} {
517 tk_messageBox -title Error -type Ok \
518 -message "You cannot run X applications on $runHost"
521 exec /bin/sh -c "$RunCmd($runHost) $runCommand" &>@stdout &
526 # Change state of pause button
528 proc pauseButtonState {} {
535 .runwindow.pause configure -state $state
537 ##############################################################
538 # Popup borderless windows
539 ##############################################################
540 proc popup {widget args} {
541 array set widget_args $args
543 if {![info exists widget_args(-class)]} {
544 set widget_args(-class) Popup
548 set w [eval toplevel $widget [array get widget_args ]]
550 foreach event [bind Popup] {
551 bind $widget_args(-class) $event [bind Popup $event]
555 wm overrideredirect $w yes
559 proc show_popup {window origin} {
560 set x [winfo rootx $origin]
561 set y [expr [winfo rooty $origin]+[winfo height $origin]]
562 if {$y+[winfo reqheight $window]>[winfo screenheight $window]} {
563 set y [expr [winfo rooty $origin] - [winfo reqheight $window]]
565 set y [expr [winfo screenheight $window]-[winfo reqheight $window]]
571 if {$x+[winfo reqwidth $window]>[winfo screenwidth $window]} {
572 set x [expr [winfo screenwidth $window]-[winfo reqwidth $window]]
577 wm geometry $window +$x+$y
583 proc popupLeft {window x y} {
584 if {$x<0||$y<0||$x>[winfo width $window]||$y>[winfo height $window]} {
589 proc hide_popup window {
593 bind Popup <Button-1> {popupLeft %W %x %y}
594 bind Popup <Button-2> {popupLeft %W %x %y}
595 bind Popup <Button-3> {popupLeft %W %x %y}
596 ##############################################################
597 # Menu of xterms on all possible hosts
598 ##############################################################
601 # Creates menu for invoke shell window on any of known hosts
603 proc make_termmenu {} {
604 menubutton .xterm -text "Xterm" -menu .xterm.menu -bd 2 -relief raised
605 bind .xterm <ButtonRelease-3> {create_or_raise .hostlist edit_hostlist}
606 menu .xterm.menu -tearoff n -postcommand check_hostFile
608 balloonhelp .xterm "Click to open new terminal window"
610 proc build_xtermmenu {} {
612 build_host_menu .xterm.menu command {-command {exec $Xterm($host) >&@stdout &}}
613 pack .xterm -side left
616 proc build_host_menu {menu type options } {
617 global HostList Xterm
620 catch [concat destroy [winfo children $menu]]
623 foreach host $HostList {
624 if { $host == "-" } {
626 } elseif {[regexp "^>(.*)$" $host => label]} {
627 lappend menu_stack $menu
628 $menu add cascade -label $label -menu [set menu [menu $top_menu.m[incr submenu]]]
629 } elseif { $host == "<" } {
630 set menu [lindex $menu_stack end]
631 set menu_stack [lrange $menu_stack 0 end-1]
633 eval [list $menu add $type -label $host ] [subst " $options"]
639 # start periodic tasks like menu update
642 global scheduled_commands
643 foreach cmd $scheduled_commands {
644 uplevel #0 $cmd [clock seconds]
646 set sec [string trimleft [clock format [clock seconds] -format "%S"] 0]
647 if ![string length $sec] {
650 after [expr (60-$sec)*1000] scheduler
653 # Allows plugin to register proc which would be run each minute
655 proc notifier {command} {
656 global scheduled_commands
657 lappend scheduled_commands $command
660 # Find menu - allows to find out lot of useful things about system
663 proc make_findmenu {} {
664 menubutton .find -text Find -relief raised -bd 2 -menu .find.m
665 balloonhelp .find "Find a useful information about..."
666 set m [menu .find.m -tearoff no]
667 $m add command -label "File..." -command "create_or_raise\
668 .find_file find_file; focus .find_file.locate"
669 #balloonhelp $m -index 0 "Search for a file on the filesystem"
670 $m add command -label "Host..." -command "create_or_raise\
671 .find_host find_host;focus .find_host.addr"
672 #balloonhelp $m -index 3 "Search for a person in the phonebook or passwd file"
673 $m add command -label "Command..." -command "create_or_raise\
674 .find_command find_command; focus .find_command.cmd"
675 #balloonhelp $m -index 4 "Search for command man page (apropos)"
676 if {![findInPath "apropos"]} {
677 $m entryconfigure "Command..." -state disabled
679 pack .find -side left
682 proc findInPath {cmd} {
684 foreach dir [split $env(PATH) ":"] {
685 if [file executable [file join $dir $cmd]] {
691 proc create_or_raise {w fillproc args} {
692 if [winfo exists $w] {
693 if {[wm state $w] != "normal"} {
701 eval toplevel $w $args
708 wm title $w "Find file"
709 label $w.l1 -text "Locate:" -anchor w
710 entry $w.locate -width 30
711 bind $w.locate <Key-Return> [list do_locate $w]
712 button $w.do_locate -text "Locate" -command [list do_locate $w]
713 grid $w.l1 $w.locate $w.do_locate - -sticky news
714 label $w.l2 -text "Find:" -anchor w
716 entry $w.find -width 50
717 bind $w.find <Key-Return> [list do_find $w]
718 button $w.do_find -text "Find" -command [list do_find $w]
719 grid $w.find - $w.do_find - -sticky news
720 text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled
721 $w.result tag configure error -foreground red
722 $w.result tag configure done -foreground green
723 scrollbar $w.y -orient vert -command [list $w.result yview]
724 grid $w.result - - $w.y -sticky news
725 grid columnconfigure $w 0 -weight 0
726 grid columnconfigure $w 1 -weight 1
728 grid $w.b - - - - -sticky ns
729 button $w.b.stop -text Stop -state disabled
730 button $w.b.clear -text Clear -command [list clearresult $w.result]
731 button $w.b.close -text Close -command [list find_close $w $w.b.stop]
732 pack $w.b.stop $w.b.clear $w.b.close -side left
733 wm protocol $w WM_DELETE_WINDOW [list find_close $w $w.b.stop]
734 foreach row {0 1 2 4} {
735 grid rowconfigure $w $row -weight 0
737 grid rowconfigure $w 3 -weight 1
740 proc find_close {window stop} {
741 if {[$stop cget -state] == "normal"} {
747 proc read_cmd {channel window stopbutton} {
749 $window config -state normal
750 if [catch {close $channel} error] {
751 $window insert end $error error
753 $window insert end "****** done ******" done
755 $window config -state disabled
756 if [string length $stopbutton] {
757 $stopbutton configure -state disabled
761 $window config -state normal
762 $window insert end [read $channel]
764 $window config -state disabled
767 proc open_pipe {window command {stopbutton {}}} {
768 $window configure -state normal
769 $window delete 0.0 end
770 $window configure -state disabled
771 set f [open "|$command" r]
772 fconfigure $f -blocking no -buffering line
773 if [string length $stopbutton] {
774 $stopbutton configure -state normal -command [list kill [pid $f]]
776 fileevent $f readable [list read_cmd $f $window $stopbutton]
779 proc do_locate {window} {
780 set pattern [$window.locate get]
781 open_pipe $window.result "locate $pattern" $window.b.stop
784 proc do_find {window} {
785 set expression [$window.find get]
786 open_pipe $window.result "find $expression" $window.b.stop
790 wm title $w "Find host"
791 label $w.l -text "Enter hostname or IP address:" -anchor w
792 entry $w.addr -width 30
793 bind $w.addr <Key-Return> [list do_dns_lookup $w]
794 label $w.l2 -text "Record type:"
795 button $w.lookup -text "Lookup DNS" -command [list do_dns_lookup $w]
796 button $w.route -text "Traceroute" -command "open_pipe $w.result\
797 \"/usr/bin/traceroute \[$w.addr get\]\" $w.b.stop"
798 tk_optionMenu $w.type nslookup_type "A/PTR" "MX" "SOA" "NS"
799 grid $w.l - - - - -sticky w
800 grid $w.addr - - - - -sticky w
801 grid $w.l2 $w.type $w.lookup $w.route - -sticky ns
802 text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled
803 $w.result tag configure error -foreground red
804 $w.result tag configure done -foreground green
805 scrollbar $w.y -orient vert -command [list $w.result yview]
806 grid $w.result - - - $w.y -sticky news
807 grid columnconfigure $w 0 -weight 0
808 grid columnconfigure $w 1 -weight 0
809 grid columnconfigure $w 2 -weight 1
810 grid columnconfigure $w 3 -weight 0
811 grid columnconfigure $w 4 -weight 0
813 grid $w.b - - - - -sticky ns
814 button $w.b.stop -text Stop -state disabled
815 button $w.b.clear -text Clear -command [list clearresult $w.result]
816 button $w.b.close -text Close -command [list find_close $w $w.b.stop]
817 pack $w.b.stop $w.b.clear $w.b.close -side left
818 wm protocol $w WM_DELETE_WINDOW [list find_close $w $w.b.stop]
819 foreach row {0 1 2 4} {
820 grid rowconfigure $w $row -weight 0
822 grid rowconfigure $w 3 -weight 1
825 proc do_dns_lookup {w} {
826 global nslookup_type;
827 if {"$nslookup_type" == "A/PTR"} {
830 set command "host -t $nslookup_type"
832 open_pipe $w.result "$command [$w.addr get]" $w.b.stop
835 proc clearresult {w} {
836 $w configure -state normal
838 $w configure -state disabled
842 proc find_command {w} {
843 wm title $w "Find command in manual"
844 label $w.l -text "Command:"
845 entry $w.cmd -width 30
846 bind $w.cmd <Key-Return> [list $w.find invoke]
847 button $w.find -text "Find" -command "do_apropos $w.result \[$w.cmd get\]"
848 grid $w.l $w.cmd $w.find - -sticky news
849 text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled\
851 $w.result tag configure error -foreground red
852 $w.result tag configure done -foreground green
853 $w.result tag configure man -foreground blue -underline y
854 $w.result tag bind man <1> "show_man $w.result @%x,%y"
855 scrollbar $w.y -orient vert -command [list $w.result yview]
856 grid $w.result - - $w.y -sticky news
857 grid columnconfigure $w 0 -weight 0
858 grid columnconfigure $w 1 -weight 1
859 grid columnconfigure $w 2 -weight 0
860 grid columnconfigure $w 3 -weight 0
862 grid rowconfigure $w $row -weight 0
864 grid rowconfigure $w 2 -weight 1
868 proc do_apropos {window command} {
869 $window configure -state normal
870 $window delete 0.0 end
871 $window configure -state disabled
872 set f [open "|apropos \"$command\"" r]
873 fconfigure $f -blocking no -buffering line
874 fileevent $f readable [list read_apropos $f $window]
877 proc read_apropos {channel window} {
879 $window config -state normal
880 if [catch {close $channel} error] {
881 $window insert end $error error
883 $window insert end "****** nothing more ******" done
885 $window config -state disabled
888 $window config -state normal
889 foreach line [split [read $channel] "\n"] {
890 if [regexp "^(\[^ \]+ \\(\[^ \]+\\))(.*$)" $line all cmd comment] {
891 $window insert end $cmd man "$comment\n" {}
893 $window insert end $line error "\n" {}
897 $window config -state disabled
900 proc show_man {w index} {
902 set range [$w tag nextrange man "$index linestart"]
903 regexp "^(\[^ \]+) \\((\[^)\]+)\\)" [eval $w get $range] all command section
904 exec $CONFIGDIR/man $section $command &
908 proc edit_hostlist {w} {
909 wm title $w "Add host";
910 label $w.l1 -text "Menu label" -anchor e
912 label $w.l2 -text "Hostname" -anchor e
914 label $w.l3 -text "Access command" -anchor e
915 eval tk_optionMenu $w.protocol hostCommand $::accessCommand
916 labelframe $w.loc -text "Suppored locales" -labelanchor nw
918 foreach locale $::LocaleList {
920 checkbutton $w.loc.box$i -text $locale -offvalue "" -onvalue $locale -var hostLocale$i
921 pack $w.loc.box$i -side top
923 grid $w.l1 $w.label -sticky news
924 grid $w.l2 $w.name -sticky news
925 grid $w.l3 $w.protocol -sticky news
926 grid $w.loc - -sticky news
927 button $w.save -text Save -command "add_host_entry $w"
928 button $w.cancel -text Cancel -command "wm withdraw $w"
929 grid $w.save $w.cancel
932 proc add_host_entry {w } {
933 global CONFIGDIR hostCommand
934 set hostMenuLabel [$w.label get]
935 set hostName [$w.name get]
936 if {![string length $hostMenuLabel]} {
937 set $hostMenuLabel $hostName
939 if {![string length $hostName]} {
943 if {$hostMenuLabel eq $hostName} {
946 set line $hostMenuLabel:$hostName
948 append line " $hostCommand"
949 for {set i 1} {[winfo exists $w.loc.box$i]} {incr i} {
950 set l [uplevel #0 set hostLocale$i]
951 if {[string length $l]} {
955 set f [open $CONFIGDIR/hosts a]