fubar.tcl

   1 #!/usr/bin/wish
   2
   3 package require Tclx
   4 set noFvwm [catch {package require Fvwm}]
   5 set CONFIGDIR "~/.fubar"
   6 set LIBRARYDIR [file dirname [info script]]
   7 # Host add setup
   8 set accessCommand [list rs ssh rsh]
   9 set LocaleList {ru_RU.KOI8-R ru_RU.CP1251 ru_RU.UTF-8}
  10
  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 {}
  18 #
  19 # Lays out an application
  20 #
  21 proc myExit {args} {exit}
  22 proc main {} {
  23    # Just for convinience
  24    global CONFIGDIR LIBRARYDIR
  25    # First, transform main window into bar
  26    setup_window
  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!"
  32       exit 1
  33    }
  34    read_hostfile
  35    read_associations
  36    make_startmenu
  37    make_windowmenu
  38    make_runbutton
  39    make_termmenu
  40    make_findmenu
  41    read_hotkeys
  42         after idle load_plugins
  43    # Start tasks to be executed each minute
  44    bind . <Button-1> {raise .}
  45    scheduler
  46 }
  47
  48 proc load_plugins {} {
  49    global CONFIGDIR
  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"
  54           }
  55    }
  56 }
  57 #
  58 # Sets main window up as horizontal bar
  59 #
  60 proc setup_window {} {
  61   . configure -relief raised -bd 3
  62   if {$::noFvwm} {
  63      wm overrideredirect . yes
  64   } else {
  65           ::fvwm::send "Style [tk appname] NoTitle,NoHandles,BorderWidth 0,WindowListSkip, Sticky "
  66   }
  67   regexp {[0-9+]x[0-9+]([+-][0-9]+)([+-][0-9]+)} [wm geometry .] junk xpos ypos
  68   wm geometry . [winfo screenwidth .]x30+0$ypos
  69   update
  70 }
  71 ##############################################################
  72 # Reading universal configuration
  73 #############################################################
  74 #
  75 # Reads file of known hosts used by run window and term menu
  76 #
  77
  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)"
  86                         close $f
  87                         set f [open $CONFIGDIR/hosts]
  88                 }
  89      set HostList {}
  90      while {[gets $f line]>=0} {
  91         if {![string length $line]||[regexp "^ *#" $line]} continue
  92                 if {[regexp "^\[ \t]*-+" $line]} {
  93                         lappend HostList "-"
  94                 } elseif {[regexp "^\[ \t]*>+\[ \t]*(.*)" $line => label]} {
  95                         lappend HostList ">$label"
  96                 } elseif {[regexp "^\[ \t]*<" $line]} {
  97                         lappend HostList "<"
  98                 } else {
  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)]
 105                         }
 106                         set connect_name ""
 107                         foreach {menu_name connect_name} [split $host ":"] break
 108                         if {![string length $connect_name]} {
 109                                 set connect_name $menu_name
 110                         }
 111                         if {[lindex $locales 0]==">"} {
 112                                 set locales [lrange $locales 1 end]
 113                                 set locales_submenu 1
 114                                 lappend HostList ">$menu_name"
 115                         } else {
 116                                 set locales_submenu 0
 117                         }
 118                         set loccount [llength $locales]
 119                         foreach l $locales {
 120                                 if {$l eq $::env(LANG)} {
 121                                         set lang_prefix ""
 122                                 } else {
 123                                         set lang_prefix "env LANG=$l "
 124                                 }
 125                                 if {$loccount >1} {
 126                                         catch {unset charset}
 127                                         foreach {lang charset} [split $l "."] break
 128                                         if {[info exists charset]} {
 129                                                 set name "$menu_name\([string tolower $charset]\)"
 130                                         } else {
 131                                                 set name "$menu_name\($lang\)"
 132                                         }
 133                                 } else {
 134                                         set name $menu_name
 135                                 }
 136                                 if {$cmd eq "-"} {
 137                                         set rexec ""
 138                                         set xexec ""
 139                                         set xtermswitch " -e "
 140                                 } else {
 141                                         set rexec "$cmd $connect_name"
 142                                         set xexec "-e $cmd $connect_name"
 143                                         set xtermswitch ""
 144                                 }
 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
 149                         }
 150                         if {$locales_submenu} {
 151                                 lappend HostList "<"
 152                         }
 153             }
 154          }
 155          set hostTimeStamp [clock seconds]
 156 }
 157
 158 #
 159 # Checks mtime of hosts file and, if changed, rereads it
 160 #
 161 proc check_hostFile {} {
 162     global hostTimeStamp CONFIGDIR
 163     if {[file mtime $CONFIGDIR/hosts]>$hostTimeStamp} {
 164         read_hostfile
 165                 build_xtermmenu
 166                 build_runhostmenu
 167     }
 168 }
 169
 170 proc read_hotkeys {} {
 171
 172 }
 173
 174 proc build_runhostmenu {} {
 175    global runHost HostList
 176    build_host_menu .runwindow.host.menu radiobutton {-value $host -variable runHost}
 177 }
 178 #
 179 # Read file of associations
 180 #
 181 proc read_associations {} {
 182    global Associations CONFIGDIR noFvwm
 183    array set Associations {
 184        .tcl builtin
 185    }
 186    if {!$noFvwm} {
 187       set Associations(.fvwm) builtin
 188    }
 189    if [file readable $CONFIGDIR/associations] {
 190       set f [open $CONFIGDIR/associations]
 191       catch {array set Associations [read -nonewline $f]}
 192       close $f
 193    }
 194 }
 195 ######################################################################
 196 # Start menu stuff
 197 ######################################################################
 198
 199 #
 200 # Creates start menu (which is actually recreated each time as posted)
 201 #
 202 proc make_startmenu {} {
 203     global CONFIGDIR
 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
 213         }
 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]
 217 }
 218 #
 219 # Deletes all items from menu and all associated submenus
 220 #
 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
 226             destroy $submenu
 227         }
 228         $menu delete 0
 229     }
 230 }
 231
 232 #
 233 # Scans given directory and forms menu
 234 #
 235 proc make_cascade {path menu} {
 236    global XtermCmd Associations HostList
 237         set runHost [lindex $HostList 0]
 238    set counter 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
 243           incr counter
 244           $menu add cascade -label [mklabel $name] -menu $submenu
 245           menu $submenu -tearoff n
 246           make_cascade $f $submenu
 247        } else {
 248            set state normal
 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 &"
 253                } else {
 254                   set command "exec [list $f] >&@ stdout &"
 255                }
 256            } else {
 257               set command "launch [list $f]"
 258               if ![info exist Associations([file extension $f])] {
 259                  set state disabled
 260               } else {
 261                  set name [file rootname $name]
 262               }
 263           }
 264           $menu add command -label [mklabel $name] -command $command -state $state
 265         }
 266    }
 267 }
 268 #
 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] {
 273      set name $label
 274   }
 275   regsub {_} $name " " label
 276   return $label
 277 }
 278 #
 279 # import_history - creates Start menu items from run menu history
 280 #
 281 proc import_history {} {
 282         tk_messageBox -type ok -title "Import history" -message "Not implemented yet"
 283 }
 284
 285
 286 #
 287 # launch - invokes non-executable file which have associations
 288 #
 289 proc launch {file} {
 290    global Associations
 291    set ext [file extension $file]
 292    switch -exact $ext {
 293      .tcl {
 294           uplevel #0 source [list $file]
 295      }
 296      .fvwm {
 297            set f [open $file]
 298            set list [split [read -nonewline $f] "\n"]
 299            close $f
 300            foreach command $list {
 301                if [regexp "\[ \t]*#" $command] continue
 302                ::fvwm::send $command
 303            }
 304       }
 305       default {
 306             exec /bin/sh -c [format $Associations($ext) $file] >&@stdout &
 307       }
 308    }
 309 }
 310
 311 proc scan_appdir {} {
 312    global CONFIGDIR
 313    deleteCascade .start.menu
 314    make_cascade  $CONFIGDIR/menu .start.menu
 315 }
 316 ######################################################################
 317 # Window list hangling - only if invoked as Fvwm Module
 318 ######################################################################
 319 #
 320 # Creates window menu which is actually recreated each time as posted
 321 #
 322 proc make_windowmenu {} {
 323     global noFvwm
 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
 328     if $noFvwm {
 329           .windows configure -state disabled
 330     }
 331     balloonhelp .windows "Click here to list open windows"
 332     balloonhelp .windows.menu "Left - raise right- winops menu"
 333 }
 334 #
 335 # Rescans current windows and forms window menu
 336 #
 337 proc getwinlist {} {
 338     global WindowIds
 339     while {[.windows.menu index 0] != "none"} {
 340        .windows.menu delete 0
 341     }
 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\""
 351          }
 352          set cmd "Iconify -1"
 353        } else {
 354          set label $list($idx)
 355                  if {$label == "[tk appname]"} continue
 356          regsub -all "\0" $label {} label
 357          set cmd "MyFocus"
 358        }
 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
 363
 364    }
 365 }
 366 #
 367 # Executes executes fvwm window-ops menu on given command
 368 #
 369 proc winop_menu {index} {
 370     if {$index=="none"} return
 371     global WindowIds WindowMenu
 372     ::fvwm::send "Popup $WindowMenu" $WindowIds($index)
 373 }
 374 #
 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
 377 # WINDOWS
 378 #
 379 proc make_runbutton {} {
 380     button .run -text Run -relief raised -pady 1 \
 381       -command {show_popup .runwindow .run; focus -force .runwindow.command}
 382     pack .run -side left
 383     balloonhelp .run "Click here for single command prompt"
 384     make_run_window
 385
 386 }
 387 #
 388 # Creates run window
 389 #
 390 proc make_run_window {} {
 391   global runHost HostList runInXterm pauseAfterRun
 392   set runHost [lindex $HostList 0]
 393   set runInXterm 0
 394   set pauseAfterRun 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:"
 408   global runHost
 409   menubutton .runwindow.host -textvar runHost -relief raised -indicatoron y -menu .runwindow.host.menu
 410   menu .runwindow.host.menu
 411   build_runhostmenu
 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
 431 }
 432
 433 proc checkHostIsLocal {args} {
 434    global runHost
 435    if {[string match localhost* $runHost]} {
 436        .runwindow.browse configure -state normal
 437    } else {
 438        .runwindow.browse configure -state disabled
 439    }
 440 }
 441 #
 442 # Reads history file (invoked once on startup)
 443 #
 444
 445 proc read_history {menu} {
 446   global CONFIGDIR
 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] }
 453   }
 454   close $f
 455 }
 456 #
 457 # Sets widgets in run window to command got from history
 458 #
 459 proc set_command {cmd host xt pause} {
 460   global runCommand  runInXterm pauseAfterRun runHost
 461   set runHost $host
 462   set runCommand $cmd
 463   set runInXterm $xt
 464   set pauseAfterRun $pause
 465 }
 466 #
 467 # Adds current command into history and saves history to file
 468 #
 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\
 474             $pauseAfterRun]
 475   while {[.runwindow.history.menu index end]>20} {
 476      .runwindow.history.menu delete end
 477   }
 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]"
 482   }
 483   close $f;
 484 }
 485 #
 486 # Pops up file dialog and inserts choosen name in place of selection
 487 # into command line
 488 #
 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
 496   } else {
 497      $e insert insert $name
 498   }
 499 }
 500 #
 501 # Executes command entered in runwindow
 502 #
 503 proc runACommand {} {
 504     global RunCmd XtermCmd runCommand runHost runInXterm pauseAfterRun
 505     hide_popup .runwindow
 506     add_history
 507
 508     if $runInXterm {
 509        if $pauseAfterRun {
 510          set command "/bin/sh -c '$runCommand;echo \"Hit <Return>\";read junk'"
 511        } else {
 512          set command $runCommand
 513        }
 514         exec /bin/sh -c "$XtermCmd($runHost) $command" &>@stdout &
 515     } else {
 516        if {$RunCmd($runHost)=="*"} {
 517           tk_messageBox -title Error -type Ok \
 518                -message "You cannot run X applications on $runHost"
 519           return
 520        }
 521        exec /bin/sh -c "$RunCmd($runHost) $runCommand" &>@stdout &
 522     }
 523     set runCommand {}
 524 }
 525 #
 526 # Change state of pause button
 527 #
 528 proc pauseButtonState {} {
 529   global runInXterm
 530   if $runInXterm {
 531      set state normal
 532   } else {
 533      set state disabled
 534   }
 535   .runwindow.pause configure -state $state
 536 }
 537 ##############################################################
 538 # Popup borderless windows
 539 ##############################################################
 540 proc popup {widget args}  {
 541    array set widget_args $args
 542    set need_bind 0
 543    if {![info exists widget_args(-class)]} {
 544         set widget_args(-class) Popup
 545    } else {
 546         set need_bind 1
 547    }
 548    set w [eval toplevel $widget [array get widget_args ]]
 549    if {$need_bind} {
 550                 foreach event [bind Popup] {
 551                         bind $widget_args(-class) $event [bind Popup $event]
 552                 }
 553    }
 554
 555    wm overrideredirect $w yes
 556    wm withdraw $w
 557 }
 558
 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]]
 564      if {$y<0} {
 565         set y [expr [winfo screenheight $window]-[winfo reqheight $window]]
 566         if {$y<0} {
 567             set y 0
 568         }
 569      }
 570    }
 571    if {$x+[winfo reqwidth $window]>[winfo screenwidth $window]} {
 572      set x [expr [winfo screenwidth $window]-[winfo reqwidth $window]]
 573      if {$x<0} {
 574        set x 0
 575      }
 576    }
 577    wm geometry $window +$x+$y
 578    wm deiconify $window
 579    raise $window
 580    grab -global $window
 581 }
 582
 583 proc popupLeft {window x y} {
 584   if {$x<0||$y<0||$x>[winfo width $window]||$y>[winfo height $window]} {
 585      hide_popup $window
 586   }
 587 }
 588
 589 proc hide_popup window {
 590   grab release $window
 591   wm withdraw $window
 592 }
 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 ##############################################################
 599
 600 #
 601 # Creates menu for invoke shell window on any of known hosts
 602 #
 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
 607   build_xtermmenu
 608   balloonhelp .xterm "Click to open new terminal window"
 609 }
 610 proc build_xtermmenu {} {
 611   global Xterm
 612   build_host_menu .xterm.menu command {-command {exec $Xterm($host) >&@stdout &}}
 613   pack .xterm -side left
 614 }
 615
 616 proc build_host_menu {menu type options } {
 617   global HostList Xterm
 618   set top_menu $menu
 619   $menu delete 0 end
 620   catch [concat destroy [winfo children $menu]]
 621   set menu_stack {}
 622   set submenu 0
 623   foreach host $HostList {
 624       if { $host == "-" } {
 625         $menu add separator
 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]
 632       } else {
 633         eval [list $menu add $type -label $host ] [subst " $options"]
 634           }
 635   }
 636 }
 637
 638 #
 639 # start periodic tasks like menu update
 640 #
 641 proc scheduler {} {
 642     global scheduled_commands
 643     foreach cmd $scheduled_commands {
 644         uplevel #0 $cmd [clock seconds]
 645     }
 646     set sec [string trimleft [clock format [clock seconds] -format "%S"] 0]
 647     if ![string length $sec] {
 648        set sec 0
 649     }
 650     after [expr (60-$sec)*1000] scheduler
 651 }
 652 #
 653 # Allows plugin to register proc which would be run each minute
 654 #
 655 proc notifier {command} {
 656    global scheduled_commands
 657    lappend scheduled_commands $command
 658 }
 659 #
 660 # Find menu - allows to find out lot of useful things about system
 661 #
 662
 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
 678 }
 679 pack .find -side left
 680 }
 681
 682 proc findInPath {cmd} {
 683     global env
 684     foreach dir [split $env(PATH) ":"] {
 685        if [file executable [file join $dir $cmd]] {
 686              return 1
 687        }
 688     }
 689     return 0
 690 }
 691 proc create_or_raise {w fillproc args} {
 692   if [winfo exists $w] {
 693     if {[wm state $w] != "normal"} {
 694       wm deiconify $w
 695     } else {
 696       raise $w
 697       focus $w
 698     }
 699     return 0
 700   } else {
 701     eval toplevel $w $args
 702     $fillproc $w
 703   }
 704   return 1
 705 }
 706
 707 proc find_file {w} {
 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
 715      grid $w.l2 x x x
 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
 727      frame $w.b
 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
 736      }
 737      grid rowconfigure $w 3 -weight 1
 738 }
 739
 740 proc find_close {window stop} {
 741    if {[$stop cget -state] == "normal"} {
 742       $stop invoke
 743    }
 744    destroy $window
 745 }
 746
 747 proc read_cmd {channel window stopbutton} {
 748    if [eof $channel] {
 749        $window config -state normal
 750        if [catch {close $channel} error] {
 751           $window insert end $error error
 752        } else {
 753           $window insert end "****** done ******" done
 754        }
 755        $window config -state disabled
 756        if [string length $stopbutton] {
 757            $stopbutton configure -state disabled
 758        }
 759        return
 760    }
 761    $window config -state normal
 762    $window insert end [read $channel]
 763    $window see end
 764    $window config -state disabled
 765 }
 766
 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]]
 775     }
 776     fileevent $f readable [list read_cmd $f $window $stopbutton]
 777 }
 778
 779 proc do_locate {window} {
 780    set pattern [$window.locate get]
 781    open_pipe $window.result "locate $pattern" $window.b.stop
 782 }
 783
 784 proc do_find {window} {
 785    set expression [$window.find get]
 786    open_pipe $window.result "find $expression" $window.b.stop
 787 }
 788
 789 proc find_host {w} {
 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
 812      frame $w.b
 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
 821      }
 822      grid rowconfigure $w 3 -weight 1
 823 }
 824
 825 proc do_dns_lookup {w} {
 826     global nslookup_type;
 827     if {"$nslookup_type" == "A/PTR"} {
 828         set command "host"
 829     } else {
 830         set command "host -t $nslookup_type"
 831     }
 832     open_pipe $w.result "$command [$w.addr get]" $w.b.stop
 833 }
 834
 835 proc clearresult {w} {
 836    $w configure -state normal
 837    $w delete 0.0 end
 838    $w configure -state disabled
 839 }
 840
 841
 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\
 850      -font 6x13
 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
 861      foreach row {0 1} {
 862          grid rowconfigure $w $row -weight 0
 863      }
 864      grid rowconfigure $w 2 -weight 1
 865 }
 866
 867
 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]
 875 }
 876
 877 proc read_apropos {channel window} {
 878    if [eof $channel] {
 879        $window config -state normal
 880        if [catch {close $channel} error] {
 881           $window insert end $error error
 882        } else {
 883           $window insert end "****** nothing more ******" done
 884        }
 885        $window config -state disabled
 886        return
 887    }
 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" {}
 892      } else {
 893        $window insert end $line error "\n" {}
 894      }
 895    }
 896    $window see end
 897    $window config -state disabled
 898 }
 899
 900 proc show_man {w index} {
 901   global CONFIGDIR
 902   set range [$w tag nextrange man "$index linestart"]
 903   regexp "^(\[^ \]+) \\((\[^)\]+)\\)" [eval $w get $range] all command section
 904   exec $CONFIGDIR/man $section $command &
 905 }
 906
 907
 908 proc edit_hostlist {w} {
 909   wm title $w "Add host";
 910   label $w.l1 -text "Menu label" -anchor e
 911   entry $w.label
 912   label $w.l2 -text "Hostname" -anchor e
 913   entry $w.name
 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
 917   set i 0
 918   foreach locale $::LocaleList {
 919         incr i
 920         checkbutton $w.loc.box$i -text $locale -offvalue "" -onvalue $locale -var hostLocale$i
 921         pack $w.loc.box$i -side top
 922   }
 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
 930 }
 931
 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
 938         }
 939         if {![string length $hostName]} {
 940                 bell
 941                 return
 942         }
 943         if {$hostMenuLabel eq $hostName} {
 944                 set line $hostName
 945         } else {
 946                 set line $hostMenuLabel:$hostName
 947         }
 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]} {
 952                         append line " $l"
 953                 }
 954         }
 955         set f [open $CONFIGDIR/hosts a]
 956         puts $f $line
 957         close $f
 958         wm withdraw $w
 959 }
 960 main