#!/bin/sh
 # The next line restarts using wish \
 exec wish "$0" -- ${1+"$@"}
 
 # tkButtonFly: A Tk-based replacement of SGI's buttonfly program.
 # Notice: Currently not supported:
 #    ".popup." and ".menu. -".
 #    Toggling between window and fullscreen mode.
 #    No 3D buttons - and therfore no "fly".
 
 set auto_path [linsert $auto_path 0 [file dirname [info script]]]
 set auto_path [linsert $auto_path 0 [file dirname [info nameofexecutable]]]
 
 # Some functions to implement a simple toolhelp.
 proc poToolhelp:Init { w { bgColor yellow } { fgColor black } } {
     if { [winfo exists $w] } {
         destroy $w
     }
     toplevel $w
     set ::topWidget $w
     label $w.l -text "This is toolhelp" -bg $bgColor -fg $fgColor -relief ridge
     pack $w.l
     wm overrideredirect $w true
     wm geometry $w [format "+%d+%d" -100 -100]
 }
 
 proc poToolhelp:ShowToolhelp { x y str } {
     $::topWidget.l configure -text $str
     raise $::topWidget
     wm geometry $::topWidget [format "+%d+%d" $x [expr $y +10]]
 }
 
 proc poToolhelp:HideToolhelp {} {
     wm geometry $::topWidget [format "+%d+%d" -100 -100]
 }
 
 proc poToolhelp:AddBinding { w str } {
     if { ![info exists ::topWidget]} {
         poToolhelp:Init .poToolhelp
     }
     bind $w <Enter>  "poToolhelp:ShowToolhelp %X %Y [list $str]"
     bind $w <Leave>  { poToolhelp:HideToolhelp }
     bind $w <Button> { poToolhelp:HideToolhelp }
 }
 
 # Convert color value from range [0..1] into [0..255].
 proc f2i { col } {
     return [expr int($col * 255.0)]
 }
 
 # Convert color given as (r, g, b) into #RRGGBB.
 proc rgb2hex { r g b } {
     return [format "#%02X%02X%02X" [f2i $r] [f2i $g] [f2i $b]]
 }
 
 # Parse the config file fileName to build up the panel information in gMenu.
 proc parseFile { fileName } {
     global gMenu gFile gBtn gCurDir
 
     set retVal [catch {open $fileName r} inFp]
     if { $retVal != 0 } {
         tk_messageBox -message "Cannot read file $fileName" \
                       -icon warning -type ok 
         return
     }
     while { [gets $inFp line] >= 0 } {
         if { [string match "#*" $line] } {
             # Comment line. Do nothing.
         } elseif { [string match "\t*" $line] } {
             # Line starts with a tab. Should be one of the defined dot-commands
             # or the action for the button.
             if { [string length [string trim $line]] == 0 } {
                 # Blank or whitespaced line. Do nothing.
             } elseif { [string match "\t.color.*" $line] } {
                 scan $line " %s %f %f %f" dummy r g b
                 set ::gMenu($::gFile,$::gBtn,fore) [rgb2hex $r $g $b]
             } elseif { [string match "\t.backcolor.*" $line] } {
                 scan $line " %s %f %f %f" dummy r g b
                 set ::gMenu($::gFile,$::gBtn,back) [rgb2hex $r $g $b]
             } elseif { [string match "\t.highcolor.*" $line] } {
                 scan $line " %s %f %f %f" dummy r g b
                 set ::gMenu($::gFile,$::gBtn,high) [rgb2hex $r $g $b]
             } elseif { [string match "\t.cd.*" $line] } {
                 scan $line " %s %s" dummy dir
                 if { [string compare [file pathtype $dir] "relative"] == 0 } {
                     set dir [file join $gCurDir $dir]
                 }
                 set ::gMenu($::gFile,$::gBtn,cd) [list $dir]
             } elseif { [string match "\t.menu.*" $line] } {
                 scan $line " %s %s" dummy menuName
                 set ::gMenu($::gFile,$::gBtn,menu) $menuName
             } elseif { [string match "\t.popup.*" $line] } {
                 scan $line " %s %s" dummy popupTitle
                 set ::gMenu($::gFile,$::gBtn,popup) $popupTitle
                 tk_messageBox -message "Popup menus not supported." \
                       -icon warning -type ok 
             } else {
                 set gMenu($gFile,$gBtn,cmd) [string trimleft $line]
             }
         } else {
             if { [string length [string trim $line]] != 0 } {
                 # This must be the button's name.
                 lappend gMenu($gFile,btns) $line
                 set gBtn $line
                 # Initialize buttons attributes with default values.
                 set gMenu($gFile,$gBtn,high) "#CCCCCC"  ; # Active color
                 set gMenu($gFile,$gBtn,fore) "#AAAAAA"  ; # Button color
                 set gMenu($gFile,$gBtn,back) "#444444"  ; # Frame background
                 set gMenu($gFile,$gBtn,cd)   "$gCurDir" ; # Dir to cd to
                 set gMenu($gFile,$gBtn,cmd)  ""         ; # Default command
             }
         }
     }
 }
 
 # Read the config file fileName.
 # If there were references to other panels via .menu.,
 # recursively parse these files, too.
 proc readFile { parent fileName } {
     global gMenu gFile gBtn gScanned
 
     set gFile $fileName
     parseFile $fileName
     lappend gScanned $fileName
     set gMenu($gFile,parent) $parent
     foreach f [array names gMenu $fileName,*,menu] {
         set foundInd [lsearch -exact $gScanned $gMenu($f)]
         if { $foundInd < 0 } {
             readFile $fileName $gMenu($f)
         }
     }
 }
 
 # Build a button panel into frame $fr according to config file fileName.
 # The background of the panel's parent frame will be set to frColor.
 proc buildPanel { fr fileName { frColor "#444444" } } {
     global gMenu gFile gBtn
 
     # Destroy an existing panel frame (and all contained buttons)
     # and create a new one.
     set newFr $fr.f
     catch { destroy $newFr }
     frame $newFr -bg $frColor
     pack $newFr -expand 1 -fill both
     
     if { [string compare $gMenu($fileName,parent) ""] != 0 } {
         bind Frame <ButtonRelease-1> "buildPanel $fr $gMenu($fileName,parent)"
     }
 
     # Step through the list of button names for this panel and create
     # button widgets with corresponding colors. Add a binding either for
     # creating a new panel via buildPanel or for executing a command.
     set ind 0
     set row 0
     set col 0
     set btnList $gMenu($fileName,btns)
     set noCols [expr int (ceil (sqrt ([llength $btnList])))]
     set noRows [expr int (ceil (double ([llength $btnList]) / $noCols))]
     for { set c 0 } { $c < $noCols } { incr c } {
         grid columnconfigure $newFr $c -weight 1
     }
     for { set r 0 } { $r < $noRows } { incr r } {
         grid rowconfigure $newFr $r -weight 1
     }
 
     foreach btnName $btnList {
         set indStr "$fileName,$btnName"
         button $newFr.b$ind \
             -text $btnName \
             -bg $gMenu($indStr,fore) \
             -activebackground $gMenu($indStr,high)
 
         if { [info exists gMenu($indStr,menu)] } {
             $newFr.b$ind configure -command \
                 "buildPanel $fr $gMenu($indStr,menu) $gMenu($indStr,back)"
             poToolhelp:AddBinding $newFr.b$ind "Goto: $btnName"
         } else {
             $newFr.b$ind configure -command \
                 [list execCmd $gMenu($indStr,cd) $gMenu($indStr,cmd)]
             poToolhelp:AddBinding $newFr.b$ind "Exec: $btnName"
         }
         grid $newFr.b$ind -sticky news -row $row -column $col -padx 10 -pady 10
         incr col
         if { $col >= $noCols } {
             set col 0
             incr row
         }
         incr ind
     }
 }
 
 proc execCmd { dir cmd } {
     if { [string compare $cmd ""] == 0 } {
         tk_messageBox -message "No command specified. Check config file." \
                       -icon warning -type ok 
     }
     cd $dir
     eval exec $cmd &
 }
 
 # Start of program. Check command line arguments first.
 set optFullScreen 0
 set inFile ".menu"
 set curArg 0
 
 if { $argc >= 1 } {
     while { $curArg < $argc } {
         set curParam [lindex $argv $curArg]
         if { [string compare -length 1 $curParam "-"] == 0 } {
             if { [string compare $curParam "-f"] == 0 } {
                 # Fullscreen mode does not work correctly under Linux/KDE.
                 set optFullScreen 1
             }
         } else {
             set inFile $curParam
         }
         incr curArg
     }
 }
 
 if { ![file readable $inFile] }  {
     tk_messageBox -message "Start configuration file $inFile not found." \
                   -icon warning -type ok 
     exit 1
 }
 
 # Set initial values for variables needed for reading the config files.
 set gCurDir  [pwd]
 set gFile    $inFile
 set gBtn     "tkButtonFly"
 set gScanned [list]
 
 # Now (recursively) read all config files and enter all relevant information
 # into array gMenu.
 readFile "" $inFile
 
 # Create window title and main frame.
 wm title . "tkButtonFly"
 wm minsize . 100 100
 wm geometry . "400x300"
 frame .f
 pack .f -expand 1 -fill both
 
 # Exit tkButtonFly with Escape.
 bind all <KeyPress-Escape> exit
 
 # Build the first button panel.
 buildPanel .f $inFile
 
 if { $optFullScreen } {
     set xmax [winfo screenwidth .]
     set ymax [winfo screenheight .]
     bind all <Button-3> exit
     wm geometry . [format "%dx%d+0+0" $xmax $ymax]
     wm overrideredirect . 1
 }
 update
 raise .
 
 # We are in the event loop now.