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)