Mercurial > hg > xemacs-beta

comparison lisp/easymenu.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 7039e6323819
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
22 ;; along with XEmacs; if not, write to the Free Software 22 ;; along with XEmacs; if not, write to the Free Software
23 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 23 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ;; 02111-1307, USA. 24 ;; 02111-1307, USA.
25 25
26 ;;; Synched up with: Not synched with FSF but coordinated with the FSF 26 ;;; Synched up with: Not synched with FSF but coordinated with the FSF
27 ;;; easymenu maintor for compatibility with FSF 20.4. 27 ;;; easymenu maintainer for compatibility with FSF 20.4.
28 ;;; Please: Coordinate changes with Inge Frick <inge@nada.kth.se> 28 ;;; Please: Coordinate changes with Inge Frick <inge@nada.kth.se>
29 29
30 ;; Commentary: 30 ;; Commentary:
31 31
32 ;; This file is dumped with XEmacs. 32 ;; This file is dumped with XEmacs.
33 33
34 ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs. 34 ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
35 35
36 ;; This file 36 ;; This file
37 ;; The advantages of using easymenu are: 37 ;; The advantages of using easymenu are:
38 38
39 ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax. 39 ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
40 40
41 ;; - Common interface for Emacs 18, Emacs 19, and XEmacs. 41 ;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
42 ;; (The code does nothing when run under Emacs 18). 42 ;; (The code does nothing when run under Emacs 18).
43 43
44 ;; The public functions are: 44 ;; The public functions are:
45 45
46 ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU 46 ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
47 ;; SYMBOL is both the name of the variable that holds the menu and 47 ;; SYMBOL is both the name of the variable that holds the menu and
48 ;; the name of a function that will present a the menu. 48 ;; the name of a function that will present the menu.
49 ;; MAPS is a list of keymaps where the menu should appear in the menubar. 49 ;; MAPS is a list of keymaps where the menu should appear in the menubar.
50 ;; DOC is the documentation string for the variable. 50 ;; DOC is the documentation string for the variable.
51 ;; MENU is an XEmacs style menu description. 51 ;; MENU is an XEmacs style menu description.
52 52
53 ;; See the documentation for easy-menu-define for details. 53 ;; See the documentation for easy-menu-define for details.
54 54
55 ;; - Function: easy-menu-change PATH NAME ITEMS 55 ;; - Function: easy-menu-change PATH NAME ITEMS
56 ;; Change an existing menu. 56 ;; Change an existing menu.
57 ;; The menu must already exist and be visible on the menu bar. 57 ;; The menu must already exist and be visible on the menu bar.
58 ;; PATH is a list of strings used for locating the menu on the menu bar. 58 ;; PATH is a list of strings used for locating the menu on the menu bar.
59 ;; NAME is the name of the menu. 59 ;; NAME is the name of the menu.
60 ;; ITEMS is a list of menu items, as defined in `easy-menu-define'. 60 ;; ITEMS is a list of menu items, as defined in `easy-menu-define'.
61 61
62 ;; - Function: easy-menu-add MENU [ MAP ] 62 ;; - Function: easy-menu-add MENU [ MAP ]
63 ;; Add MENU to the current menubar in MAP. 63 ;; Add MENU to the current menubar in MAP.
64 64
103 or a list to evaluate when the item is chosen. 103 or a list to evaluate when the item is chosen.
104 104
105 ENABLE is an expression; the item is enabled for selection 105 ENABLE is an expression; the item is enabled for selection
106 whenever this expression's value is non-nil. 106 whenever this expression's value is non-nil.
107 107
108 Alternatively, a menu item may have the form: 108 Alternatively, a menu item may have the form:
109 109
110 [ NAME CALLBACK [ KEYWORD ARG ] ... ] 110 [ NAME CALLBACK [ KEYWORD ARG ] ... ]
111 111
112 Where KEYWORD is one of the symbol defined below. 112 Where KEYWORD is one of the symbol defined below.
113 113
123 :suffix NAME 123 :suffix NAME
124 124
125 NAME is a string; the name of an argument to CALLBACK. 125 NAME is a string; the name of an argument to CALLBACK.
126 126
127 :style STYLE 127 :style STYLE
128 128
129 STYLE is a symbol describing the type of menu item. The following are 129 STYLE is a symbol describing the type of menu item. The following are
130 defined: 130 defined:
131 131
132 toggle: A checkbox. 132 toggle: A checkbox.
133 Currently just prepend the name with the string \"Toggle \". 133 Currently just prepend the name with the string \"Toggle \".
134 radio: A radio button. 134 radio: A radio button.
135 nil: An ordinary menu item. 135 nil: An ordinary menu item.
136 136
137 :selected SELECTED 137 :selected SELECTED
138 138
139 SELECTED is an expression; the checkbox or radio button is selected 139 SELECTED is an expression; the checkbox or radio button is selected
151 `(progn 151 `(progn
152 (defvar ,symbol nil ,doc) 152 (defvar ,symbol nil ,doc)
153 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) 153 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
154 154
155 (defun easy-menu-do-define (symbol maps doc menu) 155 (defun easy-menu-do-define (symbol maps doc menu)
156 (if (featurep 'menubar) 156 (when (featurep 'menubar)
157 (progn 157 (set symbol menu)
158 (set symbol menu) 158 (fset symbol `(lambda (e)
159 (fset symbol (list 'lambda '(e) 159 ,doc
160 doc 160 (interactive "@e")
161 '(interactive "@e") 161 (run-hooks 'activate-menubar-hook)
162 '(run-hooks 'activate-menubar-hook) 162 (setq zmacs-region-stays 't)
163 '(setq zmacs-region-stays 't) 163 (popup-menu ,symbol)))))
164 (list 'popup-menu symbol))))))
165 164
166 (defun easy-menu-change (&rest args) 165 (defun easy-menu-change (&rest args)
167 (when (featurep 'menubar) 166 (when (featurep 'menubar)
168 (apply 'add-menu args))) 167 (apply 'add-menu args)))
169 168
172 (defvar easy-menu-all-popups nil) 171 (defvar easy-menu-all-popups nil)
173 (make-variable-buffer-local 'easy-menu-all-popups) 172 (make-variable-buffer-local 'easy-menu-all-popups)
174 173
175 (defun easy-menu-add (menu &optional map) 174 (defun easy-menu-add (menu &optional map)
176 "Add MENU to the current menu bar." 175 "Add MENU to the current menu bar."
177 (if (featurep 'menubar) 176 (when (featurep 'menubar)
178 (progn 177 (unless (member menu easy-menu-all-popups)
179 (unless (member menu easy-menu-all-popups) 178 (push menu easy-menu-all-popups))
180 (push menu easy-menu-all-popups)) 179 (setq mode-popup-menu (if (> (length easy-menu-all-popups) 1)
181 (setq mode-popup-menu (if (> (length easy-menu-all-popups) 1) 180 (cons (easy-menu-title)
182 (cons (easy-menu-title) 181 (reverse easy-menu-all-popups))
183 (reverse easy-menu-all-popups)) 182 (let ((same-as-menu
184 (car easy-menu-all-popups))) 183 (car easy-menu-all-popups)))
185 184 (cons (normalize-menu-item-name
186 (cond ((null current-menubar) 185 (car same-as-menu))
187 ;; Don't add it to a non-existing menubar. 186 (cdr same-as-menu)))))
188 nil) 187
189 ((assoc (car menu) current-menubar) 188 (cond ((null current-menubar)
190 ;; Already present. 189 ;; Don't add it to a non-existing menubar.
191 nil) 190 nil)
192 ((equal current-menubar '(nil)) 191 ((assoc (car menu) current-menubar)
193 ;; Set at left if only contains right marker. 192 ;; Already present.
194 (set-buffer-menubar (list menu nil))) 193 nil)
195 (t 194 ((equal current-menubar '(nil))
196 ;; Add at right. 195 ;; Set at left if only contains right marker.
197 (set-buffer-menubar (copy-sequence current-menubar)) 196 (set-buffer-menubar (list menu nil)))
198 (add-menu nil (car menu) (cdr menu))))))) 197 (t
198 ;; Add at right.
199 (set-buffer-menubar (copy-sequence current-menubar))
200 (add-menu nil (car menu) (cdr menu))))))
199 201
200 (defun easy-menu-remove (menu) 202 (defun easy-menu-remove (menu)
201 "Remove MENU from the current menu bar." 203 "Remove MENU from the current menu bar."
202 (if (featurep 'menubar) 204 (when (featurep 'menubar)
203 (progn 205 (setq easy-menu-all-popups (delq menu easy-menu-all-popups)
204 (setq easy-menu-all-popups (delq menu easy-menu-all-popups) 206 mode-popup-menu (if (< (length easy-menu-all-popups) 1)
205 mode-popup-menu (if (< (length easy-menu-all-popups) 1) 207 (cons (easy-menu-title)
206 (cons (easy-menu-title) 208 (reverse easy-menu-all-popups))
207 (reverse easy-menu-all-popups)) 209 (let ((same-as-menu
208 (car easy-menu-all-popups))) 210 (car easy-menu-all-popups)))
209 211 (cons (normalize-menu-item-name
210 (and current-menubar 212 (car same-as-menu))
211 (assoc (car menu) current-menubar) 213 (cdr same-as-menu)))))
212 (delete-menu-item (list (car menu))))))) 214
215 (and current-menubar
216 (assoc (car menu) current-menubar)
217 (delete-menu-item (list (car menu))))))
213 218
214 (defsubst easy-menu-normalize (menu) 219 (defsubst easy-menu-normalize (menu)
215 (if (symbolp menu) 220 (if (symbolp menu)
216 (symbol-value menu) 221 (symbol-value menu)
217 menu)) 222 menu))
218 223
219 (defun easy-menu-add-item (menu path item &optional before) 224 (defun easy-menu-add-item (menu path item &optional before)
220 "At the end of the submenu of MENU with path PATH add ITEM. 225 "At the end of the submenu of MENU with path PATH, add ITEM.
221 If ITEM is already present in this submenu, then this item will be changed. 226 If ITEM is already present in this submenu, then this item will be changed.
222 otherwise ITEM will be added at the end of the submenu, unless the optional 227 otherwise ITEM will be added at the end of the submenu, unless the optional
223 argument BEFORE is present, in which case ITEM will instead be added 228 argument BEFORE is present, in which case ITEM will instead be added
224 before the item named BEFORE. 229 before the item named BEFORE.
225 MENU is either a symbol, which have earlier been used as the first 230 MENU is either a symbol, which have earlier been used as the first
226 argument in a call to `easy-menu-define', or the value of such a symbol 231 argument in a call to `easy-menu-define', or the value of such a symbol
227 i.e. a menu, or nil which stands for the current menubar. 232 i.e. a menu, or nil, which stands for the current menubar.
228 PATH is a list of strings for locating the submenu where ITEM is to be 233 PATH is a list of strings for locating the submenu where ITEM is to be
229 added. If PATH is nil, MENU itself is used. Otherwise, the first 234 added. If PATH is nil, MENU itself is used. Otherwise, the first
230 element should be the name of a submenu directly under MENU. This 235 element should be the name of a submenu directly under MENU. This
231 submenu is then traversed recursively with the remaining elements of PATH. 236 submenu is then traversed recursively with the remaining elements of PATH.
232 ITEM is either defined as in `easy-menu-define', a menu defined earlier 237 ITEM is either defined as in `easy-menu-define', a menu defined earlier
233 by `easy-menu-define' or `easy-menu-create-menu' or an item returned 238 by `easy-menu-define' or `easy-menu-create-menu' or an item returned
234 from `easy-menu-item-present-p' or `easy-menu-remove-item'." 239 from `easy-menu-item-present-p' or `easy-menu-remove-item'."
235 (add-menu-button path item before (easy-menu-normalize menu))) 240 (when (featurep 'menubar)
241 (add-menu-button path item before (easy-menu-normalize menu))))
236 242
237 (defun easy-menu-item-present-p (menu path name) 243 (defun easy-menu-item-present-p (menu path name)
238 "In submenu of MENU with path PATH, return true iff item NAME is present. 244 "In submenu of MENU with path PATH, return true iff item NAME is present.
239 MENU and PATH are defined as in `easy-menu-add-item'. 245 MENU and PATH are defined as in `easy-menu-add-item'.
240 NAME should be a string, the name of the element to be looked for. 246 NAME should be a string, the name of the element to be looked for.
241 247
242 The return value can be used as as an argument to `easy-menu-add-item'." 248 The return value can be used as an argument to `easy-menu-add-item'."
243 (car (find-menu-item (or (easy-menu-normalize menu) current-menubar) 249 (if (featurep 'menubar)
244 (append path (list name))))) 250 (car (find-menu-item (or (easy-menu-normalize menu) current-menubar)
251 (append path (list name))))
252 nil))
245 253
246 (defun easy-menu-remove-item (menu path name) 254 (defun easy-menu-remove-item (menu path name)
247 "From submenu of MENU with path PATH remove item NAME. 255 "From submenu of MENU with path PATH, remove item NAME.
248 MENU and PATH are defined as in `easy-menu-add-item'. 256 MENU and PATH are defined as in `easy-menu-add-item'.
249 NAME should be a string, the name of the element to be removed. 257 NAME should be a string, the name of the element to be removed.
250 258
251 The return value can be used as as an argument to `easy-menu-add-item'." 259 The return value can be used as an argument to `easy-menu-add-item'."
252 (delete-menu-item (append path (list name)) 260 (when (featurep 'menubar)
253 (easy-menu-normalize menu))) 261 (delete-menu-item (append path (list name))
254 262 (easy-menu-normalize menu))))
263
255 264
256 265
257 266
258 ;; Think up a good title for the menu. Take the major-mode of the 267 ;; Think up a good title for the menu. Take the major-mode of the
259 ;; buffer, strip the -mode part, convert hyphens to spaces, and 268 ;; buffer, strip the -mode part, convert hyphens to spaces, and