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