Mercurial > hg > xemacs-beta

comparison lisp/dialog-gtk.el @ 2081:e8db6a10ad42

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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
comparison
equal deleted inserted replaced
2080:ebba17579ace 2081:e8db6a10ad42
42 gtk-color-selection-dialog-cancel-button gtk-widget-show-now 42 gtk-color-selection-dialog-cancel-button gtk-widget-show-now
43 gtk-widget-grab-focus gtk-widget-destroy gtk-dialog-new 43 gtk-widget-grab-focus gtk-widget-destroy gtk-dialog-new
44 gtk-window-set-title gtk-container-set-border-width 44 gtk-window-set-title gtk-container-set-border-width
45 gtk-box-set-spacing gtk-dialog-vbox gtk-container-add 45 gtk-box-set-spacing gtk-dialog-vbox gtk-container-add
46 gtk-label-new gtk-button-new-with-label 46 gtk-label-new gtk-button-new-with-label
47 gtk-widget-set-sensitive gtk-widget-show gtk-dialog-action-area)) 47 gtk-widget-set-sensitive gtk-widget-show gtk-dialog-action-area
48 gtk-label-parse-uline gtk-widget-add-accelerator gtk-accel-group-new))
49
50 (defun gtk-popup-convert-underscores (str)
51 ;; Convert the XEmacs button accelerator representation to Gtk mnemonic
52 ;; form. If no accelerator has been provided, put one at the start of the
53 ;; string (this mirrors the behaviour under X). This algorithm is also found
54 ;; in menubar-gtk.c:convert_underscores().
55 (let ((new-str (string))
56 (i 0)
57 (found-accel nil))
58 (while (< i (length str))
59 (let ((c (aref str i)))
60 (cond ((eq c ?%)
61 (setq i (1+ i))
62 (if (and (not (eq (aref str i) ?_)) (not (eq (aref str i) ?%)))
63 (setq i (1- i)))
64 (setq found-accel 1)
65 )
66 ((eq c ?_)
67 (setq new-str (concat new-str "_")))
68 ))
69 (setq new-str (concat new-str (string (aref str i))))
70 (setq i (1+ i))
71 )
72 (if found-accel new-str (concat "_" new-str))
73 ))
48 74
49 (defun popup-builtin-open-dialog (keys) 75 (defun popup-builtin-open-dialog (keys)
50 ;; Allowed keywords are: 76 ;; Allowed keywords are:
51 ;; 77 ;;
52 ;; :initial-filename fname 78 ;; :initial-filename fname
195 (buttons nil) ; List of GtkButton objects 221 (buttons nil) ; List of GtkButton objects
196 (activep t) 222 (activep t)
197 (callback nil) 223 (callback nil)
198 (flushrightp nil) 224 (flushrightp nil)
199 (length nil) 225 (length nil)
226 (label nil)
227 (gui-button nil)
228 (accel-group (gtk-accel-group-new))
229 (accel-key nil)
200 (errp t)) 230 (errp t))
201 (if (not buttons-descr) 231 (if (not buttons-descr)
202 (error 'syntax-error 232 (error 'syntax-error
203 "Dialog descriptor must supply at least one button")) 233 "Dialog descriptor must supply at least one button"))
204 234
242 (t ; 100% keyword specification 272 (t ; 100% keyword specification
243 (let ((plist (cdr (mapcar 'identity button)))) 273 (let ((plist (cdr (mapcar 'identity button))))
244 (setq activep (plist-get plist :active) 274 (setq activep (plist-get plist :active)
245 callback (plist-get plist :callback))))) 275 callback (plist-get plist :callback)))))
246 276
247 (push (gtk-button-new-with-label (aref button 0)) buttons) 277 ;; Create the label and determine what the mnemonic key is.
278 (setq label (gtk-label-new ""))
279 (setq accel-key (gtk-label-parse-uline label
280 (gtk-popup-convert-underscores (aref button 0))))
281 ;; Place the label in the button.
282 (gtk-misc-set-alignment label 0.5 0.5)
283 (setq gui-button (gtk-button-new))
284 (gtk-container-add gui-button label)
285 ;; Add ALT-mnemonic to the dialog's accelerator group.
286 (gtk-widget-add-accelerator gui-button "clicked" accel-group
287 accel-key
288 8 ; GDK_MOD1_MASK
289 4 ; GTK_ACCEL_LOCKED
290 )
291
292 (push gui-button buttons)
248 (gtk-widget-set-sensitive (car buttons) (eval activep)) 293 (gtk-widget-set-sensitive (car buttons) (eval activep))
249 294
250 ;; Apply the callback 295 ;; Apply the callback
251 (gtk-signal-connect 296 (gtk-signal-connect
252 (car buttons) 'clicked 297 (car buttons) 'clicked
271 ;; Make sure they can't close it with the window manager 316 ;; Make sure they can't close it with the window manager
272 (gtk-signal-connect dialog 'delete-event (lambda (&rest ignored) t)) 317 (gtk-signal-connect dialog 'delete-event (lambda (&rest ignored) t))
273 (gtk-window-set-transient-for dialog (frame-property nil 'shell-widget)) 318 (gtk-window-set-transient-for dialog (frame-property nil 'shell-widget))
274 (put dialog 'type 'dialog) 319 (put dialog 'type 'dialog)
275 (put dialog 'modal t) 320 (put dialog 'modal t)
321 ;; Make the dialog listen for global mnemonic keys/
322 (gtk-window-add-accel-group dialog accel-group)
323
276 (gtk-widget-show-all dialog) 324 (gtk-widget-show-all dialog)
277 (gtk-main) 325 (gtk-main)
278 (gtk-widget-destroy dialog) 326 (gtk-widget-destroy dialog)
279 (setq errp nil)) 327 (setq errp nil))
280 (if (not errp) 328 (if (not errp)