Mercurial > hg > xemacs-beta
diff lisp/dialog-gtk.el @ 2081:e8db6a10ad42
[xemacs-hg @ 2004-05-15 07:31:43 by malcolmp]
Added support for Gtk menu bar, menu item and dialog button mnemonics.
author | malcolmp |
---|---|
date | Sat, 15 May 2004 07:31:49 +0000 |
parents | a307f9a2021d |
children | ecf1ebac70d8 |
line wrap: on
line diff
--- a/lisp/dialog-gtk.el Fri May 14 21:50:44 2004 +0000 +++ b/lisp/dialog-gtk.el Sat May 15 07:31:49 2004 +0000 @@ -44,7 +44,33 @@ gtk-window-set-title gtk-container-set-border-width gtk-box-set-spacing gtk-dialog-vbox gtk-container-add gtk-label-new gtk-button-new-with-label - gtk-widget-set-sensitive gtk-widget-show gtk-dialog-action-area)) + gtk-widget-set-sensitive gtk-widget-show gtk-dialog-action-area + gtk-label-parse-uline gtk-widget-add-accelerator gtk-accel-group-new)) + +(defun gtk-popup-convert-underscores (str) + ;; Convert the XEmacs button accelerator representation to Gtk mnemonic + ;; form. If no accelerator has been provided, put one at the start of the + ;; string (this mirrors the behaviour under X). This algorithm is also found + ;; in menubar-gtk.c:convert_underscores(). + (let ((new-str (string)) + (i 0) + (found-accel nil)) + (while (< i (length str)) + (let ((c (aref str i))) + (cond ((eq c ?%) + (setq i (1+ i)) + (if (and (not (eq (aref str i) ?_)) (not (eq (aref str i) ?%))) + (setq i (1- i))) + (setq found-accel 1) + ) + ((eq c ?_) + (setq new-str (concat new-str "_"))) + )) + (setq new-str (concat new-str (string (aref str i)))) + (setq i (1+ i)) + ) + (if found-accel new-str (concat "_" new-str)) + )) (defun popup-builtin-open-dialog (keys) ;; Allowed keywords are: @@ -197,6 +223,10 @@ (callback nil) (flushrightp nil) (length nil) + (label nil) + (gui-button nil) + (accel-group (gtk-accel-group-new)) + (accel-key nil) (errp t)) (if (not buttons-descr) (error 'syntax-error @@ -244,7 +274,22 @@ (setq activep (plist-get plist :active) callback (plist-get plist :callback))))) - (push (gtk-button-new-with-label (aref button 0)) buttons) + ;; Create the label and determine what the mnemonic key is. + (setq label (gtk-label-new "")) + (setq accel-key (gtk-label-parse-uline label + (gtk-popup-convert-underscores (aref button 0)))) + ;; Place the label in the button. + (gtk-misc-set-alignment label 0.5 0.5) + (setq gui-button (gtk-button-new)) + (gtk-container-add gui-button label) + ;; Add ALT-mnemonic to the dialog's accelerator group. + (gtk-widget-add-accelerator gui-button "clicked" accel-group + accel-key + 8 ; GDK_MOD1_MASK + 4 ; GTK_ACCEL_LOCKED + ) + + (push gui-button buttons) (gtk-widget-set-sensitive (car buttons) (eval activep)) ;; Apply the callback @@ -273,6 +318,9 @@ (gtk-window-set-transient-for dialog (frame-property nil 'shell-widget)) (put dialog 'type 'dialog) (put dialog 'modal t) + ;; Make the dialog listen for global mnemonic keys/ + (gtk-window-add-accel-group dialog accel-group) + (gtk-widget-show-all dialog) (gtk-main) (gtk-widget-destroy dialog)