;;; lmenu.el --- emulate Lucid's menubar support
-;; Keywords: emulations
+;; Copyright (C) 1992, 1993, 1994, 1997, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Keywords: emulations obsolete
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
;;; Code:
;; Arrange to use current-menubar to set up part of the menu bar.
(defvar current-menubar)
+(defvar lucid-menubar-map)
+(defvar lucid-failing-menubar)
-(setq recompute-lucid-menubar 'recompute-lucid-menubar)
+(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
(defun recompute-lucid-menubar ()
(define-key lucid-menubar-map [menu-bar]
(condition-case nil
(cons (cons 'current-menubar lucid-menubar-map)
minor-mode-map-alist)))
+;; XEmacs compatibility
(defun set-menubar-dirty-flag ()
(force-mode-line-update)
(setq lucid-menu-bar-dirty-flag t))
;; 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 name)
+ (let ((item (car menu-items))
+ command name callback)
(cond ((stringp item)
(setq command nil)
(setq name (if (string-match "^-+$" item) "" item)))
(setq name (car item)))
((vectorp item)
(setq command (make-symbol (format "menu-function-%d"
- add-menu-item-count)))
- (setq add-menu-item-count (1+ add-menu-item-count))
- (if (aref item 2)
- (put command 'menu-enable (aref item 2))
- (put command 'menu-enable 'make-lucid-menu-keymap-disable))
- (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)))))
+ (fset command (list 'lambda () '(interactive) callback)))
+ (put command 'menu-alias t)
+ (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
+ (if name
(define-key menu (vector (intern name)) (cons name command)))))
(setq menu-items (cdr menu-items)))
menu))
-(defun popup-menu (menu-desc)
- "Pop up the given menu.
-A menu is a list of menu items, strings, and submenus.
-
-The first element of a menu must be a string, which is the name of the
-menu. This is the string that will be displayed in the parent menu, if
-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:
-
- - 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.
-
-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.
-
-If an element of a menu is a string consisting solely of hyphens, then that
-item will be presented as a solid horizontal line.
-
-If an element of a menu is a list, it is treated as a submenu. The name of
-that submenu (the first element in the list) will be used as the name of the
-item representing this menu on the parent.
-
-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 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 ]+ ')'
-"
- (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
- (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))))))
-
+;; XEmacs compatibility function
(defun popup-dialog-box (data)
"Pop up a dialog box.
A dialog box description is a list.
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
+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:
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))))))
+ (if choice
+ (if (symbolp choice)
+ (call-interactively choice)
+ (eval choice)))))
\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)
+;; XEmacs compatibility
(defun set-menubar (menubar)
"Set the default menubar to be menubar."
(setq-default current-menubar (copy-sequence menubar))
(set-menubar-dirty-flag))
+;; XEmacs compatibility
(defun set-buffer-menubar (menubar)
"Set the buffer-local menubar to be menubar."
(make-local-variable 'current-menubar)
\f
;;; menu manipulation functions
+;; XEmacs compatibility
(defun find-menu-item (menubar item-path-list &optional parent)
"Searches MENUBAR for item given by ITEM-PATH-LIST.
Returns (ITEM . PARENT), where PARENT is the immediate parent of
(cons result parent)))))
+;; XEmacs compatibility
(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))
item))
+;; XEmacs compatibility
(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))
(car (find-menu-item (cdr so-far) (list (car rest))))))
(or menu
(let ((rest2 so-far))
+ (or rest2
+ (error "Trying to modify a menu that doesn't exist"))
(while (and (cdr rest2) (car (cdr rest2)))
(setq rest2 (cdr rest2)))
(setcdr rest2
(set-menubar-dirty-flag)
item))
+;; XEmacs compatibility
(defun add-menu-item (menu-path item-name function enabled-p &optional before)
"Add a menu item to some menu, creating the menu first if necessary.
If the named item exists already, it is changed.
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
(add-menu-item-1 t menu-path item-name function enabled-p before))
+;; XEmacs compatibility
(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))
item)))
+;; XEmacs compatibility
(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)
(set-menubar-dirty-flag)
item))
+;; XEmacs compatibility
(defun add-menu (menu-path menu-name menu-items &optional before)
"Add a menu to the menubar or one of its submenus.
If the named menu exists already, it is changed.
\f
(provide 'lmenu)
+;;; arch-tag: 7051c396-2837-435a-ae11-b2d2e2af8fc1
;;; lmenu.el ends here
HCoop / bpt / emacs.git / blobdiff