annotate lisp/emacs-lisp/lmenu.el @ 2563:c8ae06bda9fa

(global-map): Remove function key bindings that duplicate stuff in loaddefs.el.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Fri, 23 Apr 1993 02:21:02 +0000
parents fb0ed5a1d0f3
children f95808ad4b95
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2231
diff changeset
1 ;;; lmenu.el --- emulate Lucid's menubar support
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2231
diff changeset
2
2233
fb0ed5a1d0f3 Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
3 ;; Keywords: emulations
fb0ed5a1d0f3 Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
4
2231
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
5 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
6
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12 ;; any later version.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17 ;; GNU General Public License for more details.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
22
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2231
diff changeset
23 ;;; Code:
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2231
diff changeset
24
2231
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26 ;; First, emulate the Lucid menubar support in GNU Emacs 19.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
27
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
28 ;; Arrange to use current-menubar to set up part of the menu bar.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
30 (setq recompute-lucid-menubar 'recompute-lucid-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
31 (defun recompute-lucid-menubar ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32 (define-key lucid-menubar-map [menu-bar]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33 (condition-case nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 (make-lucid-menu-keymap "menu-bar" current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36 (sit-for 1)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37 (setq lucid-failing-menubar current-menubar
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38 current-menubar nil))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39 (setq lucid-menu-bar-dirty-flag nil))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 (defvar lucid-menubar-map (make-sparse-keymap))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 (or (assq 'current-menubar minor-mode-map-alist)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
43 (setq minor-mode-map-alist
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
44 (cons (cons 'current-menubar lucid-menubar-map)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
45 minor-mode-map-alist)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
46
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
47 (defun set-menubar-dirty-flag ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48 (force-mode-line-update)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49 (setq lucid-menu-bar-dirty-flag t))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51 (defvar add-menu-item-count 0)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
52
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
53 ;; Return a menu keymap corresponding to a Lucid-style menu list
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54 ;; MENU-ITEMS, and with name MENU-NAME.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
55 (defun make-lucid-menu-keymap (menu-name menu-items)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
56 (let ((menu (make-sparse-keymap menu-name)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
57 ;; Process items in reverse order,
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
58 ;; since the define-key loop reverses them again.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59 (setq menu-items (reverse menu-items))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60 (while menu-items
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 (let* ((item (car menu-items))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 (callback (if (vectorp item) (aref item 1)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 command enabler name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64 (cond ((stringp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65 (setq command nil)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
66 (setq name item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
67 ((consp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
68 (setq command (make-lucid-menu-keymap (car item) (cdr item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
69 (setq name (car item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
70 ((vectorp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
71 (setq command (make-symbol (format "menu-function-%d"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72 add-menu-item-count)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 (setq enabler (make-symbol (format "menu-function-%d-enabler"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
74 add-menu-item-count)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
75 (setq add-menu-item-count (1+ add-menu-item-count))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
76 (put command 'menu-enable enabler)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
77 (set enabler (aref item 2))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
78 (setq name (aref item 0))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
79 (if (symbolp callback)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
80 (fset command callback)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 (fset command (list 'lambda () '(interactive) callback)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82 (if name
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
83 (define-key menu (vector (intern name)) (cons name command))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
84 (setq menu-items (cdr menu-items)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
85 menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
86
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
87 (defun popup-menu (menu-desc)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
88 "Pop up the given menu.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
89 A menu is a list of menu items, strings, and submenus.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
90
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
91 The first element of a menu must be a string, which is the name of the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
92 menu. This is the string that will be displayed in the parent menu, if
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
93 any. For toplevel menus, it is ignored. This string is not displayed
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
94 in the menu itself.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
95
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
96 A menu item is a vector of three or four elements:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
97
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
98 - the name of the menu item (a string);
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
99 - the `callback' of that item;
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100 - whether this item is active (selectable);
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
101 - and an optional string to append to the name.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
102
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
103 If the `callback' of a menu item is a symbol, then it must name a command.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
104 It will be invoked with `call-interactively'. If it is a list, then it is
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
105 evaluated with `eval'.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
106
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
107 The fourth element of a menu item is a convenient way of adding the name
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
108 of a command's ``argument'' to the menu, like ``Kill Buffer NAME''.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
109
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
110 If an element of a menu is a string, then that string will be presented in
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
111 the menu as unselectable text.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
112
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
113 If an element of a menu is a string consisting solely of hyphens, then that
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
114 item will be presented as a solid horizontal line.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
115
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
116 If an element of a menu is a list, it is treated as a submenu. The name of
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
117 that submenu (the first element in the list) will be used as the name of the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
118 item representing this menu on the parent.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
119
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
120 The syntax, more precisely:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
121
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
122 form := <something to pass to `eval'>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
123 command := <a symbol or string, to pass to `call-interactively'>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124 callback := command | form
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
125 active-p := <t or nil, whether this thing is selectable>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
126 text := <string, non selectable>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
127 name := <string>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
128 argument := <string>
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
129 menu-item := '[' name callback active-p [ argument ] ']'
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
130 menu := '(' name [ menu-item | menu | text ]+ ')'
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
131 "
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
132 (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
133 (pos (mouse-position))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
134 answer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
135 (setq answer (x-popup-menu (list (list (nth 1 pos) (nthcdr 2 pos))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
136 (car pos))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
137 menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
138 (setq cmd (lookup-key menu (vector answer)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
139 (if cmd (call-interactively cmd))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
140
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
141 (defconst default-menubar
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
142 '(("File" ["New Frame" x-new-frame t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
143 ["Open File..." find-file t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
144 ["Save Buffer" save-buffer t nil]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
145 ["Save Buffer As..." write-file t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
146 ["Revert Buffer" revert-buffer t nil]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
147 "-----"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
148 ["Print Buffer" lpr-buffer t nil]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
149 "-----"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
150 ["Delete Frame" delete-frame t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
151 ;; ["Kill Buffer..." kill-buffer t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
152 ["Kill Buffer" kill-this-buffer t nil]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
153 ["Exit Emacs" save-buffers-kill-emacs t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
154 )
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
155 ("Edit" ["Undo" advertised-undo t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
156 ["Cut" x-kill-primary-selection t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
157 ["Copy" x-copy-primary-selection t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
158 ["Paste" x-yank-clipboard-selection t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
159 ["Clear" x-delete-primary-selection t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
160 )
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
161 ("Buffers" "")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
162
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
163 nil ; the partition: menus after this are flushright
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
164
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
165 ("Help" ["Info" info t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
166 ["Describe Mode" describe-mode t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
167 ["Command Apropos..." command-apropos t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
168 ["List Keybindings" describe-bindings t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
169 ["Describe Key..." describe-key t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
170 ["Describe Function..." describe-function t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
171 ["Describe Variable..." describe-variable t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
172 "-----"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
173 ["Man..." manual-entry t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
174 ["Emacs Tutorial" help-with-tutorial t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
175 ["Emacs News" view-emacs-news t]
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
176 )
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
177 ))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
178
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
179
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
180 (defun kill-this-buffer () ; for the menubar
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
181 "Kills the current buffer."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
182 (interactive)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
183 (kill-buffer (current-buffer)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
184
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
185 (defun x-new-frame (&optional frame-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
186 "Creates a new Emacs frame (that is, a new X window.)"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
187 (interactive)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
188 (select-frame (x-create-frame
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
189 (append (if frame-name
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
190 (list (cons 'name frame-name))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
191 nil)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
192 frame-default-alist)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
193 (switch-to-buffer (get-buffer-create "*scratch*"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
194 )
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
195
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
196 (defun set-menubar (menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
197 "Set the default menubar to be menubar."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
198 (setq-default current-menubar (copy-sequence menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
199 (set-menubar-dirty-flag))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
200
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
201 (defun set-buffer-menubar (menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
202 "Set the buffer-local menubar to be menubar."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
203 (make-local-variable 'current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
204 (setq current-menubar (copy-sequence menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
205 (set-menubar-dirty-flag))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
206
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
207
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
208 ;;; menu manipulation functions
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
209
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
210 (defun find-menu-item (menubar item-path-list &optional parent)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
211 "Searches MENUBAR for item given by ITEM-PATH-LIST.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
212 Returns (ITEM . PARENT), where PARENT is the immediate parent of
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
213 the item found.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
214 Signals an error if the item is not found."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
215 (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
216 (if (not (consp menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
217 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
218 (let ((rest menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
219 result)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
220 (while rest
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
221 (if (and (car rest)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
222 (equal (car item-path-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
223 (downcase (if (vectorp (car rest))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
224 (aref (car rest) 0)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
225 (if (stringp (car rest))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
226 (car rest)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
227 (car (car rest)))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
228 (setq result (car rest) rest nil)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
229 (setq rest (cdr rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
230 (if (cdr item-path-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
231 (if (consp result)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
232 (find-menu-item (cdr result) (cdr item-path-list) result)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
233 (if result
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
234 (signal 'error (list "not a submenu" result))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
235 (signal 'error (list "no such submenu" (car item-path-list)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
236 (cons result parent)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
237
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
238
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
239 (defun disable-menu-item (path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
240 "Make the named menu item be unselectable.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
241 PATH is a list of strings which identify the position of the menu item in
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
242 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
243 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
244 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
245 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
246 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
247 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
248 (menu (cdr pair)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
249 (or item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
250 (signal 'error (list (if menu "No such menu item" "No such menu")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
251 path)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
252 (if (consp item) (error "can't disable menus, only menu items"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
253 (aset item 2 nil)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
254 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
255 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
256
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
257
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
258 (defun enable-menu-item (path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
259 "Make the named menu item be selectable.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
260 PATH is a list of strings which identify the position of the menu item in
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
261 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
262 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
263 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
264 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
265 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
266 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
267 (menu (cdr pair)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
268 (or item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
269 (signal 'error (list (if menu "No such menu item" "No such menu")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
270 path)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
271 (if (consp item) (error "%S is a menu, not a menu item" path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
272 (aset item 2 t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
273 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
274 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
275
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
276
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
277 (defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
278 (if before (setq before (downcase before)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
279 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
280 (menu (condition-case ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
281 (car (find-menu-item menubar menu-path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
282 (error nil)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
283 (item (if (listp menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
284 (car (find-menu-item (cdr menu) (list item-name)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
285 (signal 'error (list "not a submenu" menu-path)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
286 (or menu
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
287 (let ((rest menu-path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
288 (so-far menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
289 (while rest
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
290 ;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
291 (setq menu
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
292 (if (eq so-far menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
293 (car (find-menu-item so-far (list (car rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
294 (car (find-menu-item (cdr so-far) (list (car rest))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
295 (or menu
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
296 (let ((rest2 so-far))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
297 (while (and (cdr rest2) (car (cdr rest2)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
298 (setq rest2 (cdr rest2)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
299 (setcdr rest2
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
300 (nconc (list (setq menu (list (car rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
301 (cdr rest2)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
302 (setq so-far menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
303 (setq rest (cdr rest)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
304 (or menu (setq menu menubar))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
305 (if item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
306 nil ; it's already there
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
307 (if item-p
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
308 (setq item (vector item-name item-data enabled-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
309 (setq item (cons item-name item-data)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
310 ;; if BEFORE is specified, try to add it there.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
311 (if before
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
312 (setq before (car (find-menu-item menu (list before)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
313 (let ((rest menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
314 (added-before nil))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
315 (while rest
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
316 (if (eq before (car (cdr rest)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
317 (progn
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
318 (setcdr rest (cons item (cdr rest)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
319 (setq rest nil added-before t))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
320 (setq rest (cdr rest))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
321 (if (not added-before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
322 ;; adding before the first item on the menubar itself is harder
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
323 (if (and (eq menu menubar) (eq before (car menu)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
324 (setq menu (cons item menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
325 current-menubar menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
326 ;; otherwise, add the item to the end.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
327 (nconc menu (list item))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
328 (if item-p
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
329 (progn
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
330 (aset item 1 item-data)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
331 (aset item 2 (not (null enabled-p))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
332 (setcar item item-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
333 (setcdr item item-data))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
334 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
335 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
336
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
337 (defun add-menu-item (menu-path item-name function enabled-p &optional before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
338 "Add a menu item to some menu, creating the menu first if necessary.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
339 If the named item exists already, it is changed.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
340 MENU-PATH identifies the menu under which the new menu item should be inserted.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
341 It is a list of strings; for example, (\"File\") names the top-level \"File\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
342 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
343 ITEM-NAME is the string naming the menu item to be added.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
344 FUNCTION is the command to invoke when this menu item is selected.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
345 If it is a symbol, then it is invoked with `call-interactively', in the same
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
346 way that functions bound to keys are invoked. If it is a list, then the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
347 list is simply evaluated.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
348 ENABLED-P controls whether the item is selectable or not.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
349 BEFORE, if provided, is the name of a menu item before which this item should
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
350 be added, if this item is not on the menu already. If the item is already
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
351 present, it will not be moved."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
352 (or menu-path (error "must specify a menu path"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
353 (or item-name (error "must specify an item name"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
354 (add-menu-item-1 t menu-path item-name function enabled-p before))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
355
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
356
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
357 (defun delete-menu-item (path)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
358 "Remove the named menu item from the menu hierarchy.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
359 PATH is a list of strings which identify the position of the menu item in
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
360 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
361 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
362 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
363 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
364 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
365 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
366 (menu (or (cdr pair) menubar)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
367 (if (not item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
368 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
369 ;; the menubar is the only special case, because other menus begin
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
370 ;; with their name.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
371 (if (eq menu current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
372 (setq current-menubar (delq item menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
373 (delq item menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
374 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
375 item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
376
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
377
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
378 (defun relabel-menu-item (path new-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
379 "Change the string of the specified menu item.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
380 PATH is a list of strings which identify the position of the menu item in
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
381 the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
382 under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
383 menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
384 NEW-NAME is the string that the menu item will be printed as from now on."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
385 (or (stringp new-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
386 (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
387 (let* ((menubar current-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
388 (pair (find-menu-item menubar path))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
389 (item (car pair))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
390 (menu (cdr pair)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
391 (or item
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
392 (signal 'error (list (if menu "No such menu item" "No such menu")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
393 path)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
394 (if (and (consp item)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
395 (stringp (car item)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
396 (setcar item new-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
397 (aset item 0 new-name))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
398 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
399 item))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
400
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
401 (defun add-menu (menu-path menu-name menu-items &optional before)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
402 "Add a menu to the menubar or one of its submenus.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
403 If the named menu exists already, it is changed.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
404 MENU-PATH identifies the menu under which the new menu should be inserted.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
405 It is a list of strings; for example, (\"File\") names the top-level \"File\"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
406 menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
407 If MENU-PATH is nil, then the menu will be added to the menubar itself.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
408 MENU-NAME is the string naming the menu to be added.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
409 MENU-ITEMS is a list of menu item descriptions.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
410 Each menu item should be a vector of three elements:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
411 - a string, the name of the menu item;
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
412 - a symbol naming a command, or a form to evaluate;
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
413 - and t or nil, whether this item is selectable.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
414 BEFORE, if provided, is the name of a menu before which this menu should
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
415 be added, if this menu is not on its parent already. If the menu is already
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
416 present, it will not be moved."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
417 (or menu-name (error "must specify a menu name"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
418 (or menu-items (error "must specify some menu items"))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
419 (add-menu-item-1 nil menu-path menu-name menu-items t before))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
420
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
421
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
422
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
423 (defvar put-buffer-names-in-file-menu t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
424
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
425 (defun sensitize-file-and-edit-menus-hook ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
426 "For use as a value of activate-menubar-hook.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
427 This function changes the sensitivity of these File and Edit menu items:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
428
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
429 Cut sensitive only when emacs owns the primary X Selection.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
430 Copy sensitive only when emacs owns the primary X Selection.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
431 Clear sensitive only when emacs owns the primary X Selection.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
432 Paste sensitive only when there is an owner for the X Clipboard Selection.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
433 Undo sensitive only when there is undo information.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
434 While in the midst of an undo, this is changed to \"Undo More\".
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
435
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
436 Kill Buffer has the name of the current buffer appended to it.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
437 Print Buffer has the name of the current buffer appended to it.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
438 Save Buffer has the name of the current buffer appended to it, and is
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
439 sensitive only when the current buffer is modified.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
440 Revert Buffer has the name of the current buffer appended to it, and is
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
441 sensitive only when the current buffer has a file.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
442 Delete Frame sensitive only when there is more than one visible frame."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
443 ;;
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
444 ;; the hair in here to not update the menubar unless something has changed
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
445 ;; isn't really necessary (the menubar code is fast enough) but it makes
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
446 ;; me feel better (and creates marginally less list garbage.)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
447 (let* ((file-menu (cdr (car (find-menu-item current-menubar '("File")))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
448 (edit-menu (cdr (car (find-menu-item current-menubar '("Edit")))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
449 (save (car (find-menu-item file-menu '("Save Buffer"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
450 (rvt (car (find-menu-item file-menu '("Revert Buffer"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
451 (del (car (find-menu-item file-menu '("Delete Frame"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
452 (print (car (find-menu-item file-menu '("Print Buffer"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
453 (kill (car (find-menu-item file-menu '("Kill Buffer"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
454 (cut (car (find-menu-item edit-menu '("Cut"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
455 (copy (car (find-menu-item edit-menu '("Copy"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
456 (paste (car (find-menu-item edit-menu '("Paste"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
457 (clear (car (find-menu-item edit-menu '("Clear"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
458 (undo (or (car (find-menu-item edit-menu '("Undo")))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
459 (car (find-menu-item edit-menu '("Undo More")))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
460 (name (buffer-name))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
461 (emacs-owns-selection-p (x-selection-owner-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
462 (clipboard-exists-p (x-selection-exists-p 'CLIPBOARD))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
463 undo-available undoing-more
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
464 (undo-info-available (not (null (and (not (eq t buffer-undo-list))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
465 (if (eq last-command 'undo)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
466 (setq undoing-more
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
467 (and (boundp 'pending-undo-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
468 pending-undo-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
469 buffer-undo-list))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
470 undo-name undo-state
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
471 (change-p
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
472 (or (and cut (not (eq emacs-owns-selection-p (aref cut 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
473 (and copy (not (eq emacs-owns-selection-p (aref copy 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
474 (and clear (not (eq emacs-owns-selection-p (aref clear 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
475 (and paste (not (eq clipboard-exists-p (aref paste 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
476 (and save (not (eq (buffer-modified-p) (aref save 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
477 (and rvt (not (eq (not (not buffer-file-name)) (aref rvt 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
478 (and del (not (eq (null (cdr (visible-frame-list))) (aref del 2))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
479 )))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
480 (if (not put-buffer-names-in-file-menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
481 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
482 (if (= (length save) 4) (progn (aset save 3 name) (setq change-p t)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
483 (if (= (length rvt) 4) (progn (aset rvt 3 name) (setq change-p t)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
484 (if (= (length print) 4) (progn (aset print 3 name) (setq change-p t)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
485 (if (= (length kill) 4) (progn (aset kill 3 name) (setq change-p t))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
486 (if save (aset save 2 (buffer-modified-p)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
487 (if rvt (aset rvt 2 (not (not buffer-file-name))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
488 (if del (aset del 2 (null (cdr (visible-frame-list)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
489 (if cut (aset cut 2 emacs-owns-selection-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
490 (if copy (aset copy 2 emacs-owns-selection-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
491 (if clear (aset clear 2 emacs-owns-selection-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
492 (if paste (aset paste 2 clipboard-exists-p))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
493
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
494 ;; we could also do this with the third field of the item.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
495 (if (eq last-command 'undo)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
496 (setq undo-name "Undo More"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
497 undo-state (not (null (and (boundp 'pending-undo-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
498 pending-undo-list))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
499 (setq undo-name "Undo"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
500 undo-state (and (not (eq buffer-undo-list t))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
501 (not (null
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
502 (or buffer-undo-list
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
503 (and (boundp 'pending-undo-list)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
504 pending-undo-list)))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
505 (if buffer-read-only (setq undo-state nil))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
506 (if (and undo
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
507 (or (not (equal undo-name (aref undo 0)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
508 (not (eq undo-state (aref undo 2)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
509 (progn (aset undo 0 undo-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
510 (aset undo 2 undo-state)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
511 (setq change-p t)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
512 ;; if we made any changes, return nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
513 ;; otherwise return t to indicate that we haven't done anything.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
514 (not change-p)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
515
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
516 ;; this version is too slow
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
517 (defun format-buffers-menu-line (buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
518 "Returns a string to represent the given buffer in the Buffer menu.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
519 nil means the buffer shouldn't be listed. You can redefine this."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
520 (if (string-match "\\` " (buffer-name buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
521 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
522 (save-excursion
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
523 (set-buffer buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
524 (let ((size (buffer-size)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
525 (format "%s%s %-19s %6s %-15s %s"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
526 (if (buffer-modified-p) "*" " ")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
527 (if buffer-read-only "%" " ")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
528 (buffer-name)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
529 size
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
530 mode-name
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
531 (or (buffer-file-name) ""))))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
532
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
533 (defun format-buffers-menu-line (buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
534 (if (string-match "\\` " (setq buffer (buffer-name buffer)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
535 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
536 buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
537
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
538 (defvar buffers-menu-max-size 10
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
539 "*Maximum number of entries which may appear on the \"Buffers\" menu.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
540 If this is 10, then only the ten most-recently-selected buffers will be
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
541 shown. If this is nil, then all buffers will be shown. Setting this to
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
542 a large number or nil will slow down menu responsiveness.")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
543
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
544 (defvar complex-buffers-menu-p nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
545 "*If true, the buffers menu will contain several commands, as submenus
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
546 of each buffer line. If this is false, then there will be only one command:
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
547 select that buffer.")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
548
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
549 (defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
550 "*The function to call to select a buffer from the buffers menu.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
551 `switch-to-buffer' is a good choice, as is `pop-to-buffer'.")
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
552
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
553
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
554 (defun buffer-menu-save-buffer (buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
555 (save-excursion
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
556 (set-buffer buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
557 (save-buffer)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
558
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
559 (defun buffer-menu-write-file (buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
560 (save-excursion
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
561 (set-buffer buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
562 (write-file (read-file-name
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
563 (concat "Write " (buffer-name (current-buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
564 " to file: ")))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
565
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
566
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
567 (defsubst build-buffers-menu-internal (buffers)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
568 (let (name line)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
569 (mapcar
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
570 (if complex-buffers-menu-p
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
571 (function
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
572 (lambda (buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
573 (if (setq line (format-buffers-menu-line buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
574 (list line
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
575 (vector "Switch to Buffer"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
576 (list buffers-menu-switch-to-buffer-function
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
577 (setq name (buffer-name buffer)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
578 t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
579 (if (and (buffer-modified-p buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
580 (buffer-file-name buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
581 (vector "Save Buffer"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
582 (list 'buffer-menu-save-buffer name) t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
583 ["Save Buffer" nil nil])
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
584 (vector "Save Buffer As..."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
585 (list 'buffer-menu-write-file name) t)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
586 (vector "Kill Buffer" (list 'kill-buffer name) t)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
587 (function (lambda (buffer)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
588 (if (setq line (format-buffers-menu-line buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
589 (vector line
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
590 (list buffers-menu-switch-to-buffer-function
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
591 (buffer-name buffer))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
592 t)))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
593 buffers)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
594
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
595 (defun build-buffers-menu-hook ()
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
596 "For use as a value of activate-menubar-hook.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
597 This function changes the contents of the \"Buffers\" menu to correspond
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
598 to the current set of buffers. Only the most-recently-used few buffers
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
599 will be listed on the menu, for efficiency reasons. You can control how
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
600 many buffers will be shown by setting `buffers-menu-max-size'.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
601 You can control the text of the menu items by redefining the function
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
602 `format-buffers-menu-line'."
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
603 (let ((buffer-menu (car (find-menu-item current-menubar '("Buffers"))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
604 name
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
605 buffers)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
606 (if (not buffer-menu)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
607 nil
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
608 (setq buffers (buffer-list))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
609
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
610 (if (and (integerp buffers-menu-max-size)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
611 (> buffers-menu-max-size 1))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
612 (if (> (length buffers) buffers-menu-max-size)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
613 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
614
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
615 (setq buffers (build-buffers-menu-internal buffers))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
616 (setq buffers (nconc (delq nil buffers)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
617 '("----" ["List All Buffers" list-buffers t])))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
618 ;; slightly (only slightly) more efficient to not install the menubar
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
619 ;; if it hasn't visibly changed.
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
620 (if (equal buffers (cdr buffer-menu))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
621 t ; return t meaning "no change"
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
622 (setcdr buffer-menu buffers)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
623 (set-menubar-dirty-flag)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
624 nil))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
625
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
626 (add-hook 'activate-menubar-hook 'build-buffers-menu-hook)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
627 (add-hook 'activate-menubar-hook 'sensitize-file-and-edit-menus-hook)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
628
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
629 (let ((frames (frame-list)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
630 (while frames
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
631 (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
632 (setq frames (cdr frames))))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
633 (or (assq 'menu-bar-lines default-frame-alist)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
634 (setq default-frame-alist
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
635 (cons '(menu-bar-lines . 1) default-frame-alist)))
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
636
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
637 (set-menubar default-menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
638
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
639 (provide 'menubar)
1c7ad2a0f4d9 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
640
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2231
diff changeset
641 ;;; lmenu.el ends here