|
0
|
1 ;;; easymenu.el --- support the easymenu interface for defining a menu.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Keywords: emulations
|
|
|
6 ;; Author: rms
|
|
|
7
|
|
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
23
|
|
|
24 ;;; This is compatible with easymenu.el by Per Abrahamsen
|
|
|
25 ;;; but it is much simpler as it doesn't try to support other Emacs versions.
|
|
|
26 ;;; The code was mostly derived from lmenu.el.
|
|
|
27
|
|
|
28 ;;; Changed 17-May-1995, Kyle Jones
|
|
|
29 ;;; Made easy-menu-create-keymaps handle the
|
|
|
30 ;;; [ NAME CALLBACK ENABLE ]
|
|
|
31 ;;; case properly. Previously the enabler function was not
|
|
|
32 ;;; being put on the property list of the command.
|
|
|
33 ;;; Changed 20-May-1995, Kyle Jones
|
|
|
34 ;;; Made easy-menu-create-keymaps handle the
|
|
|
35 ;;; [ NAME CALLBACK ENABLE SUFFIX ]
|
|
|
36 ;;; case properly.
|
|
|
37 ;;; Changed 25-May-1995, Kyle Jones
|
|
|
38 ;;; Renamed easy-menu- functions to vm-easy-menu- to avoid
|
|
|
39 ;;; non-vm compatible versions.
|
|
|
40 ;;; Changed 2-July-1995, Kyle Jones
|
|
|
41 ;;; If callback is a symbol use it in the menu keymap instead
|
|
|
42 ;;; of the uninterned menu-function-XXX symbols. This allows
|
|
|
43 ;;; Emacs' menu code to set this-command properly when
|
|
|
44 ;;; launching a command from the menubar.
|
|
|
45 ;;;
|
|
|
46 ;;; Code:
|
|
|
47
|
|
|
48 (provide 'vm-easymenu)
|
|
|
49
|
|
|
50 ;;;###autoload
|
|
|
51 (defmacro vm-easy-menu-define (symbol maps doc menu)
|
|
|
52 "Define a menu bar submenu in maps MAPS, according to MENU.
|
|
|
53 The menu keymap is stored in symbol SYMBOL, both as its value
|
|
|
54 and as its function definition. DOC is used as the doc string for SYMBOL.
|
|
|
55
|
|
|
56 The first element of MENU must be a string. It is the menu bar item name.
|
|
|
57 The rest of the elements are menu items.
|
|
|
58
|
|
|
59 A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
|
|
|
60
|
|
|
61 NAME is a string--the menu item name.
|
|
|
62
|
|
|
63 CALLBACK is a command to run when the item is chosen,
|
|
|
64 or a list to evaluate when the item is chosen.
|
|
|
65
|
|
|
66 ENABLE is an expression; the item is enabled for selection
|
|
|
67 whenever this expression's value is non-nil.
|
|
|
68
|
|
|
69 Alternatively, a menu item may have the form:
|
|
|
70
|
|
|
71 [ NAME CALLBACK [ KEYWORD ARG ] ... ]
|
|
|
72
|
|
|
73 Where KEYWORD is one of the symbol defined below.
|
|
|
74
|
|
|
75 :keys KEYS
|
|
|
76
|
|
|
77 KEYS is a string; a complex keyboard equivalent to this menu item.
|
|
|
78 This is normally not needed because keyboard equivalents are usually
|
|
|
79 computed automatically.
|
|
|
80
|
|
|
81 :active ENABLE
|
|
|
82
|
|
|
83 ENABLE is an expression; the item is enabled for selection
|
|
|
84 whenever this expression's value is non-nil.
|
|
|
85
|
|
|
86 :suffix NAME
|
|
|
87
|
|
|
88 NAME is a string; the name of an argument to CALLBACK.
|
|
|
89
|
|
|
90 :style
|
|
|
91
|
|
|
92 STYLE is a symbol describing the type of menu item. The following are
|
|
|
93 defined:
|
|
|
94
|
|
|
95 toggle: A checkbox.
|
|
|
96 Currently just prepend the name with the string \"Toggle \".
|
|
|
97 radio: A radio button.
|
|
|
98 nil: An ordinary menu item.
|
|
|
99
|
|
|
100 :selected SELECTED
|
|
|
101
|
|
|
102 SELECTED is an expression; the checkbox or radio button is selected
|
|
|
103 whenever this expression's value is non-nil.
|
|
|
104 Currently just disable radio buttons, no effect on checkboxes.
|
|
|
105
|
|
|
106 A menu item can be a string. Then that string appears in the menu as
|
|
|
107 unselectable text. A string consisting solely of hyphens is displayed
|
|
|
108 as a solid horizontal line.
|
|
|
109
|
|
|
110 A menu item can be a list. It is treated as a submenu.
|
|
|
111 The first element should be the submenu name. That's used as the
|
|
|
112 menu item in the top-level menu. The cdr of the submenu list
|
|
|
113 is a list of menu items, as above."
|
|
|
114 (` (progn
|
|
|
115 (defvar (, symbol) nil (, doc))
|
|
|
116 (vm-easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
|
|
|
117
|
|
|
118 (defun vm-easy-menu-do-define (symbol maps doc menu)
|
|
|
119 ;; We can't do anything that might differ between Emacs dialects in
|
|
|
120 ;; `vm-easy-menu-define' in order to make byte compiled files
|
|
|
121 ;; compatible. Therefore everything interesting is done in this
|
|
|
122 ;; function.
|
|
|
123 (set symbol (vm-easy-menu-create-keymaps (car menu) (cdr menu)))
|
|
|
124 (fset symbol (` (lambda (event) (, doc) (interactive "@e")
|
|
|
125 (easy-popup-menu event (, symbol)))))
|
|
|
126 (mapcar (function (lambda (map)
|
|
|
127 (define-key map (vector 'menu-bar (intern (car menu)))
|
|
|
128 (cons (car menu) (symbol-value symbol)))))
|
|
|
129 (if (keymapp maps) (list maps) maps)))
|
|
|
130
|
|
|
131 (defvar vm-easy-menu-item-count 0)
|
|
|
132
|
|
|
133 ;; Return a menu keymap corresponding to a Lucid-style menu list
|
|
|
134 ;; MENU-ITEMS, and with name MENU-NAME.
|
|
|
135 ;;;###autoload
|
|
|
136 (defun vm-easy-menu-create-keymaps (menu-name menu-items)
|
|
|
137 (let ((menu (make-sparse-keymap menu-name)))
|
|
|
138 ;; Process items in reverse order,
|
|
|
139 ;; since the define-key loop reverses them again.
|
|
|
140 (setq menu-items (reverse menu-items))
|
|
|
141 (while menu-items
|
|
|
142 (let* ((item (car menu-items))
|
|
|
143 (callback (if (vectorp item) (aref item 1)))
|
|
|
144 command enabler name)
|
|
|
145 (cond ((stringp item)
|
|
|
146 (setq command nil)
|
|
|
147 (setq name (if (string-match "^-+$" item) "" item)))
|
|
|
148 ((consp item)
|
|
|
149 (setq command (vm-easy-menu-create-keymaps (car item) (cdr item)))
|
|
|
150 (setq name (car item)))
|
|
|
151 ((vectorp item)
|
|
|
152 (if (symbolp callback)
|
|
|
153 (setq command callback)
|
|
|
154 (setq command (make-symbol (format "menu-function-%d"
|
|
|
155 vm-easy-menu-item-count)))
|
|
|
156 (setq vm-easy-menu-item-count (1+ vm-easy-menu-item-count)))
|
|
|
157 (setq name (aref item 0))
|
|
|
158 (let ((keyword (aref item 2)))
|
|
|
159 (if (and (symbolp keyword)
|
|
|
160 (= ?: (aref (symbol-name keyword) 0)))
|
|
|
161 (let ((count 2)
|
|
|
162 style selected active keys
|
|
|
163 arg)
|
|
|
164 (while (> (length item) count)
|
|
|
165 (setq keyword (aref item count))
|
|
|
166 (setq arg (aref item (1+ count)))
|
|
|
167 (setq count (+ 2 count))
|
|
|
168 (cond ((eq keyword ':keys)
|
|
|
169 (setq keys arg))
|
|
|
170 ((eq keyword ':active)
|
|
|
171 (setq active arg))
|
|
|
172 ((eq keyword ':suffix)
|
|
|
173 (setq name (concat name " " arg)))
|
|
|
174 ((eq keyword ':style)
|
|
|
175 (setq style arg))
|
|
|
176 ((eq keyword ':selected)
|
|
|
177 (setq selected arg))))
|
|
|
178 (if keys
|
|
|
179 (setq name (concat name " (" keys ")")))
|
|
|
180 (if (eq style 'toggle)
|
|
|
181 ;; Simulate checkboxes.
|
|
|
182 (setq name (concat "Toggle " name)))
|
|
|
183 (if active
|
|
|
184 (put command 'menu-enable active)
|
|
|
185 (and (eq style 'radio)
|
|
|
186 selected
|
|
|
187 ;; Simulate radio buttons with menu-enable.
|
|
|
188 (put command 'menu-enable
|
|
|
189 (list 'not selected)))))
|
|
|
190 (if (= (length item) 4)
|
|
|
191 (setq name (concat name " " (aref item 3))))
|
|
|
192 (put command 'menu-enable keyword)))
|
|
|
193 (if (keymapp callback)
|
|
|
194 (setq name (concat name " ...")))
|
|
|
195 (if (symbolp callback)
|
|
|
196 nil ;;(fset command callback)
|
|
|
197 (fset command (list 'lambda () '(interactive) callback)))))
|
|
|
198 (if (null command)
|
|
|
199 ;; Handle inactive strings specially--allow any number
|
|
|
200 ;; of identical ones.
|
|
|
201 (setcdr menu (cons (list nil name) (cdr menu)))
|
|
|
202 (if name
|
|
|
203 (define-key menu (vector (intern name)) (cons name command)))))
|
|
|
204 (setq menu-items (cdr menu-items)))
|
|
|
205 menu))
|
|
|
206
|
|
|
207 (defun vm-easy-menu-change (path name items)
|
|
|
208 "Change menu found at PATH as item NAME to contain ITEMS.
|
|
|
209 PATH is a list of strings for locating the menu containing NAME in the
|
|
|
210 menu bar. ITEMS is a list of menu items, as in `vm-easy-menu-define'.
|
|
|
211 These items entirely replace the previous items in that map.
|
|
|
212
|
|
|
213 Call this from `activate-menubar-hook' to implement dynamic menus."
|
|
|
214 (let ((map (key-binding (apply 'vector
|
|
|
215 'menu-bar
|
|
|
216 (mapcar 'intern (append path (list name)))))))
|
|
|
217 (if (keymapp map)
|
|
|
218 (setcdr map (cdr (vm-easy-menu-create-keymaps name items)))
|
|
|
219 (error "Malformed menu in `vm-easy-menu-change'"))))
|
|
|
220
|
|
|
221 (defun vm-easy-menu-remove (menu))
|
|
|
222
|
|
|
223 (defun vm-easy-menu-add (menu &optional map))
|
|
|
224
|
|
|
225 ;;; vm-easymenu.el ends here
|
