#--------------- # popup.tcl #--------------- # Created by William J Giddings, 2006. # # This package acts a simple template for adding popups # to any TK applicaiton. # # Description: # ----------- # A private namespace contains an array of list which # define each menu item using standard definitions. # # Usage: # ----- # See demo proc for example #--------------- namespace eval popup { # some package defaults set DEMO yes set DEBUG no set VERSION 0.1 # build menu description in custom namespace # regular stuff, utlize virtual events set menu(Edit) { {command -label Undo -command {event generate [focus] <>}} {command -label Redo -command {event generate [focus] <>}} {separator} {command -label Cut -command {event generate [focus] <>}} {command -label Copy -command {event generate [focus] <>}} {command -label Paste -command {event generate [focus] <>}} } # file I/O require more customisation set menu(Files) { {command -label New -command {puts New}} {command -label Open -command {puts Open}} {separator} {command -label Close -command {puts Close}} {command -label Save -command {puts Undo}} {command -label "Save As.." -command {puts "Save As.."}} } } #---------------- # create menu (m) with from list of supplied items (a) #--------------- proc popup::create {m} { set c $m set m ".[string tolower $m]" # destroy any pre-exising menu with the same name destroy $m # create new menus menu $m -tearoff 0 foreach i $popup::menu($c) { eval $m add $i } } #--------------- # display the popup menu adjacent to the current pointer location #--------------- proc popup::show {w m} { set m ".[string tolower $m]" # set w [winfo parent $m] # lassign [winfo pointerxy $w] x y foreach {x y} [winfo pointerxy $w] {} set ::active(tag) $m #get active ta tk_popup $m $x $y } #--------------- # initialise existing menus #--------------- popup::create Edit popup::create Files # end of package #--------------- # the ubiquitous demo #--------------- proc demo {} { wm title . "Popup($::popup::VERSION):" # build custom menus # define.. set popup::menu(UK) { {command -label England -command {demoStub "England:\tLondon"}} {command -label Wales -command {demoStub "Wales:\tCardif"}} {separator} {command -label Ireland -command {demoStub "Ireland:\tBelfast"}} {command -label Scotland -command {demoStub "Scotland:\tEdinburgh"}} } # initialize.. popup::create UK # define.. set popup::menu(Europe) { {command -label Germany -command {demoStub "Germany:\tBerlin"}} {command -label France -command {demoStub "France:\tParis"}} {separator} {command -label Italy -command {demoStub "Italy:\tRome"}} {command -label Spain -command {demoStub "Span:\tMadrid"}} } # initialize.. popup::create Europe # build simple GUI console show pack [text .txt1 -undo yes -font {Palatino 12} -height 10 -width 25 -bg #ffffff] -fill both -expand 1 -side top -anchor nw pack [text .txt2 -undo yes -font {Palatino 12} -height 10 -width 25 -bg #ffffdd] -fill both -expand 1 -side top -anchor nw .txt1 insert end "Cut-n Paste Me." .txt2 insert end "Capitals of Europe." # add some odd bindings just to test the packacge bind .txt1 {popup::show %W Files} bind .txt1 {popup::show %W Edit} bind .txt2 {popup::show %W UK} bind .txt2 {popup::show %W Europe} focus -force .txt2 #--------------- # let our menus do something... #--------------- proc demoStub {str} { set w [focus] $w insert end $str\n } } if {$popup::DEMO} {demo} # EOF