Mercurial > emacs
annotate lisp/emacs-lisp/lmenu.el @ 26940:f1998d661bc2
Remove conditional definition of eval-when-compile. Don't specify abs,
expt, gethash, hash-table-count, hash-table-p as side-effect-free here.
(cl-emacs-type): Don't declare.
(cl-compile-time-init): Remove Emacs 18 compiler patch.
(cl-parse-loop-clause): Remove compatibility code.
author | Dave Love <fx@gnu.org> |
---|---|
date | Sat, 18 Dec 1999 17:10:56 +0000 |
parents | 8941ce81cd7c |
children | 8c99980d4906 |
rev | line source |
---|---|
2232
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2231
diff
changeset
|
1 ;;; lmenu.el --- emulate Lucid's menubar support |
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2231
diff
changeset
|
2 |
18410
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. |
14169 | 4 |
2233
fb0ed5a1d0f3
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2232
diff
changeset
|
5 ;; Keywords: emulations |
fb0ed5a1d0f3
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2232
diff
changeset
|
6 |
2231 | 7 ;; This file is part of GNU Emacs. |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
14169 | 20 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 ;; Boston, MA 02111-1307, USA. | |
2231 | 23 |
2232
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2231
diff
changeset
|
24 ;;; Code: |
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2231
diff
changeset
|
25 |
2231 | 26 |
27 ;; First, emulate the Lucid menubar support in GNU Emacs 19. | |
28 | |
29 ;; Arrange to use current-menubar to set up part of the menu bar. | |
30 | |
7656
d50e5481aae2
(popup-dialog-box): Bind meaning with let.
Richard M. Stallman <rms@gnu.org>
parents:
7655
diff
changeset
|
31 (defvar current-menubar) |
d50e5481aae2
(popup-dialog-box): Bind meaning with let.
Richard M. Stallman <rms@gnu.org>
parents:
7655
diff
changeset
|
32 |
2231 | 33 (setq recompute-lucid-menubar 'recompute-lucid-menubar) |
34 (defun recompute-lucid-menubar () | |
35 (define-key lucid-menubar-map [menu-bar] | |
36 (condition-case nil | |
37 (make-lucid-menu-keymap "menu-bar" current-menubar) | |
38 (error (message "Invalid data in current-menubar moved to lucid-failing-menubar") | |
39 (sit-for 1) | |
40 (setq lucid-failing-menubar current-menubar | |
41 current-menubar nil)))) | |
42 (setq lucid-menu-bar-dirty-flag nil)) | |
43 | |
44 (defvar lucid-menubar-map (make-sparse-keymap)) | |
45 (or (assq 'current-menubar minor-mode-map-alist) | |
46 (setq minor-mode-map-alist | |
47 (cons (cons 'current-menubar lucid-menubar-map) | |
48 minor-mode-map-alist))) | |
49 | |
50 (defun set-menubar-dirty-flag () | |
51 (force-mode-line-update) | |
52 (setq lucid-menu-bar-dirty-flag t)) | |
53 | |
54 (defvar add-menu-item-count 0) | |
55 | |
8868
5eff9b0c1a43
(make-lucid-menu-keymap-disable): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
8051
diff
changeset
|
56 ;; This is a variable whose value is always nil. |
5eff9b0c1a43
(make-lucid-menu-keymap-disable): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
8051
diff
changeset
|
57 (defvar make-lucid-menu-keymap-disable nil) |
5eff9b0c1a43
(make-lucid-menu-keymap-disable): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
8051
diff
changeset
|
58 |
2231 | 59 ;; Return a menu keymap corresponding to a Lucid-style menu list |
60 ;; MENU-ITEMS, and with name MENU-NAME. | |
61 (defun make-lucid-menu-keymap (menu-name menu-items) | |
62 (let ((menu (make-sparse-keymap menu-name))) | |
63 ;; Process items in reverse order, | |
64 ;; since the define-key loop reverses them again. | |
65 (setq menu-items (reverse menu-items)) | |
66 (while menu-items | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
67 (let ((item (car menu-items)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
68 command name callback) |
2231 | 69 (cond ((stringp item) |
70 (setq command nil) | |
6445
19bf0e182eda
(make-lucid-menu-keymap): Any row of dashes means blank.
Karl Heuer <kwzh@gnu.org>
parents:
6435
diff
changeset
|
71 (setq name (if (string-match "^-+$" item) "" item))) |
2231 | 72 ((consp item) |
73 (setq command (make-lucid-menu-keymap (car item) (cdr item))) | |
74 (setq name (car item))) | |
75 ((vectorp item) | |
76 (setq command (make-symbol (format "menu-function-%d" | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
77 add-menu-item-count)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
78 add-menu-item-count (1+ add-menu-item-count) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
79 name (aref item 0) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
80 callback (aref item 1)) |
2231 | 81 (if (symbolp callback) |
82 (fset command callback) | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
83 (fset command (list 'lambda () '(interactive) callback))) |
15430
760c7139c19c
(make-lucid-menu-keymap): Add menu-alias property.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
84 (put command 'menu-alias t) |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
85 (let ((i 2)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
86 (while (< i (length item)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
87 (cond |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
88 ((eq (aref item i) ':active) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
89 (put command 'menu-enable |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
90 (or (aref item (1+ i)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
91 'make-lucid-menu-keymap-disable)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
92 (setq i (+ 2 i))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
93 ((eq (aref item i) ':suffix) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
94 ;; unimplemented |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
95 (setq i (+ 2 i))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
96 ((eq (aref item i) ':keys) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
97 ;; unimplemented |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
98 (setq i (+ 2 i))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
99 ((eq (aref item i) ':style) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
100 ;; unimplemented |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
101 (setq i (+ 2 i))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
102 ((eq (aref item i) ':selected) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
103 ;; unimplemented |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
104 (setq i (+ 2 i))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
105 ((and (symbolp (aref item i)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
106 (= ?: (string-to-char (symbol-name (aref item i))))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
107 (error "Unrecognized menu item keyword: %S" |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
108 (aref item i))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
109 ((= i 2) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
110 ;; old-style format: active-p &optional suffix |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
111 (put command 'menu-enable |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
112 (or (aref item i) 'make-lucid-menu-keymap-disable)) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
113 ;; suffix is unimplemented |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
114 (setq i (length item))) |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
115 (t |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
116 (error "Unexpected menu item value: %S" |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
117 (aref item i)))))))) |
5477
2efe469a9c24
(make-lucid-menu-keymap): Allow multiple identical inactive strings.
Richard M. Stallman <rms@gnu.org>
parents:
5461
diff
changeset
|
118 (if (null command) |
2efe469a9c24
(make-lucid-menu-keymap): Allow multiple identical inactive strings.
Richard M. Stallman <rms@gnu.org>
parents:
5461
diff
changeset
|
119 ;; Handle inactive strings specially--allow any number |
2efe469a9c24
(make-lucid-menu-keymap): Allow multiple identical inactive strings.
Richard M. Stallman <rms@gnu.org>
parents:
5461
diff
changeset
|
120 ;; of identical ones. |
2efe469a9c24
(make-lucid-menu-keymap): Allow multiple identical inactive strings.
Richard M. Stallman <rms@gnu.org>
parents:
5461
diff
changeset
|
121 (setcdr menu (cons (list nil name) (cdr menu))) |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
122 (if name |
5477
2efe469a9c24
(make-lucid-menu-keymap): Allow multiple identical inactive strings.
Richard M. Stallman <rms@gnu.org>
parents:
5461
diff
changeset
|
123 (define-key menu (vector (intern name)) (cons name command))))) |
2231 | 124 (setq menu-items (cdr menu-items))) |
125 menu)) | |
126 | |
18410
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
127 ;; The value of the cache-symbol for a menu |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
128 ;; is |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
129 ;; unbound -- nothing computed |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
130 ;; (ORIG . TRANSL) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
131 ;; ORIG is the original menu spec list |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
132 ;; and TRANSL is its translation. |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
133 |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
134 (defmacro popup-menu (arg) |
2231 | 135 "Pop up the given menu. |
136 A menu is a list of menu items, strings, and submenus. | |
137 | |
138 The first element of a menu must be a string, which is the name of the | |
139 menu. This is the string that will be displayed in the parent menu, if | |
140 any. For toplevel menus, it is ignored. This string is not displayed | |
141 in the menu itself. | |
142 | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
143 A menu item is a vector containing: |
2231 | 144 |
145 - the name of the menu item (a string); | |
146 - the `callback' of that item; | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
147 - a list of keywords with associated values: |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
148 - :active active-p a form specifying whether this item is selectable; |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
149 - :suffix suffix a string to be appended to the name as an `argument' |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
150 to the command, like `Kill Buffer NAME'; |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
151 - :keys command-keys a string, suitable for `substitute-command-keys', |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
152 to specify the keyboard equivalent of a command |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
153 when the callback is a form (this is not necessary |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
154 when the callback is a symbol, as the keyboard |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
155 equivalent is computed automatically in that case); |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
156 - :style style a symbol: nil for a normal menu item, `toggle' for |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
157 a toggle button (a single option that can be turned |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
158 on or off), or `radio' for a radio button (one of a |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
159 group of mutually exclusive options); |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
160 - :selected form for `toggle' or `radio' style, a form that specifies |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
161 whether the button will be in the selected state. |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
162 |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
163 Alternately, the vector may contain exactly 3 or 4 elements, with the third |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
164 element specifying `active-p' and the fourth specifying `suffix'. |
2231 | 165 |
166 If the `callback' of a menu item is a symbol, then it must name a command. | |
167 It will be invoked with `call-interactively'. If it is a list, then it is | |
168 evaluated with `eval'. | |
169 | |
170 If an element of a menu is a string, then that string will be presented in | |
171 the menu as unselectable text. | |
172 | |
173 If an element of a menu is a string consisting solely of hyphens, then that | |
174 item will be presented as a solid horizontal line. | |
175 | |
176 If an element of a menu is a list, it is treated as a submenu. The name of | |
177 that submenu (the first element in the list) will be used as the name of the | |
178 item representing this menu on the parent. | |
179 | |
180 The syntax, more precisely: | |
181 | |
182 form := <something to pass to `eval'> | |
183 command := <a symbol or string, to pass to `call-interactively'> | |
184 callback := command | form | |
185 active-p := <t or nil, whether this thing is selectable> | |
186 text := <string, non selectable> | |
187 name := <string> | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
188 suffix := <string> |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
189 command-keys := <string> |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
190 object-style := 'nil' | 'toggle' | 'radio' |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
191 keyword := ':active' active-p |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
192 | ':suffix' suffix |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
193 | ':keys' command-keys |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
194 | ':style' object-style |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
195 | ':selected' form |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
196 menu-item := '[' name callback active-p [ suffix ] ']' |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
197 | '[' name callback [ keyword ]+ ']' |
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
198 menu := '(' name [ menu-item | menu | text ]+ ')'" |
18410
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
199 (if (not (symbolp arg)) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
200 `(popup-menu-internal ,arg nil) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
201 `(popup-menu-internal ,arg |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
202 ',(intern (concat "popup-menu-" (symbol-name arg)))))) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
203 |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
204 (defun popup-menu-internal (menu cache-symbol) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
205 (if (null cache-symbol) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
206 ;; If no cache symbol, translate the menu afresh each time. |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
207 (popup-menu-popup (make-lucid-menu-keymap (car menu) (cdr menu))) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
208 ;; We have a cache symbol. See if the cache is valid |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
209 ;; for the same menu we have now. |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
210 (or (and (boundp cache-symbol) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
211 (consp (symbol-value cache-symbol)) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
212 (equal (car (symbol-value cache-symbol)) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
213 menu)) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
214 ;; If not, update it. |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
215 (set cache-symbol |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
216 (cons menu (make-lucid-menu-keymap (car menu) (cdr menu))))) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
217 ;; Use the menu in the cache. |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
218 (popup-menu-popup (cdr (symbol-value cache-symbol))))) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
219 |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
220 ;; Pop up MENU-KEYMAP which was made by make-lucid-menu-keymap. |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
221 (defun popup-menu-popup (menu-keymap) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
222 (let ((pos (mouse-pixel-position)) |
7655
9134274acb76
(popup-menu): Bind cmd with let.
Richard M. Stallman <rms@gnu.org>
parents:
7641
diff
changeset
|
223 answer cmd) |
18410
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
224 (while (and menu-keymap |
8051
a320525f4d8f
(popup-menu): Allow user to select nothing.
Karl Heuer <kwzh@gnu.org>
parents:
8038
diff
changeset
|
225 (setq answer (x-popup-menu (list (list (nth 1 pos) |
a320525f4d8f
(popup-menu): Allow user to select nothing.
Karl Heuer <kwzh@gnu.org>
parents:
8038
diff
changeset
|
226 (nthcdr 2 pos)) |
a320525f4d8f
(popup-menu): Allow user to select nothing.
Karl Heuer <kwzh@gnu.org>
parents:
8038
diff
changeset
|
227 (car pos)) |
18410
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
228 menu-keymap))) |
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
229 (setq cmd (lookup-key menu-keymap (apply 'vector answer))) |
21878
8941ce81cd7c
(popup-menu-popup): Fix typo: set menu-keymap.
Richard M. Stallman <rms@gnu.org>
parents:
18410
diff
changeset
|
230 (setq menu-keymap nil) |
5439
77798fccc85c
(popup-menu): Add loop to handle submenus.
Richard M. Stallman <rms@gnu.org>
parents:
2751
diff
changeset
|
231 (and cmd |
77798fccc85c
(popup-menu): Add loop to handle submenus.
Richard M. Stallman <rms@gnu.org>
parents:
2751
diff
changeset
|
232 (if (keymapp cmd) |
18410
e414b2e486a3
(popup-menu): Redefine as macro.
Richard M. Stallman <rms@gnu.org>
parents:
15430
diff
changeset
|
233 (setq menu-keymap cmd) |
5439
77798fccc85c
(popup-menu): Add loop to handle submenus.
Richard M. Stallman <rms@gnu.org>
parents:
2751
diff
changeset
|
234 (call-interactively cmd)))))) |
6744
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
235 |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
236 (defun popup-dialog-box (data) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
237 "Pop up a dialog box. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
238 A dialog box description is a list. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
239 |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
240 - The first element of the list is a string to display in the dialog box. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
241 - The rest of the elements are descriptions of the dialog box's buttons. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
242 Each one is a vector of three elements: |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
243 - The first element is the text of the button. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
244 - The second element is the `callback'. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
245 - The third element is t or nil, whether this button is selectable. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
246 |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
247 If the `callback' of a button is a symbol, then it must name a command. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
248 It will be invoked with `call-interactively'. If it is a list, then it is |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
249 evaluated with `eval'. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
250 |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
251 One (and only one) of the buttons may be `nil'. This marker means that all |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
252 following buttons should be flushright instead of flushleft. |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
253 |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
254 The syntax, more precisely: |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
255 |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
256 form := <something to pass to `eval'> |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
257 command := <a symbol or string, to pass to `call-interactively'> |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
258 callback := command | form |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
259 active-p := <t, nil, or a form to evaluate to decide whether this |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
260 button should be selectable> |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
261 name := <string> |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
262 partition := 'nil' |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
263 button := '[' name callback active-p ']' |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
264 dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')'" |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
265 (let ((name (car data)) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
266 (tail (cdr data)) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
267 converted |
7656
d50e5481aae2
(popup-dialog-box): Bind meaning with let.
Richard M. Stallman <rms@gnu.org>
parents:
7655
diff
changeset
|
268 choice meaning) |
6744
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
269 (while tail |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
270 (if (null (car tail)) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
271 (setq converted (cons nil converted)) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
272 (let ((item (aref (car tail) 0)) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
273 (callback (aref (car tail) 1)) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
274 (enable (aref (car tail) 2))) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
275 (setq converted |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
276 (cons (if enable (cons item callback) item) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
277 converted)))) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
278 (setq tail (cdr tail))) |
67485a72803d
(popup-dialog-box): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6445
diff
changeset
|
279 (setq choice (x-popup-dialog t (cons name (nreverse converted)))) |
11765
3bc36769004f
(popup-dialog-box): x-popup-dialog returns the value, not the cons cell.
Richard M. Stallman <rms@gnu.org>
parents:
10954
diff
changeset
|
280 (if choice |
3bc36769004f
(popup-dialog-box): x-popup-dialog returns the value, not the cons cell.
Richard M. Stallman <rms@gnu.org>
parents:
10954
diff
changeset
|
281 (if (symbolp choice) |
3bc36769004f
(popup-dialog-box): x-popup-dialog returns the value, not the cons cell.
Richard M. Stallman <rms@gnu.org>
parents:
10954
diff
changeset
|
282 (call-interactively choice) |
3bc36769004f
(popup-dialog-box): x-popup-dialog returns the value, not the cons cell.
Richard M. Stallman <rms@gnu.org>
parents:
10954
diff
changeset
|
283 (eval choice))))) |
2231 | 284 |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
285 ;; This is empty because the usual elements of the menu bar |
2751
f95808ad4b95
(default-menubar): Make initial value nil.
Richard M. Stallman <rms@gnu.org>
parents:
2233
diff
changeset
|
286 ;; are provided by menu-bar.el instead. |
f95808ad4b95
(default-menubar): Make initial value nil.
Richard M. Stallman <rms@gnu.org>
parents:
2233
diff
changeset
|
287 ;; It would not make sense to duplicate them here. |
f95808ad4b95
(default-menubar): Make initial value nil.
Richard M. Stallman <rms@gnu.org>
parents:
2233
diff
changeset
|
288 (defconst default-menubar nil) |
2231 | 289 |
290 (defun set-menubar (menubar) | |
291 "Set the default menubar to be menubar." | |
292 (setq-default current-menubar (copy-sequence menubar)) | |
293 (set-menubar-dirty-flag)) | |
294 | |
295 (defun set-buffer-menubar (menubar) | |
296 "Set the buffer-local menubar to be menubar." | |
297 (make-local-variable 'current-menubar) | |
298 (setq current-menubar (copy-sequence menubar)) | |
299 (set-menubar-dirty-flag)) | |
300 | |
301 | |
302 ;;; menu manipulation functions | |
303 | |
304 (defun find-menu-item (menubar item-path-list &optional parent) | |
305 "Searches MENUBAR for item given by ITEM-PATH-LIST. | |
306 Returns (ITEM . PARENT), where PARENT is the immediate parent of | |
307 the item found. | |
308 Signals an error if the item is not found." | |
309 (or parent (setq item-path-list (mapcar 'downcase item-path-list))) | |
310 (if (not (consp menubar)) | |
311 nil | |
312 (let ((rest menubar) | |
313 result) | |
314 (while rest | |
315 (if (and (car rest) | |
316 (equal (car item-path-list) | |
317 (downcase (if (vectorp (car rest)) | |
318 (aref (car rest) 0) | |
319 (if (stringp (car rest)) | |
320 (car rest) | |
321 (car (car rest))))))) | |
322 (setq result (car rest) rest nil) | |
323 (setq rest (cdr rest)))) | |
324 (if (cdr item-path-list) | |
325 (if (consp result) | |
326 (find-menu-item (cdr result) (cdr item-path-list) result) | |
327 (if result | |
328 (signal 'error (list "not a submenu" result)) | |
329 (signal 'error (list "no such submenu" (car item-path-list))))) | |
330 (cons result parent))))) | |
331 | |
332 | |
333 (defun disable-menu-item (path) | |
334 "Make the named menu item be unselectable. | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
335 PATH is a list of strings which identify the position of the menu item in |
2231 | 336 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
337 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
2231 | 338 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." |
339 (let* ((menubar current-menubar) | |
340 (pair (find-menu-item menubar path)) | |
341 (item (car pair)) | |
342 (menu (cdr pair))) | |
343 (or item | |
344 (signal 'error (list (if menu "No such menu item" "No such menu") | |
345 path))) | |
346 (if (consp item) (error "can't disable menus, only menu items")) | |
347 (aset item 2 nil) | |
348 (set-menubar-dirty-flag) | |
349 item)) | |
350 | |
351 | |
352 (defun enable-menu-item (path) | |
353 "Make the named menu item be selectable. | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
354 PATH is a list of strings which identify the position of the menu item in |
2231 | 355 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
356 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
2231 | 357 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." |
358 (let* ((menubar current-menubar) | |
359 (pair (find-menu-item menubar path)) | |
360 (item (car pair)) | |
361 (menu (cdr pair))) | |
362 (or item | |
363 (signal 'error (list (if menu "No such menu item" "No such menu") | |
364 path))) | |
365 (if (consp item) (error "%S is a menu, not a menu item" path)) | |
366 (aset item 2 t) | |
367 (set-menubar-dirty-flag) | |
368 item)) | |
369 | |
370 | |
371 (defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before) | |
372 (if before (setq before (downcase before))) | |
373 (let* ((menubar current-menubar) | |
374 (menu (condition-case () | |
375 (car (find-menu-item menubar menu-path)) | |
376 (error nil))) | |
377 (item (if (listp menu) | |
378 (car (find-menu-item (cdr menu) (list item-name))) | |
379 (signal 'error (list "not a submenu" menu-path))))) | |
380 (or menu | |
381 (let ((rest menu-path) | |
382 (so-far menubar)) | |
383 (while rest | |
384 ;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest))))) | |
385 (setq menu | |
386 (if (eq so-far menubar) | |
387 (car (find-menu-item so-far (list (car rest)))) | |
388 (car (find-menu-item (cdr so-far) (list (car rest)))))) | |
389 (or menu | |
390 (let ((rest2 so-far)) | |
10954
d9ab06338f6a
(add-menu-item-1): Better error message if
Richard M. Stallman <rms@gnu.org>
parents:
9523
diff
changeset
|
391 (or rest2 |
d9ab06338f6a
(add-menu-item-1): Better error message if
Richard M. Stallman <rms@gnu.org>
parents:
9523
diff
changeset
|
392 (error "Trying to modify a menu that doesn't exist")) |
2231 | 393 (while (and (cdr rest2) (car (cdr rest2))) |
394 (setq rest2 (cdr rest2))) | |
395 (setcdr rest2 | |
7699 | 396 (nconc (list (setq menu (list (car rest)))) |
397 (cdr rest2))))) | |
2231 | 398 (setq so-far menu) |
399 (setq rest (cdr rest))))) | |
400 (or menu (setq menu menubar)) | |
401 (if item | |
402 nil ; it's already there | |
403 (if item-p | |
404 (setq item (vector item-name item-data enabled-p)) | |
405 (setq item (cons item-name item-data))) | |
406 ;; if BEFORE is specified, try to add it there. | |
407 (if before | |
408 (setq before (car (find-menu-item menu (list before))))) | |
409 (let ((rest menu) | |
410 (added-before nil)) | |
411 (while rest | |
412 (if (eq before (car (cdr rest))) | |
413 (progn | |
414 (setcdr rest (cons item (cdr rest))) | |
415 (setq rest nil added-before t)) | |
416 (setq rest (cdr rest)))) | |
417 (if (not added-before) | |
418 ;; adding before the first item on the menubar itself is harder | |
419 (if (and (eq menu menubar) (eq before (car menu))) | |
420 (setq menu (cons item menu) | |
421 current-menubar menu) | |
422 ;; otherwise, add the item to the end. | |
423 (nconc menu (list item)))))) | |
424 (if item-p | |
425 (progn | |
426 (aset item 1 item-data) | |
427 (aset item 2 (not (null enabled-p)))) | |
428 (setcar item item-name) | |
429 (setcdr item item-data)) | |
430 (set-menubar-dirty-flag) | |
431 item)) | |
432 | |
433 (defun add-menu-item (menu-path item-name function enabled-p &optional before) | |
434 "Add a menu item to some menu, creating the menu first if necessary. | |
435 If the named item exists already, it is changed. | |
436 MENU-PATH identifies the menu under which the new menu item should be inserted. | |
437 It is a list of strings; for example, (\"File\") names the top-level \"File\" | |
438 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". | |
439 ITEM-NAME is the string naming the menu item to be added. | |
440 FUNCTION is the command to invoke when this menu item is selected. | |
441 If it is a symbol, then it is invoked with `call-interactively', in the same | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
442 way that functions bound to keys are invoked. If it is a list, then the |
2231 | 443 list is simply evaluated. |
444 ENABLED-P controls whether the item is selectable or not. | |
445 BEFORE, if provided, is the name of a menu item before which this item should | |
446 be added, if this item is not on the menu already. If the item is already | |
447 present, it will not be moved." | |
448 (or menu-path (error "must specify a menu path")) | |
449 (or item-name (error "must specify an item name")) | |
450 (add-menu-item-1 t menu-path item-name function enabled-p before)) | |
451 | |
452 | |
453 (defun delete-menu-item (path) | |
454 "Remove the named menu item from the menu hierarchy. | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
455 PATH is a list of strings which identify the position of the menu item in |
2231 | 456 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
457 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
2231 | 458 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." |
459 (let* ((menubar current-menubar) | |
460 (pair (find-menu-item menubar path)) | |
461 (item (car pair)) | |
462 (menu (or (cdr pair) menubar))) | |
463 (if (not item) | |
464 nil | |
465 ;; the menubar is the only special case, because other menus begin | |
466 ;; with their name. | |
467 (if (eq menu current-menubar) | |
468 (setq current-menubar (delq item menu)) | |
469 (delq item menu)) | |
470 (set-menubar-dirty-flag) | |
471 item))) | |
472 | |
473 | |
474 (defun relabel-menu-item (path new-name) | |
475 "Change the string of the specified menu item. | |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
476 PATH is a list of strings which identify the position of the menu item in |
2231 | 477 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
9523
f9cba4810d7b
(make-lucid-menu-keymap): Allow Lucid-style keyword-based menu items.
Karl Heuer <kwzh@gnu.org>
parents:
8868
diff
changeset
|
478 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
2231 | 479 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\". |
480 NEW-NAME is the string that the menu item will be printed as from now on." | |
481 (or (stringp new-name) | |
482 (setq new-name (signal 'wrong-type-argument (list 'stringp new-name)))) | |
483 (let* ((menubar current-menubar) | |
484 (pair (find-menu-item menubar path)) | |
485 (item (car pair)) | |
486 (menu (cdr pair))) | |
487 (or item | |
488 (signal 'error (list (if menu "No such menu item" "No such menu") | |
489 path))) | |
490 (if (and (consp item) | |
491 (stringp (car item))) | |
492 (setcar item new-name) | |
493 (aset item 0 new-name)) | |
494 (set-menubar-dirty-flag) | |
495 item)) | |
496 | |
497 (defun add-menu (menu-path menu-name menu-items &optional before) | |
498 "Add a menu to the menubar or one of its submenus. | |
499 If the named menu exists already, it is changed. | |
500 MENU-PATH identifies the menu under which the new menu should be inserted. | |
501 It is a list of strings; for example, (\"File\") names the top-level \"File\" | |
502 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". | |
503 If MENU-PATH is nil, then the menu will be added to the menubar itself. | |
504 MENU-NAME is the string naming the menu to be added. | |
505 MENU-ITEMS is a list of menu item descriptions. | |
506 Each menu item should be a vector of three elements: | |
507 - a string, the name of the menu item; | |
508 - a symbol naming a command, or a form to evaluate; | |
7742
2b0419458768
(make-lucid-menu-keymap): Allow any form as the enabler.
Richard M. Stallman <rms@gnu.org>
parents:
7699
diff
changeset
|
509 - and a form whose value determines whether this item is selectable. |
2231 | 510 BEFORE, if provided, is the name of a menu before which this menu should |
511 be added, if this menu is not on its parent already. If the menu is already | |
512 present, it will not be moved." | |
513 (or menu-name (error "must specify a menu name")) | |
514 (or menu-items (error "must specify some menu items")) | |
515 (add-menu-item-1 nil menu-path menu-name menu-items t before)) | |
516 | |
517 | |
518 | |
519 (defvar put-buffer-names-in-file-menu t) | |
520 | |
521 | |
5982
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
522 ;; Don't unconditionally enable menu bars; leave that up to the user. |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
523 ;;(let ((frames (frame-list))) |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
524 ;; (while frames |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
525 ;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1))) |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
526 ;; (setq frames (cdr frames)))) |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
527 ;;(or (assq 'menu-bar-lines default-frame-alist) |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
528 ;; (setq default-frame-alist |
a9f7e018245b
Delete the code to enable menu bars.
Richard M. Stallman <rms@gnu.org>
parents:
5477
diff
changeset
|
529 ;; (cons '(menu-bar-lines . 1) default-frame-alist))) |
2231 | 530 |
531 (set-menubar default-menubar) | |
532 | |
6435
050f711140e0
Provide lmenu, not menubar.
Richard M. Stallman <rms@gnu.org>
parents:
5982
diff
changeset
|
533 (provide 'lmenu) |
2231 | 534 |
2232
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2231
diff
changeset
|
535 ;;; lmenu.el ends here |