X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b578f267af27af50e3c091f8c9c9eee939b69978..086af77cf525ef51c8f15ef2b1c3673c86eea5ff:/lisp/emacs-lisp/lmenu.el diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el index 6572166fdc..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 -;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Keywords: emulations +;; Keywords: emulations obsolete ;; This file is part of GNU Emacs. @@ -21,6 +21,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: @@ -47,6 +49,7 @@ (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)) @@ -81,6 +84,7 @@ (if (symbolp callback) (fset command callback) (fset command (list 'lambda () '(interactive) callback))) + (put command 'menu-alias t) (let ((i 2)) (while (< i (length item)) (cond @@ -123,86 +127,7 @@ (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 containing: - - - the name of the menu item (a string); - - the `callback' of that item; - - 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'. - -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 := - suffix := - command-keys := - 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-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. @@ -218,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: @@ -257,11 +182,13 @@ The syntax, more precisely: ;; 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) @@ -271,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 @@ -300,6 +228,7 @@ 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 @@ -319,6 +248,7 @@ 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 @@ -400,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. @@ -420,6 +351,7 @@ 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 @@ -441,6 +373,7 @@ 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 @@ -464,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. @@ -502,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