Mercurial > emacs
comparison lisp/emacs-lisp/easymenu.el @ 21745:38a6d62cddb9
Use new menu item format. Don't simulate button prefix.
(easy-menu-create-menu): Understand also keywords :active,
:label and :visible. Don't worry about button prefix.
(easy-menu-button-prefix): Modified value.
(easy-menu-do-add-item): Extensive changes to use new menu item format.
(easy-menu-define-key, easy-menu-always-true): New functions.
(easy-menu-make-symbol): Don't use indirection for symbols.
Property `menu-alias' not set.
(easy-menu-filter, easy-menu-update-button): Deleted.
(easy-menu-add-item): Don't worry about button prefix.
(easy-menu-remove-item): Don't worry about button prefix.
Use `easy-menu-define-key'.
(easy-menu-is-button, easy-menu-have-button): Deleted.
(easy-menu-real-binding, easy-menu-change-prefix): Deleted.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 24 Apr 1998 01:54:09 +0000 |
parents | 95c0fe8d25a7 |
children | c62197b13ece |
comparison
equal
deleted
inserted
replaced
21744:64c815fe1bdc | 21745:38a6d62cddb9 |
---|---|
131 (defun easy-menu-create-menu (menu-name menu-items) | 131 (defun easy-menu-create-menu (menu-name menu-items) |
132 "Create a menu called MENU-NAME with items described in MENU-ITEMS. | 132 "Create a menu called MENU-NAME with items described in MENU-ITEMS. |
133 MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items | 133 MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items |
134 possibly preceded by keyword pairs as described in `easy-menu-define'." | 134 possibly preceded by keyword pairs as described in `easy-menu-define'." |
135 (let ((menu (make-sparse-keymap menu-name)) | 135 (let ((menu (make-sparse-keymap menu-name)) |
136 keyword filter have-buttons) | 136 prop keyword arg label enable filter visible) |
137 ;; Look for keywords. | 137 ;; Look for keywords. |
138 (while (and menu-items (cdr menu-items) | 138 (while (and menu-items (cdr menu-items) |
139 (symbolp (setq keyword (car menu-items))) | 139 (symbolp (setq keyword (car menu-items))) |
140 (= ?: (aref (symbol-name keyword) 0))) | 140 (= ?: (aref (symbol-name keyword) 0))) |
141 (if (eq keyword ':filter) (setq filter (cadr menu-items))) | 141 (setq arg (cadr menu-items)) |
142 (setq menu-items (cddr menu-items))) | 142 (setq menu-items (cddr menu-items)) |
143 (while menu-items | 143 (cond |
144 (setq have-buttons | 144 ((eq keyword ':filter) (setq filter arg)) |
145 (easy-menu-do-add-item menu (car menu-items) have-buttons)) | 145 ((eq keyword ':active) (setq enable (or arg ''nil))) |
146 (setq menu-items (cdr menu-items))) | 146 ((eq keyword ':label) (setq label arg)) |
147 (when filter | 147 ((eq keyword ':visible) (setq visible (or arg ''nil))))) |
148 (setq menu (easy-menu-make-symbol menu)) | 148 (if (equal visible ''nil) nil ; Invisible menu entry, return nil. |
149 (put menu 'menu-enable | 149 (if (and visible (not (easy-menu-always-true visible))) |
150 `(easy-menu-filter (quote ,menu) (quote ,filter)))) | 150 (setq prop (cons :visible (cons visible prop)))) |
151 menu)) | 151 (if (and enable (not (easy-menu-always-true enable))) |
152 (setq prop (cons :enable (cons enable prop)))) | |
153 (if filter (setq prop (cons :filter (cons filter prop)))) | |
154 (if label (setq prop (cons nil (cons label prop)))) | |
155 (while menu-items | |
156 (easy-menu-do-add-item menu (car menu-items)) | |
157 (setq menu-items (cdr menu-items))) | |
158 (when prop | |
159 (setq menu (easy-menu-make-symbol menu)) | |
160 (put menu 'menu-prop prop)) | |
161 menu))) | |
152 | 162 |
153 | 163 |
154 ;; Button prefixes. | 164 ;; Button prefixes. |
155 (defvar easy-menu-button-prefix | 165 (defvar easy-menu-button-prefix |
156 '((radio ?* . "( ) ") (toggle ?X . "[ ] "))) | 166 '((radio . :radio) (toggle . :toggle))) |
157 | 167 |
158 (defun easy-menu-do-add-item (menu item have-buttons &optional before top) | 168 (defun easy-menu-do-add-item (menu item &optional before) |
159 ;; Parse an item description and add the item to a keymap. This is | 169 ;; Parse an item description and add the item to a keymap. This is |
160 ;; the function that is used for item definition by the other easy-menu | 170 ;; the function that is used for item definition by the other easy-menu |
161 ;; functions. | 171 ;; functions. |
162 ;; MENU is a sparse keymap i.e. a list starting with the symbol `keymap'. | 172 ;; MENU is a sparse keymap i.e. a list starting with the symbol `keymap'. |
163 ;; ITEM defines an item as in `easy-menu-define'. | 173 ;; ITEM defines an item as in `easy-menu-define'. |
164 ;; HAVE-BUTTONS is a string or nil. If not nil, use as item prefix for | 174 ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil |
165 ;; items that are not toggle or radio buttons to compensate for the | 175 ;; put item before BEFORE in MENU, otherwise if item is already present in |
166 ;; button prefix. | 176 ;; MENU, just change it, otherwise put it last in MENU. |
167 ;; Optional argument BEFORE is nil or a symbol used as a key in MENU. If | 177 (let (name command label prop remove) |
168 ;; BEFORE is not nil put item before BEFORE in MENU, otherwise if item is | |
169 ;; already present in MENU, just change it, otherwise put it last in MENU. | |
170 ;; If optional TOP is true, this is an item in the menu bar itself so | |
171 ;; don't use prefix. In this case HAVE-BUTTONS will be nil. | |
172 (let (command name item-string is-button done inserted) | |
173 (cond | 178 (cond |
174 ((stringp item) | 179 ((stringp item) |
175 (setq item-string | 180 (setq label |
176 (if (string-match ; If an XEmacs separator | 181 (if (string-match ; If an XEmacs separator |
177 "^\\(-+\\|\ | 182 "^\\(-+\\|\ |
178 --:\\(\\(no\\|\\(sing\\|doub\\)le\\(Dashed\\)?\\)Line\\|\ | 183 --:\\(\\(no\\|\\(sing\\|doub\\)le\\(Dashed\\)?\\)Line\\|\ |
179 shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" | 184 shadow\\(Double\\)?Etched\\(In\\|Out\\)\\(Dash\\)?\\)\\)$" |
180 item) "" ; use a single line separator. | 185 item) "" ; use a single line separator. |
181 (concat have-buttons item)))) | 186 item))) |
182 ((consp item) | 187 ((consp item) |
183 (setq name (setq item-string (car item))) | 188 (setq label (setq name (car item))) |
184 (setq command (if (keymapp (setq item (cdr item))) item | 189 (setq command (cdr item)) |
185 (easy-menu-create-menu name item)))) | 190 (if (not (keymapp command)) |
191 (setq command (easy-menu-create-menu name command))) | |
192 (if (null command) | |
193 ;; Invisible menu item. Don't insert into keymap. | |
194 (setq remove t) | |
195 (when (and (symbolp command) (setq prop (get command 'menu-prop))) | |
196 (when (null (car prop)) | |
197 (setq label (cadr prop)) | |
198 (setq prop (cddr prop))) | |
199 (setq command (symbol-function command))))) | |
186 ((vectorp item) | 200 ((vectorp item) |
187 (setq name (setq item-string (aref item 0))) | 201 (let ((active (if (> (length item) 2) (or (aref item 2) ''nil) t)) |
188 (setq command (easy-menu-make-symbol (aref item 1) t)) | 202 (no-name (not (symbolp (setq command (aref item 1))))) |
189 (let ((active (if (> (length item) 2) (aref item 2) t)) | 203 cache cache-specified |
190 (active-specified (> (length item) 2)) | 204 (count 2)) |
191 (count 2) | 205 (setq label (setq name (aref item 0))) |
192 style selected) | 206 (if no-name (setq command (easy-menu-make-symbol command))) |
193 (if (and (symbolp active) (= ?: (aref (symbol-name active) 0))) | 207 (if (and (symbolp active) (= ?: (aref (symbol-name active) 0))) |
194 (let ((count 2) keyword arg suffix keys) | 208 (let ((count 2) |
195 (setq active-specified nil) | 209 keyword arg suffix visible style selected keys) |
210 (setq active nil) | |
196 (while (> (length item) count) | 211 (while (> (length item) count) |
197 (setq keyword (aref item count)) | 212 (setq keyword (aref item count)) |
198 (setq arg (aref item (1+ count))) | 213 (setq arg (aref item (1+ count))) |
199 (setq count (+ 2 count)) | 214 (setq count (+ 2 count)) |
200 (cond | 215 (cond |
201 ((eq keyword ':keys) (setq keys arg)) | 216 ((eq keyword :visible) (setq visible (or arg ''nil))) |
202 ((eq keyword ':active) (setq active arg active-specified t)) | 217 ((eq keyword :key-sequence) |
203 ((eq keyword ':suffix) (setq suffix (concat " " arg))) | 218 (setq cache arg cache-specified t)) |
204 ((eq keyword ':style) (setq style arg)) | 219 ((eq keyword :keys) (setq keys arg no-name nil)) |
205 ((eq keyword ':selected) (setq selected arg)))) | 220 ((eq keyword :label) (setq label arg)) |
206 (if keys (setq suffix (concat suffix " (" keys ")"))) | 221 ((eq keyword :active) (setq active (or arg ''nil))) |
207 (if suffix (setq item-string (concat item-string " " suffix))) | 222 ((eq keyword :suffix) (setq suffix arg)) |
208 (when (and selected | 223 ((eq keyword :style) (setq style arg)) |
209 (setq style (assq style easy-menu-button-prefix))) | 224 ((eq keyword :selected) (setq selected (or arg ''nil))))) |
210 ;; Simulate checkboxes and radio buttons. | 225 (if (stringp suffix) |
211 (setq item-string (concat (cddr style) item-string)) | 226 (setq label (if (stringp label) (concat label " " suffix) |
212 (put command 'menu-enable | 227 (list 'concat label (concat " " suffix))))) |
213 `(easy-menu-update-button ,item-string | 228 (if (and selected |
214 ,(cadr style) | 229 (setq style (assq style easy-menu-button-prefix))) |
215 ,selected | 230 (setq prop (cons :button |
216 ,(or active t))) | 231 (cons (cons (cdr style) (or selected ''nil)) |
217 (setq is-button t) | 232 prop)))) |
218 (setq active-specified nil) ; Already taken care of active. | 233 (when (stringp keys) |
219 (when (not (or have-buttons top)) | 234 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" |
220 (setq have-buttons " ") | 235 keys) |
221 ;; Add prefix to menu items defined so far. | 236 (let ((prefix |
222 (easy-menu-change-prefix menu t)))) | 237 (if (< (match-beginning 0) (match-beginning 1)) |
223 (and (null active) active-specified | 238 (substring keys 0 (match-beginning 1)))) |
224 (setq active ''nil))) | 239 (postfix |
225 (if active-specified (put command 'menu-enable active)))) | 240 (if (< (match-end 1) (match-end 0)) |
226 (t "Invalid menu item in easymenu")) | 241 (substring keys (match-end 1)))) |
227 (when name | 242 (cmd (intern (substring keys (match-beginning 2) |
228 (and (not is-button) have-buttons | 243 (match-end 2))))) |
229 (setq item-string (concat have-buttons item-string))) | 244 (setq keys |
230 (setq name (intern name))) | 245 (and (or prefix postfix (not (eq command cmd))) |
231 (setq item (cons item-string command)) | 246 (cons cmd |
232 (if before (setq before (intern before))) | 247 (and (or prefix postfix) |
233 ;; The following loop is simlar to `define-key-after'. It | 248 (cons prefix postfix)))))) |
234 ;; inserts (name . item) in keymap menu. | 249 (setq cache-specified nil)) |
235 ;; If name is not nil then delete any duplications. | 250 (if keys (setq prop (cons :keys (cons keys prop))))) |
236 ;; If before is not nil, insert before before. Otherwise | 251 (if (and visible (not (easy-menu-always-true visible))) |
237 ;; if name is not nil and it is found in menu, insert there, else | 252 (if (equal visible ''nil) |
238 ;; insert at end. | 253 ;; Invisible menu item. Don't insert into keymap. |
254 (setq remove t) | |
255 (setq prop (cons :visible (cons visible prop))))))) | |
256 (if (and active (not (easy-menu-always-true active))) | |
257 (setq prop (cons :enable (cons active prop)))) | |
258 (if (and (or no-name cache-specified) | |
259 (or (null cache) (stringp cache) (vectorp cache))) | |
260 (setq prop (cons :key-sequence (cons cache prop)))))) | |
261 (t (error "Invalid menu item in easymenu."))) | |
262 (easy-menu-define-key menu (if (stringp name) (intern name) name) | |
263 (and (not remove) | |
264 (cons 'menu-item | |
265 (cons label | |
266 (and name (cons command prop))))) | |
267 (if (stringp before) (intern before) before)))) | |
268 | |
269 (defun easy-menu-define-key (menu key item &optional before) | |
270 ;; Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. | |
271 ;; If KEY is not nil then delete any duplications. If ITEM is nil, then | |
272 ;; don't insert, only delete. | |
273 ;; Optional argument BEFORE is nil or a key in MENU. If BEFORE is not nil | |
274 ;; put binding before BEFORE in MENU, otherwise if binding is already | |
275 ;; present in MENU, just change it, otherwise put it last in MENU. | |
276 (let ((inserted (null item)) ; Fake already inserted. | |
277 done) | |
239 (while (not done) | 278 (while (not done) |
240 (cond | 279 (cond |
241 ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) | 280 ((or (setq done (or (null (cdr menu)) (keymapp (cdr menu)))) |
242 (and before (eq (car-safe (cadr menu)) before))) | 281 (and before (equal (car-safe (cadr menu)) before))) |
243 ;; If name is nil, stop here, otherwise keep going past the | 282 ;; If key is nil, stop here, otherwise keep going past the |
244 ;; inserted element so we can delete any duplications that come | 283 ;; inserted element so we can delete any duplications that come |
245 ;; later. | 284 ;; later. |
246 (if (null name) (setq done t)) | 285 (if (null key) (setq done t)) |
247 (unless inserted ; Don't insert more than once. | 286 (unless inserted ; Don't insert more than once. |
248 (setcdr menu (cons (cons name item) (cdr menu))) | 287 (setcdr menu (cons (cons key item) (cdr menu))) |
249 (setq inserted t) | 288 (setq inserted t) |
250 (setq menu (cdr menu)))) | 289 (setq menu (cdr menu)))) |
251 ((and name (eq (car-safe (cadr menu)) name)) | 290 ((and key (equal (car-safe (cadr menu)) key)) |
252 (if (and before ; Wanted elsewere and | 291 (if (and (or inserted ; Already inserted or |
253 (not (setq done ; not the last in this keymap. | 292 before) ; wanted elsewhere and |
254 (or (null (cddr menu)) (keymapp (cddr menu)))))) | 293 (or (not (setq done ; not the last in this keymap. |
255 (setcdr menu (cddr menu)) | 294 (or (null (cddr menu)) |
256 (setcdr (cadr menu) item) ; Change item. | 295 (keymapp (cddr menu))))) |
296 inserted)) | |
297 ;; The contorted logic above, guarantees `done' has been computed. | |
298 (setcdr menu (cddr menu)) ; Remove item. | |
299 (setcdr (cadr menu) item) ; Change item. | |
257 (setq inserted t)))) | 300 (setq inserted t)))) |
258 (setq menu (cdr menu))) | 301 (setq menu (cdr menu))))) |
259 have-buttons)) | 302 |
303 (defun easy-menu-always-true (x) | |
304 ;; Return true if X never evaluates to nil. | |
305 (if (consp x) (and (eq (car x) 'quote) (cadr x)) | |
306 (or (eq x t) (not (symbolp x))))) | |
260 | 307 |
261 (defvar easy-menu-item-count 0) | 308 (defvar easy-menu-item-count 0) |
262 | 309 |
263 (defun easy-menu-make-symbol (callback &optional call) | 310 (defun easy-menu-make-symbol (callback) |
264 ;; Return a unique symbol with CALLBACK as function value. | 311 ;; Return a unique symbol with CALLBACK as function value. |
265 ;; If CALL is false then this is a keymap, not a function. | |
266 ;; Else if CALLBACK is a symbol, avoid the indirection when looking for | |
267 ;; key-bindings in menu. | |
268 ;; Else make a lambda expression of CALLBACK. | |
269 (let ((command | 312 (let ((command |
270 (make-symbol (format "menu-function-%d" easy-menu-item-count)))) | 313 (make-symbol (format "menu-function-%d" easy-menu-item-count)))) |
271 (setq easy-menu-item-count (1+ easy-menu-item-count)) | 314 (setq easy-menu-item-count (1+ easy-menu-item-count)) |
272 (fset command | 315 (fset command |
273 (cond | 316 (if (keymapp callback) callback |
274 ((not call) callback) | 317 `(lambda () (interactive) ,callback))) |
275 ((symbolp callback) | |
276 ;; Try find key-bindings for callback instead of for command | |
277 (put command 'menu-alias t) ; when displaying menu. | |
278 callback) | |
279 (t `(lambda () (interactive) ,callback)))) | |
280 command)) | 318 command)) |
281 | |
282 (defun easy-menu-filter (name filter) | |
283 "Used as menu-enable property to filter menus. | |
284 A call to this function is used as the menu-enable property for a menu with | |
285 a filter function. | |
286 NAME is a symbol with a keymap as function value. Call the function FILTER | |
287 with this keymap as argument. FILTER must return a keymap which becomes the | |
288 new function value for NAME. Use `easy-menu-filter-return' to return the | |
289 correct value in a way portable to XEmacs. If the new keymap is `eq' the old, | |
290 then the menu is not updated." | |
291 (let* ((old (symbol-function name)) | |
292 (new (funcall filter old))) | |
293 (or (eq old new) ; No change | |
294 (and (fset name new) | |
295 ;; Make sure the menu gets updated by returning a | |
296 ;; different value than last time to cheat the cache. | |
297 (random))))) | |
298 | |
299 (defun easy-menu-update-button (item ch selected active) | |
300 "Used as menu-enable property to update buttons. | |
301 A call to this function is used as the menu-enable property for buttons. | |
302 ITEM is the item-string into which CH or ` ' is inserted depending on if | |
303 SELECTED is true or not. The menu entry in enabled iff ACTIVE is true." | |
304 (let ((new (if selected ch ? )) | |
305 (old (aref item 1))) | |
306 (if (eq new old) | |
307 ;; No change, just use the active value. | |
308 active | |
309 ;; It has changed. Update the entry. | |
310 (aset item 1 new) | |
311 ;; If the entry is active, make sure the menu gets updated by | |
312 ;; returning a different value than last time to cheat the cache. | |
313 (and active | |
314 (random))))) | |
315 | 319 |
316 (defun easy-menu-change (path name items &optional before) | 320 (defun easy-menu-change (path name items &optional before) |
317 "Change menu found at PATH as item NAME to contain ITEMS. | 321 "Change menu found at PATH as item NAME to contain ITEMS. |
318 PATH is a list of strings for locating the menu containing NAME in the | 322 PATH is a list of strings for locating the menu containing NAME in the |
319 menu bar. ITEMS is a list of menu items, as in `easy-menu-define'. | 323 menu bar. ITEMS is a list of menu items, as in `easy-menu-define'. |
346 added. If PATH is nil, MENU itself is used. Otherwise, the first | 350 added. If PATH is nil, MENU itself is used. Otherwise, the first |
347 element should be the name of a submenu directly under MENU. This | 351 element should be the name of a submenu directly under MENU. This |
348 submenu is then traversed recursively with the remaining elements of PATH. | 352 submenu is then traversed recursively with the remaining elements of PATH. |
349 ITEM is either defined as in `easy-menu-define' or a menu defined earlier | 353 ITEM is either defined as in `easy-menu-define' or a menu defined earlier |
350 by `easy-menu-define' or `easy-menu-create-menu'." | 354 by `easy-menu-define' or `easy-menu-create-menu'." |
351 (let ((top (not (or menu path)))) | 355 (setq menu (easy-menu-get-map menu path)) |
352 (setq menu (easy-menu-get-map menu path)) | 356 (if (or (keymapp item) |
353 (if (or (keymapp item) | 357 (and (symbolp item) (keymapp (symbol-value item)))) |
354 (and (symbolp item) (keymapp (symbol-value item)))) | 358 ;; Item is a keymap, find the prompt string and use as item name. |
355 ;; Item is a keymap, find the prompt string and use as item name. | 359 (let ((tail (easy-menu-get-map item nil)) name) |
356 (let ((tail (easy-menu-get-map item nil)) name) | 360 (if (not (keymapp item)) (setq item tail)) |
357 (if (not (keymapp item)) (setq item tail)) | 361 (while (and (null name) (consp (setq tail (cdr tail))) |
358 (while (and (null name) (consp (setq tail (cdr tail))) | 362 (not (keymapp tail))) |
359 (not (keymapp tail))) | 363 (if (stringp (car tail)) (setq name (car tail)) ; Got a name. |
360 (if (stringp (car tail)) (setq name (car tail)) ; Got a name. | 364 (setq tail (cdr tail)))) |
361 (setq tail (cdr tail)))) | 365 (setq item (cons name item)))) |
362 (setq item (cons name item)))) | 366 (easy-menu-do-add-item menu item before)) |
363 (easy-menu-do-add-item menu item | |
364 (and (not top) (easy-menu-have-button menu) | |
365 " ") | |
366 before top))) | |
367 | 367 |
368 (defun easy-menu-item-present-p (menu path name) | 368 (defun easy-menu-item-present-p (menu path name) |
369 "In submenu of MENU with path PATH, return true iff item NAME is present. | 369 "In submenu of MENU with path PATH, return true iff item NAME is present. |
370 MENU and PATH are defined as in `easy-menu-add-item'. | 370 MENU and PATH are defined as in `easy-menu-add-item'. |
371 NAME should be a string, the name of the element to be looked for." | 371 NAME should be a string, the name of the element to be looked for." |
373 | 373 |
374 (defun easy-menu-remove-item (menu path name) | 374 (defun easy-menu-remove-item (menu path name) |
375 "From submenu of MENU with path PATH remove item NAME. | 375 "From submenu of MENU with path PATH remove item NAME. |
376 MENU and PATH are defined as in `easy-menu-add-item'. | 376 MENU and PATH are defined as in `easy-menu-add-item'. |
377 NAME should be a string, the name of the element to be removed." | 377 NAME should be a string, the name of the element to be removed." |
378 (let ((item (vector (intern name))) | 378 (easy-menu-define-key (easy-menu-get-map menu path) (intern name) nil)) |
379 (top (not (or menu path))) | |
380 tmp) | |
381 (setq menu (easy-menu-get-map menu path)) | |
382 (when (setq tmp (lookup-key menu item)) | |
383 (define-key menu item nil) | |
384 (and (not top) | |
385 (easy-menu-is-button tmp) ; Removed item was a button and | |
386 (not (easy-menu-have-button menu)) ; no buttons left then | |
387 ;; remove prefix from items in menu | |
388 (easy-menu-change-prefix menu nil))))) | |
389 | 379 |
390 (defun easy-menu-get-map (menu path) | 380 (defun easy-menu-get-map (menu path) |
391 ;; Return a sparse keymap in which to add or remove an item. | 381 ;; Return a sparse keymap in which to add or remove an item. |
392 ;; MENU and PATH are as defined in `easy-menu-remove-item'. | 382 ;; MENU and PATH are as defined in `easy-menu-add-item'. |
393 (if (null menu) | 383 (if (null menu) |
394 (setq menu (key-binding (vconcat '(menu-bar) (mapcar 'intern path)))) | 384 (setq menu (key-binding (vconcat '(menu-bar) (mapcar 'intern path)))) |
395 (if (and (symbolp menu) (not (keymapp menu))) | 385 (if (and (symbolp menu) (not (keymapp menu))) |
396 (setq menu (symbol-value menu))) | 386 (setq menu (symbol-value menu))) |
397 (if path (setq menu (lookup-key menu (vconcat (mapcar 'intern path)))))) | 387 (if path (setq menu (lookup-key menu (vconcat (mapcar 'intern path)))))) |
398 (while (and (symbolp menu) (keymapp menu)) | 388 (while (and (symbolp menu) (keymapp menu)) |
399 (setq menu (symbol-function menu))) | 389 (setq menu (symbol-function menu))) |
400 (or (keymapp menu) (error "Malformed menu in easy-menu: (%s)" menu)) | 390 (or (keymapp menu) (error "Malformed menu in easy-menu: (%s)" menu)) |
401 menu) | 391 menu) |
402 | 392 |
403 (defun easy-menu-is-button (val) | |
404 ;; VAL is a real menu binding. Return true iff it is a toggle or | |
405 ;; radio button. | |
406 (and (symbolp val) | |
407 (consp (setq val (get val 'menu-enable))) | |
408 (eq (car val) 'easy-menu-update-button))) | |
409 | |
410 (defun easy-menu-have-button (map) | |
411 ;; MAP is a sparse keymap. Return true iff there is any toggle or radio | |
412 ;; button in MAP. | |
413 (let ((have nil) tmp) | |
414 (while (and (consp map) (not have)) | |
415 (and (consp (setq tmp (car map))) | |
416 (consp (setq tmp (cdr tmp))) | |
417 (stringp (car tmp)) | |
418 (setq have (easy-menu-is-button (easy-menu-real-binding tmp)))) | |
419 (setq map (cdr map))) | |
420 have)) | |
421 | |
422 (defun easy-menu-real-binding (val) | |
423 ;; Val is a menu keymap binding. Skip item string. | |
424 ;; Also skip a possible help string and/or key-binding cache. | |
425 (if (and (consp (setq val (cdr val))) (stringp (car val))) | |
426 (setq val (cdr val))) ; Skip help string. | |
427 (if (and (consp val) (consp (car val)) | |
428 (or (null (caar val)) (vectorp (caar val)))) | |
429 (setq val (cdr val))) ; Skip key-binding cache. | |
430 val) | |
431 | |
432 (defun easy-menu-change-prefix (map add) | |
433 ;; MAP is a sparse keymap. | |
434 ;; If ADD is true add a button compensating prefix to each menu item in MAP. | |
435 ;; Else remove prefix instead. | |
436 (let (tmp val) | |
437 (while (consp map) | |
438 (when (and (consp (setq tmp (car map))) | |
439 (consp (setq tmp (cdr tmp))) | |
440 (stringp (car tmp))) | |
441 (cond | |
442 (add (setcar tmp (concat " " (car tmp)))) | |
443 ((string-match "$ " (car tmp)) | |
444 (setcar tmp (substring (car tmp) (match-end 0)))))) | |
445 (setq map (cdr map))))) | |
446 | |
447 (provide 'easymenu) | 393 (provide 'easymenu) |
448 | 394 |
449 ;;; easymenu.el ends here | 395 ;;; easymenu.el ends here |