[Gitk PATCH 1/6] gitk: Add procedure to create accelerated menus

From

Robin Rosenberg <robin.rosenberg@dewire.com>

Date

Oct 9, 2008, 06:09 UTC

Message-ID

<1223532590-8706-2-git-send-email-robin.rosenberg@dewire.com>

In-Reply-To

<1223532590-8706-1-git-send-email-robin.rosenberg@dewire.com>

Signed-off-by: Robin Rosenberg <robin.rosenberg@dewire.com>
---
 gitk |   27 +++++++++++++++++++++++++++
 1 files changed, 27 insertions(+), 0 deletions(-)

diff --git a/gitk b/gitk
index 2eaa2ae..050019c 100755
--- a/gitk
+++ b/gitk
@@ -1750,6 +1750,33 @@ proc setoptions {} {
     option add *Entry.font uifont startupFile
 }
 
+# Menu command wrapper. Intercepts any -label arguments, 
+# removes the & and adds the -underline argument necessary
+# to implement the menu accelerator.
+proc mcw {menubar args} {
+    set ai [lsearch $args "-label"]
+    if { $ai > 0 } {
+	set label [lindex $args [expr {$ai + 1}]]
+	foreach {l u} [::tk::UnderlineAmpersand $label] {
+	    lset args [expr {$ai + 1}] $l
+	}
+	lappend args -underline
+	lappend args $u
+    }
+    set cmd [ list $menubar ]
+    foreach a $args {
+	lappend cmd $a
+    }
+    eval $cmd
+}
+
+# Wrapper for mc to remove ampersands used for accelerators.
+proc mca {label} {
+    set tl8 [mc $label]
+    foreach {l u} [::tk::UnderlineAmpersand $tl8] break
+    return $l
+}
+
 proc makewindow {} {
     global canv canv2 canv3 linespc charspc ctext cflist cscroll
     global tabstop

-- 
1.6.0.2.308.gef4a