git: fix "&" and "_" handling in labels

This commit is contained in:
Matthew Flatt 2011-07-06 09:45:13 -06:00
parent de54efc84e
commit ff49859c80
5 changed files with 28 additions and 30 deletions

View File

@ -14,7 +14,7 @@
(protect-out menu-bar%
gtk_menu_item_new_with_mnemonic
gtk_menu_shell_append
fixup-mneumonic))
fixup-mnemonic))
(define-gtk gtk_menu_bar_new (_fun -> _GtkWidget))
(define-gtk gtk_menu_shell_append (_fun _GtkWidget _GtkWidget -> _void))
@ -26,17 +26,8 @@
(define-gtk gtk_widget_set_usize (_fun _GtkWidget _int _int -> _void))
(define (fixup-mneumonic title)
(regexp-replace*
"&&"
(regexp-replace*
#rx"&([^&])"
(regexp-replace*
#rx"_"
(regexp-replace #rx"\t.*$" title "")
"__")
"_\\1")
"&"))
(define (fixup-mnemonic title)
(mnemonic-string (regexp-replace #rx"\t.*$" title "")))
(define-signal-handler connect-select "select"
(_fun _GtkWidget -> _void)
@ -136,7 +127,7 @@
(let ([l (list-ref menus pos)])
(let ([item-gtk (car l)])
(gtk_label_set_text_with_mnemonic (gtk_bin_get_child item-gtk)
(fixup-mneumonic str)))))
(fixup-mnemonic str)))))
(define/public (enable-top pos on?)
(gtk_widget_set_sensitive (car (list-ref menus pos)) on?))
@ -159,7 +150,7 @@
(define (append-menu menu title)
(send menu set-parent this)
(atomically
(let* ([item (let ([title (fixup-mneumonic title)])
(let* ([item (let ([title (fixup-mnemonic title)])
(as-gtk-allocation
(gtk_menu_item_new_with_mnemonic title)))]
[item-wx (new top-menu% [parent this] [gtk item])])

View File

@ -204,7 +204,7 @@
(public [append-item append])
(define (append-item i label help-str-or-submenu chckable?)
(atomically
(let ([item-gtk (let ([label (fixup-mneumonic label)])
(let ([item-gtk (let ([label (fixup-mnemonic label)])
(as-gtk-allocation
((if (and chckable?
(not (help-str-or-submenu . is-a? . menu%)))
@ -258,7 +258,7 @@
(let ([gtk (find-gtk item)])
(when gtk
(gtk_label_set_text_with_mnemonic (gtk_bin_get_child gtk)
(fixup-mneumonic str)))))
(fixup-mnemonic str)))))
(define/public (enable item on?)
(let ([gtk (find-gtk item)])

View File

@ -13,8 +13,7 @@
(protect-out message%
gtk_label_new_with_mnemonic
gtk_label_set_text_with_mnemonic
mnemonic-string))
gtk_label_set_text_with_mnemonic))
;; ----------------------------------------
@ -25,17 +24,6 @@
(define-gtk gtk_misc_set_alignment (_fun _GtkWidget _float _float -> _void))
(define-gtk gtk_image_set_from_pixbuf (_fun _GtkWidget _GdkPixbuf -> _void))
(define (mnemonic-string s)
(if (regexp-match? #rx"&" s)
(regexp-replace*
#rx"_&"
(regexp-replace*
#rx"&(.)"
(regexp-replace* #rx"_" s "__")
"_\\1")
"\\&")
(regexp-replace* #rx"_" s "__")))
(define (gtk_label_new_with_mnemonic s)
(let ([l (gtk_label_new s)])
(when (regexp-match? #rx"&" s)

View File

@ -2,6 +2,7 @@
(require ffi/unsafe
ffi/unsafe/define
ffi/unsafe/alloc
racket/string
racket/draw/unsafe/glib
(only-in '#%foreign ctype-c->scheme)
"../common/utils.rkt"
@ -47,7 +48,8 @@
gdk_screen_get_default
;; for declaring derived structures:
_GtkObject))
_GtkObject)
mnemonic-string)
(define gdk-lib
(case (system-type)
@ -182,3 +184,16 @@
(g_slist_free gl)))))
(define-gdk gdk_screen_get_default (_fun -> _GdkScreen))
(define (mnemonic-string orig-s)
(string-join
(for/list ([s (in-list (regexp-split #rx"&&" orig-s))])
(regexp-replace*
#rx"&(.)"
(regexp-replace*
#rx"_"
s
"__")
"_\\1"))
"&"))

View File

@ -270,6 +270,10 @@
"6 && Half-D&ozen"
m
void)
(make-object menu-item%
"&&_A"
m
void)
(let mloop ([m m][sub-at-50? #t])
(let ([sm (if (and sub-at-50?
(send e button-down? 'middle))