X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e24cb6c5c4ecfcbc65d21ade319304bd46b51f16..086af77cf525ef51c8f15ef2b1c3673c86eea5ff:/lisp/emacs-lisp/lmenu.el diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el index ee9417d01b..ab29ed972f 100644 --- a/lisp/emacs-lisp/lmenu.el +++ b/lisp/emacs-lisp/lmenu.el @@ -1,8 +1,8 @@ ;;; lmenu.el --- emulate Lucid's menubar support -;; Keywords: emulations +;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. +;; Keywords: emulations obsolete ;; This file is part of GNU Emacs. @@ -17,8 +17,11 @@ ;; 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: ;;; Code: @@ -46,12 +49,16 @@ (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)) (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) @@ -60,9 +67,8 @@ ;; 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))) @@ -71,81 +77,57 @@ (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)) - (put command 'menu-enable (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))))) + (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 := - command := - callback := command | form - active-p := - text := - name := - argument := - 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 menu - (setq answer (x-popup-menu (list (list (nth 1 pos) (nthcdr 2 pos)) - (car pos)) - menu)) - (setq cmd (lookup-key menu (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. @@ -161,7 +143,7 @@ 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 +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: @@ -190,22 +172,23 @@ 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))))) -;; 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) @@ -215,6 +198,7 @@ The syntax, more precisely: ;;; 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 @@ -244,11 +228,12 @@ Signals an error if the item is not found." (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)) @@ -263,11 +248,12 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." 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)) @@ -302,6 +288,8 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." (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 @@ -342,6 +330,7 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." (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. @@ -351,7 +340,7 @@ MENU-PATH identifies the menu under which the new menu item should be inserted. 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 @@ -362,11 +351,12 @@ 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)) @@ -383,11 +373,12 @@ menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." 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) @@ -406,6 +397,7 @@ NEW-NAME is the string that the menu item will be printed as from now on." (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. @@ -444,4 +436,5 @@ BEFORE, if provided, is the name of a menu before which this menu should (provide 'lmenu) +;;; arch-tag: 7051c396-2837-435a-ae11-b2d2e2af8fc1 ;;; lmenu.el ends here