X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fdialog-gtk.el;h=1cfdaf29dca2a301c6ee68c5b5826f9b2b1b6c42;hb=c5202dd83f0118ffb33a0ed364bef7833b0717e7;hp=aaca803ef4482430e8f58d9399c42dbfb0f60c79;hpb=02f4d2761a98c5cb9d5b423d2361160a5d8c9ee4;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/dialog-gtk.el b/lisp/dialog-gtk.el
index aaca803..1cfdaf2 100644
--- a/lisp/dialog-gtk.el
+++ b/lisp/dialog-gtk.el
@@ -32,6 +32,31 @@
 (require 'gtk-password-dialog)
 (require 'gtk-file-dialog)
 
+(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:
   ;;
@@ -180,7 +205,13 @@
 	(dialog nil)			; GtkDialog
 	(buttons nil)			; List of GtkButton objects
 	(activep t)
+	(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
@@ -206,28 +237,44 @@
 		    (if (not (vectorp button))
 			(error "Button descriptor is not a vector: %S" button))
 
-		    (if (< (length button) 3)
-			(error "Button descriptor is too small: %S" button))
-
-		    (push (gtk-button-new-with-label (aref button 0)) buttons)
-
-		    ;; Need to detect what flavor of descriptor it is.
-		    (if (not (keywordp (aref button 2)))
-			;; Simple style... just [ name callback activep ]
-			;; We ignore the 'suffix' entry, because that is what
-			;; the X code does.
-			(setq activep (aref button 2))
-		      (let ((ctr 2)
-			    (len (length button)))
-			(if (logand len 1)
-			    (error
-			     "Button descriptor has an odd number of keywords and values: %S"
-			     button))
-			(while (< ctr len)
-			  (if (eq (aref button ctr) :active)
-			      (setq activep (aref button (1+ ctr))
-				    ctr len))
-			  (setq ctr (+ ctr 2)))))
+		    (setq length (length button))
+
+		    (cond
+		     ((= length 1)	; [ "name" ]
+		      (setq callback nil
+			    activep nil))
+		     ((= length 2)	; [ "name" callback ]
+		      (setq callback (aref button 1)
+			    activep t))
+		     ((and (or (= length 3) (= length 4))
+			   (not (keywordp (aref button 2))))
+		      ;; [ "name" callback active-p ] or
+		      ;; [ "name" callback active-p suffix ]
+		      ;; We ignore the 'suffix' entry, because that is
+		      ;; what the X code does.
+		      (setq callback (aref button 1)
+			    activep (aref button 2)))
+		     (t			; 100% keyword specification
+		      (let ((plist (cdr (mapcar 'identity button))))
+			(setq activep (plist-get plist :active)
+			      callback (plist-get plist :callback)))))
+
+		    ;; 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
@@ -243,7 +290,7 @@
 			     unread-command-events)
 		       (gtk-main-quit)
 		       t)
-		     (cons (aref button 1) dialog))
+		     (cons callback dialog))
 
 		    (gtk-widget-show (car buttons))
 		    (funcall (if flushrightp 'gtk-box-pack-end 'gtk-box-pack-start)
@@ -256,6 +303,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)