tkButtonFly

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

PO Well, working more than 15 years on SGI, ...

Here are some screenshots:

https://www.tcl3d.org/poApps/images/buttonfly0.png https://www.tcl3d.org/poApps/images/buttonfly1.png

An excerpt from the manual page:

 NAME
     buttonfly - a pretty user interface for Silicon Graphics demos

 SYNOPSIS
     buttonfly [ menufile ]

 DESCRIPTION
     Buttonfly is a user reconfigurable, hierarchical, graphical menu system.

     Buttonfly opens up a window and displays one or more buttons, each with
     its own title.  Moving the mouse pointer over a button and pressing the
     left mouse button selects that button, and will cause it to either exe-
     cute UNIX commands (such as running a program) or fly forward and flip
     over, exposing one or more new buttons.  Each of the newly exposed but-
     tons may also be selected to either execute UNIX commands or expose a new
     level of buttons, and so on.

     To go back to the previous set of buttons move the mouse pointer so it
     isn't over any of the buttons, and press the left mouse button (i.e.
     select the background). The buttons will flip over backwards to bring up
     the previous set.  Selecting the background at the top level does noth-
     ing.

Here are screenshots from the Tk version (no 3D currently):

https://www.tcl3d.org/poApps/images/tkButtonFly0.png https://www.tcl3d.org/poApps/images/tkButtonFly1.png


 #!/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