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