Re: Looking for menu enhancement
- From: Dave Bodenstab <mrdave@xxxxxxxxxx>
- Date: Sat, 31 May 2008 14:20:13 -0500
Thanks for both replies.
However, I was trying to find something that would work
on a "menu ... -type cascade" on the toplevel menubar.
(In addition, ubuntu's Tk 8.5 does not work with ubuntu's
sqlite3 tcl interface so I'd have to start rebuilding
packages and be dependent on 8.5.)
I've got something that sort of works (proof of concept?)
using an independent "menu .popup" (attached for anyone
particularly interested.)
I then tried to use a separate toplevel window with a
couple of label's (holding my up/down arrow images) and
a listbox in-between. It soon became too tedious to continue;
it looks like, to do it right, I'd have to take the standard menu.tcl and
listbox.tcl from the Tk library and implement a completely
new type of menu widget. And then it's not clear to me whether
or not I'd be able to simulate its being attached to the
menubar (on unix probably; windows? I doubt it.)
Anyway, I've given up; its unlikely that my current
cascade menu will actually get too long for the screen
height. I had just wanted to handle that eventuality
if it had been relatively easy to do.
PS. It still seems that this style of menu (click on a
very long bookmark list with Firefox to see an example) would be a useful
addition to Tk... is development/feature additions complete
for 8.5?
------------------------------------------------
Proof? of concept:
# Bugs:
# Clicking on a normal cascade menubutton causes the manu to be displayed
# and the button remains highlight'ed and with -relief raised; when the
# custom menu is clicked, the menu is displayed, then button is re-activated
# BUT the -relief raised disappears
console show
menu .m -type menubar -tearoff false
bind .m <Button1-ButtonRelease> "B1Released %W %X %Y"
# State of .popup menu
# {}=off, up=tk_popup'ed, other=after queued
set active {}
# Called on Button1-ButtonRelease for cloned menu .#m
# If the mouse was released over menubar button #2 (exit), exit
# If the mouse was released over menubar button #1 (custom popup), bring up the
# .popup menu in place of the normal cascade menu
# If the mouse was released over the .popup menu, invoke the appropriate menu entry
proc B1Released {w X Y} {
puts [info level 0],$::active
if { "[set win [winfo containing $X $Y]]" eq "$w" } {
# Button released inside .#m
set wx [winfo rootx $w]
set wy [winfo rooty $w]
set index [.#m index @[expr {$X-$wx}],[expr {$Y-$wy}]]
# puts B1:@[expr {$X-$wx}],[expr {$Y-$wy}]=$index
if { $index == 2 } {
# Mouse button released over the menubar button for .#m.#m#help -- the exit "X"
exit
}
if { $index == 1 } {
# Mouse button released over the menubar button for .#m.#m#custom
# Tk would normally post this menu, but this must be intercepted so the
# custom menu can be activated in it's place
# puts B2:[winfo geometry .#m.#m#custom]
regexp {^\d+x\d+([-+]\d+)([-+]\d+)$} [winfo geometry ..#m.#m#custom] -> px py
if { "$::active" eq "" } {
# Queue a tk_popup
set ::active [after idle "enablePopup $w $px $py"]
} else {
# Already up or queued, do two things:
# Keep the menu button high-lighted in .#m
# Activate the first entry in .popup (as is done for a normal cascade menu)
after 100 "puts After100,\$::active; $w activate 1; .popup activate 0"
}
# Un-post and un-activate .#m.#m#custom so Tk doesn't lock up
$w postcascade none
$w activate none
} else {
# Mouse button released somewhere else in the menubar
# Remove .popup if it's been brought up
if { "$::active" eq "up" } {
.popup unpost
set ::active {}
}
}
} elseif { "$win" eq ".popup" && "$::active" eq "up" } {
# Mouse button released inside .popup
# Activate whatever entry upon which the mouse pointer lies
set wy [winfo rooty .popup]
set index [.popup index @[expr {$Y-$wy}]]
puts .popup:@[expr {$Y-$wy}]=$index
if { "$index" ne "none" } {
.popup invoke $index
}
# Do two things:
# Arrange for .popup to be removed,
# Reset ::active
after idle "puts AfterIdle,\$::active; .popup unpost; set ::active {}"
}
}
# The mouse button has been released over the button in the menubar
# Bring up .popup and place it in the correct position just below the button;
# this is where the normal cascade menu is placed
proc enablePopup {w x y} {
puts [info level 0],$::active
# Only once...
if { "$::active" ne "" && "$::active" ne "up" } {
tk_popup .popup $x $y
# Activate the first entry just like a cascade menu
.popup activate 0
set ::active "up"
}
# Keep the button highlighted in the menubar
# BUG: How can the relief be changed on the menubutton?
$w activate 1
}
bind .m <Button1-Motion> "B1Motion %W %X %Y"
bind .m <ButtonPress-1> "B1Motion %W %X %Y"; # Pretend it moved zero pixels
# Called on Button1-Motion or Button-ButtonPress for cloned menu .#m
# Arrange for the .popup menu to be shown whenever the mouse is over menubar
# button #1 (custom popup), and removed when the mouse leaves button #1.
proc B1Motion {w X Y} {
#puts [info level 0],$::active
if { "[set win [winfo containing $X $Y]]" eq "$w" } {
# Mouse is inside .#m
set wx [winfo rootx $w]
set wy [winfo rooty $w]
set index [.#m index @[expr {$X-$wx}],[expr {$Y-$wy}]]
# puts M1:@[expr {$X-$wx}],[expr {$Y-$wy}]=$index
if { $index == 1 } {
# Mouse is inside menubar button #1, our custom menu popup
# Arrange for the .popup menu to be shown
if { "$::active" eq "" } {
set ::active [after idle showPopup]
}
} else {
# Mouse is not inside menubar button #1, remove .popup menu if it exists
if { "$::active" eq "up" } {
.popup unpost
set ::active {}
}
}
} elseif { "$win" eq ".popup" } {
# Mouse is inside .popup
# Keep the menubar button highlight'ed
.#m activate 1
# Activate the appropriate entry in .popup (as is done for a normal cascade menu)
set wy [winfo rooty .popup]
set index [.popup index @[expr {$Y-$wy}]]
puts .popup:@[expr {$Y-$wy}]=$index
if { "$index" ne "none" } {
.popup activate $index
}
} else {
# Mouse is not inside either menubar button #1, or .popup, remove the .popup
# menu if it exists
if { "$::active" eq "up" } {
.popup unpost
set ::active {}
}
}
}
# The mouse button has been pressed and it has moved into menubar button #1.
# Show the .popup menu in place of the normal cascade menu
proc showPopup {} {
puts [info level 0],$::active
# At this point, Tk has (at least it has during my testing) posted the empty
# casdade menu (1x1) in it's normal place, just underneath the menubar button.
# Grab its geometry and x,y coordinates, and do a tk_popup with the custom menu
# puts geometry=[winfo geometry .#m.#m#custom]
regexp {^\d+x\d+([-+]\d+)([-+]\d+)$} [winfo geometry .#m.#m#custom] -> px py
if { "$::active" ne "" && "$::active" ne "up" } {
# The withdraw stuff stops ::tk_popup issuing a grab on the menu
wm withdraw .popup
tk_popup .popup $px $py
wm deiconify .popup
set ::active "up"
}
}
# Don't bother trying to move or adjust .popup if the parent window is moved
# or resized
bind . <Configure> configureEvent
proc configureEvent {} {
if { "$::active" eq "up" } {
.popup unpost
set ::active {}
}
}
# Standard Tk cascade menu for reference
menu .m.file -type normal -tearoff false; # For windoze, this menu must be named .file
for {set i 1} {$i <= 5} {incr i} {
.m.file add command -label [format "Choice #%d" $i] -command "puts \"Normal cascade menu, choice #$i\""
}
# Menubar button #0
..m add cascade -label Normal -menu .m.file
# Need to have this empty menu to obtain its geometry when it's posted so it can
# be replaced with a custom menu
menu .m.custom -type normal -tearoff false -borderwidth 0 -activeborderwidth 0
# Custom Tk cascade menu, menubar button #1
..m add cascade -label Custom -menu .m.custom
# The separate custom menu; hopefully, this could be a toplevel
# instead of a menu -- the tk_popup's would just be replaced with
# wm withdraw/deiconify calls
set m [menu .popup -tearoff false -type normal]
$m add command -label "First" -command "Command \"First popup menu entry\""
$m add command -label "Last" -command "Command \"Last popup menu entry\""
proc Command {args} {
puts [info level 0],$::active
# Next two lines should be added to .popup menu entry's -command
set ::active {}
.#m activate none
# Do whatever...
}
# Menubar button #2, a familiar exit X but for unix
menu .m.help -type normal -tearoff false -borderwidth 0 -activeborderwidth 0
..m add cascade -label X -menu .m.help
.. configure -menu .m
frame .f -background Cyan
label .f.b -background Green -width 10 -height 3
pack .f.b -side right -padx 60 -pady 30
pack .f
.
- Follow-Ups:
- Re: Looking for menu enhancement
- From: billposer
- Re: Looking for menu enhancement
- Prev by Date: Re: Not able to bind <B1-Button>?
- Next by Date: Re: Looking for menu enhancement
- Previous by thread: Re: Looking for menu enhancement
- Next by thread: Re: Looking for menu enhancement
- Index(es):
Relevant Pages
|
