Popups -Using popup menus to offer variations in displayed text

WJG (7th September, 2005) One of my commissions over the summer has been to work on the development a Chinese language course for use at a local school. This needed the creation of parallel text documents. That is, one line of Chinese Characters with the associated pinyin romanisation underneath. Anyone who has had to work on this sort of task knows what fiddle it can be getting the right diacritices for the various tones. To make matters worse, many characters have variants pronunciations. I'd already automated the HZ->PY process but the output strings had all the variants included. Inspired by the spell-check popups found in wordprocessors such as OpenOffice, I decided to make myself something similar. Chuffed with the result, I thought I'd share it with the lads at the Wiki.

MG notes that this seems to require either Tcl 8.5, or an 8.4 version of lassign from that page

WJG If anyone's using versions of Tcl earlier than 8.5, then simply replace lassign with:

  foreach {x y} [winfo pointerxy $w] {}

 # popups.tcl
 # Created by William J Giddings, 2005.
 # Description:
 # -----------
 # In automating the conversion of Chinese hanzi into roman pinyin, 
 # a single character may a have number of variant pronunciations. 
 # Rather than including all the available choices in the displayed output
 # the first item in the list is offered, the text tagged with a unique 
 # id and the alternatives are then used to create selectable items in a popup-menu. 
 # Access to the menu occurs when a <Button-3> event occurs over the tagged text. 
 # Should one of the menu items be selected, the currently displayed 
 # word is replaced with the new choice. 
 # Usage:
 # -----
 # See demo proc for example 

 namespace eval popup {
  set cursor ""   ;# store default widget cursor during rollovers

 # create menu (m) with from list of supplied items (a) 
 proc popup::create {m a} {
  # destroy any pre-exising menu with the same name
  destroy $m

  # create new menus
  menu $m -tearoff 0  
  foreach i $a {
    $m add command -label $i -command "popup::swap $m $i" 
  popup::config [winfo parent $m] $m

 # display the popup menu adjacent to the current pointer location
 proc popup::show {m} {
  set w [winfo parent $m]
  lassign [winfo pointerxy $w] x y
  set ::active(tag) $m
  #get active ta
  tk_popup $m $x $y
 # swap text displayed in the text widget with the selected menu item
 proc popup::swap {m i} {

  # get ranges of tag $m
  lassign [[winfo parent $m] tag ranges $m] from to
  # swap range content for $i
  [winfo parent $m] delete $from $to
  [winfo parent $m] insert $from "$i " $m

 # configure tag display options and bindings
 proc popup::config {path name} {

  $path tag configure $name -foreground red
  $path tag bind $name <Button-3> "popup::show $name"
  $path tag bind $name <Enter> {
      set popup::cursor [%W cget -cursor]
      %W configure -cursor arrow
  $path tag bind $name <Leave> {
      %W configure -cursor $popup::cursor

 # the ubiquitous demo
 proc demo {} {

  package require Tk
  # build simple GUI
  text .txt -font {Palatino 12}
  pack .txt -fill both -expand 1
  focus .txt
  # A few examples 
  .txt insert insert "A demonstration of alternatives.\nSimply click Button-3 over a red word for a popup menu of choices.\n"
  # Step 1) add some tagged words 
  .txt insert insert "Fruit " .txt.menu_1
  # Step 2) build a list of alternatives
  set menuitems(1) [list Apple Bannana Cherry Damson Elder]
  # Step 3) create popup
  popup::create .txt.menu_1 $menuitems(1) 
  # just a few other entries for company....
  .txt insert insert "Trees " .txt.menu_2
   set menuitems(2) [list Ash Birch Chestnut ]
  popup::create .txt.menu_2 $menuitems(2)
  .txt insert insert "Birds " .txt.menu_3
  set menuitems(3) [list Blue-Tit Great-Tit Coal-Tit Robin]
  popup::create .txt.menu_3 $menuitems(3)