Mercurial > emacs
comparison lisp/emacs-lisp/lmenu.el @ 31655:8c99980d4906
(popup-menu, popup-menu-internal, popup-menu-popup): Remove.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sat, 16 Sep 2000 23:35:51 +0000 |
parents | 8941ce81cd7c |
children | 79c77eec747f |
comparison
equal
deleted
inserted
replaced
31654:3d1b298f0f22 | 31655:8c99980d4906 |
---|---|
1 ;;; lmenu.el --- emulate Lucid's menubar support | 1 ;;; lmenu.el --- emulate Lucid's menubar support |
2 | 2 |
3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Keywords: emulations | 5 ;; Keywords: emulations obsolete |
6 | 6 |
7 ;; This file is part of GNU Emacs. | 7 ;; This file is part of GNU Emacs. |
8 | 8 |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | 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 | 10 ;; it under the terms of the GNU General Public License as published by |
45 (or (assq 'current-menubar minor-mode-map-alist) | 45 (or (assq 'current-menubar minor-mode-map-alist) |
46 (setq minor-mode-map-alist | 46 (setq minor-mode-map-alist |
47 (cons (cons 'current-menubar lucid-menubar-map) | 47 (cons (cons 'current-menubar lucid-menubar-map) |
48 minor-mode-map-alist))) | 48 minor-mode-map-alist))) |
49 | 49 |
50 ;; XEmacs compatibility | |
50 (defun set-menubar-dirty-flag () | 51 (defun set-menubar-dirty-flag () |
51 (force-mode-line-update) | 52 (force-mode-line-update) |
52 (setq lucid-menu-bar-dirty-flag t)) | 53 (setq lucid-menu-bar-dirty-flag t)) |
53 | 54 |
54 (defvar add-menu-item-count 0) | 55 (defvar add-menu-item-count 0) |
122 (if name | 123 (if name |
123 (define-key menu (vector (intern name)) (cons name command))))) | 124 (define-key menu (vector (intern name)) (cons name command))))) |
124 (setq menu-items (cdr menu-items))) | 125 (setq menu-items (cdr menu-items))) |
125 menu)) | 126 menu)) |
126 | 127 |
127 ;; The value of the cache-symbol for a menu | 128 ;; XEmacs compatibility function |
128 ;; is | |
129 ;; unbound -- nothing computed | |
130 ;; (ORIG . TRANSL) | |
131 ;; ORIG is the original menu spec list | |
132 ;; and TRANSL is its translation. | |
133 | |
134 (defmacro popup-menu (arg) | |
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 | |
143 A menu item is a vector containing: | |
144 | |
145 - the name of the menu item (a string); | |
146 - the `callback' of that item; | |
147 - a list of keywords with associated values: | |
148 - :active active-p a form specifying whether this item is selectable; | |
149 - :suffix suffix a string to be appended to the name as an `argument' | |
150 to the command, like `Kill Buffer NAME'; | |
151 - :keys command-keys a string, suitable for `substitute-command-keys', | |
152 to specify the keyboard equivalent of a command | |
153 when the callback is a form (this is not necessary | |
154 when the callback is a symbol, as the keyboard | |
155 equivalent is computed automatically in that case); | |
156 - :style style a symbol: nil for a normal menu item, `toggle' for | |
157 a toggle button (a single option that can be turned | |
158 on or off), or `radio' for a radio button (one of a | |
159 group of mutually exclusive options); | |
160 - :selected form for `toggle' or `radio' style, a form that specifies | |
161 whether the button will be in the selected state. | |
162 | |
163 Alternately, the vector may contain exactly 3 or 4 elements, with the third | |
164 element specifying `active-p' and the fourth specifying `suffix'. | |
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> | |
188 suffix := <string> | |
189 command-keys := <string> | |
190 object-style := 'nil' | 'toggle' | 'radio' | |
191 keyword := ':active' active-p | |
192 | ':suffix' suffix | |
193 | ':keys' command-keys | |
194 | ':style' object-style | |
195 | ':selected' form | |
196 menu-item := '[' name callback active-p [ suffix ] ']' | |
197 | '[' name callback [ keyword ]+ ']' | |
198 menu := '(' name [ menu-item | menu | text ]+ ')'" | |
199 (if (not (symbolp arg)) | |
200 `(popup-menu-internal ,arg nil) | |
201 `(popup-menu-internal ,arg | |
202 ',(intern (concat "popup-menu-" (symbol-name arg)))))) | |
203 | |
204 (defun popup-menu-internal (menu cache-symbol) | |
205 (if (null cache-symbol) | |
206 ;; If no cache symbol, translate the menu afresh each time. | |
207 (popup-menu-popup (make-lucid-menu-keymap (car menu) (cdr menu))) | |
208 ;; We have a cache symbol. See if the cache is valid | |
209 ;; for the same menu we have now. | |
210 (or (and (boundp cache-symbol) | |
211 (consp (symbol-value cache-symbol)) | |
212 (equal (car (symbol-value cache-symbol)) | |
213 menu)) | |
214 ;; If not, update it. | |
215 (set cache-symbol | |
216 (cons menu (make-lucid-menu-keymap (car menu) (cdr menu))))) | |
217 ;; Use the menu in the cache. | |
218 (popup-menu-popup (cdr (symbol-value cache-symbol))))) | |
219 | |
220 ;; Pop up MENU-KEYMAP which was made by make-lucid-menu-keymap. | |
221 (defun popup-menu-popup (menu-keymap) | |
222 (let ((pos (mouse-pixel-position)) | |
223 answer cmd) | |
224 (while (and menu-keymap | |
225 (setq answer (x-popup-menu (list (list (nth 1 pos) | |
226 (nthcdr 2 pos)) | |
227 (car pos)) | |
228 menu-keymap))) | |
229 (setq cmd (lookup-key menu-keymap (apply 'vector answer))) | |
230 (setq menu-keymap nil) | |
231 (and cmd | |
232 (if (keymapp cmd) | |
233 (setq menu-keymap cmd) | |
234 (call-interactively cmd)))))) | |
235 | |
236 (defun popup-dialog-box (data) | 129 (defun popup-dialog-box (data) |
237 "Pop up a dialog box. | 130 "Pop up a dialog box. |
238 A dialog box description is a list. | 131 A dialog box description is a list. |
239 | 132 |
240 - The first element of the list is a string to display in the dialog box. | 133 - The first element of the list is a string to display in the dialog box. |
285 ;; This is empty because the usual elements of the menu bar | 178 ;; This is empty because the usual elements of the menu bar |
286 ;; are provided by menu-bar.el instead. | 179 ;; are provided by menu-bar.el instead. |
287 ;; It would not make sense to duplicate them here. | 180 ;; It would not make sense to duplicate them here. |
288 (defconst default-menubar nil) | 181 (defconst default-menubar nil) |
289 | 182 |
183 ;; XEmacs compatibility | |
290 (defun set-menubar (menubar) | 184 (defun set-menubar (menubar) |
291 "Set the default menubar to be menubar." | 185 "Set the default menubar to be menubar." |
292 (setq-default current-menubar (copy-sequence menubar)) | 186 (setq-default current-menubar (copy-sequence menubar)) |
293 (set-menubar-dirty-flag)) | 187 (set-menubar-dirty-flag)) |
294 | 188 |
189 ;; XEmacs compatibility | |
295 (defun set-buffer-menubar (menubar) | 190 (defun set-buffer-menubar (menubar) |
296 "Set the buffer-local menubar to be menubar." | 191 "Set the buffer-local menubar to be menubar." |
297 (make-local-variable 'current-menubar) | 192 (make-local-variable 'current-menubar) |
298 (setq current-menubar (copy-sequence menubar)) | 193 (setq current-menubar (copy-sequence menubar)) |
299 (set-menubar-dirty-flag)) | 194 (set-menubar-dirty-flag)) |
300 | 195 |
301 | 196 |
302 ;;; menu manipulation functions | 197 ;;; menu manipulation functions |
303 | 198 |
199 ;; XEmacs compatibility | |
304 (defun find-menu-item (menubar item-path-list &optional parent) | 200 (defun find-menu-item (menubar item-path-list &optional parent) |
305 "Searches MENUBAR for item given by ITEM-PATH-LIST. | 201 "Searches MENUBAR for item given by ITEM-PATH-LIST. |
306 Returns (ITEM . PARENT), where PARENT is the immediate parent of | 202 Returns (ITEM . PARENT), where PARENT is the immediate parent of |
307 the item found. | 203 the item found. |
308 Signals an error if the item is not found." | 204 Signals an error if the item is not found." |
328 (signal 'error (list "not a submenu" result)) | 224 (signal 'error (list "not a submenu" result)) |
329 (signal 'error (list "no such submenu" (car item-path-list))))) | 225 (signal 'error (list "no such submenu" (car item-path-list))))) |
330 (cons result parent))))) | 226 (cons result parent))))) |
331 | 227 |
332 | 228 |
229 ;; XEmacs compatibility | |
333 (defun disable-menu-item (path) | 230 (defun disable-menu-item (path) |
334 "Make the named menu item be unselectable. | 231 "Make the named menu item be unselectable. |
335 PATH is a list of strings which identify the position of the menu item in | 232 PATH is a list of strings which identify the position of the menu item in |
336 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | 233 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
337 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | 234 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
347 (aset item 2 nil) | 244 (aset item 2 nil) |
348 (set-menubar-dirty-flag) | 245 (set-menubar-dirty-flag) |
349 item)) | 246 item)) |
350 | 247 |
351 | 248 |
249 ;; XEmacs compatibility | |
352 (defun enable-menu-item (path) | 250 (defun enable-menu-item (path) |
353 "Make the named menu item be selectable. | 251 "Make the named menu item be selectable. |
354 PATH is a list of strings which identify the position of the menu item in | 252 PATH is a list of strings which identify the position of the menu item in |
355 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | 253 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
356 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | 254 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
428 (setcar item item-name) | 326 (setcar item item-name) |
429 (setcdr item item-data)) | 327 (setcdr item item-data)) |
430 (set-menubar-dirty-flag) | 328 (set-menubar-dirty-flag) |
431 item)) | 329 item)) |
432 | 330 |
331 ;; XEmacs compatibility | |
433 (defun add-menu-item (menu-path item-name function enabled-p &optional before) | 332 (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. | 333 "Add a menu item to some menu, creating the menu first if necessary. |
435 If the named item exists already, it is changed. | 334 If the named item exists already, it is changed. |
436 MENU-PATH identifies the menu under which the new menu item should be inserted. | 335 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\" | 336 It is a list of strings; for example, (\"File\") names the top-level \"File\" |
448 (or menu-path (error "must specify a menu path")) | 347 (or menu-path (error "must specify a menu path")) |
449 (or item-name (error "must specify an item name")) | 348 (or item-name (error "must specify an item name")) |
450 (add-menu-item-1 t menu-path item-name function enabled-p before)) | 349 (add-menu-item-1 t menu-path item-name function enabled-p before)) |
451 | 350 |
452 | 351 |
352 ;; XEmacs compatibility | |
453 (defun delete-menu-item (path) | 353 (defun delete-menu-item (path) |
454 "Remove the named menu item from the menu hierarchy. | 354 "Remove the named menu item from the menu hierarchy. |
455 PATH is a list of strings which identify the position of the menu item in | 355 PATH is a list of strings which identify the position of the menu item in |
456 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | 356 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
457 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | 357 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
469 (delq item menu)) | 369 (delq item menu)) |
470 (set-menubar-dirty-flag) | 370 (set-menubar-dirty-flag) |
471 item))) | 371 item))) |
472 | 372 |
473 | 373 |
374 ;; XEmacs compatibility | |
474 (defun relabel-menu-item (path new-name) | 375 (defun relabel-menu-item (path new-name) |
475 "Change the string of the specified menu item. | 376 "Change the string of the specified menu item. |
476 PATH is a list of strings which identify the position of the menu item in | 377 PATH is a list of strings which identify the position of the menu item in |
477 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" | 378 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" |
478 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the | 379 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the |
492 (setcar item new-name) | 393 (setcar item new-name) |
493 (aset item 0 new-name)) | 394 (aset item 0 new-name)) |
494 (set-menubar-dirty-flag) | 395 (set-menubar-dirty-flag) |
495 item)) | 396 item)) |
496 | 397 |
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; | |
509 - and a form whose value determines whether this item is selectable. | |
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 | 398 |
518 | 399 |
519 (defvar put-buffer-names-in-file-menu t) | 400 (defvar put-buffer-names-in-file-menu t) |
520 | 401 |
521 | 402 |