Paul Obermeier 2002/09/16
Tk based program inspired by SGI's buttonfly.
Ten words about what it does, how it looks, would be nice. -- CLN
#!/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.
Test files for Linux:
# Save this in a file called 'menu' # Check for tabs on indented lines. Editors .menu. editors Image viewers .color. 0 0.6 0 .backcolor. 0 0.8 0 .highcolor. 0 0.8 0 .menu. imageViewers View system files .color. 0.6 0 0 .backcolor. 0.8 0 0 .highcolor. 0.8 0 0 .menu. systemDir
# Save this in a file called 'editors' # Check for tabs on indented lines. Graphical ViM gvim Emacs emacs KDE Editor kedit KDE Write kwrite
# Save this in a file called 'imageViewers' # Check for tabs on indented lines. Start gimp. gimp Start xv. xv
# Save this in a file called 'systemDir' # Check for tabs on indented lines. User related files. .menu. systemUser Network related files. .menu. systemNet
# Save this in a file called 'systemUser' # Check for tabs on indented lines. View password file. gvim -R /etc/passwd View group file. .cd. /etc gvim group Go back to main panel. .menu. menu
# Save this in a file called 'systemNet' # Check for tabs on indented lines. View hosts file. .cd. /etc gvim hosts View fstab file. gvim /etc/fstab Go back to main panel. .menu. menu