# Menu Client Tcl code for tkgoodstuff # format of menu: list of items: # 0:type 1:label 2:list of switches 3:list of children for cascades proc MenuDeclare {} { set Prefs_taborder(:Clients,Menu) "Menu Misc Button" TKGDeclare Menu(makebutton) 1 -typelist [list Clients Menu Button Misc]\ -label "Produce a button (otherwise Menu 1 is bound to clock)"\ -vartype boolean TKGDeclare Menu(text) "Menu" -typelist [list Clients Menu Button Misc]\ -label "Text on button" TKGDeclare Menu(balloon) "" \ -typelist [list Clients Menu Button Misc]\ -label "Text of balloon help" TKGDeclare Menu(imagefile) {%tkgmenu} -typelist [list Clients Menu Button Misc]\ -label "Image on Button (file)" TKGDeclare Menu(iconside) background -typelist [list Clients Menu Button Misc] \ -label {Side of icon on button} -vartype optionMenu\ -optionlist {left right top bottom background} TKGDeclare Menu(ignore) 1 \ -label {Ignore general preferences for no labels and no icons} \ -vartype boolean -typelist [list Clients Menu Button Misc] ConfigDeclare TkMan ClientButton1 TkMan [list Clients TkMan Button] TKGDeclare Menu(font) ""\ -vartype font\ -typelist [list Clients Menu Button Misc]\ -label "Font on button" -help "Leave blank for a default that depends on the tkgoodstuff\ font scale." if [Empty $Menu(font)] { # set Menu(font) "Times [lindex {14 18 24} $TKG(fontscale)] bold" set Menu(font) tkghugebold } TKGDeclare Menu(tearoff) 0 -typelist [list Clients Menu Misc]\ -label "Make tear-off menus" -vartype boolean ConfigDeclare Menu ClientButton3 Menu [list Clients Menu Button] set mdata [list \ [list Menu Applications {} [list \ [list Exec Rxvt [list -command rxvt]]\ [list Exec Emacs [list -command emacs]]\ [list Exec Knews [list -command knews]]\ [list Exec Netscape [list -command netscape]]\ [list Exec XV [list -command xv]]\ ]]\ [list Separator "-------"]\ [list Menu Utilities {} [list \ [list Exec tkdesk]\ [list Exec xdir]\ [list Exec tkman]\ [list Exec xfontsel]\ [list Exec xcolorsel]\ [list Exec "TkCon" [list -command tkcon.tcl]]\ ]]\ [list Separator "-------"]\ [list Run "Run . . ."]\ [list Separator "-------"]\ [list TKGMenu "tkgoodstuff Menu"]\ ] TKGDeclare Menu(data) $mdata\ -typelist [list Clients Menu Menu]\ -vartype menu -nolabel 1 -nodefault 1 unset mdata } proc MenuCreateWindow {} { global MenuClient-params Menu if {![TKGReGrid MenuClient] && ![info exists Menu(current)]} { if $Menu(makebutton) { lappend c TKGMakeButton MenuClient \ -menu .menu\ -foreground $Menu(foreground) \ -background $Menu(background) \ -activeforeground $Menu(activeforeground) \ -activebackground $Menu(activebackground) \ -font $Menu(font) -ignore $Menu(ignore) foreach v {text imagefile balloon iconside} { if ![Empty $Menu($v)] { lappend c -$v $Menu($v) } } eval $c set button [set MenuClient-params(pathname)] set Menu(current) $button.menu menu $Menu(current) -tearoff $Menu(tearoff) $button configure -menu $Menu(current) } else { global Clock set Clock(menu) .menu set Menu(current) .menu } set Menu(counter) 0 foreach item $Menu(data) { Menu[lindex $item 0] $item } } } proc MenuMenu {item} { set label [lindex $item 1] global Menu set m $Menu(current).[incr Menu(counter)] menu $m -tearoff $Menu(tearoff) $Menu(current) add cascade -label $label -menu $m set Menu(parent,$m) $Menu(current) set Menu(current) $m foreach child [lindex $item 3] { Menu[lindex $child 0] $child } set Menu(current) $Menu(parent,$Menu(current)) } proc MenuExec {item} { global Menu set label [lindex $item 1] set switches [lindex $item 2] set command [lindex $switches [expr [lsearch $switches -command] +1]] if {$command == ""} {set command $label} set command [SelectionSub $command] $Menu(current) add command -label $label -command [list MenuDoExec $command] } proc MenuDoExec {command} { global Fvwm if {[info exists Fvwm(outid)] && [string match Fvwm* $command]} { lappend C fvwm send 0 "Module $command" } else { lappend C eval exec $command & } if [catch $C err] { error $err } } proc MenuTcl {item} { global Menu set label [lindex $item 1] set switches [lindex $item 2] set command [lindex $switches [expr [lsearch $switches -command] +1]] if {$command == ""} {set command $label} set command [SelectionSub $command] $Menu(current) add command -label $label -command $command } proc MenuRun {item} { global Menu $Menu(current) add command -label "Run . . ." -command TKGRun } proc MenuTKGMenu {item} { global Menu set m $Menu(current).tkgpopup $Menu(current) add cascade -label "TkGoodStuff menu" \ -menu $m menu $m -tearoff $Menu(tearoff) -postcommand "TKGMenuDup .tkgpopup $m" } proc MenuSeparator {item} { global Menu $Menu(current) add separator } proc TKGRun {} { TKGDialog tkgrun -wmtitle "Run . . ." -title "Run . . ."\ -buttons [list [list ok OK {eval exec $TKGRun_command &;destroy .tkgrun}]] grid [entry .tkgrun.entry -width 40 -textvariable TKGRun_command]\ -row 5 -column 0 -sticky nsew focus .tkgrun.entry bind .tkgrun.entry { .tkgrun.buttons.ok flash .tkgrun.buttons.ok invoke break } } # a slightly modified version of tkMenuDup in tearoff.tcl proc TKGMenuDup {src dst} { set cmd "$dst configure" foreach option [$src configure] { if {[llength $option] == 2} { continue } lappend cmd [lindex $option 0] [lindex $option 4] } eval $cmd set last [$src index last] if {$last == "none"} { return } for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { set cmd "$dst add [$src type $i]" foreach option [$src entryconfigure $i] { lappend cmd [lindex $option 0] [lindex $option 4] } eval $cmd if {[$src type $i] == "cascade"} { tkMenuDup [$src entrycget $i -menu] $dst.m$i normal $dst entryconfigure $i -menu $dst.m$i } } regsub -all . $src {\\&} quotedSrc regsub -all . $dst {\\&} quotedDst regsub -all $quotedSrc [bindtags $src] $dst x bindtags $dst $x foreach event [bind $src] { regsub -all $quotedSrc [bind $src $event] $dst x bind $dst $event $x } } DEBUG "Loaded Menu.tcl"