/usr/lib/exmh/widgetMenu.tcl is in exmh 1:2.8.0-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | #
# This was hacked upon by <John@LoVerso.Southborough.MA.US>, 4/94.
#
# From: allan@piano.sta.sub.org (Allan Brighton)
# Newsgroups: comp.lang.tcl
# Subject: Re: How do I post a menu from a canvas item ??
# Message-ID: <1895@piano.stasys.UUCP>
# Date: 23 Mar 94 10:41:06 GMT
#
#In an article mh@awds.imsd.contel.com (Michael Hoegeman) writes:
#>How do you get a menu posted from a canvas and make it behave like one
#>that was posted from a menubutton and get cascades and the like to work
#>properly? I'd much rather use someone else's soultion rather than slog it
#>out myself.
#
#I've been using these routines to deal with menus in a canvas.
#They are not perfect, but they work. Suggestions for improvements
#are welcome.
#
# setup canvas bindings
#
# $canvas bind $tag <ButtonPress-1> "menu_post $menu $canvas %X %Y"
# $canvas bind $tag <ButtonRelease-1> "menu_unpost $menu $canvas"
#
# To avoid internal text tag grab problems, use these bindings
# bind $tw <ButtonPress-3> {text_menu_post %W %x %y %X %Y}
# bind $tw <Any-ButtonRelease-3> {text_menu_unpost %W}
# and use a tag to determine which menu to invoke.
#
proc text_menu_post {w wx wy x y} {
global tkPriv
set tags [$w tag names @$wx,$wy]
Exmh_Debug $tags
set tkPriv(textmenu) {}
foreach tag $tags {
catch {
if {[winfo class $w.$tag] == "Menu"} {
set tkPriv(textmenu) $w.$tag
}
}
}
catch {menu_post $tkPriv(textmenu) $w $x $y}
}
proc text_menu_unpost {w} {
global tkPriv
catch {menu_unpost $tkPriv(textmenu) $w}
catch {unset tkPriv(textmenu)}
}
# post the given menu at the given position in the widget (or canvas) w
proc menu_post {menu w x y} {
global tkPriv
$menu activate none
tk_popup $menu $x $y
set tkPriv(cursor) [$w cget -cursor]
$w config -cursor arrow
grab set $w
}
# unpost the given menu in the widget
proc menu_unpost {menu w} {
global tkPriv
tkMenuUnpost $menu
catch {$w config -cursor $tkPriv(cursor)}
grab release $w
}
# invoke the selected item in the menu, if any
proc menu_invoke {menu w} {
set i [$menu index active]
menu_unpost $menu $w
if {$i != "none"} {
$menu invoke $i
}
}
# setup the bindings for a local widget menu
proc menu_bind {menu w} {
bindtags $menu $menu
bind $menu <Any-ButtonPress> {}
bind $menu <Any-ButtonRelease> "menu_invoke $menu $w"
bind $menu <2> { }
bind $menu <B2-Motion> { }
bind $menu <Any-Motion> {%W activate @%y}
bind $menu <Any-Enter> {%W activate @%y}
bind $menu <Any-Leave> {%W activate none}
}
|