WJG (1 February 2006) This morning I need to create yet another popop menu for a project. So, rather than just adding some in-line code I thought: "How many more times am I going to do this? Time for a package!" I had examined some menuing solutions in the past but was not inclined towards learning a replacement set of instructions for the ones already available. So my choice was to maintain menus as lists of Tk commands then load them run as required. If there's any need to append or reconfigure a menu, just change the appropriate list then call popup::create again. At this point I'll let the code below speak for itself.
#---------------
# 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] <<Undo>>}}
{command -label Redo -command {event generate [focus] <<Redo>>}}
{separator}
{command -label Cut -command {event generate [focus] <<Cut>>}}
{command -label Copy -command {event generate [focus] <<Copy>>}}
{command -label Paste -command {event generate [focus] <<Paste>>}}
}
# 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 <Button-2> {popup::show %W Files}
bind .txt1 <Button-3> {popup::show %W Edit}
bind .txt2 <Button-2> {popup::show %W UK}
bind .txt2 <Button-3> {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