(init_casetab_once): Initialize the purpose slot.
[bpt/emacs.git] / lisp / menu-bar.el
CommitLineData
235aa29b
ER
1;;; menu-bar.el --- define a default menu bar.
2
b578f267
EN
3;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
4
235aa29b 5;; Author: RMS
b7f66977 6;; Keywords: internal
235aa29b 7
1db87953
RS
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
b578f267
EN
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
1db87953 24
260130bb
KH
25;; Avishai Yacobi suggested some menu rearrangements.
26
b578f267
EN
27;;; Code:
28
d537086b
RS
29;;; User options:
30
31(defvar buffers-menu-max-size 10
32 "*Maximum number of entries which may appear on the Buffers menu.
33If this is 10, then only the ten most-recently-selected buffers are shown.
34If this is nil, then all buffers are shown.
35A large number or nil slows down menu responsiveness.")
36
b132f2b1
RM
37;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
38;; definitions made in loaddefs.el.
39(or (lookup-key global-map [menu-bar])
40 (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
22390f50 41(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
ffbdd83d
RS
42
43;; Force Help item to come last, after the major mode's own items.
0d31efcd
KH
44;; The symbol used to be called `help', but that gets confused with the
45;; help key.
46(setq menu-bar-final-items '(help-menu))
ffbdd83d 47
0d31efcd 48(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu))
ffbdd83d
RS
49(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
50(define-key global-map [menu-bar search] (cons "Search" menu-bar-search-menu))
22390f50 51(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
40954111 52(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
ffbdd83d
RS
53(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
54(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
55(defvar menu-bar-files-menu (make-sparse-keymap "Files"))
56(define-key global-map [menu-bar files] (cons "Files" menu-bar-files-menu))
1b009b97
RS
57
58;; This alias is for compatibility with 19.28 and before.
59(defvar menu-bar-file-menu menu-bar-files-menu)
9bb8e471 60\f
9dcdc43d
RS
61(defvar vc-menu-map (make-sparse-keymap "Version Control"))
62
147f1d2a
RS
63(define-key menu-bar-tools-menu [gdb] '("Debugger..." . gdb))
64(define-key menu-bar-tools-menu [compile] '("Compile..." . compile))
65(define-key menu-bar-tools-menu [grep] '("Search Files..." . grep))
66
67(define-key menu-bar-tools-menu [separator-1]
68 '("--"))
69
e1726722 70(define-key menu-bar-tools-menu [calendar] '("Display Calendar" . calendar))
c0965058 71(define-key menu-bar-tools-menu [compose-mail] '("Send Mail" . compose-mail))
ffbdd83d 72(define-key menu-bar-tools-menu [rmail] '("Read Mail" . rmail))
96a699d0 73(define-key menu-bar-tools-menu [gnus] '("Read Net News" . gnus))
ffbdd83d
RS
74
75(define-key menu-bar-tools-menu [separator-vc]
76 '("--"))
77
fe74180c 78(define-key menu-bar-tools-menu [vc]
ffbdd83d 79 (cons "Version Control" vc-menu-map))
9bb8e471 80
ffbdd83d 81(define-key menu-bar-tools-menu [separator-compare]
9bb8e471
RS
82 '("--"))
83
ffbdd83d 84(define-key menu-bar-tools-menu [epatch]
080ac1ac 85 '("Apply Patch" . menu-bar-epatch-menu))
ffbdd83d 86(define-key menu-bar-tools-menu [ediff-merge]
5438ecd3 87 '("Merge" . menu-bar-ediff-merge-menu))
57eed34a 88(define-key menu-bar-tools-menu [compare]
40a8cde1 89 '("Compare" . menu-bar-ediff-menu))
9bb8e471 90
ffbdd83d 91(define-key menu-bar-tools-menu [separator-print]
9bb8e471
RS
92 '("--"))
93
ffbdd83d
RS
94(put 'print-region 'menu-enable 'mark-active)
95(put 'ps-print-region-with-faces 'menu-enable 'mark-active)
96
97(define-key menu-bar-tools-menu [ps-print-region]
98 '("Postscript Print Region" . ps-print-region-with-faces))
99(define-key menu-bar-tools-menu [ps-print-buffer]
100 '("Postscript Print Buffer" . ps-print-buffer-with-faces))
101(define-key menu-bar-tools-menu [print-region]
102 '("Print Region" . print-region))
103(define-key menu-bar-tools-menu [print-buffer]
104 '("Print Buffer" . print-buffer))
105\f
106(define-key menu-bar-files-menu [exit-emacs]
107 '("Exit Emacs" . save-buffers-kill-emacs))
108
109(define-key menu-bar-files-menu [separator-exit]
110 '("--"))
111
112(define-key menu-bar-files-menu [one-window]
113 '("One Window" . delete-other-windows))
114
115(define-key menu-bar-files-menu [split-window]
116 '("Split Window" . split-window-vertically))
9bb8e471 117
ca1a9692
RS
118(if (fboundp 'delete-frame)
119 (progn
a4e4b916
RS
120 ;; Don't use delete-frame as event name
121 ;; because that is a special event.
122 (define-key menu-bar-files-menu [delete-this-frame]
ca1a9692 123 '("Delete Frame" . delete-frame))
ffbdd83d
RS
124 (define-key menu-bar-files-menu [make-frame-on-display]
125 '("Open New Display..." . make-frame-on-display))
126 (define-key menu-bar-files-menu [make-frame]
ca1a9692 127 '("Make New Frame" . make-frame))))
9bb8e471 128
ffbdd83d 129(define-key menu-bar-files-menu [separator-buffers]
9bb8e471
RS
130 '("--"))
131
ffbdd83d
RS
132(define-key menu-bar-files-menu [kill-buffer]
133 '("Kill Current Buffer" . kill-this-buffer))
134(define-key menu-bar-files-menu [insert-file]
1f50590a 135 '("Insert File..." . insert-file))
ffbdd83d 136(define-key menu-bar-files-menu [revert-buffer]
2f1139a4 137 '("Revert Buffer" . revert-buffer))
ffbdd83d 138(define-key menu-bar-files-menu [write-file]
2f1139a4 139 '("Save Buffer As..." . write-file))
ffbdd83d
RS
140(define-key menu-bar-files-menu [save-buffer] '("Save Buffer" . save-buffer))
141(define-key menu-bar-files-menu [dired] '("Open Directory..." . dired))
142(define-key menu-bar-files-menu [open-file] '("Open File..." . find-file))
40a8cde1 143
9bb8e471 144\f
ffbdd83d
RS
145(defun nonincremental-search-forward (string)
146 "Read a string and search for it nonincrementally."
147 (interactive "sSearch for string: ")
148 (if (equal string "")
149 (search-forward (car search-ring))
150 (isearch-update-ring string nil)
151 (search-forward string)))
152
153(defun nonincremental-search-backward (string)
154 "Read a string and search backward for it nonincrementally."
155 (interactive "sSearch for string: ")
156 (if (equal string "")
157 (search-backward (car search-ring))
158 (isearch-update-ring string nil)
159 (search-backward string)))
160
161(defun nonincremental-re-search-forward (string)
162 "Read a regular expression and search for it nonincrementally."
163 (interactive "sSearch for regexp: ")
164 (if (equal string "")
165 (re-search-forward (car regexp-search-ring))
166 (isearch-update-ring string t)
167 (re-search-forward string)))
168
169(defun nonincremental-re-search-backward (string)
170 "Read a regular expression and search backward for it nonincrementally."
171 (interactive "sSearch for regexp: ")
172 (if (equal string "")
173 (re-search-backward (car regexp-search-ring))
174 (isearch-update-ring string t)
175 (re-search-backward string)))
176
1f50590a 177(defun nonincremental-repeat-search-forward ()
ffbdd83d
RS
178 "Search forward for the previous search string."
179 (interactive)
180 (search-forward (car search-ring)))
181
1f50590a 182(defun nonincremental-repeat-search-backward ()
ffbdd83d
RS
183 "Search backward for the previous search string."
184 (interactive)
185 (search-backward (car search-ring)))
186
1f50590a 187(defun nonincremental-repeat-re-search-forward ()
ffbdd83d
RS
188 "Search forward for the previous regular expression."
189 (interactive)
190 (re-search-forward (car regexp-search-ring)))
191
1f50590a 192(defun nonincremental-repeat-re-search-backward ()
ffbdd83d
RS
193 "Search backward for the previous regular expression."
194 (interactive)
195 (re-search-backward (car regexp-search-ring)))
196
1f50590a
RS
197(define-key menu-bar-search-menu [query-replace-regexp]
198 '("Query Replace Regexp..." . query-replace-regexp))
ffbdd83d 199(define-key menu-bar-search-menu [query-replace]
1f50590a 200 '("Query Replace..." . query-replace))
ffbdd83d 201(define-key menu-bar-search-menu [find-tag]
1f50590a 202 '("Find Tag..." . find-tag))
ffbdd83d
RS
203(define-key menu-bar-search-menu [bookmark]
204 '("Bookmarks" . menu-bar-bookmark-map))
205
206(define-key menu-bar-search-menu [separator-search]
207 '("--"))
208
fe74180c 209(define-key menu-bar-search-menu [repeat-regexp-back]
ffbdd83d 210 '("Repeat Regexp Backwards" . nonincremental-repeat-re-search-backward))
fe74180c 211(define-key menu-bar-search-menu [repeat-search-back]
ffbdd83d 212 '("Repeat Backwards" . nonincremental-repeat-search-backward))
fe74180c 213(define-key menu-bar-search-menu [repeat-regexp-fwd]
ffbdd83d 214 '("Repeat Regexp" . nonincremental-repeat-re-search-forward))
fe74180c 215(define-key menu-bar-search-menu [repeat-search-fwd]
ffbdd83d
RS
216 '("Repeat Search" . nonincremental-repeat-search-forward))
217
218(define-key menu-bar-search-menu [separator-repeat]
9bb8e471
RS
219 '("--"))
220
fe74180c 221(define-key menu-bar-search-menu [re-search-backward]
1f50590a 222 '("Regexp Search Backwards..." . nonincremental-re-search-backward))
fe74180c 223(define-key menu-bar-search-menu [search-backward]
1f50590a 224 '("Search Backwards..." . nonincremental-search-backward))
fe74180c 225(define-key menu-bar-search-menu [re-search-forward]
1f50590a 226 '("Regexp Search..." . nonincremental-re-search-forward))
fe74180c 227(define-key menu-bar-search-menu [search-forward]
1f50590a 228 '("Search..." . nonincremental-search-forward))
ffbdd83d 229\f
5b42ec2b
RS
230(if (fboundp 'start-process)
231 (define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map)))
9bb8e471 232(define-key menu-bar-edit-menu [fill] '("Fill" . fill-region))
6507ffb1 233(define-key menu-bar-edit-menu [props] '("Text Properties" . facemenu-menu))
9bb8e471
RS
234
235(define-key menu-bar-edit-menu [separator-edit]
236 '("--"))
237
238(define-key menu-bar-edit-menu [clear] '("Clear" . delete-region))
3dd92899 239
e1726722 240(define-key menu-bar-edit-menu [paste] '("Paste Most Recent" . yank))
3dd92899
KH
241
242(defvar yank-menu (cons "Select Yank" nil))
243(fset 'yank-menu (cons 'keymap yank-menu))
244(define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu))
4c0317b1 245(define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save))
057d49d1
RS
246(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
247(define-key menu-bar-edit-menu [undo] '("Undo" . undo))
248
4c0317b1
RS
249(defun menu-bar-kill-ring-save (beg end)
250 (interactive "r")
251 (if (mouse-region-match)
252 (message "Select a region with the mouse does `copy' automatically")
253 (kill-ring-save beg end)))
254
25b048ee
RS
255(put 'fill-region 'menu-enable '(and mark-active (not buffer-read-only)))
256(put 'kill-region 'menu-enable '(and mark-active (not buffer-read-only)))
4c0317b1 257(put 'menu-bar-kill-ring-save 'menu-enable 'mark-active)
25b048ee
RS
258(put 'yank 'menu-enable '(and (x-selection-exists-p) (not buffer-read-only)))
259(put 'yank-menu 'menu-enable '(and (cdr yank-menu) (not buffer-read-only)))
4c0317b1 260(put 'delete-region 'menu-enable '(and mark-active
25b048ee 261 (not buffer-read-only)
4c0317b1 262 (not (mouse-region-match))))
25b048ee
RS
263(put 'undo 'menu-enable '(and (not buffer-read-only)
264 (if (eq last-command 'undo)
265 pending-undo-list
266 (consp buffer-undo-list))))
3a841b0b 267(put 'query-replace 'menu-enable '(not buffer-read-only))
25b048ee 268(put 'query-replace-regexp 'menu-enable '(not buffer-read-only))
db774a16 269
9e18f0a0
RS
270(autoload 'ispell-menu-map "ispell" nil t 'keymap)
271
f9cf0be2 272;; These are alternative definitions for the cut, paste and copy
4c0317b1 273;; menu items. Use them if your system expects these to use the clipboard.
f9cf0be2 274
f9cf0be2
RS
275(put 'clipboard-kill-region 'menu-enable 'mark-active)
276(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
277(put 'clipboard-yank 'menu-enable
278 '(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))
279
280(defun clipboard-yank ()
281 "Reinsert the last stretch of killed text, or the clipboard contents."
282 (interactive)
283 (let ((x-select-enable-clipboard t))
284 (yank)))
285
286(defun clipboard-kill-ring-save (beg end)
287 "Copy region to kill ring, and save in the X clipboard."
288 (interactive "r")
289 (let ((x-select-enable-clipboard t))
290 (kill-ring-save beg end)))
291
292(defun clipboard-kill-region (beg end)
293 "Kill the region, and save it in the X clipboard."
294 (interactive "r")
295 (let ((x-select-enable-clipboard t))
296 (kill-region beg end)))
297
298(defun menu-bar-enable-clipboard ()
5cbdeb30
RS
299 "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
300Do the same for the keys of the same name."
f9cf0be2 301 (interactive)
5754d7f2
RS
302 ;; We can't use constant list structure here because it becomes pure,
303 ;; and because it gets modified with cache data.
304 (define-key menu-bar-edit-menu [paste]
305 (cons "Paste" 'clipboard-yank))
306 (define-key menu-bar-edit-menu [copy]
307 (cons "Copy" 'clipboard-kill-ring-save))
308 (define-key menu-bar-edit-menu [cut]
5cbdeb30
RS
309 (cons "Cut" 'clipboard-kill-region))
310
311 (define-key global-map [f20] 'clipboard-kill-region)
312 (define-key global-map [f16] 'clipboard-kill-ring-save)
313 (define-key global-map [f18] 'clipboard-yank)
314 ;; X11R6 versions
315 (define-key global-map [cut] 'clipboard-kill-region)
316 (define-key global-map [copy] 'clipboard-kill-ring-save)
317 (define-key global-map [paste] 'clipboard-yank))
f9cf0be2 318\f
efb166ff
RS
319(define-key menu-bar-help-menu [emacs-version]
320 '("Show Version" . emacs-version))
48433a65 321(define-key menu-bar-help-menu [report-emacs-bug]
1c6e18f6 322 '("Send Bug Report..." . report-emacs-bug))
260130bb
KH
323(define-key menu-bar-help-menu [finder-by-keyword]
324 '("Find Lisp Packages..." . finder-by-keyword))
ca9b40a1 325(define-key menu-bar-help-menu [emacs-tutorial]
db774a16 326 '("Emacs Tutorial" . help-with-tutorial))
260130bb
KH
327(define-key menu-bar-help-menu [man]
328 '("Man..." . manual-entry))
2f1139a4
RS
329(define-key menu-bar-help-menu [describe-variable]
330 '("Describe Variable..." . describe-variable))
331(define-key menu-bar-help-menu [describe-function]
332 '("Describe Function..." . describe-function))
333(define-key menu-bar-help-menu [describe-key]
334 '("Describe Key..." . describe-key))
335(define-key menu-bar-help-menu [list-keybindings]
336 '("List Keybindings" . describe-bindings))
337(define-key menu-bar-help-menu [command-apropos]
338 '("Command Apropos..." . command-apropos))
339(define-key menu-bar-help-menu [describe-mode]
340 '("Describe Mode" . describe-mode))
e1726722 341(define-key menu-bar-help-menu [info] '("Browse Manuals" . info))
889560ed 342(define-key menu-bar-help-menu [emacs-faq] '("Emacs FAQ" . view-emacs-FAQ))
2f1139a4 343(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
889560ed 344
db774a16
RS
345(defun kill-this-buffer () ; for the menubar
346 "Kills the current buffer."
347 (interactive)
348 (kill-buffer (current-buffer)))
349
2f1139a4
RS
350(defun kill-this-buffer-enabled-p ()
351 (let ((count 0)
352 (buffers (buffer-list)))
353 (while buffers
354 (or (string-match "^ " (buffer-name (car buffers)))
355 (setq count (1+ count)))
356 (setq buffers (cdr buffers)))
a6f8cbf1 357 (and (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))
1f50590a
RS
358 (> count 1))))
359
360(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
361
362(put 'save-buffer 'menu-enable
363 '(and (buffer-modified-p)
a6f8cbf1 364 (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))))
1f50590a
RS
365
366(put 'write-file 'menu-enable
a6f8cbf1 367 '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
1f50590a
RS
368
369(put 'find-file 'menu-enable
a6f8cbf1 370 '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
1f50590a
RS
371
372(put 'dired 'menu-enable
a6f8cbf1 373 '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
1f50590a
RS
374
375(put 'insert-file 'menu-enable
a6f8cbf1 376 '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
2f1139a4 377
da183f87
RS
378(put 'revert-buffer 'menu-enable
379 '(or revert-buffer-function revert-buffer-insert-file-contents-function
380 (and (buffer-file-name)
660fa562
RM
381 (or (buffer-modified-p)
382 (not (verify-visited-file-modtime (current-buffer)))))))
82a74107 383
a0213a97
RS
384;; Permit deleting frame if it would leave a visible or iconified frame.
385(put 'delete-frame 'menu-enable
82a74107
KH
386 '(delete-frame-enabled-p))
387
388(defun delete-frame-enabled-p ()
389 "Return non-nil if `delete-frame' should be enabled in the menu bar."
390 (let ((frames (frame-list))
27aa8132
RS
391 (count 0))
392 (while frames
393 (if (frame-visible-p (car frames))
394 (setq count (1+ count)))
395 (setq frames (cdr frames)))
396 (> count 1)))
2f1139a4 397
db774a16
RS
398(put 'advertised-undo 'menu-enable
399 '(and (not (eq t buffer-undo-list))
400 (if (eq last-command 'undo)
2f1139a4
RS
401 (and (boundp 'pending-undo-list)
402 pending-undo-list)
403 buffer-undo-list)))
2877eac2 404
c3e1d435 405(defvar yank-menu-length 20
3dd92899
KH
406 "*Maximum length to display in the yank-menu.")
407
408(defun menu-bar-update-yank-menu (string old)
409 (let ((front (car (cdr yank-menu)))
410 (menu-string (if (<= (length string) yank-menu-length)
411 string
c3e1d435
RS
412 (concat
413 (substring string 0 (/ yank-menu-length 2))
414 "..."
415 (substring string (- (/ yank-menu-length 2)))))))
7c70a955
RS
416 ;; Don't let the menu string be all dashes
417 ;; because that has a special meaning in a menu.
418 (if (string-match "\\`-+\\'" menu-string)
419 (setq menu-string (concat menu-string " ")))
3dd92899
KH
420 ;; If we're supposed to be extending an existing string, and that
421 ;; string really is at the front of the menu, then update it in place.
422 (if (and old (or (eq old (car front))
423 (string= old (car front))))
dfabc98f 424 (progn
3dd92899
KH
425 (setcar front string)
426 (setcar (cdr front) menu-string))
427 (setcdr yank-menu
428 (cons
429 (cons string (cons menu-string 'menu-bar-select-yank))
430 (cdr yank-menu)))))
431 (if (> (length (cdr yank-menu)) kill-ring-max)
432 (setcdr (nthcdr kill-ring-max yank-menu) nil)))
433
434(defun menu-bar-select-yank ()
435 (interactive "*")
436 (push-mark (point))
437 (insert last-command-event))
40954111 438\f
3f557298
RS
439;; This definition is just to show what this looks like.
440;; It gets overridden below when menu-bar-update-buffers is called.
441(define-key global-map [menu-bar buffer]
442 (cons "Buffers" (make-sparse-keymap "Buffers")))
40954111 443
d0690d12
RS
444(defvar list-buffers-directory nil)
445
08e8171f
RS
446(defvar menu-bar-update-buffers-maxbuf)
447
09642d97
RS
448(defun menu-bar-select-buffer ()
449 (interactive)
450 (switch-to-buffer last-command-event))
451
452(defun menu-bar-select-frame ()
453 (interactive)
454 (make-frame-visible last-command-event)
455 (raise-frame last-command-event)
456 (select-frame last-command-event))
457
c171b42f
RS
458(defun menu-bar-update-buffers-1 (elt)
459 (cons (format
08e8171f 460 (format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf)
c171b42f
RS
461 (cdr elt)
462 (if (buffer-modified-p (car elt))
463 "*" " ")
464 (save-excursion
465 (set-buffer (car elt))
466 (if buffer-read-only "%" " "))
467 (let ((file
468 (or (buffer-file-name (car elt))
469 (save-excursion
470 (set-buffer (car elt))
471 list-buffers-directory)
472 "")))
473 (setq file (or (file-name-directory file)
474 ""))
475 (if (> (length file) 20)
476 (setq file (concat "..." (substring file -17))))
477 file))
478 (car elt)))
479
06ff7539
RS
480(defvar menu-bar-buffers-menu-list-buffers-entry nil)
481
09642d97 482(defun menu-bar-update-buffers ()
29397c58 483 ;; If user discards the Buffers item, play along.
4d587a6c 484 (and (lookup-key (current-global-map) [menu-bar buffer])
29397c58
RS
485 (frame-or-buffer-changed-p)
486 (let ((buffers (buffer-list))
487 (frames (frame-list))
b3398af1 488 (maxlen 0)
29397c58
RS
489 buffers-menu frames-menu)
490 ;; If requested, list only the N most recently selected buffers.
491 (if (and (integerp buffers-menu-max-size)
492 (> buffers-menu-max-size 1))
493 (if (> (length buffers) buffers-menu-max-size)
494 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
495
496 ;; Make the menu of buffers proper.
497 (setq buffers-menu
498 (cons "Select Buffer"
c171b42f
RS
499 (let* ((buffer-list
500 (mapcar 'list buffers))
501 tail
08e8171f 502 (menu-bar-update-buffers-maxbuf 0)
c171b42f
RS
503 alist
504 head)
505 ;; Put into each element of buffer-list
506 ;; the name for actual display,
507 ;; perhaps truncated in the middle.
508 (setq tail buffer-list)
509 (while tail
510 (let ((name (buffer-name (car (car tail)))))
511 (setcdr (car tail)
512 (if (> (length name) 27)
513 (concat (substring name 0 12)
514 "..."
515 (substring name -12))
516 name)))
517 (setq tail (cdr tail)))
518 ;; Compute the maximum length of any name.
519 (setq tail buffer-list)
29397c58 520 (while tail
c171b42f 521 (or (eq ?\ (aref (cdr (car tail)) 0))
08e8171f
RS
522 (setq menu-bar-update-buffers-maxbuf
523 (max menu-bar-update-buffers-maxbuf
c171b42f 524 (length (cdr (car tail))))))
29397c58 525 (setq tail (cdr tail)))
c171b42f
RS
526 ;; Set ALIST to an alist of the form
527 ;; ITEM-STRING . BUFFER
528 (setq tail buffer-list)
29397c58
RS
529 (while tail
530 (let ((elt (car tail)))
c171b42f 531 (or (eq ?\ (aref (cdr elt) 0))
29397c58 532 (setq alist (cons
c171b42f 533 (menu-bar-update-buffers-1 elt)
29397c58
RS
534 alist)))
535 (and alist (> (length (car (car alist))) maxlen)
536 (setq maxlen (length (car (car alist))))))
537 (setq tail (cdr tail)))
538 (setq alist (nreverse alist))
06ff7539
RS
539 ;; Make the menu item for list-buffers
540 ;; or reuse the one we already have.
541 ;; The advantage in reusing one
542 ;; is that it already has the keyboard equivalent
543 ;; cached, so we save the time to look that up again.
544 (or menu-bar-buffers-menu-list-buffers-entry
545 (setq menu-bar-buffers-menu-list-buffers-entry
546 (cons
547 'list-buffers
548 (cons
549 ""
550 'list-buffers))))
551 ;; Update the item string for menu's new width.
552 (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)
553 (concat (make-string (max (- (/ maxlen 2) 8) 0)
554 ?\ )
555 "List All Buffers"))
556 ;; Now make the actual list of items,
557 ;; ending with the list-buffers item.
29397c58
RS
558 (nconc (mapcar '(lambda (pair)
559 ;; This is somewhat risque, to use
560 ;; the buffer name itself as the event
561 ;; type to define, but it works.
562 ;; It would not work to use the buffer
563 ;; since a buffer as an event has its
564 ;; own meaning.
565 (nconc (list (buffer-name (cdr pair))
566 (car pair)
567 (cons nil nil))
568 'menu-bar-select-buffer))
569 alist)
06ff7539 570 (list menu-bar-buffers-menu-list-buffers-entry)))))
29397c58
RS
571
572
573 ;; Make a Frames menu if we have more than one frame.
574 (if (cdr frames)
b3398af1
RS
575 (let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0)
576 ?\ )
577 "Frames"))
578 (frames-menu
579 (cons 'keymap
580 (cons "Select Frame"
581 (mapcar '(lambda (frame)
582 (nconc (list frame
583 (cdr (assq 'name
584 (frame-parameters frame)))
585 (cons nil nil))
586 'menu-bar-select-frame))
587 frames)))))
588 ;; Put it underneath the Buffers menu.
589 (setq buffers-menu (cons (cons 'frames (cons name frames-menu))
590 buffers-menu))))
29397c58
RS
591 (if buffers-menu
592 (setq buffers-menu (cons 'keymap buffers-menu)))
4d587a6c 593 (define-key (current-global-map) [menu-bar buffer]
b3398af1 594 (cons "Buffers" buffers-menu)))))
09642d97
RS
595
596(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4 597
3f557298
RS
598(menu-bar-update-buffers)
599
40954111
RS
600;; this version is too slow
601;;;(defun format-buffers-menu-line (buffer)
602;;; "Returns a string to represent the given buffer in the Buffer menu.
603;;;nil means the buffer shouldn't be listed. You can redefine this."
604;;; (if (string-match "\\` " (buffer-name buffer))
605;;; nil
606;;; (save-excursion
607;;; (set-buffer buffer)
608;;; (let ((size (buffer-size)))
609;;; (format "%s%s %-19s %6s %-15s %s"
610;;; (if (buffer-modified-p) "*" " ")
611;;; (if buffer-read-only "%" " ")
612;;; (buffer-name)
613;;; size
614;;; mode-name
615;;; (or (buffer-file-name) ""))))))
616\f
25b048ee
RS
617;;; Set up a menu bar menu for the minibuffer.
618
619(mapcar
620 (function
621 (lambda (map)
622 (define-key map [menu-bar minibuf]
623 (cons "Minibuf" (make-sparse-keymap "Minibuf")))))
624 (list minibuffer-local-ns-map
625 minibuffer-local-must-match-map
626 minibuffer-local-isearch-map
627 minibuffer-local-map
628 minibuffer-local-completion-map))
629
630(mapcar
631 (function
632 (lambda (map)
633 (define-key map [menu-bar minibuf ?\?]
634 '("List Completions" . minibuffer-completion-help))
635 (define-key map [menu-bar minibuf space]
636 '("Complete Word" . minibuffer-complete-word))
637 (define-key map [menu-bar minibuf tab]
4e9d1906 638 '("Complete" . minibuffer-complete))
25b048ee
RS
639 ))
640 (list minibuffer-local-must-match-map
641 minibuffer-local-completion-map))
642
643(mapcar
644 (function
645 (lambda (map)
646 (define-key map [menu-bar minibuf quit]
647 '("Quit" . keyboard-escape-quit))
648 (define-key map [menu-bar minibuf return]
649 '("Enter" . exit-minibuffer))
650 ))
651 (list minibuffer-local-ns-map
652 minibuffer-local-must-match-map
653 minibuffer-local-isearch-map
654 minibuffer-local-map
655 minibuffer-local-completion-map))
656\f
7b7d6615
RS
657(defvar menu-bar-mode nil)
658
057d49d1 659(defun menu-bar-mode (flag)
dfd29450 660 "Toggle display of a menu bar on each frame.
057d49d1
RS
661This command applies to all frames that exist and frames to be
662created in the future.
663With a numeric argument, if the argument is negative,
dfd29450 664turn off menu bars; otherwise, turn on menu bars."
dad8e392 665 (interactive "P")
dad8e392 666
7b7d6615
RS
667 ;; Make menu-bar-mode and default-frame-alist consistent.
668 (let ((default (assq 'menu-bar-lines default-frame-alist)))
669 (if default
670 (setq menu-bar-mode (not (eq (cdr default) 0)))
671 (setq default-frame-alist
672 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
673 default-frame-alist))))
674
675 ;; Toggle or set the mode, according to FLAG.
676 (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
677 (> (prefix-numeric-value flag) 0)))
678
679 ;; Apply it to default-frame-alist.
680 (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
681 (if (consp parameter)
682 (setcdr parameter (if menu-bar-mode 1 0))
683 (setq default-frame-alist
684 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
685 default-frame-alist))))
686
687 ;; Apply it to existing frames.
688 (let ((frames (frame-list)))
689 (while frames
690 (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
691 (modify-frame-parameters (car frames)
692 (list (cons 'menu-bar-lines
693 (if menu-bar-mode 1 0))))
694 (modify-frame-parameters (car frames)
695 (list (cons 'height height))))
696 (setq frames (cdr frames)))))
1db87953 697
bffa5d4d
RS
698(provide 'menu-bar)
699
235aa29b 700;;; menu-bar.el ends here