Mercurial > hg > xemacs-beta

comparison lisp/menubar.el @ 321:19dcec799385 r21-0-58

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-58
author cvs
date Mon, 13 Aug 2007 10:46:44 +0200
parents 11cf20601dec
children cc15677e0335
comparison
equal deleted inserted replaced
320:73c75c43c1f2 321:19dcec799385
216 (t 216 (t
217 (signal 'error (list (gettext "no such submenu") 217 (signal 'error (list (gettext "no such submenu")
218 (car item-path-list))))) 218 (car item-path-list)))))
219 (cons result parent))))) 219 (cons result parent)))))
220 220
221 (defun add-menu-item-1 (leaf-p menu-path new-item before) 221 (defun add-menu-item-1 (leaf-p menu-path new-item before in-menu)
222 ;; This code looks like it could be cleaned up some more 222 ;; This code looks like it could be cleaned up some more
223 ;; Do we really need 6 calls to find-menu-item? 223 ;; Do we really need 6 calls to find-menu-item?
224 (when before (setq before (normalize-menu-item-name before))) 224 (when before (setq before (normalize-menu-item-name before)))
225 (let* ((item-name 225 (let* ((item-name
226 (cond ((vectorp new-item) (aref new-item 0)) 226 (cond ((vectorp new-item) (aref new-item 0))
227 ((consp new-item) (car new-item)) 227 ((consp new-item) (car new-item))
228 (t nil))) 228 (t nil)))
229 (menubar current-menubar) 229 (menubar (or in-menu current-menubar))
230 (menu (condition-case () 230 (menu (condition-case ()
231 (car (find-menu-item menubar menu-path)) 231 (car (find-menu-item menubar menu-path))
232 (error nil))) 232 (error nil)))
233 (item-found (cond 233 (item-found (cond
234 ((null item-name) 234 ((null item-name)
290 ;; otherwise, add the item to the end. 290 ;; otherwise, add the item to the end.
291 (nconc menu (list new-item)))))) 291 (nconc menu (list new-item))))))
292 (set-menubar-dirty-flag) 292 (set-menubar-dirty-flag)
293 new-item)) 293 new-item))
294 294
295 (defun add-menu-button (menu-path menu-leaf &optional before) 295 (defun add-menu-button (menu-path menu-leaf &optional before in-menu)
296 "Add a menu item to some menu, creating the menu first if necessary. 296 "Add a menu item to some menu, creating the menu first if necessary.
297 If the named item exists already, it is changed. 297 If the named item exists already, it is changed.
298 MENU-PATH identifies the menu under which the new menu item should be inserted. 298 MENU-PATH identifies the menu under which the new menu item should be inserted.
299 It is a list of strings; for example, (\"File\") names the top-level \"File\" 299 It is a list of strings; for example, (\"File\") names the top-level \"File\"
300 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". 300 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
301 MENU-LEAF is a menubar leaf node. See the documentation of `current-menubar'. 301 MENU-LEAF is a menubar leaf node. See the documentation of `current-menubar'.
302 BEFORE, if provided, is the name of a menu item before which this item should 302 BEFORE, if provided, is the name of a menu item before which this item should
303 be added, if this item is not on the menu already. If the item is already 303 be added, if this item is not on the menu already. If the item is already
304 present, it will not be moved." 304 present, it will not be moved.
305 (add-menu-item-1 t menu-path menu-leaf before)) 305 If IN-MENU is present use that instead of `current-menubar' as the menu to
306 change.
307 "
308 ;; Note easymenu.el uses the fact that menu-leaf can be a submenu.
309 (add-menu-item-1 t menu-path menu-leaf before in-menu))
306 310
307 ;; I actually liked the old name better, but the interface has changed too 311 ;; I actually liked the old name better, but the interface has changed too
308 ;; drastically to keep it. --Stig 312 ;; drastically to keep it. --Stig
309 (defun add-submenu (menu-path submenu &optional before) 313 (defun add-submenu (menu-path submenu &optional before in-menu)
310 "Add a menu to the menubar or one of its submenus. 314 "Add a menu to the menubar or one of its submenus.
311 If the named menu exists already, it is changed. 315 If the named menu exists already, it is changed.
312 MENU-PATH identifies the menu under which the new menu should be inserted. 316 MENU-PATH identifies the menu under which the new menu should be inserted.
313 It is a list of strings; for example, (\"File\") names the top-level \"File\" 317 It is a list of strings; for example, (\"File\") names the top-level \"File\"
314 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". 318 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
317 See the documentation of `current-menubar' for the syntax. 321 See the documentation of `current-menubar' for the syntax.
318 BEFORE, if provided, is the name of a menu before which this menu should 322 BEFORE, if provided, is the name of a menu before which this menu should
319 be added, if this menu is not on its parent already. If the menu is already 323 be added, if this menu is not on its parent already. If the menu is already
320 present, it will not be moved." 324 present, it will not be moved."
321 (check-menu-syntax submenu nil) 325 (check-menu-syntax submenu nil)
322 (add-menu-item-1 nil menu-path submenu before)) 326 (add-menu-item-1 nil menu-path submenu before in-menu))
323 327
324 (defun purecopy-menubar (x) 328 (defun purecopy-menubar (x)
325 ;; this calls purecopy on the strings, and the contents of the vectors, 329 ;; this calls purecopy on the strings, and the contents of the vectors,
326 ;; but not on the vectors themselves, or the conses - those must be 330 ;; but not on the vectors themselves, or the conses - those must be
327 ;; writable. 331 ;; writable.
338 (setq rest (cdr rest)))) 342 (setq rest (cdr rest))))
339 x) 343 x)
340 (t 344 (t
341 (purecopy x)))) 345 (purecopy x))))
342 346
343 (defun delete-menu-item (path) 347 (defun delete-menu-item (path &optional from-menu)
344 "Remove the named menu item from the menu hierarchy. 348 "Remove the named menu item from the menu hierarchy.
345 PATH is a list of strings which identify the position of the menu item in 349 PATH is a list of strings which identify the position of the menu item in
346 the menu hierarchy. The documentation of `add-submenu' describes menu-paths." 350 the menu hierarchy. The documentation of `add-submenu' describes menu-paths."
347 (let* ((pair (condition-case nil (find-menu-item current-menubar path) 351 (let* ((pair (condition-case nil (find-menu-item (or from-menu
352 current-menubar) path)
348 (error nil))) 353 (error nil)))
349 (item (car pair)) 354 (item (car pair))
350 (parent (or (cdr pair) current-menubar))) 355 (parent (or (cdr pair) current-menubar)))
351 (if (not item) 356 (if (not item)
352 nil 357 nil