annotate lisp/emacs-lisp/lmenu.el @ 20303:13efdf0fe96e

(printchar): Declare `work' as unsigned char. (internal_with_output_to_temp_buffer): Protoype parameter FUNCTION. (Ferror_message_string): Remove extra argument of print_error_message. (write_string): Define as returning nothing. (write_string_1): Likewise. (print_error_message): Likewise.
author Andreas Schwab <schwab@suse.de>
date Fri, 21 Nov 1997 14:05:58 +0000
parents e414b2e486a3
children 8941ce81cd7c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11765
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12 ;; any later version.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17 ;; GNU General Public License for more details.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11765
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11765
diff changeset
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 11765
diff changeset
22 ;; Boston, MA 02111-1307, USA.
2231
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
27 ;; First, emulate the Lucid menubar support in GNU Emacs 19.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
28
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29 ;; Arrange to use current-menubar to set up part of the menu bar.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33 (setq recompute-lucid-menubar 'recompute-lucid-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 (defun recompute-lucid-menubar ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 (define-key lucid-menubar-map [menu-bar]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36 (condition-case nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37 (make-lucid-menu-keymap "menu-bar" current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38 (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39 (sit-for 1)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40 (setq lucid-failing-menubar current-menubar
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 current-menubar nil))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 (setq lucid-menu-bar-dirty-flag nil))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
43
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
44 (defvar lucid-menubar-map (make-sparse-keymap))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
45 (or (assq 'current-menubar minor-mode-map-alist)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
46 (setq minor-mode-map-alist
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
47 (cons (cons 'current-menubar lucid-menubar-map)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48 minor-mode-map-alist)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50 (defun set-menubar-dirty-flag ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51 (force-mode-line-update)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
52 (setq lucid-menu-bar-dirty-flag t))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
53
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54 (defvar add-menu-item-count 0)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59 ;; Return a menu keymap corresponding to a Lucid-style menu list
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60 ;; MENU-ITEMS, and with name MENU-NAME.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 (defun make-lucid-menu-keymap (menu-name menu-items)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 (let ((menu (make-sparse-keymap menu-name)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 ;; Process items in reverse order,
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64 ;; since the define-key loop reverses them again.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65 (setq menu-items (reverse menu-items))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
69 (cond ((stringp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72 ((consp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 (setq command (make-lucid-menu-keymap (car item) (cdr item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
74 (setq name (car item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
75 ((vectorp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 (if (symbolp callback)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124 (setq menu-items (cdr menu-items)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
125 menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
135 "Pop up the given menu.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
136 A menu is a list of menu items, strings, and submenus.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
137
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
138 The first element of a menu must be a string, which is the name of the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
139 menu. This is the string that will be displayed in the parent menu, if
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
140 any. For toplevel menus, it is ignored. This string is not displayed
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
141 in the menu itself.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
144
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
145 - the name of the menu item (a string);
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
165
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
166 If the `callback' of a menu item is a symbol, then it must name a command.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
167 It will be invoked with `call-interactively'. If it is a list, then it is
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
168 evaluated with `eval'.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
169
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
170 If an element of a menu is a string, then that string will be presented in
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
171 the menu as unselectable text.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
172
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
173 If an element of a menu is a string consisting solely of hyphens, then that
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
174 item will be presented as a solid horizontal line.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
175
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
176 If an element of a menu is a list, it is treated as a submenu. The name of
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
177 that submenu (the first element in the list) will be used as the name of the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
178 item representing this menu on the parent.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
179
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
180 The syntax, more precisely:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
181
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
182 form := <something to pass to `eval'>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
183 command := <a symbol or string, to pass to `call-interactively'>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
184 callback := command | form
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
185 active-p := <t or nil, whether this thing is selectable>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
186 text := <string, non selectable>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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)))
5439
77798fccc85c (popup-menu): Add loop to handle submenus.
Richard M. Stallman <rms@gnu.org>
parents: 2751
diff changeset
230 (setq menu nil)
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
289
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
290 (defun set-menubar (menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
291 "Set the default menubar to be menubar."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
292 (setq-default current-menubar (copy-sequence menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
293 (set-menubar-dirty-flag))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
294
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
295 (defun set-buffer-menubar (menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
296 "Set the buffer-local menubar to be menubar."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
297 (make-local-variable 'current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
298 (setq current-menubar (copy-sequence menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
299 (set-menubar-dirty-flag))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
300
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
301
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
302 ;;; menu manipulation functions
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
303
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
304 (defun find-menu-item (menubar item-path-list &optional parent)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
305 "Searches MENUBAR for item given by ITEM-PATH-LIST.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
306 Returns (ITEM . PARENT), where PARENT is the immediate parent of
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
307 the item found.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
308 Signals an error if the item is not found."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
309 (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
310 (if (not (consp menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
311 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
312 (let ((rest menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
313 result)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
314 (while rest
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
315 (if (and (car rest)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
316 (equal (car item-path-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
317 (downcase (if (vectorp (car rest))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
318 (aref (car rest) 0)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
319 (if (stringp (car rest))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
320 (car rest)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
321 (car (car rest)))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
322 (setq result (car rest) rest nil)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
323 (setq rest (cdr rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
324 (if (cdr item-path-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
325 (if (consp result)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
326 (find-menu-item (cdr result) (cdr item-path-list) result)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
327 (if result
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
328 (signal 'error (list "not a submenu" result))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
329 (signal 'error (list "no such submenu" (car item-path-list)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
330 (cons result parent)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
331
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
332
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
333 (defun disable-menu-item (path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
338 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
339 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
340 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
341 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
342 (menu (cdr pair)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
343 (or item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
344 (signal 'error (list (if menu "No such menu item" "No such menu")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
345 path)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
346 (if (consp item) (error "can't disable menus, only menu items"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
347 (aset item 2 nil)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
348 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
349 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
350
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
351
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
352 (defun enable-menu-item (path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
357 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
358 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
359 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
360 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
361 (menu (cdr pair)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
362 (or item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
363 (signal 'error (list (if menu "No such menu item" "No such menu")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
364 path)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
365 (if (consp item) (error "%S is a menu, not a menu item" path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
366 (aset item 2 t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
367 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
368 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
369
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
370
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
371 (defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
372 (if before (setq before (downcase before)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
373 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
374 (menu (condition-case ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
375 (car (find-menu-item menubar menu-path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
376 (error nil)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
377 (item (if (listp menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
378 (car (find-menu-item (cdr menu) (list item-name)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
379 (signal 'error (list "not a submenu" menu-path)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
380 (or menu
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
381 (let ((rest menu-path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
382 (so-far menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
383 (while rest
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
384 ;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
385 (setq menu
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
386 (if (eq so-far menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
387 (car (find-menu-item so-far (list (car rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
388 (car (find-menu-item (cdr so-far) (list (car rest))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
389 (or menu
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
393 (while (and (cdr rest2) (car (cdr rest2)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
394 (setq rest2 (cdr rest2)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
395 (setcdr rest2
7699
87513c7850f9 Whitespace cleanup.
Richard M. Stallman <rms@gnu.org>
parents: 7656
diff changeset
396 (nconc (list (setq menu (list (car rest))))
87513c7850f9 Whitespace cleanup.
Richard M. Stallman <rms@gnu.org>
parents: 7656
diff changeset
397 (cdr rest2)))))
2231
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
398 (setq so-far menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
399 (setq rest (cdr rest)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
400 (or menu (setq menu menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
401 (if item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
402 nil ; it's already there
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
403 (if item-p
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
404 (setq item (vector item-name item-data enabled-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
405 (setq item (cons item-name item-data)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
406 ;; if BEFORE is specified, try to add it there.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
407 (if before
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
408 (setq before (car (find-menu-item menu (list before)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
409 (let ((rest menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
410 (added-before nil))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
411 (while rest
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
412 (if (eq before (car (cdr rest)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
413 (progn
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
414 (setcdr rest (cons item (cdr rest)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
415 (setq rest nil added-before t))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
416 (setq rest (cdr rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
417 (if (not added-before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
418 ;; adding before the first item on the menubar itself is harder
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
419 (if (and (eq menu menubar) (eq before (car menu)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
420 (setq menu (cons item menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
421 current-menubar menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
422 ;; otherwise, add the item to the end.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
423 (nconc menu (list item))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
424 (if item-p
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
425 (progn
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
426 (aset item 1 item-data)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
427 (aset item 2 (not (null enabled-p))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
428 (setcar item item-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
429 (setcdr item item-data))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
430 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
431 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
432
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
433 (defun add-menu-item (menu-path item-name function enabled-p &optional before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
434 "Add a menu item to some menu, creating the menu first if necessary.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
435 If the named item exists already, it is changed.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
436 MENU-PATH identifies the menu under which the new menu item should be inserted.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
437 It is a list of strings; for example, (\"File\") names the top-level \"File\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
438 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
439 ITEM-NAME is the string naming the menu item to be added.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
440 FUNCTION is the command to invoke when this menu item is selected.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
443 list is simply evaluated.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
444 ENABLED-P controls whether the item is selectable or not.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
445 BEFORE, if provided, is the name of a menu item before which this item should
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
446 be added, if this item is not on the menu already. If the item is already
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
447 present, it will not be moved."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
448 (or menu-path (error "must specify a menu path"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
449 (or item-name (error "must specify an item name"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
450 (add-menu-item-1 t menu-path item-name function enabled-p before))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
451
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
452
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
453 (defun delete-menu-item (path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
458 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
459 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
460 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
461 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
462 (menu (or (cdr pair) menubar)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
463 (if (not item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
464 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
465 ;; the menubar is the only special case, because other menus begin
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
466 ;; with their name.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
467 (if (eq menu current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
468 (setq current-menubar (delq item menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
469 (delq item menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
470 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
471 item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
472
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
473
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
474 (defun relabel-menu-item (path new-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
479 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
480 NEW-NAME is the string that the menu item will be printed as from now on."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
481 (or (stringp new-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
482 (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
483 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
484 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
485 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
486 (menu (cdr pair)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
487 (or item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
488 (signal 'error (list (if menu "No such menu item" "No such menu")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
489 path)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
490 (if (and (consp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
491 (stringp (car item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
492 (setcar item new-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
493 (aset item 0 new-name))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
494 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
495 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
496
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
497 (defun add-menu (menu-path menu-name menu-items &optional before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
498 "Add a menu to the menubar or one of its submenus.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
499 If the named menu exists already, it is changed.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
500 MENU-PATH identifies the menu under which the new menu should be inserted.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
501 It is a list of strings; for example, (\"File\") names the top-level \"File\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
502 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
503 If MENU-PATH is nil, then the menu will be added to the menubar itself.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
504 MENU-NAME is the string naming the menu to be added.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
505 MENU-ITEMS is a list of menu item descriptions.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
506 Each menu item should be a vector of three elements:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
507 - a string, the name of the menu item;
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
510 BEFORE, if provided, is the name of a menu before which this menu should
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
511 be added, if this menu is not on its parent already. If the menu is already
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
512 present, it will not be moved."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
513 (or menu-name (error "must specify a menu name"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
514 (or menu-items (error "must specify some menu items"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
515 (add-menu-item-1 nil menu-path menu-name menu-items t before))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
516
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
517
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
518
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
519 (defvar put-buffer-names-in-file-menu t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
520
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
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
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
530
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
531 (set-menubar default-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
532
6435
050f711140e0 Provide lmenu, not menubar.
Richard M. Stallman <rms@gnu.org>
parents: 5982
diff changeset
533 (provide 'lmenu)
2231
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
534
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2231
diff changeset
535 ;;; lmenu.el ends here