;; Keywords: emulations
-;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; Arrange to use current-menubar to set up part of the menu bar.
+(defvar current-menubar)
+
(setq recompute-lucid-menubar 'recompute-lucid-menubar)
(defun recompute-lucid-menubar ()
(define-key lucid-menubar-map [menu-bar]
(defvar add-menu-item-count 0)
+;; This is a variable whose value is always nil.
+(defvar make-lucid-menu-keymap-disable nil)
+
;; Return a menu keymap corresponding to a Lucid-style menu list
;; MENU-ITEMS, and with name MENU-NAME.
(defun make-lucid-menu-keymap (menu-name menu-items)
;; since the define-key loop reverses them again.
(setq menu-items (reverse menu-items))
(while menu-items
- (let* ((item (car menu-items))
- (callback (if (vectorp item) (aref item 1)))
- command enabler name)
+ (let ((item (car menu-items))
+ command name callback)
(cond ((stringp item)
(setq command nil)
- (setq name item))
+ (setq name (if (string-match "^-+$" item) "" item)))
((consp item)
(setq command (make-lucid-menu-keymap (car item) (cdr item)))
(setq name (car item)))
((vectorp item)
(setq command (make-symbol (format "menu-function-%d"
- add-menu-item-count)))
- (setq enabler (make-symbol (format "menu-function-%d-enabler"
- add-menu-item-count)))
- (setq add-menu-item-count (1+ add-menu-item-count))
- (put command 'menu-enable enabler)
- (set enabler (aref item 2))
- (setq name (aref item 0))
+ add-menu-item-count))
+ add-menu-item-count (1+ add-menu-item-count)
+ name (aref item 0)
+ callback (aref item 1))
(if (symbolp callback)
(fset command callback)
- (fset command (list 'lambda () '(interactive) callback)))))
- (if name
- (define-key menu (vector (intern name)) (cons name command))))
+ (fset command (list 'lambda () '(interactive) callback)))
+ (let ((i 2))
+ (while (< i (length item))
+ (cond
+ ((eq (aref item i) ':active)
+ (put command 'menu-enable
+ (or (aref item (1+ i))
+ 'make-lucid-menu-keymap-disable))
+ (setq i (+ 2 i)))
+ ((eq (aref item i) ':suffix)
+ ;; unimplemented
+ (setq i (+ 2 i)))
+ ((eq (aref item i) ':keys)
+ ;; unimplemented
+ (setq i (+ 2 i)))
+ ((eq (aref item i) ':style)
+ ;; unimplemented
+ (setq i (+ 2 i)))
+ ((eq (aref item i) ':selected)
+ ;; unimplemented
+ (setq i (+ 2 i)))
+ ((and (symbolp (aref item i))
+ (= ?: (string-to-char (symbol-name (aref item i)))))
+ (error "Unrecognized menu item keyword: %S"
+ (aref item i)))
+ ((= i 2)
+ ;; old-style format: active-p &optional suffix
+ (put command 'menu-enable
+ (or (aref item i) 'make-lucid-menu-keymap-disable))
+ ;; suffix is unimplemented
+ (setq i (length item)))
+ (t
+ (error "Unexpected menu item value: %S"
+ (aref item i))))))))
+ (if (null command)
+ ;; Handle inactive strings specially--allow any number
+ ;; of identical ones.
+ (setcdr menu (cons (list nil name) (cdr menu)))
+ (if name
+ (define-key menu (vector (intern name)) (cons name command)))))
(setq menu-items (cdr menu-items)))
menu))
any. For toplevel menus, it is ignored. This string is not displayed
in the menu itself.
-A menu item is a vector of three or four elements:
+A menu item is a vector containing:
- the name of the menu item (a string);
- the `callback' of that item;
- - whether this item is active (selectable);
- - and an optional string to append to the name.
+ - a list of keywords with associated values:
+ - :active active-p a form specifying whether this item is selectable;
+ - :suffix suffix a string to be appended to the name as an `argument'
+ to the command, like `Kill Buffer NAME';
+ - :keys command-keys a string, suitable for `substitute-command-keys',
+ to specify the keyboard equivalent of a command
+ when the callback is a form (this is not necessary
+ when the callback is a symbol, as the keyboard
+ equivalent is computed automatically in that case);
+ - :style style a symbol: nil for a normal menu item, `toggle' for
+ a toggle button (a single option that can be turned
+ on or off), or `radio' for a radio button (one of a
+ group of mutually exclusive options);
+ - :selected form for `toggle' or `radio' style, a form that specifies
+ whether the button will be in the selected state.
+
+Alternately, the vector may contain exactly 3 or 4 elements, with the third
+element specifying `active-p' and the fourth specifying `suffix'.
If the `callback' of a menu item is a symbol, then it must name a command.
It will be invoked with `call-interactively'. If it is a list, then it is
evaluated with `eval'.
-The fourth element of a menu item is a convenient way of adding the name
-of a command's ``argument'' to the menu, like ``Kill Buffer NAME''.
-
If an element of a menu is a string, then that string will be presented in
the menu as unselectable text.
active-p := <t or nil, whether this thing is selectable>
text := <string, non selectable>
name := <string>
- argument := <string>
- menu-item := '[' name callback active-p [ argument ] ']'
- menu := '(' name [ menu-item | menu | text ]+ ')'
-"
+ suffix := <string>
+ command-keys := <string>
+ object-style := 'nil' | 'toggle' | 'radio'
+ keyword := ':active' active-p
+ | ':suffix' suffix
+ | ':keys' command-keys
+ | ':style' object-style
+ | ':selected' form
+ menu-item := '[' name callback active-p [ suffix ] ']'
+ | '[' name callback [ keyword ]+ ']'
+ menu := '(' name [ menu-item | menu | text ]+ ')'"
(let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
- (pos (mouse-position))
- answer)
- (setq answer (x-popup-menu (list (list (nth 1 pos) (nthcdr 2 pos))
- (car pos))
- menu))
- (setq cmd (lookup-key menu (vector answer)))
- (if cmd (call-interactively cmd))))
+ (pos (mouse-pixel-position))
+ answer cmd)
+ (while (and menu
+ (setq answer (x-popup-menu (list (list (nth 1 pos)
+ (nthcdr 2 pos))
+ (car pos))
+ menu)))
+ (setq cmd (lookup-key menu (apply 'vector answer)))
+ (setq menu nil)
+ (and cmd
+ (if (keymapp cmd)
+ (setq menu cmd)
+ (call-interactively cmd))))))
+
+(defun popup-dialog-box (data)
+ "Pop up a dialog box.
+A dialog box description is a list.
+
+ - The first element of the list is a string to display in the dialog box.
+ - The rest of the elements are descriptions of the dialog box's buttons.
+ Each one is a vector of three elements:
+ - The first element is the text of the button.
+ - The second element is the `callback'.
+ - The third element is t or nil, whether this button is selectable.
+
+If the `callback' of a button is a symbol, then it must name a command.
+It will be invoked with `call-interactively'. If it is a list, then it is
+evaluated with `eval'.
+
+One (and only one) of the buttons may be `nil'. This marker means that all
+following buttons should be flushright instead of flushleft.
+
+The syntax, more precisely:
+
+ form := <something to pass to `eval'>
+ command := <a symbol or string, to pass to `call-interactively'>
+ callback := command | form
+ active-p := <t, nil, or a form to evaluate to decide whether this
+ button should be selectable>
+ name := <string>
+ partition := 'nil'
+ button := '[' name callback active-p ']'
+ dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')'"
+ (let ((name (car data))
+ (tail (cdr data))
+ converted
+ choice meaning)
+ (while tail
+ (if (null (car tail))
+ (setq converted (cons nil converted))
+ (let ((item (aref (car tail) 0))
+ (callback (aref (car tail) 1))
+ (enable (aref (car tail) 2)))
+ (setq converted
+ (cons (if enable (cons item callback) item)
+ converted))))
+ (setq tail (cdr tail)))
+ (setq choice (x-popup-dialog t (cons name (nreverse converted))))
+ (setq meaning (assq choice converted))
+ (if meaning
+ (if (symbolp (cdr meaning))
+ (call-interactively (cdr meaning))
+ (eval (cdr meaning))))))
\f
-;; This is empty because the usual elements of the menu bar
+;; This is empty because the usual elements of the menu bar
;; are provided by menu-bar.el instead.
;; It would not make sense to duplicate them here.
(defconst default-menubar nil)
(defun disable-menu-item (path)
"Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
+PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
+under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(defun enable-menu-item (path)
"Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
+PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
+under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(while (and (cdr rest2) (car (cdr rest2)))
(setq rest2 (cdr rest2)))
(setcdr rest2
- (nconc (list (setq menu (list (car rest))))
- (cdr rest2)))))
+ (nconc (list (setq menu (list (car rest))))
+ (cdr rest2)))))
(setq so-far menu)
(setq rest (cdr rest)))))
(or menu (setq menu menubar))
ITEM-NAME is the string naming the menu item to be added.
FUNCTION is the command to invoke when this menu item is selected.
If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked. If it is a list, then the
+ way that functions bound to keys are invoked. If it is a list, then the
list is simply evaluated.
ENABLED-P controls whether the item is selectable or not.
BEFORE, if provided, is the name of a menu item before which this item should
(defun delete-menu-item (path)
"Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
+PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
+under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(defun relabel-menu-item (path new-name)
"Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
+PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
+under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
NEW-NAME is the string that the menu item will be printed as from now on."
(or (stringp new-name)
Each menu item should be a vector of three elements:
- a string, the name of the menu item;
- a symbol naming a command, or a form to evaluate;
- - and t or nil, whether this item is selectable.
+ - and a form whose value determines whether this item is selectable.
BEFORE, if provided, is the name of a menu before which this menu should
be added, if this menu is not on its parent already. If the menu is already
present, it will not be moved."
(defvar put-buffer-names-in-file-menu t)
-(let ((frames (frame-list)))
- (while frames
- (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
- (setq frames (cdr frames))))
-(or (assq 'menu-bar-lines default-frame-alist)
- (setq default-frame-alist
- (cons '(menu-bar-lines . 1) default-frame-alist)))
+;; Don't unconditionally enable menu bars; leave that up to the user.
+;;(let ((frames (frame-list)))
+;; (while frames
+;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
+;; (setq frames (cdr frames))))
+;;(or (assq 'menu-bar-lines default-frame-alist)
+;; (setq default-frame-alist
+;; (cons '(menu-bar-lines . 1) default-frame-alist)))
(set-menubar default-menubar)
\f
-(provide 'menubar)
+(provide 'lmenu)
;;; lmenu.el ends here
HCoop / bpt / emacs.git / blobdiff