# 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