(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:
;;
(gtk-widget-show-all widget)
(gtk-main)
(if (not clicked-ok)
- (signal 'quit nil))))
+ (signal 'quit nil)
+ filename)))
(defalias 'popup-builtin-save-as-dialog 'popup-builtin-open-dialog)
(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
(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
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)
(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)