From c78fb6a6fb68d33409f8d4f7edd98002e46b59ef Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Fri, 24 Apr 1998 01:54:09 +0000 Subject: [PATCH] Use new menu item format. Don't simulate button prefix. (easy-menu-create-menu): Understand also keywords :active, :label and :visible. Don't worry about button prefix. (easy-menu-button-prefix): Modified value. (easy-menu-do-add-item): Extensive changes to use new menu item format. (easy-menu-define-key, easy-menu-always-true): New functions. (easy-menu-make-symbol): Don't use indirection for symbols. Property `menu-alias' not set. (easy-menu-filter, easy-menu-update-button): Deleted. (easy-menu-add-item): Don't worry about button prefix. (easy-menu-remove-item): Don't worry about button prefix. Use `easy-menu-define-key'. (easy-menu-is-button, easy-menu-have-button): Deleted. (easy-menu-real-binding, easy-menu-change-prefix): Deleted. --- lisp/emacs-lisp/easymenu.el | 354 +++++++++++++++--------------------- 1 file changed, 150 insertions(+), 204 deletions(-) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 974e21591be..ee666aa6b42 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -133,186 +133,190 @@ returns the right thing in the two cases." MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items possibly preceded by keyword pairs as described in `easy-menu-define'." (let ((menu (make-sparse-keymap menu-name)) - keyword filter have-buttons) + prop keyword arg label enable filter visible) ;; Look for keywords. (while (and menu-items (cdr menu-items) (symbolp (setq keyword (car menu-items))) (= ?: (aref (symbol-name keyword) 0))) - (if (eq keyword ':filter) (setq filter (cadr menu-items))) - (setq menu-items (cddr menu-items))) - (while menu-items - (setq have-buttons - (easy-menu-do-add-item menu (car menu-items) have-buttons)) - (setq menu-items (cdr menu-items))) - (when filter - (setq menu (easy-menu-make-symbol menu)) - (put menu 'menu-enable - `(easy-menu-filter (quote ,menu) (quote ,filter)))) - menu)) + (setq arg (cadr menu-items)) + (setq menu-items (cddr menu-items)) + (cond + ((eq keyword ':filter) (setq filter arg)) + ((eq keyword ':active) (setq enable (or arg ''nil))) + ((eq keyword ':label) (setq label arg)) + ((eq keyword ':visible) (setq visible (or arg ''nil))))) + (if (equal visible ''nil) nil ; Invisible menu entry, return nil. + (if (and visible (not (easy-menu-always-true visible))) + (setq prop (cons :visible (cons visible prop)))) + (if (and enable (not (easy-menu-always-true enable))) + (setq prop (cons :enable (cons enable prop)))) + (if filter (setq prop (cons :filter (cons filter prop)))) + (if label (setq prop (cons nil (cons label prop)))) + (while menu-items + (easy-menu-do-add-item menu (car menu-items)) + (setq menu-items (cdr menu-items))) + (when prop + (setq menu (easy-menu-make-symbol menu)) + (put menu 'menu-prop prop)) + menu))) ;; Button prefixes. (defvar easy-menu-button-prefix - '((radio ?* . "( ) ") (toggle ?X . "[ ] "))) + '((radio . :radio) (toggle . :toggle))) -(defun easy-menu-do-add-item (menu item have-buttons &optional before top) +(defun easy-menu-do-add-item (menu item &optional before) ;; Parse an item description and add the item to a keymap. This is ;; the function that is used for item definition by the other easy-menu ;; functions. ;; MENU is a sparse keymap i.e. a list starting with the symbol `keymap'. ;; ITEM defines an item as in `easy-menu-define'. - ;; HAVE-BUTTONS is a string or nil. If not nil, use as item prefix for - ;; items that are not toggle or radio buttons to compensate for the - ;; button prefix. - ;; Optional argument BEFORE is nil or a symbol used as a key in MENU. If - ;; BEFORE is not nil put item before BEFORE in MENU, otherwise if item is - ;; already present in MENU, just change it, otherwise put it last in MENU. - ;; If optional TOP is true, this is an item in the menu bar itself so - ;; don't use prefix. In this case HAVE-BUTTONS will be nil. - (let (command name item-string is-button done inserted) + ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil + ;; put item before BEFORE in MENU, otherwise if item is already present in + ;; MENU, just change it, otherwise put it last in MENU. + (let (name command label prop remove) (cond ((stringp item) - (setq item-string + (setq label (if (string-match ; If an XEmacs separator "^\\(-+\\|\ --:\\(\\(no\\|\\(sing\\|doub\\)le\\(Dashed\\)?\\)Line\\|\ shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" item) "" ; use a single line separator. - (concat have-buttons item)))) + item))) ((consp item) - (setq name (setq item-string (car item))) - (setq command (if (keymapp (setq item (cdr item))) item - (easy-menu-create-menu name item)))) + (setq label (setq name (car item))) + (setq command (cdr item)) + (if (not (keymapp command)) + (setq command (easy-menu-create-menu name command))) + (if (null command) + ;; Invisible menu item. Don't insert into keymap. + (setq remove t) + (when (and (symbolp command) (setq prop (get command 'menu-prop))) + (when (null (car prop)) + (setq label (cadr prop)) + (setq prop (cddr prop))) + (setq command (symbol-function command))))) ((vectorp item) - (setq name (setq item-string (aref item 0))) - (setq command (easy-menu-make-symbol (aref item 1) t)) - (let ((active (if (> (length item) 2) (aref item 2) t)) - (active-specified (> (length item) 2)) - (count 2) - style selected) + (let ((active (if (> (length item) 2) (or (aref item 2) ''nil) t)) + (no-name (not (symbolp (setq command (aref item 1))))) + cache cache-specified + (count 2)) + (setq label (setq name (aref item 0))) + (if no-name (setq command (easy-menu-make-symbol command))) (if (and (symbolp active) (= ?: (aref (symbol-name active) 0))) - (let ((count 2) keyword arg suffix keys) - (setq active-specified nil) + (let ((count 2) + keyword arg suffix visible style selected keys) + (setq active nil) (while (> (length item) count) (setq keyword (aref item count)) (setq arg (aref item (1+ count))) (setq count (+ 2 count)) (cond - ((eq keyword ':keys) (setq keys arg)) - ((eq keyword ':active) (setq active arg active-specified t)) - ((eq keyword ':suffix) (setq suffix (concat " " arg))) - ((eq keyword ':style) (setq style arg)) - ((eq keyword ':selected) (setq selected arg)))) - (if keys (setq suffix (concat suffix " (" keys ")"))) - (if suffix (setq item-string (concat item-string " " suffix))) - (when (and selected - (setq style (assq style easy-menu-button-prefix))) - ;; Simulate checkboxes and radio buttons. - (setq item-string (concat (cddr style) item-string)) - (put command 'menu-enable - `(easy-menu-update-button ,item-string - ,(cadr style) - ,selected - ,(or active t))) - (setq is-button t) - (setq active-specified nil) ; Already taken care of active. - (when (not (or have-buttons top)) - (setq have-buttons " ") - ;; Add prefix to menu items defined so far. - (easy-menu-change-prefix menu t)))) - (and (null active) active-specified - (setq active ''nil))) - (if active-specified (put command 'menu-enable active)))) - (t "Invalid menu item in easymenu")) - (when name - (and (not is-button) have-buttons - (setq item-string (concat have-buttons item-string))) - (setq name (intern name))) - (setq item (cons item-string command)) - (if before (setq before (intern before))) - ;; The following loop is simlar to `define-key-after'. It - ;; inserts (name . item) in keymap menu. - ;; If name is not nil then delete any duplications. - ;; If before is not nil, insert before before. Otherwise - ;; if name is not nil and it is found in menu, insert there, else - ;; insert at end. + ((eq keyword :visible) (setq visible (or arg ''nil))) + ((eq keyword :key-sequence) + (setq cache arg cache-specified t)) + ((eq keyword :keys) (setq keys arg no-name nil)) + ((eq keyword :label) (setq label arg)) + ((eq keyword :active) (setq active (or arg ''nil))) + ((eq keyword :suffix) (setq suffix arg)) + ((eq keyword :style) (setq style arg)) + ((eq keyword :selected) (setq selected (or arg ''nil))))) + (if (stringp suffix) + (setq label (if (stringp label) (concat label " " suffix) + (list 'concat label (concat " " suffix))))) + (if (and selected + (setq style (assq style easy-menu-button-prefix))) + (setq prop (cons :button + (cons (cons (cdr style) (or selected ''nil)) + prop)))) + (when (stringp keys) + (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" + keys) + (let ((prefix + (if (< (match-beginning 0) (match-beginning 1)) + (substring keys 0 (match-beginning 1)))) + (postfix + (if (< (match-end 1) (match-end 0)) + (substring keys (match-end 1)))) + (cmd (intern (substring keys (match-beginning 2) + (match-end 2))))) + (setq keys + (and (or prefix postfix (not (eq command cmd))) + (cons cmd + (and (or prefix postfix) + (cons prefix postfix)))))) + (setq cache-specified nil)) + (if keys (setq prop (cons :keys (cons keys prop))))) + (if (and visible (not (easy-menu-always-true visible))) + (if (equal visible ''nil) + ;; Invisible menu item. Don't insert into keymap. + (setq remove t) + (setq prop (cons :visible (cons visible prop))))))) + (if (and active (not (easy-menu-always-true active))) + (setq prop (cons :enable (cons active prop)))) + (if (and (or no-name cache-specified) + (or (null cache) (stringp cache) (vectorp cache))) + (setq prop (cons :key-sequence (cons cache prop)))))) + (t (error "Invalid menu item in easymenu."))) + (easy-menu-define-key menu (if (stringp name) (intern name) name) + (and (not remove) + (cons 'menu-item + (cons label + (and name (cons command prop))))) + (if (stringp before) (intern before) before)))) + +(defun easy-menu-define-key (menu key item &optional before) + ;; Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. + ;; If KEY is not nil then delete any duplications. If ITEM is nil, then + ;; don't insert, only delete. + ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil + ;; put binding before BEFORE in MENU, otherwise if binding is already + ;; present in MENU, just change it, otherwise put it last in MENU. + (let ((inserted (null item)) ; Fake already inserted. + done) (while (not done) (cond ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) - (and before (eq (car-safe (cadr menu)) before))) - ;; If name is nil, stop here, otherwise keep going past the + (and before (equal (car-safe (cadr menu)) before))) + ;; If key is nil, stop here, otherwise keep going past the ;; inserted element so we can delete any duplications that come ;; later. - (if (null name) (setq done t)) + (if (null key) (setq done t)) (unless inserted ; Don't insert more than once. - (setcdr menu (cons (cons name item) (cdr menu))) + (setcdr menu (cons (cons key item) (cdr menu))) (setq inserted t) (setq menu (cdr menu)))) - ((and name (eq (car-safe (cadr menu)) name)) - (if (and before ; Wanted elsewere and - (not (setq done ; not the last in this keymap. - (or (null (cddr menu)) (keymapp (cddr menu)))))) - (setcdr menu (cddr menu)) - (setcdr (cadr menu) item) ; Change item. + ((and key (equal (car-safe (cadr menu)) key)) + (if (and (or inserted ; Already inserted or + before) ; wanted elsewhere and + (or (not (setq done ; not the last in this keymap. + (or (null (cddr menu)) + (keymapp (cddr menu))))) + inserted)) + ;; The contorted logic above, guarantees `done' has been computed. + (setcdr menu (cddr menu)) ; Remove item. + (setcdr (cadr menu) item) ; Change item. (setq inserted t)))) - (setq menu (cdr menu))) - have-buttons)) + (setq menu (cdr menu))))) + +(defun easy-menu-always-true (x) + ;; Return true if X never evaluates to nil. + (if (consp x) (and (eq (car x) 'quote) (cadr x)) + (or (eq x t) (not (symbolp x))))) (defvar easy-menu-item-count 0) -(defun easy-menu-make-symbol (callback &optional call) +(defun easy-menu-make-symbol (callback) ;; Return a unique symbol with CALLBACK as function value. - ;; If CALL is false then this is a keymap, not a function. - ;; Else if CALLBACK is a symbol, avoid the indirection when looking for - ;; key-bindings in menu. - ;; Else make a lambda expression of CALLBACK. (let ((command (make-symbol (format "menu-function-%d" easy-menu-item-count)))) (setq easy-menu-item-count (1+ easy-menu-item-count)) (fset command - (cond - ((not call) callback) - ((symbolp callback) - ;; Try find key-bindings for callback instead of for command - (put command 'menu-alias t) ; when displaying menu. - callback) - (t `(lambda () (interactive) ,callback)))) + (if (keymapp callback) callback + `(lambda () (interactive) ,callback))) command)) -(defun easy-menu-filter (name filter) - "Used as menu-enable property to filter menus. -A call to this function is used as the menu-enable property for a menu with -a filter function. -NAME is a symbol with a keymap as function value. Call the function FILTER -with this keymap as argument. FILTER must return a keymap which becomes the -new function value for NAME. Use `easy-menu-filter-return' to return the -correct value in a way portable to XEmacs. If the new keymap is `eq' the old, -then the menu is not updated." - (let* ((old (symbol-function name)) - (new (funcall filter old))) - (or (eq old new) ; No change - (and (fset name new) - ;; Make sure the menu gets updated by returning a - ;; different value than last time to cheat the cache. - (random))))) - -(defun easy-menu-update-button (item ch selected active) - "Used as menu-enable property to update buttons. -A call to this function is used as the menu-enable property for buttons. -ITEM is the item-string into which CH or ` ' is inserted depending on if -SELECTED is true or not. The menu entry in enabled iff ACTIVE is true." - (let ((new (if selected ch ? )) - (old (aref item 1))) - (if (eq new old) - ;; No change, just use the active value. - active - ;; It has changed. Update the entry. - (aset item 1 new) - ;; If the entry is active, make sure the menu gets updated by - ;; returning a different value than last time to cheat the cache. - (and active - (random))))) - (defun easy-menu-change (path name items &optional before) "Change menu found at PATH as item NAME to contain ITEMS. PATH is a list of strings for locating the menu containing NAME in the @@ -348,22 +352,18 @@ element should be the name of a submenu directly under MENU. This submenu is then traversed recursively with the remaining elements of PATH. ITEM is either defined as in `easy-menu-define' or a menu defined earlier by `easy-menu-define' or `easy-menu-create-menu'." - (let ((top (not (or menu path)))) - (setq menu (easy-menu-get-map menu path)) - (if (or (keymapp item) - (and (symbolp item) (keymapp (symbol-value item)))) - ;; Item is a keymap, find the prompt string and use as item name. - (let ((tail (easy-menu-get-map item nil)) name) - (if (not (keymapp item)) (setq item tail)) - (while (and (null name) (consp (setq tail (cdr tail))) - (not (keymapp tail))) - (if (stringp (car tail)) (setq name (car tail)) ; Got a name. - (setq tail (cdr tail)))) - (setq item (cons name item)))) - (easy-menu-do-add-item menu item - (and (not top) (easy-menu-have-button menu) - " ") - before top))) + (setq menu (easy-menu-get-map menu path)) + (if (or (keymapp item) + (and (symbolp item) (keymapp (symbol-value item)))) + ;; Item is a keymap, find the prompt string and use as item name. + (let ((tail (easy-menu-get-map item nil)) name) + (if (not (keymapp item)) (setq item tail)) + (while (and (null name) (consp (setq tail (cdr tail))) + (not (keymapp tail))) + (if (stringp (car tail)) (setq name (car tail)) ; Got a name. + (setq tail (cdr tail)))) + (setq item (cons name item)))) + (easy-menu-do-add-item menu item before)) (defun easy-menu-item-present-p (menu path name) "In submenu of MENU with path PATH, return true iff item NAME is present. @@ -375,21 +375,11 @@ NAME should be a string, the name of the element to be looked for." "From submenu of MENU with path PATH remove item NAME. MENU and PATH are defined as in `easy-menu-add-item'. NAME should be a string, the name of the element to be removed." - (let ((item (vector (intern name))) - (top (not (or menu path))) - tmp) - (setq menu (easy-menu-get-map menu path)) - (when (setq tmp (lookup-key menu item)) - (define-key menu item nil) - (and (not top) - (easy-menu-is-button tmp) ; Removed item was a button and - (not (easy-menu-have-button menu)) ; no buttons left then - ;; remove prefix from items in menu - (easy-menu-change-prefix menu nil))))) + (easy-menu-define-key (easy-menu-get-map menu path) (intern name) nil)) (defun easy-menu-get-map (menu path) ;; Return a sparse keymap in which to add or remove an item. - ;; MENU and PATH are as defined in `easy-menu-remove-item'. + ;; MENU and PATH are as defined in `easy-menu-add-item'. (if (null menu) (setq menu (key-binding (vconcat '(menu-bar) (mapcar 'intern path)))) (if (and (symbolp menu) (not (keymapp menu))) @@ -400,50 +390,6 @@ NAME should be a string, the name of the element to be removed." (or (keymapp menu) (error "Malformed menu in easy-menu: (%s)" menu)) menu) -(defun easy-menu-is-button (val) - ;; VAL is a real menu binding. Return true iff it is a toggle or - ;; radio button. - (and (symbolp val) - (consp (setq val (get val 'menu-enable))) - (eq (car val) 'easy-menu-update-button))) - -(defun easy-menu-have-button (map) - ;; MAP is a sparse keymap. Return true iff there is any toggle or radio - ;; button in MAP. - (let ((have nil) tmp) - (while (and (consp map) (not have)) - (and (consp (setq tmp (car map))) - (consp (setq tmp (cdr tmp))) - (stringp (car tmp)) - (setq have (easy-menu-is-button (easy-menu-real-binding tmp)))) - (setq map (cdr map))) - have)) - -(defun easy-menu-real-binding (val) - ;; Val is a menu keymap binding. Skip item string. - ;; Also skip a possible help string and/or key-binding cache. - (if (and (consp (setq val (cdr val))) (stringp (car val))) - (setq val (cdr val))) ; Skip help string. - (if (and (consp val) (consp (car val)) - (or (null (caar val)) (vectorp (caar val)))) - (setq val (cdr val))) ; Skip key-binding cache. - val) - -(defun easy-menu-change-prefix (map add) - ;; MAP is a sparse keymap. - ;; If ADD is true add a button compensating prefix to each menu item in MAP. - ;; Else remove prefix instead. - (let (tmp val) - (while (consp map) - (when (and (consp (setq tmp (car map))) - (consp (setq tmp (cdr tmp))) - (stringp (car tmp))) - (cond - (add (setcar tmp (concat " " (car tmp)))) - ((string-match "$ " (car tmp)) - (setcar tmp (substring (car tmp) (match-end 0)))))) - (setq map (cdr map))))) - (provide 'easymenu) ;;; easymenu.el ends here -- 2.39.2