lisp/easymenu.el

   1 ;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs.
   2
   3 ;; Copyright (C) 1992, 1993, 1994, 1995, 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
   6 ;; Maintainer: XEmacs Development Team
   7 ;; Keywords: internal, extensions, dumped
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs 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 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; XEmacs 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 XEmacs; if not, write to the Free Software
  23 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with: Not synched with FSF but coordinated with the FSF
  27 ;;;                  easymenu maintainer for compatibility with FSF 20.4.
  28 ;;; Please: Coordinate changes with Inge Frick <inge@nada.kth.se>
  29
  30 ;; Commentary:
  31
  32 ;; This file is dumped with XEmacs.
  33
  34 ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
  35
  36 ;; This file
  37 ;; The advantages of using easymenu are:
  38
  39 ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
  40
  41 ;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
  42 ;;   (The code does nothing when run under Emacs 18).
  43
  44 ;; The public functions are:
  45
  46 ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
  47 ;;     SYMBOL is both the name of the variable that holds the menu and
  48 ;;            the name of a function that will present the menu.
  49 ;;     MAPS is a list of keymaps where the menu should appear in the menubar.
  50 ;;     DOC is the documentation string for the variable.
  51 ;;     MENU is an XEmacs style menu description.
  52
  53 ;;     See the documentation for easy-menu-define for details.
  54
  55 ;; - Function: easy-menu-change PATH NAME ITEMS
  56 ;;     Change an existing menu.
  57 ;;     The menu must already exist and be visible on the menu bar.
  58 ;;     PATH is a list of strings used for locating the menu on the menu bar.
  59 ;;     NAME is the name of the menu.
  60 ;;     ITEMS is a list of menu items, as defined in `easy-menu-define'.
  61
  62 ;; - Function: easy-menu-add MENU [ MAP ]
  63 ;;     Add MENU to the current menubar in MAP.
  64
  65 ;; - Function: easy-menu-remove MENU
  66 ;;     Remove MENU from the current menubar.
  67
  68 ;; - Function: easy-menu-add-item
  69 ;;     Add item or submenu to existing menu
  70
  71 ;; - Function: easy-menu-item-present-p
  72 ;;     Locate item
  73
  74 ;; - Function: easy-menu-remove-item
  75 ;;     Delete item from menu.
  76
  77 ;; Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', menus
  78 ;; automatically appear and disappear when the keymaps specified by
  79 ;; the MAPS argument to `easy-menu-define' are activated.
  80
  81 ;; XEmacs will bind the map to button3 in each MAPS, but you must
  82 ;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and
  83 ;; remove menus from the menu bar.
  84
  85 ;;; Code:
  86
  87 ;; ;;;###autoload
  88 (defmacro easy-menu-define (symbol maps doc menu)
  89   "Define a menu bar submenu in maps MAPS, according to MENU.
  90 The arguments SYMBOL and DOC are ignored; they are present for
  91 compatibility only.  SYMBOL is not evaluated.  In other Emacs versions
  92 these arguments may be used as a variable to hold the menu data, and a
  93 doc string for that variable.
  94
  95 The first element of MENU must be a string.  It is the menu bar item name.
  96 The rest of the elements are menu items.
  97
  98 A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]
  99
 100 NAME is a string--the menu item name.
 101
 102 CALLBACK is a command to run when the item is chosen,
 103 or a list to evaluate when the item is chosen.
 104
 105 ENABLE is an expression; the item is enabled for selection
 106 whenever this expression's value is non-nil.
 107
 108 Alternatively, a menu item may have the form:
 109
 110    [ NAME CALLBACK [ KEYWORD ARG ] ... ]
 111
 112 Where KEYWORD is one of the symbol defined below.
 113
 114    :keys KEYS
 115
 116 KEYS is a string; a complex keyboard equivalent to this menu item.
 117
 118    :active ENABLE
 119
 120 ENABLE is an expression; the item is enabled for selection
 121 whenever this expression's value is non-nil.
 122
 123    :suffix NAME
 124
 125 NAME is a string; the name of an argument to CALLBACK.
 126
 127    :style STYLE
 128
 129 STYLE is a symbol describing the type of menu item.  The following are
 130 defined:
 131
 132 toggle: A checkbox.
 133         Currently just prepend the name with the string \"Toggle \".
 134 radio: A radio button.
 135 nil: An ordinary menu item.
 136
 137    :selected SELECTED
 138
 139 SELECTED is an expression; the checkbox or radio button is selected
 140 whenever this expression's value is non-nil.
 141 Currently just disable radio buttons, no effect on checkboxes.
 142
 143 A menu item can be a string.  Then that string appears in the menu as
 144 unselectable text.  A string consisting solely of hyphens is displayed
 145 as a solid horizontal line.
 146
 147 A menu item can be a list.  It is treated as a submenu.
 148 The first element should be the submenu name.  That's used as the
 149 menu item in the top-level menu.  The cdr of the submenu list
 150 is a list of menu items, as above."
 151   `(progn
 152      (defvar ,symbol nil ,doc)
 153      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
 154
 155 (defun easy-menu-do-define (symbol maps doc menu)
 156   (when (featurep 'menubar)
 157     (set symbol menu)
 158     (fset symbol `(lambda (e)
 159                     ,doc
 160                     (interactive "@e")
 161                     (run-hooks 'activate-menubar-hook)
 162                     (setq zmacs-region-stays t)
 163                     (popup-menu ,symbol)))))
 164
 165 (defun easy-menu-change (&rest args)
 166   (when (featurep 'menubar)
 167     (apply 'add-menu args)))
 168
 169 (defvar easy-menu-all-popups nil
 170   "Don't use this.
 171 This variable holds the menus of all major and minor modes in effect in the
 172 current buffer.  ")
 173 (make-variable-buffer-local 'easy-menu-all-popups)
 174
 175 (defun easy-menu-add (menu &optional map)
 176   "Add MENU to the current menu bar."
 177   ;; If you uncomment the following, do an xemacs -vanilla, type M-x
 178   ;; folding-mode RET, you'll see that this code, which theoretically has
 179   ;; *scratch* as its buffer context, can't see *scratch*'s value for
 180   ;; mode-popup-menu--the default overrides it.
 181   ;;
 182   ;; This is not specific to *scratch*--try it on ~/.xemacs/init.el--but it
 183   ;; does appear to be specific to the first time mode-popup-menu is
 184   ;; accessed as a buffer-local variable in non-interactive code (that is,
 185   ;; M-: mode-popup-menu RET gives the correct value).
 186   ;;
 187   ;; My fixing this right now isn't going to happen. Aidan Kehoe, 2006-01-03
 188 ;    (message (concat "inside easy-menu-add, menu is %s, "
 189 ;                  "mode-popup-menu is %s, current buffer is %s, "
 190 ;                  "default-value mode-popup-menu is %s, "
 191 ;                  "easy-menu-all-popups is %s")
 192 ;          menu mode-popup-menu (current-buffer)
 193 ;          (default-value 'mode-popup-menu) easy-menu-all-popups)
 194   (when (featurep 'menubar)
 195     ;; Save the existing mode-popup-menu, if it's been changed.
 196     (when (and (zerop (length easy-menu-all-popups))
 197                (not (equal (default-value 'mode-popup-menu) mode-popup-menu)))
 198       (push mode-popup-menu easy-menu-all-popups))
 199     ;; Add the menu to our list of all the popups for the buffer.
 200     (pushnew menu easy-menu-all-popups :test 'equal)
 201     ;; If there are multiple popup menus available, make the popup menu
 202     ;; normally shown with button-3 a menu of them. If there is just one,
 203     ;; make that button show it, and no super-menu.
 204     (setq mode-popup-menu (if (= 1 (length easy-menu-all-popups))
 205                               (car easy-menu-all-popups)
 206                             (cons (easy-menu-title)
 207                                 (reverse easy-menu-all-popups))))
 208     (cond ((null current-menubar)
 209            ;; Don't add it to a non-existing menubar.
 210            nil)
 211           ((assoc (car menu) current-menubar)
 212            ;; Already present.
 213            nil)
 214           ((equal current-menubar '(nil))
 215            ;; Set at left if only contains right marker.
 216            (set-buffer-menubar (list menu nil)))
 217           (t
 218            ;; Add at right.
 219            (set-buffer-menubar (copy-sequence current-menubar))
 220            (add-menu nil (car menu) (cdr menu))))))
 221
 222 (defun easy-menu-remove (menu)
 223   "Remove MENU from the current menu bar."
 224   (when (featurep 'menubar)
 225     (setq
 226      ;; Remove this menu from the list of popups we know about.
 227      easy-menu-all-popups (delq menu easy-menu-all-popups)
 228      ;; If there are multiple popup menus available, make the popup menu
 229      ;; normally shown with button-3 a menu of them. If there is just one,
 230      ;; make that button show it, and no super-menu.
 231      mode-popup-menu (if (= 1 (length easy-menu-all-popups))
 232                          (car easy-menu-all-popups)
 233                        (cons (easy-menu-title)
 234                              (reverse easy-menu-all-popups))))
 235     ;; If we've just set mode-popup-menu to an empty menu, change that menu
 236     ;; to its default value (without intervention from easy-menu).
 237     (if (zerop (length easy-menu-all-popups))
 238         (setq mode-popup-menu (default-value 'mode-popup-menu)))
 239     (and current-menubar
 240          (assoc (car menu) current-menubar)
 241          (delete-menu-item (list (car menu))))))
 242
 243 (defsubst easy-menu-normalize (menu)
 244   (if (symbolp menu)
 245       (symbol-value menu)
 246     menu))
 247
 248 (defun easy-menu-add-item (menu path item &optional before)
 249   "At the end of the submenu of MENU with path PATH, add ITEM.
 250 If ITEM is already present in this submenu, then this item will be changed.
 251 otherwise ITEM will be added at the end of the submenu, unless the optional
 252 argument BEFORE is present, in which case ITEM will instead be added
 253 before the item named BEFORE.
 254 MENU is either a symbol, which have earlier been used as the first
 255 argument in a call to `easy-menu-define', or the value of such a symbol
 256 i.e. a menu, or nil, which stands for the current menubar.
 257 PATH is a list of strings for locating the submenu where ITEM is to be
 258 added.  If PATH is nil, MENU itself is used.  Otherwise, the first
 259 element should be the name of a submenu directly under MENU.  This
 260 submenu is then traversed recursively with the remaining elements of PATH.
 261 ITEM is either defined as in `easy-menu-define', a menu defined earlier
 262 by `easy-menu-define' or `easy-menu-create-menu' or an item returned
 263 from `easy-menu-item-present-p' or `easy-menu-remove-item'."
 264   (when (featurep 'menubar)
 265     (add-menu-button path item before (easy-menu-normalize menu))))
 266
 267 (defun easy-menu-item-present-p (menu path name)
 268   "In submenu of MENU with path PATH, return true iff item NAME is present.
 269 MENU and PATH are defined as in `easy-menu-add-item'.
 270 NAME should be a string, the name of the element to be looked for.
 271
 272 The return value can be used as an argument to `easy-menu-add-item'."
 273   (if (featurep 'menubar)
 274       (car (find-menu-item (or (easy-menu-normalize menu) current-menubar)
 275                            (append path (list name))))
 276     nil))
 277
 278 (defun easy-menu-remove-item (menu path name)
 279   "From submenu of MENU with path PATH, remove item NAME.
 280 MENU and PATH are defined as in `easy-menu-add-item'.
 281 NAME should be a string, the name of the element to be removed.
 282
 283 The return value can be used as an argument to `easy-menu-add-item'."
 284   (when (featurep 'menubar)
 285     (delete-menu-item (append path (list name))
 286                       (easy-menu-normalize menu))))
 287
 288 ;; Think up a good title for the menu.  Take the major-mode of the
 289 ;; buffer, strip the -mode part, convert hyphens to spaces, and
 290 ;; capitalize it.
 291 ;;
 292 ;; If you can think of something smarter, feel free to replace it.
 293 ;; Don't forget to mail the change to xemacs@xemacs.org where everyone
 294 ;; can flame, er, praise your changes.
 295 (defun easy-menu-title ()
 296   (capitalize (replace-in-string (replace-in-string
 297                                   (symbol-name major-mode) "-mode$" "")
 298                                  "-" " ")))
 299
 300 (provide 'easymenu)
 301
 302 ;;; easymenu.el ends here