annotate lisp/emacs-lisp/easymenu.el @ 6591:60f70854e73f

(verify_overlay_modification): Copy TAIL before a hook, in case the hook recenters the overlay lists.
author Richard M. Stallman <rms@gnu.org>
date Wed, 30 Mar 1994 06:32:54 +0000
parents 1d9da8160357
children f75ac1f3d99c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; easymenu.el --- support the easymenu interface for defining a menu.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Keywords: emulations
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Copyright (C) 1994 Free Software Foundation, Inc.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; any later version.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; GNU General Public License for more details.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;;; This is compatible with easymenu.el by Per Abrahamsen
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;;; but it is much simpler as it doesn't try to support other Emacs versions.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;;; The code was mostly derived from lmenu.el.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;;; Code:
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
29 ;;;###autoload
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 (defun easy-menu-define (symbol maps doc menu)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 "Define a menu bar submenu in maps MAPS, according to MENU.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 The arguments SYMBOL and DOC are ignored; they are present for
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
33 compatibility only. In other Emacs versions they may be used
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
34 as a variable to hold the menu data, and a doc string for that variable.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 The first element of MENU must be a string. It is the menu bar item name.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 The rest of the elements are menu items.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
39 A menu item is usually a vector of three elements: [NAME CALLBACK t]
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
41 NAME is a string--the menu item name.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
43 CALLBACK is a command to run when the item is chosen,
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
44 or a list to evaluate when the item is chosen.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
46 A menu item can be a string. Then that string appears in the menu as
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
47 unselectable text. A string consisting solely of hyphens is displayed
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
48 as a solid horizontal line.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
50 A menu item can be a list. It is treated as a submenu.
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 The first element should be the submenu name. That's used as the
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 menu item in the top-level menu. The cdr of the submenu list
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 is a list of menu items, as above."
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
54 (or (keymapp maps) (setq maps (list maps)))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (let ((keymap (easy-menu-keymap (car menu) (cdr menu))))
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
56 (while maps
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
57 (define-key (car maps) (vector 'menu-bar (intern (car menu)))
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
58 (cons (car menu) keymap))
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
59 (setq maps (cdr maps)))))
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
60
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
61 (defvar easy-menu-item-count 0)
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 ;; Return a menu keymap corresponding to a Lucid-style menu list
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;; MENU-ITEMS, and with name MENU-NAME.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 (defun easy-menu-keymap (menu-name menu-items)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 (let ((menu (make-sparse-keymap menu-name)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ;; Process items in reverse order,
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 ;; since the define-key loop reverses them again.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (setq menu-items (reverse menu-items))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (while menu-items
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (let* ((item (car menu-items))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (callback (if (vectorp item) (aref item 1)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 command enabler name)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (cond ((stringp item)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 (setq command nil)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (setq name (if (string-match "^-+$" item) "" item)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 ((consp item)
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
78 (setq command (easy-menu-keymap (car item) (cdr item)))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (setq name (car item)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 ((vectorp item)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (setq command (make-symbol (format "menu-function-%d"
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
82 easy-menu-item-count)))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 (setq enabler (make-symbol (format "menu-function-%d-enabler"
6542
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
84 easy-menu-item-count)))
1d9da8160357 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 6529
diff changeset
85 (setq easy-menu-item-count (1+ easy-menu-item-count))
6529
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (put command 'menu-enable enabler)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 (set enabler (aref item 2))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (setq name (aref item 0))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 (if (symbolp callback)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 (fset command callback)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 (fset command (list 'lambda () '(interactive) callback)))))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 (if (null command)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 ;; Handle inactive strings specially--allow any number
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 ;; of identical ones.
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (setcdr menu (cons (list nil name) (cdr menu)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (if name
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (define-key menu (vector (intern name)) (cons name command)))))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (setq menu-items (cdr menu-items)))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 menu))
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 (provide 'easymenu)
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102
79c305d1edcb Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 ;;; easymenu.el ends here