annotate lisp/emacs-lisp/easymenu.el @ 8757:5010c26b7a07

(SUNOS4): Defined.
author Richard M. Stallman <rms@gnu.org>
date Thu, 15 Sep 1994 05:51:07 +0000
parents 39e8d792604f
children bada2dc32adc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; easymenu.el --- support the easymenu interface for defining a menu.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
4
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Keywords: emulations
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
6 ;; Author: rms
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; any later version.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;;; This is compatible with easymenu.el by Per Abrahamsen
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;;; but it is much simpler as it doesn't try to support other Emacs versions.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;;; The code was mostly derived from lmenu.el.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;;; Code:
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
30 ;;;###autoload
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
31 (defmacro easy-menu-define (symbol maps doc menu)
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 "Define a menu bar submenu in maps MAPS, according to MENU.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 The arguments SYMBOL and DOC are ignored; they are present for
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
34 compatibility only. SYMBOL is not evaluated. In other Emacs versions
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
35 these arguments may be used as a variable to hold the menu data, and a
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
36 doc string for that variable.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 The first element of MENU must be a string. It is the menu bar item name.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 The rest of the elements are menu items.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
41 A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
43 NAME is a string--the menu item name.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
45 CALLBACK is a command to run when the item is chosen,
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
46 or a list to evaluate when the item is chosen.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47
8541
39e8d792604f (easy-menu-define): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8085
diff changeset
48 ENABLE is an expression; the item is enabled for selection
39e8d792604f (easy-menu-define): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8085
diff changeset
49 whenever this expression's value is non-nil.
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
50
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
51 A menu item can be a string. Then that string appears in the menu as
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
52 unselectable text. A string consisting solely of hyphens is displayed
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
53 as a solid horizontal line.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
55 A menu item can be a list. It is treated as a submenu.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 The first element should be the submenu name. That's used as the
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 menu item in the top-level menu. The cdr of the submenu list
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 is a list of menu items, as above."
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
59 (` (let* ((maps (, maps))
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
60 (menu (, menu))
7614
877b3aeaa9b5 (easy-menu-create-keymaps):
Richard M. Stallman <rms@gnu.org>
parents: 6794
diff changeset
61 (keymap (easy-menu-create-keymaps (car menu) (cdr menu))))
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
62 (and (keymapp maps) (setq maps (list maps)))
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
63 (while maps
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
64 (define-key (car maps) (vector 'menu-bar (intern (car menu)))
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
65 (cons (car menu) keymap))
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
66 (setq maps (cdr maps))))))
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
67
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
68 (defvar easy-menu-item-count 0)
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 ;; Return a menu keymap corresponding to a Lucid-style menu list
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ;; MENU-ITEMS, and with name MENU-NAME.
7614
877b3aeaa9b5 (easy-menu-create-keymaps):
Richard M. Stallman <rms@gnu.org>
parents: 6794
diff changeset
72 (defun easy-menu-create-keymaps (menu-name menu-items)
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (let ((menu (make-sparse-keymap menu-name)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 ;; Process items in reverse order,
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 ;; since the define-key loop reverses them again.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (setq menu-items (reverse menu-items))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 (while menu-items
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 (let* ((item (car menu-items))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (callback (if (vectorp item) (aref item 1)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 command enabler name)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (cond ((stringp item)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (setq command nil)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (setq name (if (string-match "^-+$" item) "" item)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 ((consp item)
7614
877b3aeaa9b5 (easy-menu-create-keymaps):
Richard M. Stallman <rms@gnu.org>
parents: 6794
diff changeset
85 (setq command (easy-menu-create-keymaps (car item) (cdr item)))
6794
3063675a5424 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 6600
diff changeset
86 (setq name (car item)))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 ((vectorp item)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (setq command (make-symbol (format "menu-function-%d"
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
89 easy-menu-item-count)))
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
90 (setq easy-menu-item-count (1+ easy-menu-item-count))
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
91 (put command 'menu-enable (aref item 2))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 (setq name (aref item 0))
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
93 (if (keymapp callback)
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
94 (setq name (concat name " ...")))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (if (symbolp callback)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (fset command callback)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (fset command (list 'lambda () '(interactive) callback)))))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (if (null command)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 ;; Handle inactive strings specially--allow any number
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 ;; of identical ones.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 (setcdr menu (cons (list nil name) (cdr menu)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (if name
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 (define-key menu (vector (intern name)) (cons name command)))))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 (setq menu-items (cdr menu-items)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 menu))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106
8085
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
107 (defun easy-menu-change (path name items)
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
108 "Change menu found at PATH as item NAME to contain ITEMS.
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
109 PATH is a list of strings for locating the menu containing NAME in the
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
110 menu bar. ITEMS is a list of menu items, as in `easy-menu-define'.
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
111 These items entirely replace the previous items in that map.
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
112
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
113 Call this from `activate-menubar-hook' to implement dynamic menus."
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
114 (let ((map (key-binding (apply 'vector
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
115 'menu-bar
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
116 (mapcar 'intern (append path (list name)))))))
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
117 (if (keymapp map)
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
118 (setcdr map (cdr (easy-menu-create-keymaps name items)))
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
119 (error "Malformed menu in `easy-menu-change'"))))
c7eb887a1e78 (easy-menu-change): New function.
Richard M. Stallman <rms@gnu.org>
parents: 7614
diff changeset
120
6600
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
121 (defmacro easy-menu-remove (menu))
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
122
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
123 (defmacro easy-menu-add (menu &optional map))
f75ac1f3d99c *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6542
diff changeset
124
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (provide 'easymenu)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 ;;; easymenu.el ends here