LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - easymenu.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 101 281 35.9 %
Date: 2017-08-30 10:12:24 Functions: 8 23 34.8 %

          Line data    Source code
       1             : ;;; easymenu.el --- support the easymenu interface for defining a menu  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1994, 1996, 1998-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Keywords: emulations
       6             : ;; Author: Richard Stallman <rms@gnu.org>
       7             : ;; Package: emacs
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      11             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      12             : ;; it under the terms of the GNU General Public License as published by
      13             : ;; the Free Software Foundation, either version 3 of the License, or
      14             : ;; (at your option) any later version.
      15             : 
      16             : ;; GNU Emacs is distributed in the hope that it will be useful,
      17             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      18             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      19             : ;; GNU General Public License for more details.
      20             : 
      21             : ;; You should have received a copy of the GNU General Public License
      22             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      23             : 
      24             : ;;; Commentary:
      25             : 
      26             : ;; This is compatible with easymenu.el by Per Abrahamsen
      27             : ;; but it is much simpler as it doesn't try to support other Emacs versions.
      28             : ;; The code was mostly derived from lmenu.el.
      29             : 
      30             : ;;; Code:
      31             : 
      32             : (defvar easy-menu-precalculate-equivalent-keybindings nil
      33             :   "Determine when equivalent key bindings are computed for easy-menu menus.
      34             : It can take some time to calculate the equivalent key bindings that are shown
      35             : in a menu.  If the variable is on, then this calculation gives a (maybe
      36             : noticeable) delay when a mode is first entered.  If the variable is off, then
      37             : this delay will come when a menu is displayed the first time.  If you never use
      38             : menus, turn this variable off, otherwise it is probably better to keep it on.")
      39             : (make-obsolete-variable
      40             :  'easy-menu-precalculate-equivalent-keybindings nil "23.1")
      41             : 
      42             : (defsubst easy-menu-intern (s)
      43          19 :   (if (stringp s) (intern s) s))
      44             : 
      45             : ;;;###autoload
      46             : (defmacro easy-menu-define (symbol maps doc menu)
      47             :   "Define a pop-up menu and/or menu bar menu specified by MENU.
      48             : If SYMBOL is non-nil, define SYMBOL as a function to pop up the
      49             : submenu defined by MENU, with DOC as its doc string.
      50             : 
      51             : MAPS, if non-nil, should be a keymap or a list of keymaps; add
      52             : the submenu defined by MENU to the keymap or each of the keymaps,
      53             : as a top-level menu bar item.
      54             : 
      55             : The first element of MENU must be a string.  It is the menu bar
      56             : item name.  It may be followed by the following keyword argument
      57             : pairs:
      58             : 
      59             :  :filter FUNCTION
      60             :     FUNCTION must be a function which, if called with one
      61             :     argument---the list of the other menu items---returns the
      62             :     items to actually display.
      63             : 
      64             :  :visible INCLUDE
      65             :     INCLUDE is an expression.  The menu is visible if the
      66             :     expression evaluates to a non-nil value.  `:included' is an
      67             :     alias for `:visible'.
      68             : 
      69             :  :active ENABLE
      70             :     ENABLE is an expression.  The menu is enabled for selection
      71             :     if the expression evaluates to a non-nil value.  `:enable' is
      72             :     an alias for `:active'.
      73             : 
      74             : The rest of the elements in MENU are menu items.
      75             : A menu item can be a vector of three elements:
      76             : 
      77             :   [NAME CALLBACK ENABLE]
      78             : 
      79             : NAME is a string--the menu item name.
      80             : 
      81             : CALLBACK is a command to run when the item is chosen, or an
      82             : expression to evaluate when the item is chosen.
      83             : 
      84             : ENABLE is an expression; the item is enabled for selection if the
      85             : expression evaluates to a non-nil value.
      86             : 
      87             : Alternatively, a menu item may have the form:
      88             : 
      89             :    [ NAME CALLBACK [ KEYWORD ARG ]... ]
      90             : 
      91             : where NAME and CALLBACK have the same meanings as above, and each
      92             : optional KEYWORD and ARG pair should be one of the following:
      93             : 
      94             :  :keys KEYS
      95             :     KEYS is a string; a keyboard equivalent to the menu item.
      96             :     This is normally not needed because keyboard equivalents are
      97             :     usually computed automatically.  KEYS is expanded with
      98             :     `substitute-command-keys' before it is used.
      99             : 
     100             :  :key-sequence KEYS
     101             :     KEYS is a hint for speeding up Emacs's first display of the
     102             :     menu.  It should be nil if you know that the menu item has no
     103             :     keyboard equivalent; otherwise it should be a string or
     104             :     vector specifying a keyboard equivalent for the menu item.
     105             : 
     106             :  :active ENABLE
     107             :     ENABLE is an expression; the item is enabled for selection
     108             :     whenever this expression's value is non-nil.  `:enable' is an
     109             :     alias for `:active'.
     110             : 
     111             :  :visible INCLUDE
     112             :     INCLUDE is an expression; this item is only visible if this
     113             :     expression has a non-nil value.  `:included' is an alias for
     114             :     `:visible'.
     115             : 
     116             :  :label FORM
     117             :     FORM is an expression that is dynamically evaluated and whose
     118             :     value serves as the menu item's label (the default is NAME).
     119             : 
     120             :  :suffix FORM
     121             :     FORM is an expression that is dynamically evaluated and whose
     122             :     value is concatenated with the menu entry's label.
     123             : 
     124             :  :style STYLE
     125             :     STYLE is a symbol describing the type of menu item; it should
     126             :     be `toggle' (a checkbox), or `radio' (a radio button), or any
     127             :     other value (meaning an ordinary menu item).
     128             : 
     129             :  :selected SELECTED
     130             :     SELECTED is an expression; the checkbox or radio button is
     131             :     selected whenever the expression's value is non-nil.
     132             : 
     133             :  :help HELP
     134             :     HELP is a string, the help to display for the menu item.
     135             : 
     136             : Alternatively, a menu item can be a string.  Then that string
     137             : appears in the menu as unselectable text.  A string consisting
     138             : solely of dashes is displayed as a menu separator.
     139             : 
     140             : Alternatively, a menu item can be a list with the same format as
     141             : MENU.  This is a submenu."
     142             :   (declare (indent defun) (debug (symbolp body)))
     143           1 :   `(progn
     144           1 :      ,(if symbol `(defvar ,symbol nil ,doc))
     145           1 :      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
     146             : 
     147             : (defun easy-menu-binding (menu &optional item-name)
     148             :   "Return a binding suitable to pass to `define-key'.
     149             : This is expected to be bound to a mouse event."
     150             :   ;; Under Emacs this is almost trivial, whereas under XEmacs this may
     151             :   ;; involve defining a function that calls popup-menu.
     152           3 :   (let ((props (if (symbolp menu)
     153           0 :                    (prog1 (get menu 'menu-prop)
     154           3 :                      (setq menu (symbol-function menu))))))
     155           3 :     (cons 'menu-item
     156           3 :           (cons (if (eq :label (car props))
     157           0 :                     (prog1 (cadr props)
     158           0 :                       (setq props (cddr props)))
     159           3 :                   (or item-name
     160           0 :                       (if (keymapp menu)
     161           0 :                           (keymap-prompt menu))
     162           3 :                       ""))
     163           3 :                 (cons menu props)))))
     164             : 
     165             : ;;;###autoload
     166             : (defun easy-menu-do-define (symbol maps doc menu)
     167             :   ;; We can't do anything that might differ between Emacs dialects in
     168             :   ;; `easy-menu-define' in order to make byte compiled files
     169             :   ;; compatible.  Therefore everything interesting is done in this
     170             :   ;; function.
     171           3 :   (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
     172           3 :     (when symbol
     173           3 :       (set symbol keymap)
     174           3 :       (defalias symbol
     175           3 :         `(lambda (event) ,doc (interactive "@e")
     176             :            ;; FIXME: XEmacs uses popup-menu which calls the binding
     177             :            ;; while x-popup-menu only returns the selection.
     178             :            (x-popup-menu event
     179           3 :                          (or (and (symbolp ,symbol)
     180             :                                   (funcall
     181           3 :                                    (or (plist-get (get ,symbol 'menu-prop)
     182             :                                                   :filter)
     183             :                                        'identity)
     184           3 :                                    (symbol-function ,symbol)))
     185           3 :                              ,symbol)))))
     186           3 :     (dolist (map (if (keymapp maps) (list maps) maps))
     187           3 :       (define-key map
     188           3 :         (vector 'menu-bar (easy-menu-intern (car menu)))
     189           3 :         (easy-menu-binding keymap (car menu))))))
     190             : 
     191             : (defun easy-menu-filter-return (menu &optional name)
     192             :  "Convert MENU to the right thing to return from a menu filter.
     193             : MENU is a menu as computed by `easy-menu-define' or `easy-menu-create-menu' or
     194             : a symbol whose value is such a menu.
     195             : In Emacs a menu filter must return a menu (a keymap), in XEmacs a filter must
     196             : return a menu items list (without menu name and keywords).
     197             : This function returns the right thing in the two cases.
     198             : If NAME is provided, it is used for the keymap."
     199           0 :  (cond
     200           0 :   ((and (not (keymapp menu)) (consp menu))
     201             :    ;; If it's a cons but not a keymap, then it can't be right
     202             :    ;; unless it's an XEmacs menu.
     203           0 :    (setq menu (easy-menu-create-menu (or name "") menu)))
     204           0 :   ((vectorp menu)
     205             :    ;; It's just a menu entry.
     206           0 :    (setq menu (cdr (easy-menu-convert-item menu)))))
     207           0 :  menu)
     208             : 
     209             : (defvar easy-menu-avoid-duplicate-keys t
     210             :   "Dynamically scoped var to register already used keys in a menu.
     211             : If it holds a list, this is expected to be a list of keys already seen in the
     212             : menu we're processing.  Else it means we're not processing a menu.")
     213             : 
     214             : ;;;###autoload
     215             : (defun easy-menu-create-menu (menu-name menu-items)
     216             :   "Create a menu called MENU-NAME with items described in MENU-ITEMS.
     217             : MENU-NAME is a string, the name of the menu.  MENU-ITEMS is a list of items
     218             : possibly preceded by keyword pairs as described in `easy-menu-define'."
     219           3 :   (let ((menu (make-sparse-keymap menu-name))
     220             :         (easy-menu-avoid-duplicate-keys nil)
     221             :         prop keyword label enable filter visible help)
     222             :     ;; Look for keywords.
     223           3 :     (while (and menu-items
     224           3 :                 (cdr menu-items)
     225           3 :                 (keywordp (setq keyword (car menu-items))))
     226           0 :       (let ((arg (cadr menu-items)))
     227           0 :         (setq menu-items (cddr menu-items))
     228           0 :         (pcase keyword
     229             :           (`:filter
     230           0 :            (setq filter (lambda (menu)
     231           0 :                           (easy-menu-filter-return (funcall arg menu)
     232           0 :                                                    menu-name))))
     233           0 :           ((or `:enable `:active) (setq enable (or arg ''nil)))
     234           0 :           (`:label (setq label arg))
     235           0 :           (`:help (setq help arg))
     236           3 :           ((or `:included `:visible) (setq visible (or arg ''nil))))))
     237           3 :     (if (equal visible ''nil)
     238             :         nil                             ; Invisible menu entry, return nil.
     239           3 :       (if (and visible (not (easy-menu-always-true-p visible)))
     240           3 :           (setq prop (cons :visible (cons visible prop))))
     241           3 :       (if (and enable (not (easy-menu-always-true-p enable)))
     242           3 :           (setq prop (cons :enable (cons enable prop))))
     243           3 :       (if filter (setq prop (cons :filter (cons filter prop))))
     244           3 :       (if help (setq prop (cons :help (cons help prop))))
     245           3 :       (if label (setq prop (cons :label (cons label prop))))
     246           3 :       (setq menu (if filter
     247             :                      ;; The filter expects the menu in its XEmacs form and the
     248             :                      ;; pre-filter form will only be passed to the filter
     249             :                      ;; anyway, so we'd better not convert it at all (it will
     250             :                      ;; be converted on the fly by easy-menu-filter-return).
     251           0 :                      menu-items
     252           3 :                    (append menu (mapcar 'easy-menu-convert-item menu-items))))
     253           3 :       (when prop
     254           0 :         (setq menu (easy-menu-make-symbol menu 'noexp))
     255           3 :         (put menu 'menu-prop prop))
     256           3 :       menu)))
     257             : 
     258             : 
     259             : ;; Known button types.
     260             : (defvar easy-menu-button-prefix
     261             :   '((radio . :radio) (toggle . :toggle)))
     262             : 
     263             : (defvar easy-menu-converted-items-table (make-hash-table :test 'equal))
     264             : 
     265             : (defun easy-menu-convert-item (item)
     266             :   "Memoize the value returned by `easy-menu-convert-item-1' called on ITEM.
     267             : This makes key-shortcut-caching work a *lot* better when this
     268             : conversion is done from within a filter.
     269             : This also helps when the NAME of the entry is recreated each time:
     270             : since the menu is built and traversed separately, the lookup
     271             : would always fail because the key is `equal' but not `eq'."
     272          24 :   (let* ((cache (gethash item easy-menu-converted-items-table))
     273          24 :          (result (or cache (easy-menu-convert-item-1 item)))
     274          24 :          (key (car-safe result)))
     275          24 :     (when (and (listp easy-menu-avoid-duplicate-keys) (symbolp key))
     276             :       ;; Merging multiple entries with the same name is sometimes what we
     277             :       ;; want, but not when the entries are actually different (e.g. same
     278             :       ;; name but different :suffix as seen in cal-menu.el) and appear in
     279             :       ;; the same menu.  So we try to detect and resolve conflicts.
     280          27 :       (while (memq key easy-menu-avoid-duplicate-keys)
     281             :         ;; We need to use some distinct object, ideally a symbol, ideally
     282             :         ;; related to the `name'.  Uninterned symbols do not work (they
     283             :         ;; are apparently turned into strings and re-interned later on).
     284           3 :         (setq key (intern (format "%s-%d" (symbol-name key)
     285           3 :                                   (length easy-menu-avoid-duplicate-keys))))
     286          24 :         (setq result (cons key (cdr result))))
     287          48 :       (push key easy-menu-avoid-duplicate-keys))
     288             : 
     289          24 :     (unless cache (puthash item result easy-menu-converted-items-table))
     290          24 :     result))
     291             : 
     292             : (defun easy-menu-convert-item-1 (item)
     293             :   "Parse an item description and convert it to a menu keymap element.
     294             : ITEM defines an item as in `easy-menu-define'."
     295          16 :   (let (name command label prop remove)
     296          16 :     (cond
     297          16 :      ((stringp item)                    ; An item or separator.
     298           1 :       (setq label item))
     299          15 :      ((consp item)                      ; A sub-menu
     300           0 :       (setq label (setq name (car item)))
     301           0 :       (setq command (cdr item))
     302           0 :       (if (not (keymapp command))
     303           0 :           (setq command (easy-menu-create-menu name command)))
     304           0 :       (if (null command)
     305             :           ;; Invisible menu item. Don't insert into keymap.
     306           0 :           (setq remove t)
     307           0 :         (when (and (symbolp command) (setq prop (get command 'menu-prop)))
     308           0 :           (when (eq :label (car prop))
     309           0 :             (setq label (cadr prop))
     310           0 :             (setq prop (cddr prop)))
     311           0 :           (setq command (symbol-function command)))))
     312          15 :      ((vectorp item)                    ; An item.
     313          15 :       (let* ((ilen (length item))
     314          15 :              (active (if (> ilen 2) (or (aref item 2) ''nil) t))
     315          15 :              (no-name (not (symbolp (setq command (aref item 1)))))
     316             :              cache cache-specified)
     317          15 :         (setq label (setq name (aref item 0)))
     318          15 :         (if no-name (setq command (easy-menu-make-symbol command)))
     319          15 :         (if (keywordp active)
     320          12 :             (let ((count 2)
     321             :                   keyword arg suffix visible style selected keys)
     322          12 :               (setq active nil)
     323          24 :               (while (> ilen count)
     324          12 :                 (setq keyword (aref item count))
     325          12 :                 (setq arg (aref item (1+ count)))
     326          12 :                 (setq count (+ 2 count))
     327          12 :                 (pcase keyword
     328           0 :                   ((or `:included `:visible) (setq visible (or arg ''nil)))
     329           0 :                   (`:key-sequence (setq cache arg cache-specified t))
     330           0 :                   (`:keys (setq keys arg no-name nil))
     331           0 :                   (`:label (setq label arg))
     332           7 :                   ((or `:active `:enable) (setq active (or arg ''nil)))
     333           5 :                   (`:help (setq prop (cons :help (cons arg prop))))
     334           0 :                   (`:suffix (setq suffix arg))
     335           0 :                   (`:style (setq style arg))
     336          12 :                   (`:selected (setq selected (or arg ''nil)))))
     337          12 :               (if suffix
     338           0 :                   (setq label
     339           0 :                         (if (stringp suffix)
     340           0 :                             (if (stringp label) (concat label " " suffix)
     341           0 :                               `(concat ,label ,(concat " " suffix)))
     342           0 :                           (if (stringp label)
     343           0 :                               `(concat ,(concat label " ") ,suffix)
     344          12 :                             `(concat ,label " " ,suffix)))))
     345          12 :               (cond
     346          12 :                ((eq style 'button)
     347           0 :                 (setq label (if (stringp label) (concat "[" label "]")
     348           0 :                               `(concat "[" ,label "]"))))
     349          12 :                ((and selected
     350          12 :                      (setq style (assq style easy-menu-button-prefix)))
     351           0 :                 (setq prop (cons :button
     352          12 :                                  (cons (cons (cdr style) selected) prop)))))
     353          12 :               (when (stringp keys)
     354           0 :                 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
     355           0 :                                   keys)
     356           0 :                     (let ((prefix
     357           0 :                            (if (< (match-beginning 0) (match-beginning 1))
     358           0 :                                (substring keys 0 (match-beginning 1))))
     359             :                           (postfix
     360           0 :                            (if (< (match-end 1) (match-end 0))
     361           0 :                                (substring keys (match-end 1))))
     362           0 :                           (cmd (intern (match-string 2 keys))))
     363           0 :                       (setq keys (and (or prefix postfix)
     364           0 :                                       (cons prefix postfix)))
     365           0 :                       (setq keys
     366           0 :                             (and (or keys (not (eq command cmd)))
     367           0 :                                  (cons cmd keys))))
     368           0 :                   (setq cache-specified nil))
     369          12 :                 (if keys (setq prop (cons :keys (cons keys prop)))))
     370          12 :               (if (and visible (not (easy-menu-always-true-p visible)))
     371           0 :                   (if (equal visible ''nil)
     372             :                       ;; Invisible menu item. Don't insert into keymap.
     373           0 :                       (setq remove t)
     374          15 :                     (setq prop (cons :visible (cons visible prop)))))))
     375          15 :         (if (and active (not (easy-menu-always-true-p active)))
     376          15 :             (setq prop (cons :enable (cons active prop))))
     377          15 :         (if (and (or no-name cache-specified)
     378          15 :                  (or (null cache) (stringp cache) (vectorp cache)))
     379          15 :             (setq prop (cons :key-sequence (cons cache prop))))))
     380          16 :      (t (error "Invalid menu item in easymenu")))
     381             :     ;; `intern' the name so as to merge multiple entries with the same name.
     382             :     ;; It also makes it easier/possible to lookup/change menu bindings
     383             :     ;; via keymap functions.
     384          16 :     (let ((key (easy-menu-intern name)))
     385          16 :       (cons key
     386          16 :             (and (not remove)
     387          16 :                  (cons 'menu-item
     388          16 :                        (cons label
     389          16 :                              (and name
     390          16 :                                   (cons command prop)))))))))
     391             : 
     392             : (defun easy-menu-define-key (menu key item &optional before)
     393             :   "Add binding in MENU for KEY => ITEM.  Similar to `define-key-after'.
     394             : If KEY is not nil then delete any duplications.
     395             : If ITEM is nil, then delete the definition of KEY.
     396             : 
     397             : Optional argument BEFORE is nil or a key in MENU.  If BEFORE is not nil,
     398             : put binding before the item in MENU named BEFORE; otherwise,
     399             : if a binding for KEY is already present in MENU, just change it;
     400             : otherwise put the new binding last in MENU.
     401             : BEFORE can be either a string (menu item name) or a symbol
     402             : \(the fake function key for the menu item).
     403             : KEY does not have to be a symbol, and comparison is done with equal."
     404           0 :   (if (symbolp menu) (setq menu (indirect-function menu)))
     405           0 :   (let ((inserted (null item))          ; Fake already inserted.
     406             :         tail done)
     407           0 :     (while (not done)
     408           0 :       (cond
     409           0 :        ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu))))
     410           0 :             (and before (easy-menu-name-match before (cadr menu))))
     411             :         ;; If key is nil, stop here, otherwise keep going past the
     412             :         ;; inserted element so we can delete any duplications that come
     413             :         ;; later.
     414           0 :         (if (null key) (setq done t))
     415           0 :         (unless inserted                ; Don't insert more than once.
     416           0 :           (setcdr menu (cons (cons key item) (cdr menu)))
     417           0 :           (setq inserted t)
     418           0 :           (setq menu (cdr menu)))
     419           0 :         (setq menu (cdr menu)))
     420           0 :        ((and key (equal (car-safe (cadr menu)) key))
     421           0 :         (if (or inserted                ; Already inserted or
     422           0 :                 (and before             ;  wanted elsewhere and
     423           0 :                      (setq tail (cddr menu)) ; not last item and not
     424           0 :                      (not (keymapp tail))
     425           0 :                      (not (easy-menu-name-match
     426           0 :                            before (car tail))))) ; in position
     427           0 :             (setcdr menu (cddr menu))   ; Remove item.
     428           0 :           (setcdr (cadr menu) item)     ; Change item.
     429           0 :           (setq inserted t)
     430           0 :           (setq menu (cdr menu))))
     431           0 :        (t (setq menu (cdr menu)))))))
     432             : 
     433             : (defun easy-menu-name-match (name item)
     434             :   "Return t if NAME is the name of menu item ITEM.
     435             : NAME can be either a string, or a symbol.
     436             : ITEM should be a keymap binding of the form (KEY . MENU-ITEM)."
     437           0 :   (if (consp item)
     438           0 :       (if (symbolp name)
     439           0 :           (eq (car-safe item) name)
     440           0 :         (if (stringp name)
     441             :             ;; Match against the text that is displayed to the user.
     442           0 :             (or (condition-case nil (member-ignore-case name item)
     443           0 :                   (error nil))          ;`item' might not be a proper list.
     444             :                 ;; Also check the string version of the symbol name,
     445             :                 ;; for backwards compatibility.
     446           0 :                 (eq (car-safe item) (intern name)))))))
     447             : 
     448             : (defun easy-menu-always-true-p (x)
     449             :   "Return true if form X never evaluates to nil."
     450          10 :   (if (consp x) (and (eq (car x) 'quote) (cadr x))
     451          10 :     (or (eq x t) (not (symbolp x)))))
     452             : 
     453             : (defvar easy-menu-item-count 0)
     454             : 
     455             : (defun easy-menu-make-symbol (callback &optional noexp)
     456             :   "Return a unique symbol with CALLBACK as function value.
     457             : When non-nil, NOEXP indicates that CALLBACK cannot be an expression
     458             : \(i.e. does not need to be turned into a function)."
     459           0 :   (let ((command
     460           0 :          (make-symbol (format "menu-function-%d" easy-menu-item-count))))
     461           0 :     (setq easy-menu-item-count (1+ easy-menu-item-count))
     462           0 :     (fset command
     463           0 :           (if (or (keymapp callback) (commandp callback)
     464             :                   ;; `functionp' is probably not needed.
     465           0 :                   (functionp callback) noexp)
     466           0 :               callback
     467           0 :             `(lambda () (interactive) ,callback)))
     468           0 :     command))
     469             : 
     470             : ;;;###autoload
     471             : (defun easy-menu-change (path name items &optional before map)
     472             :   "Change menu found at PATH as item NAME to contain ITEMS.
     473             : PATH is a list of strings for locating the menu that
     474             : should contain a submenu named NAME.
     475             : ITEMS is a list of menu items, as in `easy-menu-define'.
     476             : These items entirely replace the previous items in that submenu.
     477             : 
     478             : If MAP is specified, it should normally be a keymap; nil stands for the local
     479             : menu-bar keymap.  It can also be a symbol, which has earlier been used as the
     480             : first argument in a call to `easy-menu-define', or the value of such a symbol.
     481             : 
     482             : If the menu located by PATH has no submenu named NAME, add one.
     483             : If the optional argument BEFORE is present, add it just before
     484             : the submenu named BEFORE, otherwise add it at the end of the menu.
     485             : 
     486             : To implement dynamic menus, either call this from
     487             : `menu-bar-update-hook' or use a menu filter."
     488           0 :   (easy-menu-add-item map path (easy-menu-create-menu name items) before))
     489             : 
     490             : ;; XEmacs needs the following two functions to add and remove menus.
     491             : ;; In Emacs this is done automatically when switching keymaps, so
     492             : ;; here easy-menu-remove and easy-menu-add are a noops.
     493             : (defalias 'easy-menu-remove 'ignore
     494             :   "Remove MENU from the current menu bar.
     495             : Contrary to XEmacs, this is a nop on Emacs since menus are automatically
     496             : \(de)activated when the corresponding keymap is (de)activated.
     497             : 
     498             : \(fn MENU)")
     499             : 
     500             : (defalias 'easy-menu-add #'ignore
     501             :   "Add the menu to the menubar.
     502             : On Emacs this is a nop, because menus are already automatically
     503             : activated when the corresponding keymap is activated.  On XEmacs
     504             : this is needed to actually add the menu to the current menubar.
     505             : 
     506             : You should call this once the menu and keybindings are set up
     507             : completely and menu filter functions can be expected to work.
     508             : 
     509             : \(fn MENU &optional MAP)")
     510             : 
     511             : (defun add-submenu (menu-path submenu &optional before in-menu)
     512             :   "Add submenu SUBMENU in the menu at MENU-PATH.
     513             : If BEFORE is non-nil, add before the item named BEFORE.
     514             : If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
     515             : This is a compatibility function; use `easy-menu-add-item'."
     516           0 :   (easy-menu-add-item (or in-menu (current-global-map))
     517           0 :                       (cons "menu-bar" menu-path)
     518           0 :                       submenu before))
     519             : 
     520             : (defun easy-menu-add-item (map path item &optional before)
     521             :   "To the submenu of MAP with path PATH, add ITEM.
     522             : 
     523             : If an item with the same name is already present in this submenu,
     524             : then ITEM replaces it.  Otherwise, ITEM is added to this submenu.
     525             : In the latter case, ITEM is normally added at the end of the submenu.
     526             : However, if BEFORE is a string and there is an item in the submenu
     527             : with that name, then ITEM is added before that item.
     528             : 
     529             : MAP should normally be a keymap; nil stands for the local menu-bar keymap.
     530             : It can also be a symbol, which has earlier been used as the first
     531             : argument in a call to `easy-menu-define', or the value of such a symbol.
     532             : 
     533             : PATH is a list of strings for locating the submenu where ITEM is to be
     534             : added.  If PATH is nil, MAP itself is used.  Otherwise, the first
     535             : element should be the name of a submenu directly under MAP.  This
     536             : submenu is then traversed recursively with the remaining elements of PATH.
     537             : 
     538             : ITEM is either defined as in `easy-menu-define' or a non-nil value returned
     539             : by `easy-menu-item-present-p' or `easy-menu-remove-item' or a menu defined
     540             : earlier by `easy-menu-define' or `easy-menu-create-menu'."
     541           0 :   (setq map (easy-menu-get-map map path
     542           0 :                                (and (null map) (null path)
     543           0 :                                     (stringp (car-safe item))
     544           0 :                                     (car item))))
     545           0 :   (if (and (consp item) (consp (cdr item)) (eq (cadr item) 'menu-item))
     546             :       ;; This is a value returned by `easy-menu-item-present-p' or
     547             :       ;; `easy-menu-remove-item'.
     548           0 :       (easy-menu-define-key map (easy-menu-intern (car item))
     549           0 :                             (cdr item) before)
     550           0 :     (if (or (keymapp item)
     551           0 :             (and (symbolp item) (keymapp (symbol-value item))
     552           0 :                  (setq item (symbol-value item))))
     553             :         ;; Item is a keymap, find the prompt string and use as item name.
     554           0 :         (setq item (cons (keymap-prompt item) item)))
     555           0 :     (setq item (easy-menu-convert-item item))
     556           0 :     (easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before)))
     557             : 
     558             : (defun easy-menu-item-present-p (map path name)
     559             :   "In submenu of MAP with path PATH, return non-nil if item NAME is present.
     560             : MAP and PATH are defined as in `easy-menu-add-item'.
     561             : NAME should be a string, the name of the element to be looked for."
     562           0 :   (easy-menu-return-item (easy-menu-get-map map path) name))
     563             : 
     564             : (defun easy-menu-remove-item (map path name)
     565             :   "From submenu of MAP with path PATH remove item NAME.
     566             : MAP and PATH are defined as in `easy-menu-add-item'.
     567             : NAME should be a string, the name of the element to be removed."
     568           0 :   (setq map (easy-menu-get-map map path))
     569           0 :   (let ((ret (easy-menu-return-item map name)))
     570           0 :     (if ret (easy-menu-define-key map (easy-menu-intern name) nil))
     571           0 :     ret))
     572             : 
     573             : (defun easy-menu-return-item (menu name)
     574             :   "In menu MENU try to look for menu item with name NAME.
     575             : If a menu item is found, return (NAME . item), otherwise return nil.
     576             : If item is an old format item, a new format item is returned."
     577             :   ;; The call to `lookup-key' also calls the C function `get_keyelt' which
     578             :   ;; looks inside a menu-item to only return the actual command.  This is
     579             :   ;; not what we want here.  We should either add an arg to lookup-key to be
     580             :   ;; able to turn off this "feature", or else we could use map-keymap here.
     581             :   ;; In the mean time, I just use `assq' which is an OK approximation since
     582             :   ;; menus are rarely built from vectors or char-tables.
     583           0 :   (let ((item (or (cdr (assq name menu))
     584           0 :                   (lookup-key menu (vector (easy-menu-intern name)))))
     585             :         ret enable cache label)
     586           0 :     (cond
     587           0 :      ((stringp (car-safe item))
     588             :       ;; This is the old menu format. Convert it to new format.
     589           0 :       (setq label (car item))
     590           0 :       (when (stringp (car (setq item (cdr item)))) ; Got help string
     591           0 :         (setq ret (list :help (car item)))
     592           0 :         (setq item (cdr item)))
     593           0 :       (when (and (consp item) (consp (car item))
     594           0 :                  (or (null (caar item)) (numberp (caar item))))
     595           0 :         (setq cache (car item))         ; Got cache
     596           0 :         (setq item (cdr item)))
     597           0 :       (and (symbolp item) (setq enable (get item 'menu-enable)) ; Got enable
     598           0 :            (setq ret (cons :enable (cons enable ret))))
     599           0 :       (if cache (setq ret (cons cache ret)))
     600           0 :       (cons name (cons 'menu-enable (cons label (cons item ret)))))
     601           0 :      (item ; (or (symbolp item) (keymapp item) (eq (car-safe item) 'menu-item))
     602           0 :       (cons name item))                 ; Keymap or new menu format
     603           0 :      )))
     604             : 
     605             : (defun easy-menu-lookup-name (map name)
     606             :   "Lookup menu item NAME in keymap MAP.
     607             : Like `lookup-key' except that NAME is not an array but just a single key
     608             : and that NAME can be a string representing the menu item's name."
     609           0 :   (or (lookup-key map (vector (easy-menu-intern name)))
     610           0 :       (when (stringp name)
     611             :         ;; `lookup-key' failed and we have a menu item name: look at the
     612             :         ;; actual menu entries's names.
     613           0 :         (catch 'found
     614           0 :           (map-keymap (lambda (key item)
     615           0 :                         (if (condition-case nil (member name item)
     616           0 :                               (error nil))
     617             :                             ;; Found it!!  Look for it again with
     618             :                             ;; `lookup-key' so as to handle inheritance and
     619             :                             ;; to extract the actual command/keymap bound to
     620             :                             ;; `name' from the item (via get_keyelt).
     621           0 :                             (throw 'found (lookup-key map (vector key)))))
     622           0 :                       map)))))
     623             : 
     624             : (defun easy-menu-get-map (map path &optional to-modify)
     625             :   "Return a sparse keymap in which to add or remove an item.
     626             : MAP and PATH are as defined in `easy-menu-add-item'.
     627             : 
     628             : TO-MODIFY, if non-nil, is the name of the item the caller
     629             : wants to modify in the map that we return.
     630             : In some cases we use that to select between the local and global maps."
     631           0 :   (setq map
     632           0 :         (catch 'found
     633           0 :           (if (and map (symbolp map) (not (keymapp map)))
     634           0 :               (setq map (symbol-value map)))
     635           0 :           (let ((maps (if map (if (keymapp map) (list map) map)
     636           0 :                         (current-active-maps))))
     637             :             ;; Look for PATH in each map.
     638           0 :             (unless map (push 'menu-bar path))
     639           0 :             (dolist (name path)
     640           0 :               (setq maps
     641           0 :                     (delq nil (mapcar (lambda (map)
     642           0 :                                         (setq map (easy-menu-lookup-name
     643           0 :                                                    map name))
     644           0 :                                         (and (keymapp map) map))
     645           0 :                                       maps))))
     646             : 
     647             :             ;; Prefer a map that already contains the to-be-modified entry.
     648           0 :             (when to-modify
     649           0 :               (dolist (map maps)
     650           0 :                 (when (easy-menu-lookup-name map to-modify)
     651           0 :                   (throw 'found map))))
     652             :             ;; Use the first valid map.
     653           0 :             (when maps (throw 'found (car maps)))
     654             : 
     655             :             ;; Otherwise, make one up.
     656             :             ;; Hardcoding current-local-map is lame, but it's difficult
     657             :             ;; to know what the caller intended for us to do ;-(
     658           0 :             (let* ((name (if path (format "%s" (car (reverse path)))))
     659           0 :                    (newmap (make-sparse-keymap name)))
     660           0 :               (define-key (or map (current-local-map))
     661           0 :                 (apply 'vector (mapcar 'easy-menu-intern path))
     662           0 :                 (if name (cons name newmap) newmap))
     663           0 :               newmap))))
     664           0 :   (or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
     665           0 :   map)
     666             : 
     667             : (provide 'easymenu)
     668             : 
     669             : ;;; easymenu.el ends here

Generated by: LCOV version 1.12