#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


foreach pair {{get_widget aux/teach.tcl}} {
  if {[info procs [lindex $pair 0]] == ""} {
    source "[file dirname [info script]]/../[lindex $pair 1]"
}}
if {[info procs KeysymBox] == ""} {
  catch {source "$XF_Dir/templates/Procedures/KeysymBox.t"}
}


# Help text.

set Help "" ; append Help {Poputh -- teach a widget to pop up a menu

This program teaches a remote widget to pop up a remote menu upon some event
(such as a button-press.)


Widgets of Poputh

Event Entry

This entry contains a binding, like Button-3 which when executed in a remote
widget, should pop up some menu.


'Bind' button

This button brings up XF's keysym dialog box, which will help you in selecting
a binding for the Event entry.


The Teach Menu

  Popup

Select the "Popup" entry in the Teach menu to teach a popup menu. You must then
select the menu to use, and then select the widget. (You can select the menu by
either selecting its parent menubutton, or the menu itself.)

} $TH_Help {

The event should carry %X and %Y coordinates...only mouse button events (clicks
and releases) are really suitable events to use to pop up menus. }


# Teach a widget to use a menu for a popup
proc teach_popup {binding} {
  global App Widget Class
  if {![get_widget]} {bell ; return}
  switch $Class {
    "Menu" {set menu $Widget
    } "Menubutton" {set menu [send $App $Widget cget -menu]
    } default {bell ; return}}
  set popup_app $App

  if {![get_widget]} {bell ; return}
  if {$App != $popup_app} {bell ; return}
  do_cmd "bind $Widget <$binding> \{tk_popup $menu %X %Y\}"
}


set Popup_Event ""
create_form_entry .event "Event" Popup_Event
button .event.keysym -text {Binding} \
	-command {.event.e insert insert [KeysymBox $XF_Dir/lib/Keysyms]}
pack .event.keysym -before .event.e -side right
set Popup_Event "Button-3"
th_add_history .event.thistory .event.e $Popup_Event $Popup_Event
if {[info procs KeysymBox] == ""} {.event.keysym configure -state disabled}
.buttons.teach.m add command -label "Popup" -com {teach_popup $Popup_Event}
destroy .buttons.source