cgit.sxemacs.org Git - gnus/blob - lisp/auc-menu.el

   1 ;;; auc-menu.el - Easy menu support for GNU Emacs 19 and XEmacs.
   2 ;;
   3 ;; $Id: auc-menu.el,v 5.7 1994/11/28 01:41:22 amanda Exp $
   4 ;;
   5 ;; LCD Archive Entry:
   6 ;; auc-menu|Per Abrahamsen|abraham@iesd.auc.dk|
   7 ;; Easy menu support for GNU Emacs 19 and XEmacs|
   8 ;; $Date: 1994/11/28 01:41:22 $|$Revision: 5.7 $|~/misc/auc-menu.el.gz|
   9
  10 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  11 ;; Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
  12 ;;
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17 ;;
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; if not, write to the Free Software
  25 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;; Commentary:
  28 ;;
  29 ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
  30 ;; The advantages of using easymenu are:
  31 ;;
  32 ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
  33 ;;
  34 ;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
  35 ;;   (The code does nothing when run under Emacs 18).
  36 ;;
  37 ;; The public functions are:
  38 ;;
  39 ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
  40 ;;     SYMBOL is both the name of the variable that holds the menu and
  41 ;;            the name of a function that will present a the menu.
  42 ;;     MAPS is a list of keymaps where the menu should appear in the menubar.
  43 ;;     DOC is the documentation string for the variable.
  44 ;;     MENU is an XEmacs style menu description.
  45 ;;
  46 ;;     See the documentation for easy-menu-define for details.
  47 ;;
  48 ;; - Function: easy-menu-change PATH NAME ITEMS
  49 ;;     Change an existing menu.
  50 ;;     The menu must already exist an be visible on the menu bar.
  51 ;;     PATH is a list of strings used for locating the menu on the menu bar.
  52 ;;     NAME is the name of the menu.
  53 ;;     ITEMS is a list of menu items, as defined in `easy-menu-define'.
  54 ;;
  55 ;; - Function: easy-menu-add MENU [ MAP ]
  56 ;;     Add MENU to the current menubar in MAP.
  57 ;;
  58 ;; - Function: easy-menu-remove MENU
  59 ;;     Remove MENU from the current menubar.
  60 ;;
  61 ;; GNU Emacs 19 never uses `easy-menu-add' or `easy-menu-remove',
  62 ;; menus automatically appear and disappear when the keymaps
  63 ;; specified by the MAPS argument to `easy-menu-define' are
  64 ;; activated.
  65 ;;
  66 ;; XEmacs will bind the map to button3 in each MAPS, but you must
  67 ;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and
  68 ;; remove menus from the menu bar.
  69
  70 ;; auc-menu.el define the easymenu API included in Emacs 19.29 and
  71 ;; later.  In fact, the Emacs 19 specific code should be identical.
  72
  73 ;;; Code:
  74
  75 ;;;###autoload
  76 (defmacro easy-menu-define (symbol maps doc menu)
  77   "Define a menu bar submenu in maps MAPS, according to MENU.
  78 The arguments SYMBOL and DOC are ignored; they are present for
  79 compatibility only.  SYMBOL is not evaluated.  In other Emacs versions
  80 these arguments may be used as a variable to hold the menu data, and a
  81 doc string for that variable.
  82
  83 The first element of MENU must be a string.  It is the menu bar item name.
  84 The rest of the elements are menu items.
  85
  86 A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]
  87
  88 NAME is a string--the menu item name.
  89
  90 CALLBACK is a command to run when the item is chosen,
  91 or a list to evaluate when the item is chosen.
  92
  93 ENABLE is an expression; the item is enabled for selection
  94 whenever this expression's value is non-nil.
  95
  96 Alternatively, a menu item may have the form:
  97
  98    [ NAME CALLBACK [ KEYWORD ARG ] ... ]
  99
 100 Where KEYWORD is one of the symbol defined below.
 101
 102    :keys KEYS
 103
 104 KEYS is a string; a complex keyboard equivalent to this menu item.
 105
 106    :active ENABLE
 107
 108 ENABLE is an expression; the item is enabled for selection
 109 whenever this expression's value is non-nil.
 110
 111    :suffix NAME
 112
 113 NAME is a string; the name of an argument to CALLBACK.
 114
 115    :style STYLE
 116
 117 STYLE is a symbol describing the type of menu item.  The following are
 118 defined:
 119
 120 toggle: A checkbox.
 121         Currently just prepend the name with the string \"Toggle \".
 122 radio: A radio button.
 123 nil: An ordinary menu item.
 124
 125    :selected SELECTED
 126
 127 SELECTED is an expression; the checkbox or radio button is selected
 128 whenever this expression's value is non-nil.
 129 Currently just disable radio buttons, no effect on checkboxes.
 130
 131 A menu item can be a string.  Then that string appears in the menu as
 132 unselectable text.  A string consisting solely of hyphens is displayed
 133 as a solid horizontal line.
 134
 135 A menu item can be a list.  It is treated as a submenu.
 136 The first element should be the submenu name.  That's used as the
 137 menu item in the top-level menu.  The cdr of the submenu list
 138 is a list of menu items, as above."
 139   (` (progn
 140        (defvar (, symbol) nil (, doc))
 141        (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
 142
 143 (cond
 144
 145 ;;; Emacs 18
 146
 147 ((< (string-to-int emacs-version) 19)
 148
 149 (defun easy-menu-do-define (symbol maps doc menu)
 150   (fset symbol (symbol-function 'ignore)))
 151
 152 (defun easy-menu-remove (menu))
 153
 154 (defun easy-menu-add (menu &optional map))
 155
 156 (defun easy-menu-change (path name items))
 157
 158 )                                       ;Emacs 18
 159
 160 ;;; XEmacs
 161
 162 ((string-match "XEmacs\\|Lucid" emacs-version)
 163
 164 (defun easy-menu-do-define (symbol maps doc menu)
 165   (set symbol menu)
 166   (fset symbol (list 'lambda '(e)
 167                      doc
 168                      '(interactive "@e")
 169                      '(run-hooks 'activate-menubar-hook)
 170                      '(setq zmacs-region-stays 't)
 171                      (list 'popup-menu symbol)))
 172   (mapcar (function (lambda (map) (define-key map 'button3 symbol)))
 173           (if (keymapp maps) (list maps) maps)))
 174
 175 (fset 'easy-menu-change (symbol-function 'add-menu))
 176
 177 (defun easy-menu-add (menu &optional map)
 178   "Add MENU to the current menu bar."
 179   (cond ((null current-menubar)
 180          ;; Don't add it to a non-existing menubar.
 181          nil)
 182         ((assoc (car menu) current-menubar)
 183          ;; Already present.
 184          nil)
 185         ((equal current-menubar '(nil))
 186          ;; Set at left if only contains right marker.
 187          (set-buffer-menubar (list menu nil)))
 188         (t
 189          ;; Add at right.
 190          (set-buffer-menubar (copy-sequence current-menubar))
 191          (add-menu nil (car menu) (cdr menu)))))
 192
 193 (defun easy-menu-remove (menu)
 194   "Remove MENU from the current menu bar."
 195   (and current-menubar
 196        (assoc (car menu) current-menubar)
 197        (delete-menu-item (list (car menu)))))
 198
 199 )                                       ;XEmacs
 200
 201 ;;; GNU Emacs 19
 202
 203 (t
 204
 205 (defun easy-menu-do-define (symbol maps doc menu)
 206   ;; We can't do anything that might differ between Emacs dialects in
 207   ;; `easy-menu-define' in order to make byte compiled files
 208   ;; compatible.  Therefore everything interesting is done in this
 209   ;; function.
 210   (set symbol (easy-menu-create-keymaps (car menu) (cdr menu)))
 211   (fset symbol (` (lambda (event) (, doc) (interactive "@e")
 212                     (easy-popup-menu event (, symbol)))))
 213   (mapcar (function (lambda (map)
 214             (define-key map (vector 'menu-bar (intern (car menu)))
 215               (cons (car menu) (symbol-value symbol)))))
 216           (if (keymapp maps) (list maps) maps)))
 217
 218 (defvar easy-menu-item-count 0)
 219
 220 ;; Return a menu keymap corresponding to a XEmacs style menu list
 221 ;; MENU-ITEMS, and with name MENU-NAME.
 222 (defun easy-menu-create-keymaps (menu-name menu-items)
 223   (let ((menu (make-sparse-keymap menu-name)))
 224     ;; Process items in reverse order,
 225     ;; since the define-key loop reverses them again.
 226     (setq menu-items (reverse menu-items))
 227     (while menu-items
 228       (let* ((item (car menu-items))
 229              (callback (if (vectorp item) (aref item 1)))
 230              command enabler name)
 231         (cond ((stringp item)
 232                (setq command nil)
 233                (setq name (if (string-match "^-+$" item) "" item)))
 234               ((consp item)
 235                (setq command (easy-menu-create-keymaps (car item) (cdr item)))
 236                (setq name (car item)))
 237               ((vectorp item)
 238                (setq command (make-symbol (format "menu-function-%d"
 239                                                   easy-menu-item-count)))
 240                (setq easy-menu-item-count (1+ easy-menu-item-count))
 241                (setq name (aref item 0))
 242                (let ((keyword (aref item 2)))
 243                  (if (and (symbolp keyword)
 244                           (= ?: (aref (symbol-name keyword) 0)))
 245                      (let ((count 2)
 246                            style selected active keys
 247                            arg)
 248                        (while (> (length item) count)
 249                          (setq keyword (aref item count))
 250                          (setq arg (aref item (1+ count)))
 251                          (setq count (+ 2 count))
 252                          (cond ((eq keyword ':keys)
 253                                 (setq keys arg))
 254                                ((eq keyword ':active)
 255                                 (setq active arg))
 256                                ((eq keyword ':suffix)
 257                                 (setq name (concat name " " arg)))
 258                                ((eq keyword ':style)
 259                                 (setq style arg))
 260                                ((eq keyword ':selected)
 261                                 (setq selected arg))))
 262                        (if keys
 263                            (setq name (concat name "  (" keys ")")))
 264                        (if (eq style 'toggle)
 265                            ;; Simulate checkboxes.
 266                            (setq name (concat "Toggle " name)))
 267                        (if active
 268                            (put command 'menu-enable active)
 269                          (and (eq style 'radio)
 270                               selected
 271                               ;; Simulate radio buttons with menu-enable.
 272                               (put command 'menu-enable
 273                                    (list 'not selected)))))))
 274                (if (keymapp callback)
 275                    (setq name (concat name " ...")))
 276                (if (symbolp callback)
 277                    (fset command callback)
 278                  (fset command (list 'lambda () '(interactive) callback)))))
 279         (if (null command)
 280             ;; Handle inactive strings specially--allow any number
 281             ;; of identical ones.
 282             (setcdr menu (cons (list nil name) (cdr menu)))
 283           (if name
 284               (define-key menu (vector (intern name)) (cons name command)))))
 285       (setq menu-items (cdr menu-items)))
 286     menu))
 287
 288 (defun easy-menu-change (path name items)
 289   "Change menu found at PATH as item NAME to contain ITEMS.
 290 PATH is a list of strings for locating the menu containing NAME in the
 291 menu bar.  ITEMS is a list of menu items, as in `easy-menu-define'.
 292 These items entirely replace the previous items in that map.
 293
 294 Call this from `activate-menubar-hook' to implement dynamic menus."
 295   (let ((map (key-binding (apply 'vector
 296                                  'menu-bar
 297                                  (mapcar 'intern (append path (list name)))))))
 298     (if (keymapp map)
 299         (setcdr map (cdr (easy-menu-create-keymaps name items)))
 300       (error "Malformed menu in `easy-menu-change'"))))
 301
 302 (defun easy-menu-remove (menu))
 303
 304 (defun easy-menu-add (menu &optional map))
 305
 306 )                                       ;GNU Emacs 19
 307
 308 )                                       ;cond
 309
 310 (provide 'easymenu)
 311 (provide 'auc-menu)
 312
 313 ;;; auc-menu.el ends here