Mercurial > hg > xemacs-beta

comparison lisp/menubar.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents 19dcec799385
children d883f39b8495
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
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 in-menu) 221 (defun add-menu-item-1 (leaf-p menu-path new-item before)
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 (or in-menu current-menubar)) 229 (menubar 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 in-menu) 295 (defun add-menu-button (menu-path menu-leaf &optional before)
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 If IN-MENU is present use that instead of `current-menubar' as the menu to 305 (add-menu-item-1 t menu-path menu-leaf before))
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))
310 306
311 ;; I actually liked the old name better, but the interface has changed too 307 ;; I actually liked the old name better, but the interface has changed too
312 ;; drastically to keep it. --Stig 308 ;; drastically to keep it. --Stig
313 (defun add-submenu (menu-path submenu &optional before in-menu) 309 (defun add-submenu (menu-path submenu &optional before)
314 "Add a menu to the menubar or one of its submenus. 310 "Add a menu to the menubar or one of its submenus.
315 If the named menu exists already, it is changed. 311 If the named menu exists already, it is changed.
316 MENU-PATH identifies the menu under which the new menu should be inserted. 312 MENU-PATH identifies the menu under which the new menu should be inserted.
317 It is a list of strings; for example, (\"File\") names the top-level \"File\" 313 It is a list of strings; for example, (\"File\") names the top-level \"File\"
318 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". 314 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
321 See the documentation of `current-menubar' for the syntax. 317 See the documentation of `current-menubar' for the syntax.
322 BEFORE, if provided, is the name of a menu before which this menu should 318 BEFORE, if provided, is the name of a menu before which this menu should
323 be added, if this menu is not on its parent already. If the menu is already 319 be added, if this menu is not on its parent already. If the menu is already
324 present, it will not be moved." 320 present, it will not be moved."
325 (check-menu-syntax submenu nil) 321 (check-menu-syntax submenu nil)
326 (add-menu-item-1 nil menu-path submenu before in-menu)) 322 (add-menu-item-1 nil menu-path submenu before))
327 323
328 (defun purecopy-menubar (x) 324 (defun purecopy-menubar (x)
329 ;; this calls purecopy on the strings, and the contents of the vectors, 325 ;; this calls purecopy on the strings, and the contents of the vectors,
330 ;; but not on the vectors themselves, or the conses - those must be 326 ;; but not on the vectors themselves, or the conses - those must be
331 ;; writable. 327 ;; writable.
342 (setq rest (cdr rest)))) 338 (setq rest (cdr rest))))
343 x) 339 x)
344 (t 340 (t
345 (purecopy x)))) 341 (purecopy x))))
346 342
347 (defun delete-menu-item (path &optional from-menu) 343 (defun delete-menu-item (path)
348 "Remove the named menu item from the menu hierarchy. 344 "Remove the named menu item from the menu hierarchy.
349 PATH is a list of strings which identify the position of the menu item in 345 PATH is a list of strings which identify the position of the menu item in
350 the menu hierarchy. The documentation of `add-submenu' describes menu-paths." 346 the menu hierarchy. The documentation of `add-submenu' describes menu-paths."
351 (let* ((pair (condition-case nil (find-menu-item (or from-menu 347 (let* ((pair (condition-case nil (find-menu-item current-menubar path)
352 current-menubar) path)
353 (error nil))) 348 (error nil)))
354 (item (car pair)) 349 (item (car pair))
355 (parent (or (cdr pair) current-menubar))) 350 (parent (or (cdr pair) current-menubar)))
356 (if (not item) 351 (if (not item)
357 nil 352 nil