Line data Source code
1 : ;;; menu-bar.el --- define a default menu bar
2 :
3 : ;; Copyright (C) 1993-1995, 2000-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Richard M. Stallman
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: internal, mouse
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;; Avishai Yacobi suggested some menu rearrangements.
26 :
27 : ;;; Commentary:
28 :
29 : ;;; Code:
30 :
31 : ;; This is referenced by some code below; it is defined in uniquify.el
32 : (defvar uniquify-buffer-name-style)
33 :
34 : ;; From emulation/cua-base.el; used below
35 : (defvar cua-enable-cua-keys)
36 :
37 :
38 : ;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
39 : ;; definitions made in loaddefs.el.
40 : (or (lookup-key global-map [menu-bar])
41 : (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
42 :
43 : ;; Force Help item to come last, after the major mode's own items.
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))
47 :
48 : ;; This definition is just to show what this looks like.
49 : ;; It gets modified in place when menu-bar-update-buffers is called.
50 : (defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
51 :
52 : ;; Only declared obsolete (and only made a proper alias) in 23.3.
53 : (define-obsolete-variable-alias
54 : 'menu-bar-files-menu 'menu-bar-file-menu "22.1")
55 : (defvar menu-bar-file-menu
56 : (let ((menu (make-sparse-keymap "File")))
57 :
58 : ;; The "File" menu items
59 : (bindings--define-key menu [exit-emacs]
60 : '(menu-item "Quit" save-buffers-kill-terminal
61 : :help "Save unsaved buffers, then exit"))
62 :
63 : (bindings--define-key menu [separator-exit]
64 : menu-bar-separator)
65 :
66 : ;; Don't use delete-frame as event name because that is a special
67 : ;; event.
68 : (bindings--define-key menu [delete-this-frame]
69 : '(menu-item "Delete Frame" delete-frame
70 : :visible (fboundp 'delete-frame)
71 : :enable (delete-frame-enabled-p)
72 : :help "Delete currently selected frame"))
73 : (bindings--define-key menu [make-frame-on-display]
74 : '(menu-item "New Frame on Display..." make-frame-on-display
75 : :visible (fboundp 'make-frame-on-display)
76 : :help "Open a new frame on another display"))
77 : (bindings--define-key menu [make-frame]
78 : '(menu-item "New Frame" make-frame-command
79 : :visible (fboundp 'make-frame-command)
80 : :help "Open a new frame"))
81 :
82 : (bindings--define-key menu [separator-frame]
83 : menu-bar-separator)
84 :
85 : (bindings--define-key menu [one-window]
86 : '(menu-item "Remove Other Windows" delete-other-windows
87 : :enable (not (one-window-p t nil))
88 : :help "Make selected window fill whole frame"))
89 :
90 : (bindings--define-key menu [new-window-on-right]
91 : '(menu-item "New Window on Right" split-window-right
92 : :enable (and (menu-bar-menu-frame-live-and-visible-p)
93 : (menu-bar-non-minibuffer-window-p))
94 : :help "Make new window on right of selected one"))
95 :
96 : (bindings--define-key menu [new-window-below]
97 : '(menu-item "New Window Below" split-window-below
98 : :enable (and (menu-bar-menu-frame-live-and-visible-p)
99 : (menu-bar-non-minibuffer-window-p))
100 : :help "Make new window below selected one"))
101 :
102 : (bindings--define-key menu [separator-window]
103 : menu-bar-separator)
104 :
105 : (bindings--define-key menu [ps-print-region]
106 : '(menu-item "PostScript Print Region (B+W)" ps-print-region
107 : :enable mark-active
108 : :help "Pretty-print marked region in black and white to PostScript printer"))
109 : (bindings--define-key menu [ps-print-buffer]
110 : '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer
111 : :enable (menu-bar-menu-frame-live-and-visible-p)
112 : :help "Pretty-print current buffer in black and white to PostScript printer"))
113 : (bindings--define-key menu [ps-print-region-faces]
114 : '(menu-item "PostScript Print Region"
115 : ps-print-region-with-faces
116 : :enable mark-active
117 : :help "Pretty-print marked region to PostScript printer"))
118 : (bindings--define-key menu [ps-print-buffer-faces]
119 : '(menu-item "PostScript Print Buffer"
120 : ps-print-buffer-with-faces
121 : :enable (menu-bar-menu-frame-live-and-visible-p)
122 : :help "Pretty-print current buffer to PostScript printer"))
123 : (bindings--define-key menu [print-region]
124 : '(menu-item "Print Region" print-region
125 : :enable mark-active
126 : :help "Print region between mark and current position"))
127 : (bindings--define-key menu [print-buffer]
128 : '(menu-item "Print Buffer" print-buffer
129 : :enable (menu-bar-menu-frame-live-and-visible-p)
130 : :help "Print current buffer with page headings"))
131 :
132 : (bindings--define-key menu [separator-print]
133 : menu-bar-separator)
134 :
135 : (bindings--define-key menu [recover-session]
136 : '(menu-item "Recover Crashed Session" recover-session
137 : :enable
138 : (and auto-save-list-file-prefix
139 : (file-directory-p
140 : (file-name-directory auto-save-list-file-prefix))
141 : (directory-files
142 : (file-name-directory auto-save-list-file-prefix)
143 : nil
144 : (concat "\\`"
145 : (regexp-quote
146 : (file-name-nondirectory
147 : auto-save-list-file-prefix)))
148 : t))
149 : :help "Recover edits from a crashed session"))
150 : (bindings--define-key menu [revert-buffer]
151 : '(menu-item "Revert Buffer" revert-buffer
152 : :enable (or (not (eq revert-buffer-function
153 : 'revert-buffer--default))
154 : (not (eq
155 : revert-buffer-insert-file-contents-function
156 : 'revert-buffer-insert-file-contents--default-function))
157 : (and buffer-file-number
158 : (or (buffer-modified-p)
159 : (not (verify-visited-file-modtime
160 : (current-buffer))))))
161 : :help "Re-read current buffer from its file"))
162 : (bindings--define-key menu [write-file]
163 : '(menu-item "Save As..." write-file
164 : :enable (and (menu-bar-menu-frame-live-and-visible-p)
165 : (menu-bar-non-minibuffer-window-p))
166 : :help "Write current buffer to another file"))
167 : (bindings--define-key menu [save-buffer]
168 : '(menu-item "Save" save-buffer
169 : :enable (and (buffer-modified-p)
170 : (buffer-file-name)
171 : (menu-bar-non-minibuffer-window-p))
172 : :help "Save current buffer to its file"))
173 :
174 : (bindings--define-key menu [separator-save]
175 : menu-bar-separator)
176 :
177 :
178 : (bindings--define-key menu [kill-buffer]
179 : '(menu-item "Close" kill-this-buffer
180 : :enable (kill-this-buffer-enabled-p)
181 : :help "Discard (kill) current buffer"))
182 : (bindings--define-key menu [insert-file]
183 : '(menu-item "Insert File..." insert-file
184 : :enable (menu-bar-non-minibuffer-window-p)
185 : :help "Insert another file into current buffer"))
186 : (bindings--define-key menu [dired]
187 : '(menu-item "Open Directory..." dired
188 : :enable (menu-bar-non-minibuffer-window-p)
189 : :help "Read a directory, to operate on its files"))
190 : (bindings--define-key menu [open-file]
191 : '(menu-item "Open File..." menu-find-file-existing
192 : :enable (menu-bar-non-minibuffer-window-p)
193 : :help "Read an existing file into an Emacs buffer"))
194 : (bindings--define-key menu [new-file]
195 : '(menu-item "Visit New File..." find-file
196 : :enable (menu-bar-non-minibuffer-window-p)
197 : :help "Specify a new file's name, to edit the file"))
198 :
199 : menu))
200 :
201 : (defun menu-find-file-existing ()
202 : "Edit the existing file FILENAME."
203 : (interactive)
204 0 : (let* ((mustmatch (not (and (fboundp 'x-uses-old-gtk-dialog)
205 0 : (x-uses-old-gtk-dialog))))
206 0 : (filename (car (find-file-read-args "Find file: " mustmatch))))
207 0 : (if mustmatch
208 0 : (find-file-existing filename)
209 0 : (find-file filename))))
210 :
211 : ;; The "Edit->Search" submenu
212 : (defvar menu-bar-last-search-type nil
213 : "Type of last non-incremental search command called from the menu.")
214 :
215 : (defun nonincremental-repeat-search-forward ()
216 : "Search forward for the previous search string or regexp."
217 : (interactive)
218 0 : (cond
219 0 : ((and (eq menu-bar-last-search-type 'string)
220 0 : search-ring)
221 0 : (nonincremental-search-forward))
222 0 : ((and (eq menu-bar-last-search-type 'regexp)
223 0 : regexp-search-ring)
224 0 : (re-search-forward (car regexp-search-ring)))
225 : (t
226 0 : (error "No previous search"))))
227 :
228 : (defun nonincremental-repeat-search-backward ()
229 : "Search backward for the previous search string or regexp."
230 : (interactive)
231 0 : (cond
232 0 : ((and (eq menu-bar-last-search-type 'string)
233 0 : search-ring)
234 0 : (nonincremental-search-backward))
235 0 : ((and (eq menu-bar-last-search-type 'regexp)
236 0 : regexp-search-ring)
237 0 : (re-search-backward (car regexp-search-ring)))
238 : (t
239 0 : (error "No previous search"))))
240 :
241 : (defun nonincremental-search-forward (&optional string backward)
242 : "Read a string and search for it nonincrementally."
243 : (interactive "sSearch for string: ")
244 0 : (setq menu-bar-last-search-type 'string)
245 : ;; Ideally, this whole command would be equivalent to `C-s RET'.
246 0 : (let ((isearch-forward (not backward))
247 0 : (isearch-regexp-function search-default-mode)
248 : (isearch-regexp nil))
249 0 : (if (or (equal string "") (not string))
250 0 : (funcall (isearch-search-fun-default) (car search-ring))
251 0 : (isearch-update-ring string nil)
252 0 : (funcall (isearch-search-fun-default) string))))
253 :
254 : (defun nonincremental-search-backward (&optional string)
255 : "Read a string and search backward for it nonincrementally."
256 : (interactive "sSearch backwards for string: ")
257 0 : (nonincremental-search-forward string 'backward))
258 :
259 : (defun nonincremental-re-search-forward (string)
260 : "Read a regular expression and search for it nonincrementally."
261 : (interactive "sSearch for regexp: ")
262 0 : (setq menu-bar-last-search-type 'regexp)
263 0 : (if (equal string "")
264 0 : (re-search-forward (car regexp-search-ring))
265 0 : (isearch-update-ring string t)
266 0 : (re-search-forward string)))
267 :
268 : (defun nonincremental-re-search-backward (string)
269 : "Read a regular expression and search backward for it nonincrementally."
270 : (interactive "sSearch for regexp: ")
271 0 : (setq menu-bar-last-search-type 'regexp)
272 0 : (if (equal string "")
273 0 : (re-search-backward (car regexp-search-ring))
274 0 : (isearch-update-ring string t)
275 0 : (re-search-backward string)))
276 :
277 : ;; The Edit->Search->Incremental Search menu
278 : (defvar menu-bar-i-search-menu
279 : (let ((menu (make-sparse-keymap "Incremental Search")))
280 : (bindings--define-key menu [isearch-backward-regexp]
281 : '(menu-item "Backward Regexp..." isearch-backward-regexp
282 : :help "Search backwards for a regular expression as you type it"))
283 : (bindings--define-key menu [isearch-forward-regexp]
284 : '(menu-item "Forward Regexp..." isearch-forward-regexp
285 : :help "Search forward for a regular expression as you type it"))
286 : (bindings--define-key menu [isearch-backward]
287 : '(menu-item "Backward String..." isearch-backward
288 : :help "Search backwards for a string as you type it"))
289 : (bindings--define-key menu [isearch-forward]
290 : '(menu-item "Forward String..." isearch-forward
291 : :help "Search forward for a string as you type it"))
292 : menu))
293 :
294 : (defvar menu-bar-search-menu
295 : (let ((menu (make-sparse-keymap "Search")))
296 :
297 : (bindings--define-key menu [i-search]
298 : `(menu-item "Incremental Search" ,menu-bar-i-search-menu))
299 : (bindings--define-key menu [separator-tag-isearch]
300 : menu-bar-separator)
301 :
302 : (bindings--define-key menu [tags-continue]
303 : '(menu-item "Continue Tags Search" tags-loop-continue
304 : :help "Continue last tags search operation"))
305 : (bindings--define-key menu [tags-srch]
306 : '(menu-item "Search Tagged Files..." tags-search
307 : :help "Search for a regexp in all tagged files"))
308 : (bindings--define-key menu [separator-tag-search] menu-bar-separator)
309 :
310 : (bindings--define-key menu [repeat-search-back]
311 : '(menu-item "Repeat Backwards"
312 : nonincremental-repeat-search-backward
313 : :enable (or (and (eq menu-bar-last-search-type 'string)
314 : search-ring)
315 : (and (eq menu-bar-last-search-type 'regexp)
316 : regexp-search-ring))
317 : :help "Repeat last search backwards"))
318 : (bindings--define-key menu [repeat-search-fwd]
319 : '(menu-item "Repeat Forward"
320 : nonincremental-repeat-search-forward
321 : :enable (or (and (eq menu-bar-last-search-type 'string)
322 : search-ring)
323 : (and (eq menu-bar-last-search-type 'regexp)
324 : regexp-search-ring))
325 : :help "Repeat last search forward"))
326 : (bindings--define-key menu [separator-repeat-search]
327 : menu-bar-separator)
328 :
329 : (bindings--define-key menu [re-search-backward]
330 : '(menu-item "Regexp Backwards..."
331 : nonincremental-re-search-backward
332 : :help "Search backwards for a regular expression"))
333 : (bindings--define-key menu [re-search-forward]
334 : '(menu-item "Regexp Forward..."
335 : nonincremental-re-search-forward
336 : :help "Search forward for a regular expression"))
337 :
338 : (bindings--define-key menu [search-backward]
339 : '(menu-item "String Backwards..."
340 : nonincremental-search-backward
341 : :help "Search backwards for a string"))
342 : (bindings--define-key menu [search-forward]
343 : '(menu-item "String Forward..." nonincremental-search-forward
344 : :help "Search forward for a string"))
345 : menu))
346 :
347 : ;; The Edit->Replace submenu
348 :
349 : (defvar menu-bar-replace-menu
350 : (let ((menu (make-sparse-keymap "Replace")))
351 : (bindings--define-key menu [tags-repl-continue]
352 : '(menu-item "Continue Replace" tags-loop-continue
353 : :help "Continue last tags replace operation"))
354 : (bindings--define-key menu [tags-repl]
355 : '(menu-item "Replace in Tagged Files..." tags-query-replace
356 : :help "Interactively replace a regexp in all tagged files"))
357 : (bindings--define-key menu [separator-replace-tags]
358 : menu-bar-separator)
359 :
360 : (bindings--define-key menu [query-replace-regexp]
361 : '(menu-item "Replace Regexp..." query-replace-regexp
362 : :enable (not buffer-read-only)
363 : :help "Replace regular expression interactively, ask about each occurrence"))
364 : (bindings--define-key menu [query-replace]
365 : '(menu-item "Replace String..." query-replace
366 : :enable (not buffer-read-only)
367 : :help "Replace string interactively, ask about each occurrence"))
368 : menu))
369 :
370 : ;;; Assemble the top-level Edit menu items.
371 : (defvar menu-bar-goto-menu
372 : (let ((menu (make-sparse-keymap "Go To")))
373 :
374 : (bindings--define-key menu [set-tags-name]
375 : '(menu-item "Set Tags File Name..." visit-tags-table
376 : :visible (menu-bar-goto-uses-etags-p)
377 : :help "Tell navigation commands which tag table file to use"))
378 :
379 : (bindings--define-key menu [separator-tag-file]
380 : '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p)))
381 :
382 : (bindings--define-key menu [xref-pop]
383 : '(menu-item "Back" xref-pop-marker-stack
384 : :visible (and (featurep 'xref)
385 : (not (xref-marker-stack-empty-p)))
386 : :help "Back to the position of the last search"))
387 :
388 : (bindings--define-key menu [xref-apropos]
389 : '(menu-item "Find Apropos..." xref-find-apropos
390 : :help "Find function/variables whose names match regexp"))
391 :
392 : (bindings--define-key menu [xref-find-otherw]
393 : '(menu-item "Find Definition in Other Window..."
394 : xref-find-definitions-other-window
395 : :help "Find function/variable definition in another window"))
396 : (bindings--define-key menu [xref-find-def]
397 : '(menu-item "Find Definition..." xref-find-definitions
398 : :help "Find definition of function or variable"))
399 :
400 : (bindings--define-key menu [separator-xref]
401 : menu-bar-separator)
402 :
403 : (bindings--define-key menu [end-of-buf]
404 : '(menu-item "Goto End of Buffer" end-of-buffer))
405 : (bindings--define-key menu [beg-of-buf]
406 : '(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
407 : (bindings--define-key menu [go-to-pos]
408 : '(menu-item "Goto Buffer Position..." goto-char
409 : :help "Read a number N and go to buffer position N"))
410 : (bindings--define-key menu [go-to-line]
411 : '(menu-item "Goto Line..." goto-line
412 : :help "Read a line number and go to that line"))
413 : menu))
414 :
415 : (defun menu-bar-goto-uses-etags-p ()
416 0 : (or (not (boundp 'xref-backend-functions))
417 0 : (eq (car xref-backend-functions) 'etags--xref-backend)))
418 :
419 : (defvar yank-menu (cons (purecopy "Select Yank") nil))
420 : (fset 'yank-menu (cons 'keymap yank-menu))
421 :
422 : (defvar menu-bar-edit-menu
423 : (let ((menu (make-sparse-keymap "Edit")))
424 :
425 : (bindings--define-key menu [props]
426 : `(menu-item "Text Properties" facemenu-menu))
427 :
428 : ;; ns-win.el said: Add spell for platform consistency.
429 : (if (featurep 'ns)
430 : (bindings--define-key menu [spell]
431 : `(menu-item "Spell" ispell-menu-map)))
432 :
433 : (bindings--define-key menu [fill]
434 : `(menu-item "Fill" fill-region
435 : :enable (and mark-active (not buffer-read-only))
436 : :help
437 : "Fill text in region to fit between left and right margin"))
438 :
439 : (bindings--define-key menu [separator-bookmark]
440 : menu-bar-separator)
441 :
442 : (bindings--define-key menu [bookmark]
443 : `(menu-item "Bookmarks" menu-bar-bookmark-map))
444 :
445 : (bindings--define-key menu [goto]
446 : `(menu-item "Go To" ,menu-bar-goto-menu))
447 :
448 : (bindings--define-key menu [replace]
449 : `(menu-item "Replace" ,menu-bar-replace-menu))
450 :
451 : (bindings--define-key menu [search]
452 : `(menu-item "Search" ,menu-bar-search-menu))
453 :
454 : (bindings--define-key menu [separator-search]
455 : menu-bar-separator)
456 :
457 : (bindings--define-key menu [mark-whole-buffer]
458 : '(menu-item "Select All" mark-whole-buffer
459 : :help "Mark the whole buffer for a subsequent cut/copy"))
460 : (bindings--define-key menu [clear]
461 : '(menu-item "Clear" delete-region
462 : :enable (and mark-active
463 : (not buffer-read-only))
464 : :help
465 : "Delete the text in region between mark and current position"))
466 :
467 :
468 : (bindings--define-key menu (if (featurep 'ns) [select-paste]
469 : [paste-from-menu])
470 : ;; ns-win.el said: Change text to be more consistent with
471 : ;; surrounding menu items `paste', etc."
472 : `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
473 : yank-menu
474 : :enable (and (cdr yank-menu) (not buffer-read-only))
475 : :help "Choose a string from the kill ring and paste it"))
476 : (bindings--define-key menu [paste]
477 : `(menu-item "Paste" yank
478 : :enable (funcall
479 : ',(lambda ()
480 : (and (or
481 : (gui-backend-selection-exists-p 'CLIPBOARD)
482 : (if (featurep 'ns) ; like paste-from-menu
483 : (cdr yank-menu)
484 : kill-ring))
485 : (not buffer-read-only))))
486 : :help "Paste (yank) text most recently cut/copied"))
487 : (bindings--define-key menu [copy]
488 : ;; ns-win.el said: Substitute a Copy function that works better
489 : ;; under X (for GNUstep).
490 : `(menu-item "Copy" ,(if (featurep 'ns)
491 : 'ns-copy-including-secondary
492 : 'kill-ring-save)
493 : :enable mark-active
494 : :help "Copy text in region between mark and current position"
495 : :keys ,(if (featurep 'ns)
496 : "\\[ns-copy-including-secondary]"
497 : "\\[kill-ring-save]")))
498 : (bindings--define-key menu [cut]
499 : '(menu-item "Cut" kill-region
500 : :enable (and mark-active (not buffer-read-only))
501 : :help
502 : "Cut (kill) text in region between mark and current position"))
503 : ;; ns-win.el said: Separate undo from cut/paste section.
504 : (if (featurep 'ns)
505 : (bindings--define-key menu [separator-undo] menu-bar-separator))
506 :
507 : (bindings--define-key menu [undo]
508 : '(menu-item "Undo" undo
509 : :enable (and (not buffer-read-only)
510 : (not (eq t buffer-undo-list))
511 : (if (eq last-command 'undo)
512 : (listp pending-undo-list)
513 : (consp buffer-undo-list)))
514 : :help "Undo last operation"))
515 :
516 : menu))
517 :
518 : (define-obsolete-function-alias
519 : 'menu-bar-kill-ring-save 'kill-ring-save "24.1")
520 :
521 : ;; These are alternative definitions for the cut, paste and copy
522 : ;; menu items. Use them if your system expects these to use the clipboard.
523 :
524 : (put 'clipboard-kill-region 'menu-enable
525 : '(and mark-active (not buffer-read-only)))
526 : (put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
527 : (put 'clipboard-yank 'menu-enable
528 : `(funcall ',(lambda ()
529 : (and (or (gui-backend-selection-exists-p 'PRIMARY)
530 : (gui-backend-selection-exists-p 'CLIPBOARD))
531 : (not buffer-read-only)))))
532 :
533 : (defun clipboard-yank ()
534 : "Insert the clipboard contents, or the last stretch of killed text."
535 : (interactive "*")
536 0 : (let ((select-enable-clipboard t))
537 0 : (yank)))
538 :
539 : (defun clipboard-kill-ring-save (beg end &optional region)
540 : "Copy region to kill ring, and save in the GUI's clipboard.
541 : If the optional argument REGION is non-nil, the function ignores
542 : BEG and END, and saves the current region instead."
543 : (interactive "r\np")
544 0 : (let ((select-enable-clipboard t))
545 0 : (kill-ring-save beg end region)))
546 :
547 : (defun clipboard-kill-region (beg end &optional region)
548 : "Kill the region, and save it in the GUI's clipboard.
549 : If the optional argument REGION is non-nil, the function ignores
550 : BEG and END, and kills the current region instead."
551 : (interactive "r\np")
552 0 : (let ((select-enable-clipboard t))
553 0 : (kill-region beg end region)))
554 :
555 : (defun menu-bar-enable-clipboard ()
556 : "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
557 : Do the same for the keys of the same name."
558 : (interactive)
559 : ;; These are Sun server keysyms for the Cut, Copy and Paste keys
560 : ;; (also for XFree86 on Sun keyboard):
561 0 : (define-key global-map [f20] 'clipboard-kill-region)
562 0 : (define-key global-map [f16] 'clipboard-kill-ring-save)
563 0 : (define-key global-map [f18] 'clipboard-yank)
564 : ;; X11R6 versions:
565 0 : (define-key global-map [cut] 'clipboard-kill-region)
566 0 : (define-key global-map [copy] 'clipboard-kill-ring-save)
567 0 : (define-key global-map [paste] 'clipboard-yank))
568 :
569 : ;; The "Options" menu items
570 :
571 : (defvar menu-bar-custom-menu
572 : (let ((menu (make-sparse-keymap "Customize")))
573 :
574 : (bindings--define-key menu [customize-apropos-faces]
575 : '(menu-item "Faces Matching..." customize-apropos-faces
576 : :help "Browse faces matching a regexp or word list"))
577 : (bindings--define-key menu [customize-apropos-options]
578 : '(menu-item "Options Matching..." customize-apropos-options
579 : :help "Browse options matching a regexp or word list"))
580 : (bindings--define-key menu [customize-apropos]
581 : '(menu-item "All Settings Matching..." customize-apropos
582 : :help "Browse customizable settings matching a regexp or word list"))
583 : (bindings--define-key menu [separator-1]
584 : menu-bar-separator)
585 : (bindings--define-key menu [customize-group]
586 : '(menu-item "Specific Group..." customize-group
587 : :help "Customize settings of specific group"))
588 : (bindings--define-key menu [customize-face]
589 : '(menu-item "Specific Face..." customize-face
590 : :help "Customize attributes of specific face"))
591 : (bindings--define-key menu [customize-option]
592 : '(menu-item "Specific Option..." customize-option
593 : :help "Customize value of specific option"))
594 : (bindings--define-key menu [separator-2]
595 : menu-bar-separator)
596 : (bindings--define-key menu [customize-changed-options]
597 : '(menu-item "New Options..." customize-changed-options
598 : :help "Options added or changed in recent Emacs versions"))
599 : (bindings--define-key menu [customize-saved]
600 : '(menu-item "Saved Options" customize-saved
601 : :help "Customize previously saved options"))
602 : (bindings--define-key menu [separator-3]
603 : menu-bar-separator)
604 : (bindings--define-key menu [customize-browse]
605 : '(menu-item "Browse Customization Groups" customize-browse
606 : :help "Browse all customization groups"))
607 : (bindings--define-key menu [customize]
608 : '(menu-item "Top-level Customization Group" customize
609 : :help "The master group called `Emacs'"))
610 : (bindings--define-key menu [customize-themes]
611 : '(menu-item "Custom Themes" customize-themes
612 : :help "Choose a pre-defined customization theme"))
613 : menu))
614 : ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
615 :
616 : (defmacro menu-bar-make-mm-toggle (fname doc help &optional props)
617 : "Make a menu-item for a global minor mode toggle.
618 : FNAME is the minor mode's name (variable and function).
619 : DOC is the text to use for the menu entry.
620 : HELP is the text to use for the tooltip.
621 : PROPS are additional properties."
622 12 : `'(menu-item ,doc ,fname
623 12 : ,@props
624 12 : :help ,help
625 12 : :button (:toggle . (and (default-boundp ',fname)
626 12 : (default-value ',fname)))))
627 :
628 : (defmacro menu-bar-make-toggle (name variable doc message help &rest body)
629 7 : `(progn
630 7 : (defun ,name (&optional interactively)
631 7 : ,(concat "Toggle whether to " (downcase (substring help 0 1))
632 7 : (substring help 1) ".
633 : In an interactive call, record this option as a candidate for saving
634 7 : by \"Save Options\" in Custom buffers.")
635 : (interactive "p")
636 7 : (if ,(if body `(progn . ,body)
637 5 : `(progn
638 5 : (custom-load-symbol ',variable)
639 5 : (let ((set (or (get ',variable 'custom-set) 'set-default))
640 5 : (get (or (get ',variable 'custom-get) 'default-value)))
641 7 : (funcall set ',variable (not (funcall get ',variable))))))
642 7 : (message ,message "enabled globally")
643 7 : (message ,message "disabled globally"))
644 : ;; The function `customize-mark-as-set' must only be called when
645 : ;; a variable is set interactively, as the purpose is to mark it as
646 : ;; a candidate for "Save Options", and we do not want to save options
647 : ;; the user have already set explicitly in his init file.
648 7 : (if interactively (customize-mark-as-set ',variable)))
649 7 : '(menu-item ,doc ,name
650 7 : :help ,help
651 7 : :button (:toggle . (and (default-boundp ',variable)
652 7 : (default-value ',variable))))))
653 :
654 : ;; Function for setting/saving default font.
655 :
656 : (defun menu-set-font ()
657 : "Interactively select a font and make it the default on all frames.
658 :
659 : The selected font will be the default on both the existing and future frames."
660 : (interactive)
661 0 : (set-frame-font (if (fboundp 'x-select-font)
662 0 : (x-select-font)
663 0 : (mouse-select-font))
664 0 : nil t))
665 :
666 : (defun menu-bar-options-save ()
667 : "Save current values of Options menu items using Custom."
668 : (interactive)
669 0 : (let ((need-save nil))
670 : ;; These are set with menu-bar-make-mm-toggle, which does not
671 : ;; put on a customized-value property.
672 0 : (dolist (elt '(line-number-mode column-number-mode size-indication-mode
673 : cua-mode show-paren-mode transient-mark-mode
674 : blink-cursor-mode display-time-mode display-battery-mode
675 : ;; These are set by other functions that don't set
676 : ;; the customized state. Having them here has the
677 : ;; side-effect that turning them off via X
678 : ;; resources acts like having customized them, but
679 : ;; that seems harmless.
680 : menu-bar-mode tool-bar-mode))
681 : ;; FIXME ? It's a little annoying that running this command
682 : ;; always loads cua-base, paren, time, and battery, even if they
683 : ;; have not been customized in any way. (Due to custom-load-symbol.)
684 0 : (and (customize-mark-to-save elt)
685 0 : (setq need-save t)))
686 : ;; These are set with `customize-set-variable'.
687 0 : (dolist (elt '(scroll-bar-mode
688 : debug-on-quit debug-on-error
689 : ;; Somehow this works, when tool-bar and menu-bar don't.
690 : tooltip-mode window-divider-mode
691 : save-place uniquify-buffer-name-style fringe-mode
692 : indicate-empty-lines indicate-buffer-boundaries
693 : case-fold-search font-use-system-font
694 : current-language-environment default-input-method
695 : ;; Saving `text-mode-hook' is somewhat questionable,
696 : ;; as we might get more than we bargain for, if
697 : ;; other code may has added hooks as well.
698 : ;; Nonetheless, not saving it would like be confuse
699 : ;; more often.
700 : ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
701 : text-mode-hook tool-bar-position))
702 0 : (and (get elt 'customized-value)
703 0 : (customize-mark-to-save elt)
704 0 : (setq need-save t)))
705 0 : (when (get 'default 'customized-face)
706 0 : (put 'default 'saved-face (get 'default 'customized-face))
707 0 : (put 'default 'customized-face nil)
708 0 : (setq need-save t))
709 : ;; Save if we changed anything.
710 0 : (when need-save
711 0 : (custom-save-all))))
712 :
713 :
714 : ;;; Assemble all the top-level items of the "Options" menu
715 :
716 : ;; The "Show/Hide" submenu of menu "Options"
717 :
718 : (defun menu-bar-window-divider-customize ()
719 : "Show customization buffer for `window-divider' group."
720 : (interactive)
721 0 : (customize-group 'window-divider))
722 :
723 : (defun menu-bar-bottom-and-right-window-divider ()
724 : "Display dividers on the bottom and right of each window."
725 : (interactive)
726 0 : (customize-set-variable 'window-divider-default-places t)
727 0 : (window-divider-mode 1))
728 :
729 : (defun menu-bar-right-window-divider ()
730 : "Display dividers only on the right of each window."
731 : (interactive)
732 0 : (customize-set-variable 'window-divider-default-places 'right-only)
733 0 : (window-divider-mode 1))
734 :
735 : (defun menu-bar-bottom-window-divider ()
736 : "Display dividers only at the bottom of each window."
737 : (interactive)
738 0 : (customize-set-variable 'window-divider-default-places 'bottom-only)
739 0 : (window-divider-mode 1))
740 :
741 : (defun menu-bar-no-window-divider ()
742 : "Do not display window dividers."
743 : (interactive)
744 0 : (window-divider-mode -1))
745 :
746 : ;; For the radio buttons below we check whether the respective dividers
747 : ;; are displayed on the selected frame. This is not fully congruent
748 : ;; with `window-divider-mode' but makes the menu entries work also when
749 : ;; dividers are displayed by manipulating frame parameters directly.
750 : (defvar menu-bar-showhide-window-divider-menu
751 : (let ((menu (make-sparse-keymap "Window Divider")))
752 : (bindings--define-key menu [customize]
753 : '(menu-item "Customize" menu-bar-window-divider-customize
754 : :help "Customize window dividers"
755 : :visible (memq (window-system) '(x w32))))
756 :
757 : (bindings--define-key menu [bottom-and-right]
758 : '(menu-item "Bottom and Right"
759 : menu-bar-bottom-and-right-window-divider
760 : :help "Display window divider on the bottom and right of each window"
761 : :visible (memq (window-system) '(x w32))
762 : :button (:radio
763 : . (and (window-divider-width-valid-p
764 : (cdr (assq 'bottom-divider-width
765 : (frame-parameters))))
766 : (window-divider-width-valid-p
767 : (cdr (assq 'right-divider-width
768 : (frame-parameters))))))))
769 : (bindings--define-key menu [right-only]
770 : '(menu-item "Right Only"
771 : menu-bar-right-window-divider
772 : :help "Display window divider on the right of each window only"
773 : :visible (memq (window-system) '(x w32))
774 : :button (:radio
775 : . (and (not (window-divider-width-valid-p
776 : (cdr (assq 'bottom-divider-width
777 : (frame-parameters)))))
778 : (window-divider-width-valid-p
779 : (cdr (assq 'right-divider-width
780 : (frame-parameters))))))))
781 : (bindings--define-key menu [bottom-only]
782 : '(menu-item "Bottom Only"
783 : menu-bar-bottom-window-divider
784 : :help "Display window divider on the bottom of each window only"
785 : :visible (memq (window-system) '(x w32))
786 : :button (:radio
787 : . (and (window-divider-width-valid-p
788 : (cdr (assq 'bottom-divider-width
789 : (frame-parameters))))
790 : (not (window-divider-width-valid-p
791 : (cdr (assq 'right-divider-width
792 : (frame-parameters)))))))))
793 : (bindings--define-key menu [no-divider]
794 : '(menu-item "None"
795 : menu-bar-no-window-divider
796 : :help "Do not display window dividers"
797 : :visible (memq (window-system) '(x w32))
798 : :button (:radio
799 : . (and (not (window-divider-width-valid-p
800 : (cdr (assq 'bottom-divider-width
801 : (frame-parameters)))))
802 : (not (window-divider-width-valid-p
803 : (cdr (assq 'right-divider-width
804 : (frame-parameters)))))))))
805 : menu))
806 :
807 : (defun menu-bar-showhide-fringe-ind-customize ()
808 : "Show customization buffer for `indicate-buffer-boundaries'."
809 : (interactive)
810 0 : (customize-variable 'indicate-buffer-boundaries))
811 :
812 : (defun menu-bar-showhide-fringe-ind-mixed ()
813 : "Display top and bottom indicators in opposite fringes, arrows in right."
814 : (interactive)
815 0 : (customize-set-variable 'indicate-buffer-boundaries
816 0 : '((t . right) (top . left))))
817 :
818 : (defun menu-bar-showhide-fringe-ind-box ()
819 : "Display top and bottom indicators in opposite fringes."
820 : (interactive)
821 0 : (customize-set-variable 'indicate-buffer-boundaries
822 0 : '((top . left) (bottom . right))))
823 :
824 : (defun menu-bar-showhide-fringe-ind-right ()
825 : "Display buffer boundaries and arrows in the right fringe."
826 : (interactive)
827 0 : (customize-set-variable 'indicate-buffer-boundaries 'right))
828 :
829 : (defun menu-bar-showhide-fringe-ind-left ()
830 : "Display buffer boundaries and arrows in the left fringe."
831 : (interactive)
832 0 : (customize-set-variable 'indicate-buffer-boundaries 'left))
833 :
834 : (defun menu-bar-showhide-fringe-ind-none ()
835 : "Do not display any buffer boundary indicators."
836 : (interactive)
837 0 : (customize-set-variable 'indicate-buffer-boundaries nil))
838 :
839 : (defvar menu-bar-showhide-fringe-ind-menu
840 : (let ((menu (make-sparse-keymap "Buffer boundaries")))
841 :
842 : (bindings--define-key menu [customize]
843 : '(menu-item "Other (Customize)"
844 : menu-bar-showhide-fringe-ind-customize
845 : :help "Additional choices available through Custom buffer"
846 : :visible (display-graphic-p)
847 : :button (:radio . (not (member indicate-buffer-boundaries
848 : '(nil left right
849 : ((top . left) (bottom . right))
850 : ((t . right) (top . left))))))))
851 :
852 : (bindings--define-key menu [mixed]
853 : '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed
854 : :help
855 : "Show top/bottom indicators in opposite fringes, arrows in right"
856 : :visible (display-graphic-p)
857 : :button (:radio . (equal indicate-buffer-boundaries
858 : '((t . right) (top . left))))))
859 :
860 : (bindings--define-key menu [box]
861 : '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box
862 : :help "Show top/bottom indicators in opposite fringes, no arrows"
863 : :visible (display-graphic-p)
864 : :button (:radio . (equal indicate-buffer-boundaries
865 : '((top . left) (bottom . right))))))
866 :
867 : (bindings--define-key menu [right]
868 : '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right
869 : :help "Show buffer boundaries and arrows in right fringe"
870 : :visible (display-graphic-p)
871 : :button (:radio . (eq indicate-buffer-boundaries 'right))))
872 :
873 : (bindings--define-key menu [left]
874 : '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left
875 : :help "Show buffer boundaries and arrows in left fringe"
876 : :visible (display-graphic-p)
877 : :button (:radio . (eq indicate-buffer-boundaries 'left))))
878 :
879 : (bindings--define-key menu [none]
880 : '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none
881 : :help "Hide all buffer boundary indicators and arrows"
882 : :visible (display-graphic-p)
883 : :button (:radio . (eq indicate-buffer-boundaries nil))))
884 : menu))
885 :
886 : (defun menu-bar-showhide-fringe-menu-customize ()
887 : "Show customization buffer for `fringe-mode'."
888 : (interactive)
889 0 : (customize-variable 'fringe-mode))
890 :
891 : (defun menu-bar-showhide-fringe-menu-customize-reset ()
892 : "Reset the fringe mode: display fringes on both sides of a window."
893 : (interactive)
894 0 : (customize-set-variable 'fringe-mode nil))
895 :
896 : (defun menu-bar-showhide-fringe-menu-customize-right ()
897 : "Display fringes only on the right of each window."
898 : (interactive)
899 0 : (require 'fringe)
900 0 : (customize-set-variable 'fringe-mode '(0 . nil)))
901 :
902 : (defun menu-bar-showhide-fringe-menu-customize-left ()
903 : "Display fringes only on the left of each window."
904 : (interactive)
905 0 : (require 'fringe)
906 0 : (customize-set-variable 'fringe-mode '(nil . 0)))
907 :
908 : (defun menu-bar-showhide-fringe-menu-customize-disable ()
909 : "Do not display window fringes."
910 : (interactive)
911 0 : (require 'fringe)
912 0 : (customize-set-variable 'fringe-mode 0))
913 :
914 : (defvar menu-bar-showhide-fringe-menu
915 : (let ((menu (make-sparse-keymap "Fringe")))
916 :
917 : (bindings--define-key menu [showhide-fringe-ind]
918 : `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu
919 : :visible (display-graphic-p)
920 : :help "Indicate buffer boundaries in fringe"))
921 :
922 : (bindings--define-key menu [indicate-empty-lines]
923 : (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
924 : "Empty Line Indicators"
925 : "Indicating of empty lines %s"
926 : "Indicate trailing empty lines in fringe, globally"))
927 :
928 : (bindings--define-key menu [customize]
929 : '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
930 : :help "Detailed customization of fringe"
931 : :visible (display-graphic-p)))
932 :
933 : (bindings--define-key menu [default]
934 : '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset
935 : :help "Default width fringe on both left and right side"
936 : :visible (display-graphic-p)
937 : :button (:radio . (eq fringe-mode nil))))
938 :
939 : (bindings--define-key menu [right]
940 : '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right
941 : :help "Fringe only on the right side"
942 : :visible (display-graphic-p)
943 : :button (:radio . (equal fringe-mode '(0 . nil)))))
944 :
945 : (bindings--define-key menu [left]
946 : '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left
947 : :help "Fringe only on the left side"
948 : :visible (display-graphic-p)
949 : :button (:radio . (equal fringe-mode '(nil . 0)))))
950 :
951 : (bindings--define-key menu [none]
952 : '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable
953 : :help "Turn off fringe"
954 : :visible (display-graphic-p)
955 : :button (:radio . (eq fringe-mode 0))))
956 : menu))
957 :
958 : (defun menu-bar-right-scroll-bar ()
959 : "Display scroll bars on the right of each window."
960 : (interactive)
961 0 : (customize-set-variable 'scroll-bar-mode 'right))
962 :
963 : (defun menu-bar-left-scroll-bar ()
964 : "Display scroll bars on the left of each window."
965 : (interactive)
966 0 : (customize-set-variable 'scroll-bar-mode 'left))
967 :
968 : (defun menu-bar-no-scroll-bar ()
969 : "Turn off scroll bars."
970 : (interactive)
971 0 : (customize-set-variable 'scroll-bar-mode nil))
972 :
973 : (defvar menu-bar-showhide-scroll-bar-menu
974 : (let ((menu (make-sparse-keymap "Scroll Bar")))
975 :
976 : (bindings--define-key menu [horizontal]
977 : (menu-bar-make-mm-toggle horizontal-scroll-bar-mode
978 : "Horizontal"
979 : "Horizontal scroll bar"))
980 :
981 : (bindings--define-key menu [scrollbar-separator]
982 : menu-bar-separator)
983 :
984 : (bindings--define-key menu [right]
985 : '(menu-item "On the Right" menu-bar-right-scroll-bar
986 : :help "Scroll bar on the right side"
987 : :visible (display-graphic-p)
988 : :button (:radio . (and scroll-bar-mode
989 : (eq (frame-parameter
990 : nil 'vertical-scroll-bars)
991 : 'right)))))
992 :
993 : (bindings--define-key menu [left]
994 : '(menu-item "On the Left" menu-bar-left-scroll-bar
995 : :help "Scroll bar on the left side"
996 : :visible (display-graphic-p)
997 : :button (:radio . (and scroll-bar-mode
998 : (eq (frame-parameter
999 : nil 'vertical-scroll-bars)
1000 : 'left)))))
1001 :
1002 : (bindings--define-key menu [none]
1003 : '(menu-item "No Vertical Scroll Bar" menu-bar-no-scroll-bar
1004 : :help "Turn off vertical scroll bar"
1005 : :visible (display-graphic-p)
1006 : :button (:radio . (eq scroll-bar-mode nil))))
1007 : menu))
1008 :
1009 : (defun menu-bar-frame-for-menubar ()
1010 : "Return the frame suitable for updating the menu bar."
1011 0 : (or (and (framep menu-updating-frame)
1012 0 : menu-updating-frame)
1013 0 : (selected-frame)))
1014 :
1015 : (defun menu-bar-positive-p (val)
1016 : "Return non-nil if VAL is a positive number."
1017 0 : (and (numberp val)
1018 0 : (> val 0)))
1019 :
1020 : (defun menu-bar-set-tool-bar-position (position)
1021 0 : (customize-set-variable 'tool-bar-mode t)
1022 0 : (customize-set-variable 'tool-bar-position position))
1023 : (defun menu-bar-showhide-tool-bar-menu-customize-disable ()
1024 : "Do not display tool bars."
1025 : (interactive)
1026 0 : (customize-set-variable 'tool-bar-mode nil))
1027 : (defun menu-bar-showhide-tool-bar-menu-customize-enable-left ()
1028 : "Display tool bars on the left side."
1029 : (interactive)
1030 0 : (menu-bar-set-tool-bar-position 'left))
1031 : (defun menu-bar-showhide-tool-bar-menu-customize-enable-right ()
1032 : "Display tool bars on the right side."
1033 : (interactive)
1034 0 : (menu-bar-set-tool-bar-position 'right))
1035 : (defun menu-bar-showhide-tool-bar-menu-customize-enable-top ()
1036 : "Display tool bars on the top side."
1037 : (interactive)
1038 0 : (menu-bar-set-tool-bar-position 'top))
1039 : (defun menu-bar-showhide-tool-bar-menu-customize-enable-bottom ()
1040 : "Display tool bars on the bottom side."
1041 : (interactive)
1042 0 : (menu-bar-set-tool-bar-position 'bottom))
1043 :
1044 : (when (featurep 'move-toolbar)
1045 : (defvar menu-bar-showhide-tool-bar-menu
1046 : (let ((menu (make-sparse-keymap "Tool Bar")))
1047 :
1048 : (bindings--define-key menu [showhide-tool-bar-left]
1049 : '(menu-item "On the Left"
1050 : menu-bar-showhide-tool-bar-menu-customize-enable-left
1051 : :help "Tool bar at the left side"
1052 : :visible (display-graphic-p)
1053 : :button
1054 : (:radio . (and tool-bar-mode
1055 : (frame-parameter
1056 : (menu-bar-frame-for-menubar)
1057 : 'tool-bar-position)
1058 : 'left))))
1059 :
1060 : (bindings--define-key menu [showhide-tool-bar-right]
1061 : '(menu-item "On the Right"
1062 : menu-bar-showhide-tool-bar-menu-customize-enable-right
1063 : :help "Tool bar at the right side"
1064 : :visible (display-graphic-p)
1065 : :button
1066 : (:radio . (and tool-bar-mode
1067 : (eq (frame-parameter
1068 : (menu-bar-frame-for-menubar)
1069 : 'tool-bar-position)
1070 : 'right)))))
1071 :
1072 : (bindings--define-key menu [showhide-tool-bar-bottom]
1073 : '(menu-item "On the Bottom"
1074 : menu-bar-showhide-tool-bar-menu-customize-enable-bottom
1075 : :help "Tool bar at the bottom"
1076 : :visible (display-graphic-p)
1077 : :button
1078 : (:radio . (and tool-bar-mode
1079 : (eq (frame-parameter
1080 : (menu-bar-frame-for-menubar)
1081 : 'tool-bar-position)
1082 : 'bottom)))))
1083 :
1084 : (bindings--define-key menu [showhide-tool-bar-top]
1085 : '(menu-item "On the Top"
1086 : menu-bar-showhide-tool-bar-menu-customize-enable-top
1087 : :help "Tool bar at the top"
1088 : :visible (display-graphic-p)
1089 : :button
1090 : (:radio . (and tool-bar-mode
1091 : (eq (frame-parameter
1092 : (menu-bar-frame-for-menubar)
1093 : 'tool-bar-position)
1094 : 'top)))))
1095 :
1096 : (bindings--define-key menu [showhide-tool-bar-none]
1097 : '(menu-item "None"
1098 : menu-bar-showhide-tool-bar-menu-customize-disable
1099 : :help "Turn tool bar off"
1100 : :visible (display-graphic-p)
1101 : :button (:radio . (eq tool-bar-mode nil))))
1102 : menu)))
1103 :
1104 : (defvar display-line-numbers-type)
1105 : (defun menu-bar-display-line-numbers-mode (type)
1106 0 : (setq display-line-numbers-type type)
1107 0 : (if global-display-line-numbers-mode
1108 0 : (global-display-line-numbers-mode)
1109 0 : (display-line-numbers-mode)))
1110 :
1111 : (defvar menu-bar-showhide-line-numbers-menu
1112 : (let ((menu (make-sparse-keymap "Line Numbers")))
1113 :
1114 : (bindings--define-key menu [visual]
1115 : `(menu-item "Visual Line Numbers"
1116 : ,(lambda ()
1117 : (interactive)
1118 : (menu-bar-display-line-numbers-mode 'visual)
1119 : (message "Visual line numbers enabled"))
1120 : :help "Enable visual line numbers"
1121 : :button (:radio . (eq display-line-numbers 'visual))
1122 : :visible (menu-bar-menu-frame-live-and-visible-p)))
1123 :
1124 : (bindings--define-key menu [relative]
1125 : `(menu-item "Relative Line Numbers"
1126 : ,(lambda ()
1127 : (interactive)
1128 : (menu-bar-display-line-numbers-mode 'relative)
1129 : (message "Relative line numbers enabled"))
1130 : :help "Enable relative line numbers"
1131 : :button (:radio . (eq display-line-numbers 'relative))
1132 : :visible (menu-bar-menu-frame-live-and-visible-p)))
1133 :
1134 : (bindings--define-key menu [absolute]
1135 : `(menu-item "Absolute Line Numbers"
1136 : ,(lambda ()
1137 : (interactive)
1138 : (menu-bar-display-line-numbers-mode t)
1139 : (setq display-line-numbers t)
1140 : (message "Absolute line numbers enabled"))
1141 : :help "Enable absolute line numbers"
1142 : :button (:radio . (eq display-line-numbers t))
1143 : :visible (menu-bar-menu-frame-live-and-visible-p)))
1144 :
1145 : (bindings--define-key menu [none]
1146 : `(menu-item "No Line Numbers"
1147 : ,(lambda ()
1148 : (interactive)
1149 : (menu-bar-display-line-numbers-mode nil)
1150 : (message "Line numbers disabled"))
1151 : :help "Disable line numbers"
1152 : :button (:radio . (null display-line-numbers))
1153 : :visible (menu-bar-menu-frame-live-and-visible-p)))
1154 :
1155 : (bindings--define-key menu [global]
1156 : (menu-bar-make-mm-toggle global-display-line-numbers-mode
1157 : "Global Line Numbers Mode"
1158 : "Set line numbers globally"))
1159 : menu))
1160 :
1161 : (defvar menu-bar-showhide-menu
1162 : (let ((menu (make-sparse-keymap "Show/Hide")))
1163 :
1164 : (bindings--define-key menu [display-line-numbers]
1165 : `(menu-item "Line Numbers for All Lines"
1166 : ,menu-bar-showhide-line-numbers-menu))
1167 :
1168 : (bindings--define-key menu [column-number-mode]
1169 : (menu-bar-make-mm-toggle column-number-mode
1170 : "Column Numbers in Mode Line"
1171 : "Show the current column number in the mode line"))
1172 :
1173 : (bindings--define-key menu [line-number-mode]
1174 : (menu-bar-make-mm-toggle line-number-mode
1175 : "Line Numbers in Mode Line"
1176 : "Show the current line number in the mode line"))
1177 :
1178 : (bindings--define-key menu [size-indication-mode]
1179 : (menu-bar-make-mm-toggle size-indication-mode
1180 : "Size Indication"
1181 : "Show the size of the buffer in the mode line"))
1182 :
1183 : (bindings--define-key menu [linecolumn-separator]
1184 : menu-bar-separator)
1185 :
1186 : (bindings--define-key menu [showhide-battery]
1187 : (menu-bar-make-mm-toggle display-battery-mode
1188 : "Battery Status"
1189 : "Display battery status information in mode line"))
1190 :
1191 : (bindings--define-key menu [showhide-date-time]
1192 : (menu-bar-make-mm-toggle display-time-mode
1193 : "Time, Load and Mail"
1194 : "Display time, system load averages and \
1195 : mail status in mode line"))
1196 :
1197 : (bindings--define-key menu [datetime-separator]
1198 : menu-bar-separator)
1199 :
1200 : (bindings--define-key menu [showhide-speedbar]
1201 : '(menu-item "Speedbar" speedbar-frame-mode
1202 : :help "Display a Speedbar quick-navigation frame"
1203 : :button (:toggle
1204 : . (and (boundp 'speedbar-frame)
1205 : (frame-live-p (symbol-value 'speedbar-frame))
1206 : (frame-visible-p
1207 : (symbol-value 'speedbar-frame))))))
1208 :
1209 : (bindings--define-key menu [showhide-window-divider]
1210 : `(menu-item "Window Divider" ,menu-bar-showhide-window-divider-menu
1211 : :visible (memq (window-system) '(x w32))))
1212 :
1213 : (bindings--define-key menu [showhide-fringe]
1214 : `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu
1215 : :visible (display-graphic-p)))
1216 :
1217 : (bindings--define-key menu [showhide-scroll-bar]
1218 : `(menu-item "Scroll Bar" ,menu-bar-showhide-scroll-bar-menu
1219 : :visible (display-graphic-p)))
1220 :
1221 : (bindings--define-key menu [showhide-tooltip-mode]
1222 : '(menu-item "Tooltips" tooltip-mode
1223 : :help "Turn tooltips on/off"
1224 : :visible (and (display-graphic-p) (fboundp 'x-show-tip))
1225 : :button (:toggle . tooltip-mode)))
1226 :
1227 : (bindings--define-key menu [menu-bar-mode]
1228 : '(menu-item "Menu Bar" toggle-menu-bar-mode-from-frame
1229 : :help "Turn menu bar on/off"
1230 : :button
1231 : (:toggle . (menu-bar-positive-p
1232 : (frame-parameter (menu-bar-frame-for-menubar)
1233 : 'menu-bar-lines)))))
1234 :
1235 : (if (and (boundp 'menu-bar-showhide-tool-bar-menu)
1236 : (keymapp menu-bar-showhide-tool-bar-menu))
1237 : (bindings--define-key menu [showhide-tool-bar]
1238 : `(menu-item "Tool Bar" ,menu-bar-showhide-tool-bar-menu
1239 : :visible (display-graphic-p)))
1240 : ;; else not tool bar that can move.
1241 : (bindings--define-key menu [showhide-tool-bar]
1242 : '(menu-item "Tool Bar" toggle-tool-bar-mode-from-frame
1243 : :help "Turn tool bar on/off"
1244 : :visible (display-graphic-p)
1245 : :button
1246 : (:toggle . (menu-bar-positive-p
1247 : (frame-parameter (menu-bar-frame-for-menubar)
1248 : 'tool-bar-lines))))))
1249 : menu))
1250 :
1251 : (defvar menu-bar-line-wrapping-menu
1252 : (let ((menu (make-sparse-keymap "Line Wrapping")))
1253 :
1254 : (bindings--define-key menu [word-wrap]
1255 : `(menu-item "Word Wrap (Visual Line mode)"
1256 : ,(lambda ()
1257 : (interactive)
1258 : (unless visual-line-mode
1259 : (visual-line-mode 1))
1260 : (message "Visual-Line mode enabled"))
1261 : :help "Wrap long lines at word boundaries"
1262 : :button (:radio
1263 : . (and (null truncate-lines)
1264 : (not (truncated-partial-width-window-p))
1265 : word-wrap))
1266 : :visible (menu-bar-menu-frame-live-and-visible-p)))
1267 :
1268 : (bindings--define-key menu [truncate]
1269 : `(menu-item "Truncate Long Lines"
1270 : ,(lambda ()
1271 : (interactive)
1272 : (if visual-line-mode (visual-line-mode 0))
1273 : (setq word-wrap nil)
1274 : (toggle-truncate-lines 1))
1275 : :help "Truncate long lines at window edge"
1276 : :button (:radio . (or truncate-lines
1277 : (truncated-partial-width-window-p)))
1278 : :visible (menu-bar-menu-frame-live-and-visible-p)
1279 : :enable (not (truncated-partial-width-window-p))))
1280 :
1281 : (bindings--define-key menu [window-wrap]
1282 : `(menu-item "Wrap at Window Edge"
1283 : ,(lambda () (interactive)
1284 : (if visual-line-mode (visual-line-mode 0))
1285 : (setq word-wrap nil)
1286 : (if truncate-lines (toggle-truncate-lines -1)))
1287 : :help "Wrap long lines at window edge"
1288 : :button (:radio
1289 : . (and (null truncate-lines)
1290 : (not (truncated-partial-width-window-p))
1291 : (not word-wrap)))
1292 : :visible (menu-bar-menu-frame-live-and-visible-p)
1293 : :enable (not (truncated-partial-width-window-p))))
1294 : menu))
1295 :
1296 : (defvar menu-bar-search-options-menu
1297 : (let ((menu (make-sparse-keymap "Search Options")))
1298 :
1299 : (dolist (x '((char-fold-to-regexp "Fold Characters" "Character folding")
1300 : (isearch-symbol-regexp "Whole Symbols" "Whole symbol")
1301 : (word-search-regexp "Whole Words" "Whole word")))
1302 : (bindings--define-key menu (vector (nth 0 x))
1303 : `(menu-item ,(nth 1 x)
1304 : (lambda ()
1305 : (interactive)
1306 : (setq search-default-mode #',(nth 0 x))
1307 : (message ,(format "%s search enabled" (nth 2 x))))
1308 : :help ,(format "Enable %s search" (downcase (nth 2 x)))
1309 : :button (:radio . (eq search-default-mode #',(nth 0 x))))))
1310 :
1311 : (bindings--define-key menu [regexp-search]
1312 : '(menu-item "Regular Expression"
1313 : (lambda ()
1314 : (interactive)
1315 : (setq search-default-mode t)
1316 : (message "Regular-expression search enabled"))
1317 : :help "Enable regular-expression search"
1318 : :button (:radio . (eq search-default-mode t))))
1319 :
1320 : (bindings--define-key menu [regular-search]
1321 : '(menu-item "Literal Search"
1322 : (lambda ()
1323 : (interactive)
1324 : (when search-default-mode
1325 : (setq search-default-mode nil)
1326 : (when (symbolp search-default-mode)
1327 : (message "Literal search enabled"))))
1328 : :help "Disable special search modes"
1329 : :button (:radio . (not search-default-mode))))
1330 :
1331 : (bindings--define-key menu [custom-separator]
1332 : menu-bar-separator)
1333 : (bindings--define-key menu [case-fold-search]
1334 : (menu-bar-make-toggle
1335 : toggle-case-fold-search case-fold-search
1336 : "Ignore Case"
1337 : "Case-Insensitive Search %s"
1338 : "Ignore letter-case in search commands"))
1339 :
1340 : menu))
1341 :
1342 : (defvar menu-bar-options-menu
1343 : (let ((menu (make-sparse-keymap "Options")))
1344 : (bindings--define-key menu [customize]
1345 : `(menu-item "Customize Emacs" ,menu-bar-custom-menu))
1346 :
1347 : (bindings--define-key menu [package]
1348 : '(menu-item "Manage Emacs Packages" package-list-packages
1349 : :help "Install or uninstall additional Emacs packages"))
1350 :
1351 : (bindings--define-key menu [save]
1352 : '(menu-item "Save Options" menu-bar-options-save
1353 : :help "Save options set from the menu above"))
1354 :
1355 : (bindings--define-key menu [custom-separator]
1356 : menu-bar-separator)
1357 :
1358 : (bindings--define-key menu [menu-set-font]
1359 : '(menu-item "Set Default Font..." menu-set-font
1360 : :visible (display-multi-font-p)
1361 : :help "Select a default font"))
1362 :
1363 : (if (featurep 'system-font-setting)
1364 : (bindings--define-key menu [menu-system-font]
1365 : (menu-bar-make-toggle
1366 : toggle-use-system-font font-use-system-font
1367 : "Use System Font"
1368 : "Use system font: %s"
1369 : "Use the monospaced font defined by the system")))
1370 :
1371 : (bindings--define-key menu [showhide]
1372 : `(menu-item "Show/Hide" ,menu-bar-showhide-menu))
1373 :
1374 : (bindings--define-key menu [showhide-separator]
1375 : menu-bar-separator)
1376 :
1377 : (bindings--define-key menu [mule]
1378 : ;; It is better not to use backquote here,
1379 : ;; because that makes a bootstrapping problem
1380 : ;; if you need to recompile all the Lisp files using interpreted code.
1381 : `(menu-item "Multilingual Environment" ,mule-menu-keymap
1382 : ;; Most of the MULE menu actually does make sense in
1383 : ;; unibyte mode, e.g. language selection.
1384 : ;; :visible '(default-value 'enable-multibyte-characters)
1385 : ))
1386 : ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
1387 : ;;(bindings--define-key menu [preferences]
1388 : ;; `(menu-item "Preferences" ,menu-bar-preferences-menu
1389 : ;; :help "Toggle important global options"))
1390 :
1391 : (bindings--define-key menu [mule-separator]
1392 : menu-bar-separator)
1393 :
1394 : (bindings--define-key menu [debug-on-quit]
1395 : (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
1396 : "Enter Debugger on Quit/C-g" "Debug on Quit %s"
1397 : "Enter Lisp debugger when C-g is pressed"))
1398 : (bindings--define-key menu [debug-on-error]
1399 : (menu-bar-make-toggle toggle-debug-on-error debug-on-error
1400 : "Enter Debugger on Error" "Debug on Error %s"
1401 : "Enter Lisp debugger when an error is signaled"))
1402 : (bindings--define-key menu [debugger-separator]
1403 : menu-bar-separator)
1404 :
1405 : (bindings--define-key menu [blink-cursor-mode]
1406 : (menu-bar-make-mm-toggle
1407 : blink-cursor-mode
1408 : "Blink Cursor"
1409 : "Whether the cursor blinks (Blink Cursor mode)"))
1410 : (bindings--define-key menu [cursor-separator]
1411 : menu-bar-separator)
1412 :
1413 : (bindings--define-key menu [save-place]
1414 : (menu-bar-make-toggle
1415 : toggle-save-place-globally save-place
1416 : "Save Place in Files between Sessions"
1417 : "Saving place in files %s"
1418 : "Visit files of previous session when restarting Emacs"
1419 : (require 'saveplace)
1420 : ;; Do it by name, to avoid a free-variable
1421 : ;; warning during byte compilation.
1422 : (set-default
1423 : 'save-place (not (symbol-value 'save-place)))))
1424 :
1425 : (bindings--define-key menu [uniquify]
1426 : (menu-bar-make-toggle
1427 : toggle-uniquify-buffer-names uniquify-buffer-name-style
1428 : "Use Directory Names in Buffer Names"
1429 : "Directory name in buffer names (uniquify) %s"
1430 : "Uniquify buffer names by adding parent directory names"
1431 : (setq uniquify-buffer-name-style
1432 : (if (not uniquify-buffer-name-style)
1433 : 'post-forward-angle-brackets))))
1434 :
1435 : (bindings--define-key menu [edit-options-separator]
1436 : menu-bar-separator)
1437 : (bindings--define-key menu [cua-mode]
1438 : (menu-bar-make-mm-toggle
1439 : cua-mode
1440 : "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
1441 : "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
1442 : (:visible (or (not (boundp 'cua-enable-cua-keys))
1443 : cua-enable-cua-keys))))
1444 :
1445 : (bindings--define-key menu [cua-emulation-mode]
1446 : (menu-bar-make-mm-toggle
1447 : cua-mode
1448 : "Shift movement mark region (CUA)"
1449 : "Use shifted movement keys to set and extend the region"
1450 : (:visible (and (boundp 'cua-enable-cua-keys)
1451 : (not cua-enable-cua-keys)))))
1452 :
1453 : (bindings--define-key menu [search-options]
1454 : `(menu-item "Default Search Options"
1455 : ,menu-bar-search-options-menu))
1456 :
1457 : (bindings--define-key menu [line-wrapping]
1458 : `(menu-item "Line Wrapping in This Buffer"
1459 : ,menu-bar-line-wrapping-menu))
1460 :
1461 :
1462 : (bindings--define-key menu [highlight-separator]
1463 : menu-bar-separator)
1464 : (bindings--define-key menu [highlight-paren-mode]
1465 : (menu-bar-make-mm-toggle
1466 : show-paren-mode
1467 : "Highlight Matching Parentheses"
1468 : "Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
1469 : (bindings--define-key menu [transient-mark-mode]
1470 : (menu-bar-make-mm-toggle
1471 : transient-mark-mode
1472 : "Highlight Active Region"
1473 : "Make text in active region stand out in color (Transient Mark mode)"
1474 : (:enable (not cua-mode))))
1475 : menu))
1476 :
1477 :
1478 : ;; The "Tools" menu items
1479 :
1480 : (defvar menu-bar-games-menu
1481 : (let ((menu (make-sparse-keymap "Games")))
1482 :
1483 : (bindings--define-key menu [zone]
1484 : '(menu-item "Zone Out" zone
1485 : :help "Play tricks with Emacs display when Emacs is idle"))
1486 : (bindings--define-key menu [tetris]
1487 : '(menu-item "Tetris" tetris
1488 : :help "Falling blocks game"))
1489 : (bindings--define-key menu [solitaire]
1490 : '(menu-item "Solitaire" solitaire
1491 : :help "Get rid of all the stones"))
1492 : (bindings--define-key menu [snake]
1493 : '(menu-item "Snake" snake
1494 : :help "Move snake around avoiding collisions"))
1495 : (bindings--define-key menu [pong]
1496 : '(menu-item "Pong" pong
1497 : :help "Bounce the ball to your opponent"))
1498 : (bindings--define-key menu [mult]
1499 : '(menu-item "Multiplication Puzzle" mpuz
1500 : :help "Exercise brain with multiplication"))
1501 : (bindings--define-key menu [life]
1502 : '(menu-item "Life" life
1503 : :help "Watch how John Conway's cellular automaton evolves"))
1504 : (bindings--define-key menu [hanoi]
1505 : '(menu-item "Towers of Hanoi" hanoi
1506 : :help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
1507 : (bindings--define-key menu [gomoku]
1508 : '(menu-item "Gomoku" gomoku
1509 : :help "Mark 5 contiguous squares (like tic-tac-toe)"))
1510 : (bindings--define-key menu [bubbles]
1511 : '(menu-item "Bubbles" bubbles
1512 : :help "Remove all bubbles using the fewest moves"))
1513 : (bindings--define-key menu [black-box]
1514 : '(menu-item "Blackbox" blackbox
1515 : :help "Find balls in a black box by shooting rays"))
1516 : (bindings--define-key menu [adventure]
1517 : '(menu-item "Adventure" dunnet
1518 : :help "Dunnet, a text Adventure game for Emacs"))
1519 : (bindings--define-key menu [5x5]
1520 : '(menu-item "5x5" 5x5
1521 : :help "Fill in all the squares on a 5x5 board"))
1522 : menu))
1523 :
1524 : (defvar menu-bar-encryption-decryption-menu
1525 : (let ((menu (make-sparse-keymap "Encryption/Decryption")))
1526 : (bindings--define-key menu [insert-keys]
1527 : '(menu-item "Insert Keys" epa-insert-keys
1528 : :help "Insert public keys after the current point"))
1529 :
1530 : (bindings--define-key menu [export-keys]
1531 : '(menu-item "Export Keys" epa-export-keys
1532 : :help "Export public keys to a file"))
1533 :
1534 : (bindings--define-key menu [import-keys-region]
1535 : '(menu-item "Import Keys from Region" epa-import-keys-region
1536 : :help "Import public keys from the current region"))
1537 :
1538 : (bindings--define-key menu [import-keys]
1539 : '(menu-item "Import Keys from File..." epa-import-keys
1540 : :help "Import public keys from a file"))
1541 :
1542 : (bindings--define-key menu [list-keys]
1543 : '(menu-item "List Keys" epa-list-keys
1544 : :help "Browse your public keyring"))
1545 :
1546 : (bindings--define-key menu [separator-keys]
1547 : menu-bar-separator)
1548 :
1549 : (bindings--define-key menu [sign-region]
1550 : '(menu-item "Sign Region" epa-sign-region
1551 : :help "Create digital signature of the current region"))
1552 :
1553 : (bindings--define-key menu [verify-region]
1554 : '(menu-item "Verify Region" epa-verify-region
1555 : :help "Verify digital signature of the current region"))
1556 :
1557 : (bindings--define-key menu [encrypt-region]
1558 : '(menu-item "Encrypt Region" epa-encrypt-region
1559 : :help "Encrypt the current region"))
1560 :
1561 : (bindings--define-key menu [decrypt-region]
1562 : '(menu-item "Decrypt Region" epa-decrypt-region
1563 : :help "Decrypt the current region"))
1564 :
1565 : (bindings--define-key menu [separator-file]
1566 : menu-bar-separator)
1567 :
1568 : (bindings--define-key menu [sign-file]
1569 : '(menu-item "Sign File..." epa-sign-file
1570 : :help "Create digital signature of a file"))
1571 :
1572 : (bindings--define-key menu [verify-file]
1573 : '(menu-item "Verify File..." epa-verify-file
1574 : :help "Verify digital signature of a file"))
1575 :
1576 : (bindings--define-key menu [encrypt-file]
1577 : '(menu-item "Encrypt File..." epa-encrypt-file
1578 : :help "Encrypt a file"))
1579 :
1580 : (bindings--define-key menu [decrypt-file]
1581 : '(menu-item "Decrypt File..." epa-decrypt-file
1582 : :help "Decrypt a file"))
1583 :
1584 : menu))
1585 :
1586 : (defun menu-bar-read-mail ()
1587 : "Read mail using `read-mail-command'."
1588 : (interactive)
1589 0 : (call-interactively read-mail-command))
1590 :
1591 : (defvar menu-bar-tools-menu
1592 : (let ((menu (make-sparse-keymap "Tools")))
1593 :
1594 : (bindings--define-key menu [games]
1595 : `(menu-item "Games" ,menu-bar-games-menu))
1596 :
1597 : (bindings--define-key menu [separator-games]
1598 : menu-bar-separator)
1599 :
1600 : (bindings--define-key menu [encryption-decryption]
1601 : `(menu-item "Encryption/Decryption"
1602 : ,menu-bar-encryption-decryption-menu))
1603 :
1604 : (bindings--define-key menu [separator-encryption-decryption]
1605 : menu-bar-separator)
1606 :
1607 : (bindings--define-key menu [simple-calculator]
1608 : '(menu-item "Simple Calculator" calculator
1609 : :help "Invoke the Emacs built-in quick calculator"))
1610 : (bindings--define-key menu [calc]
1611 : '(menu-item "Programmable Calculator" calc
1612 : :help "Invoke the Emacs built-in full scientific calculator"))
1613 : (bindings--define-key menu [calendar]
1614 : '(menu-item "Calendar" calendar
1615 : :help "Invoke the Emacs built-in calendar"))
1616 :
1617 : (bindings--define-key menu [separator-net]
1618 : menu-bar-separator)
1619 :
1620 : (bindings--define-key menu [browse-web]
1621 : '(menu-item "Browse the Web..." browse-web))
1622 : (bindings--define-key menu [directory-search]
1623 : '(menu-item "Directory Servers" eudc-tools-menu))
1624 : (bindings--define-key menu [compose-mail]
1625 : '(menu-item "Compose New Mail" compose-mail
1626 : :visible (and mail-user-agent (not (eq mail-user-agent 'ignore)))
1627 : :help "Start writing a new mail message"))
1628 : (bindings--define-key menu [rmail]
1629 : '(menu-item "Read Mail" menu-bar-read-mail
1630 : :visible (and read-mail-command
1631 : (not (eq read-mail-command 'ignore)))
1632 : :help "Read your mail"))
1633 :
1634 : (bindings--define-key menu [gnus]
1635 : '(menu-item "Read Net News" gnus
1636 : :help "Read network news groups"))
1637 :
1638 : (bindings--define-key menu [separator-vc]
1639 : menu-bar-separator)
1640 :
1641 : (bindings--define-key menu [vc] nil) ;Create the place for the VC menu.
1642 :
1643 : (bindings--define-key menu [separator-compare]
1644 : menu-bar-separator)
1645 :
1646 : (bindings--define-key menu [epatch]
1647 : '(menu-item "Apply Patch" menu-bar-epatch-menu))
1648 : (bindings--define-key menu [ediff-merge]
1649 : '(menu-item "Merge" menu-bar-ediff-merge-menu))
1650 : (bindings--define-key menu [compare]
1651 : '(menu-item "Compare (Ediff)" menu-bar-ediff-menu))
1652 :
1653 : (bindings--define-key menu [separator-spell]
1654 : menu-bar-separator)
1655 :
1656 : (bindings--define-key menu [spell]
1657 : '(menu-item "Spell Checking" ispell-menu-map))
1658 :
1659 : (bindings--define-key menu [separator-prog]
1660 : menu-bar-separator)
1661 :
1662 : (bindings--define-key menu [semantic]
1663 : '(menu-item "Source Code Parsers (Semantic)"
1664 : semantic-mode
1665 : :help "Toggle automatic parsing in source code buffers (Semantic mode)"
1666 : :button (:toggle . (bound-and-true-p semantic-mode))))
1667 :
1668 : (bindings--define-key menu [ede]
1669 : '(menu-item "Project Support (EDE)"
1670 : global-ede-mode
1671 : :help "Toggle the Emacs Development Environment (Global EDE mode)"
1672 : :button (:toggle . (bound-and-true-p global-ede-mode))))
1673 :
1674 : (bindings--define-key menu [gdb]
1675 : '(menu-item "Debugger (GDB)..." gdb
1676 : :help "Debug a program from within Emacs with GDB"))
1677 : (bindings--define-key menu [shell-on-region]
1678 : '(menu-item "Shell Command on Region..." shell-command-on-region
1679 : :enable mark-active
1680 : :help "Pass marked region to a shell command"))
1681 : (bindings--define-key menu [shell]
1682 : '(menu-item "Shell Command..." shell-command
1683 : :help "Invoke a shell command and catch its output"))
1684 : (bindings--define-key menu [compile]
1685 : '(menu-item "Compile..." compile
1686 : :help "Invoke compiler or Make, view compilation errors"))
1687 : (bindings--define-key menu [grep]
1688 : '(menu-item "Search Files (Grep)..." grep
1689 : :help "Search files for strings or regexps (with Grep)"))
1690 : menu))
1691 :
1692 : ;; The "Help" menu items
1693 :
1694 : (defvar menu-bar-describe-menu
1695 : (let ((menu (make-sparse-keymap "Describe")))
1696 :
1697 : (bindings--define-key menu [mule-diag]
1698 : '(menu-item "Show All of Mule Status" mule-diag
1699 : :visible (default-value 'enable-multibyte-characters)
1700 : :help "Display multilingual environment settings"))
1701 : (bindings--define-key menu [describe-coding-system-briefly]
1702 : '(menu-item "Describe Coding System (Briefly)"
1703 : describe-current-coding-system-briefly
1704 : :visible (default-value 'enable-multibyte-characters)))
1705 : (bindings--define-key menu [describe-coding-system]
1706 : '(menu-item "Describe Coding System..." describe-coding-system
1707 : :visible (default-value 'enable-multibyte-characters)))
1708 : (bindings--define-key menu [describe-input-method]
1709 : '(menu-item "Describe Input Method..." describe-input-method
1710 : :visible (default-value 'enable-multibyte-characters)
1711 : :help "Keyboard layout for specific input method"))
1712 : (bindings--define-key menu [describe-language-environment]
1713 : `(menu-item "Describe Language Environment"
1714 : ,describe-language-environment-map))
1715 :
1716 : (bindings--define-key menu [separator-desc-mule]
1717 : menu-bar-separator)
1718 :
1719 : (bindings--define-key menu [list-keybindings]
1720 : '(menu-item "List Key Bindings" describe-bindings
1721 : :help "Display all current key bindings (keyboard shortcuts)"))
1722 : (bindings--define-key menu [describe-current-display-table]
1723 : '(menu-item "Describe Display Table" describe-current-display-table
1724 : :help "Describe the current display table"))
1725 : (bindings--define-key menu [describe-package]
1726 : '(menu-item "Describe Package..." describe-package
1727 : :help "Display documentation of a Lisp package"))
1728 : (bindings--define-key menu [describe-face]
1729 : '(menu-item "Describe Face..." describe-face
1730 : :help "Display the properties of a face"))
1731 : (bindings--define-key menu [describe-variable]
1732 : '(menu-item "Describe Variable..." describe-variable
1733 : :help "Display documentation of variable/option"))
1734 : (bindings--define-key menu [describe-function]
1735 : '(menu-item "Describe Function..." describe-function
1736 : :help "Display documentation of function/command"))
1737 : (bindings--define-key menu [describe-key-1]
1738 : '(menu-item "Describe Key or Mouse Operation..." describe-key
1739 : ;; Users typically don't identify keys and menu items...
1740 : :help "Display documentation of command bound to a \
1741 : key, a click, or a menu-item"))
1742 : (bindings--define-key menu [describe-mode]
1743 : '(menu-item "Describe Buffer Modes" describe-mode
1744 : :help "Describe this buffer's major and minor mode"))
1745 : menu))
1746 :
1747 : (defun menu-bar-read-lispref ()
1748 : "Display the Emacs Lisp Reference manual in Info mode."
1749 : (interactive)
1750 0 : (info "elisp"))
1751 :
1752 : (defun menu-bar-read-lispintro ()
1753 : "Display the Introduction to Emacs Lisp Programming in Info mode."
1754 : (interactive)
1755 0 : (info "eintr"))
1756 :
1757 : (defun search-emacs-glossary ()
1758 : "Display the Glossary node of the Emacs manual in Info mode."
1759 : (interactive)
1760 0 : (info "(emacs)Glossary"))
1761 :
1762 : (defun emacs-index-search (topic)
1763 : "Look up TOPIC in the indices of the Emacs User Manual."
1764 : (interactive "sSubject to look up: ")
1765 0 : (info "emacs")
1766 0 : (Info-index topic))
1767 :
1768 : (defun elisp-index-search (topic)
1769 : "Look up TOPIC in the indices of the Emacs Lisp Reference Manual."
1770 : (interactive "sSubject to look up: ")
1771 0 : (info "elisp")
1772 0 : (Info-index topic))
1773 :
1774 : (defvar menu-bar-search-documentation-menu
1775 : (let ((menu (make-sparse-keymap "Search Documentation")))
1776 :
1777 : (bindings--define-key menu [search-documentation-strings]
1778 : '(menu-item "Search Documentation Strings..." apropos-documentation
1779 : :help
1780 : "Find functions and variables whose doc strings match a regexp"))
1781 : (bindings--define-key menu [find-any-object-by-name]
1782 : '(menu-item "Find Any Object by Name..." apropos
1783 : :help "Find symbols of any kind whose names match a regexp"))
1784 : (bindings--define-key menu [find-option-by-value]
1785 : '(menu-item "Find Options by Value..." apropos-value
1786 : :help "Find variables whose values match a regexp"))
1787 : (bindings--define-key menu [find-options-by-name]
1788 : '(menu-item "Find Options by Name..." apropos-user-option
1789 : :help "Find user options whose names match a regexp"))
1790 : (bindings--define-key menu [find-commands-by-name]
1791 : '(menu-item "Find Commands by Name..." apropos-command
1792 : :help "Find commands whose names match a regexp"))
1793 : (bindings--define-key menu [sep1]
1794 : menu-bar-separator)
1795 : (bindings--define-key menu [lookup-command-in-manual]
1796 : '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node
1797 : :help "Display manual section that describes a command"))
1798 : (bindings--define-key menu [lookup-key-in-manual]
1799 : '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node
1800 : :help "Display manual section that describes a key"))
1801 : (bindings--define-key menu [lookup-subject-in-elisp-manual]
1802 : '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search
1803 : :help "Find description of a subject in Emacs Lisp manual"))
1804 : (bindings--define-key menu [lookup-subject-in-emacs-manual]
1805 : '(menu-item "Look Up Subject in User Manual..." emacs-index-search
1806 : :help "Find description of a subject in Emacs User manual"))
1807 : (bindings--define-key menu [emacs-terminology]
1808 : '(menu-item "Emacs Terminology" search-emacs-glossary
1809 : :help "Display the Glossary section of the Emacs manual"))
1810 : menu))
1811 :
1812 : (defvar menu-bar-manuals-menu
1813 : (let ((menu (make-sparse-keymap "More Manuals")))
1814 :
1815 : (bindings--define-key menu [man]
1816 : '(menu-item "Read Man Page..." manual-entry
1817 : :help "Man-page docs for external commands and libraries"))
1818 : (bindings--define-key menu [sep2]
1819 : menu-bar-separator)
1820 : (bindings--define-key menu [order-emacs-manuals]
1821 : '(menu-item "Ordering Manuals" view-order-manuals
1822 : :help "How to order manuals from the Free Software Foundation"))
1823 : (bindings--define-key menu [lookup-subject-in-all-manuals]
1824 : '(menu-item "Lookup Subject in all Manuals..." info-apropos
1825 : :help "Find description of a subject in all installed manuals"))
1826 : (bindings--define-key menu [other-manuals]
1827 : '(menu-item "All Other Manuals (Info)" Info-directory
1828 : :help "Read any of the installed manuals"))
1829 : (bindings--define-key menu [emacs-lisp-reference]
1830 : '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref
1831 : :help "Read the Emacs Lisp Reference manual"))
1832 : (bindings--define-key menu [emacs-lisp-intro]
1833 : '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro
1834 : :help "Read the Introduction to Emacs Lisp Programming"))
1835 : menu))
1836 :
1837 : (defun help-with-tutorial-spec-language ()
1838 : "Use the Emacs tutorial, specifying which language you want."
1839 : (interactive)
1840 0 : (help-with-tutorial t))
1841 :
1842 : (defvar menu-bar-help-menu
1843 : (let ((menu (make-sparse-keymap "Help")))
1844 : (bindings--define-key menu [about-gnu-project]
1845 : '(menu-item "About GNU" describe-gnu-project
1846 : :help "About the GNU System, GNU Project, and GNU/Linux"))
1847 : (bindings--define-key menu [about-emacs]
1848 : '(menu-item "About Emacs" about-emacs
1849 : :help "Display version number, copyright info, and basic help"))
1850 : (bindings--define-key menu [sep4]
1851 : menu-bar-separator)
1852 : (bindings--define-key menu [describe-no-warranty]
1853 : '(menu-item "(Non)Warranty" describe-no-warranty
1854 : :help "Explain that Emacs has NO WARRANTY"))
1855 : (bindings--define-key menu [describe-copying]
1856 : '(menu-item "Copying Conditions" describe-copying
1857 : :help "Show the Emacs license (GPL)"))
1858 : (bindings--define-key menu [getting-new-versions]
1859 : '(menu-item "Getting New Versions" describe-distribution
1860 : :help "How to get the latest version of Emacs"))
1861 : (bindings--define-key menu [sep2]
1862 : menu-bar-separator)
1863 : (bindings--define-key menu [external-packages]
1864 : '(menu-item "Finding Extra Packages" view-external-packages
1865 : :help "How to get more Lisp packages for use in Emacs"))
1866 : (bindings--define-key menu [find-emacs-packages]
1867 : '(menu-item "Search Built-in Packages" finder-by-keyword
1868 : :help "Find built-in packages and features by keyword"))
1869 : (bindings--define-key menu [more-manuals]
1870 : `(menu-item "More Manuals" ,menu-bar-manuals-menu))
1871 : (bindings--define-key menu [emacs-manual]
1872 : '(menu-item "Read the Emacs Manual" info-emacs-manual
1873 : :help "Full documentation of Emacs features"))
1874 : (bindings--define-key menu [describe]
1875 : `(menu-item "Describe" ,menu-bar-describe-menu))
1876 : (bindings--define-key menu [search-documentation]
1877 : `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu))
1878 : (bindings--define-key menu [sep1]
1879 : menu-bar-separator)
1880 : (bindings--define-key menu [emacs-psychotherapist]
1881 : '(menu-item "Emacs Psychotherapist" doctor
1882 : :help "Our doctor will help you feel better"))
1883 : (bindings--define-key menu [send-emacs-bug-report]
1884 : '(menu-item "Send Bug Report..." report-emacs-bug
1885 : :help "Send e-mail to Emacs maintainers"))
1886 : (bindings--define-key menu [emacs-manual-bug]
1887 : '(menu-item "How to Report a Bug" info-emacs-bug
1888 : :help "Read about how to report an Emacs bug"))
1889 : (bindings--define-key menu [emacs-known-problems]
1890 : '(menu-item "Emacs Known Problems" view-emacs-problems
1891 : :help "Read about known problems with Emacs"))
1892 : (bindings--define-key menu [emacs-news]
1893 : '(menu-item "Emacs News" view-emacs-news
1894 : :help "New features of this version"))
1895 : (bindings--define-key menu [emacs-faq]
1896 : '(menu-item "Emacs FAQ" view-emacs-FAQ
1897 : :help "Frequently asked (and answered) questions about Emacs"))
1898 :
1899 : (bindings--define-key menu [emacs-tutorial-language-specific]
1900 : '(menu-item "Emacs Tutorial (choose language)..."
1901 : help-with-tutorial-spec-language
1902 : :help "Learn how to use Emacs (choose a language)"))
1903 : (bindings--define-key menu [emacs-tutorial]
1904 : '(menu-item "Emacs Tutorial" help-with-tutorial
1905 : :help "Learn how to use Emacs"))
1906 :
1907 : ;; In macOS it's in the app menu already.
1908 : ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu.
1909 : (and (featurep 'ns)
1910 : (not (eq system-type 'darwin))
1911 : (bindings--define-key menu [info-panel]
1912 : '(menu-item "About Emacs..." ns-do-emacs-info-panel)))
1913 : menu))
1914 :
1915 : (bindings--define-key global-map [menu-bar tools]
1916 : (cons "Tools" menu-bar-tools-menu))
1917 : (bindings--define-key global-map [menu-bar buffer]
1918 : (cons "Buffers" global-buffers-menu-map))
1919 : (bindings--define-key global-map [menu-bar options]
1920 : (cons "Options" menu-bar-options-menu))
1921 : (bindings--define-key global-map [menu-bar edit]
1922 : (cons "Edit" menu-bar-edit-menu))
1923 : (bindings--define-key global-map [menu-bar file]
1924 : (cons "File" menu-bar-file-menu))
1925 : (bindings--define-key global-map [menu-bar help-menu]
1926 : (cons (purecopy "Help") menu-bar-help-menu))
1927 :
1928 : (defun menu-bar-menu-frame-live-and-visible-p ()
1929 : "Return non-nil if the menu frame is alive and visible.
1930 : The menu frame is the frame for which we are updating the menu."
1931 0 : (let ((menu-frame (or menu-updating-frame (selected-frame))))
1932 0 : (and (frame-live-p menu-frame)
1933 0 : (frame-visible-p menu-frame))))
1934 :
1935 : (defun menu-bar-non-minibuffer-window-p ()
1936 : "Return non-nil if the menu frame's selected window is no minibuffer window.
1937 : Return nil if the menu frame is dead or its selected window is a
1938 : minibuffer window. The menu frame is the frame for which we are
1939 : updating the menu."
1940 0 : (let ((menu-frame (or menu-updating-frame (selected-frame))))
1941 0 : (and (frame-live-p menu-frame)
1942 0 : (not (window-minibuffer-p
1943 0 : (frame-selected-window menu-frame))))))
1944 :
1945 : (defun kill-this-buffer () ; for the menu bar
1946 : "Kill the current buffer.
1947 : When called in the minibuffer, get out of the minibuffer
1948 : using `abort-recursive-edit'.
1949 :
1950 : This command can be reliably invoked only from the menu bar,
1951 : otherwise it could decide to silently do nothing."
1952 : (interactive)
1953 0 : (cond
1954 : ;; Don't do anything when `menu-frame' is not alive or visible
1955 : ;; (Bug#8184).
1956 0 : ((not (menu-bar-menu-frame-live-and-visible-p)))
1957 0 : ((menu-bar-non-minibuffer-window-p)
1958 0 : (kill-buffer (current-buffer)))
1959 : (t
1960 0 : (abort-recursive-edit))))
1961 :
1962 : (defun kill-this-buffer-enabled-p ()
1963 : "Return non-nil if the `kill-this-buffer' menu item should be enabled."
1964 0 : (or (not (menu-bar-non-minibuffer-window-p))
1965 0 : (let (found-1)
1966 : ;; Instead of looping over entire buffer list, stop once we've
1967 : ;; found two "killable" buffers (Bug#8184).
1968 0 : (catch 'found-2
1969 0 : (dolist (buffer (buffer-list))
1970 0 : (unless (string-match-p "^ " (buffer-name buffer))
1971 0 : (if (not found-1)
1972 0 : (setq found-1 t)
1973 0 : (throw 'found-2 t))))))))
1974 :
1975 : (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p))
1976 :
1977 : ;; Permit deleting frame if it would leave a visible or iconified frame.
1978 : (defun delete-frame-enabled-p ()
1979 : "Return non-nil if `delete-frame' should be enabled in the menu bar."
1980 0 : (let ((frames (frame-list))
1981 : (count 0))
1982 0 : (while frames
1983 0 : (if (frame-visible-p (car frames))
1984 0 : (setq count (1+ count)))
1985 0 : (setq frames (cdr frames)))
1986 0 : (> count 1)))
1987 :
1988 : (defcustom yank-menu-length 20
1989 : "Maximum length to display in the yank-menu."
1990 : :type 'integer
1991 : :group 'menu)
1992 :
1993 : (defun menu-bar-update-yank-menu (string old)
1994 0 : (let ((front (car (cdr yank-menu)))
1995 0 : (menu-string (if (<= (length string) yank-menu-length)
1996 0 : string
1997 0 : (concat
1998 0 : (substring string 0 (/ yank-menu-length 2))
1999 : "..."
2000 0 : (substring string (- (/ yank-menu-length 2)))))))
2001 : ;; Don't let the menu string be all dashes
2002 : ;; because that has a special meaning in a menu.
2003 0 : (if (string-match "\\`-+\\'" menu-string)
2004 0 : (setq menu-string (concat menu-string " ")))
2005 : ;; If we're supposed to be extending an existing string, and that
2006 : ;; string really is at the front of the menu, then update it in place.
2007 0 : (if (and old (or (eq old (car front))
2008 0 : (string= old (car front))))
2009 0 : (progn
2010 0 : (setcar front string)
2011 0 : (setcar (cdr front) menu-string))
2012 0 : (setcdr yank-menu
2013 0 : (cons
2014 0 : (cons string (cons menu-string 'menu-bar-select-yank))
2015 0 : (cdr yank-menu)))))
2016 0 : (if (> (length (cdr yank-menu)) kill-ring-max)
2017 0 : (setcdr (nthcdr kill-ring-max yank-menu) nil)))
2018 :
2019 : (put 'menu-bar-select-yank 'apropos-inhibit t)
2020 : (defun menu-bar-select-yank ()
2021 : "Insert the stretch of previously-killed text selected from menu.
2022 : The menu shows all the killed text sequences stored in `kill-ring'."
2023 : (interactive "*")
2024 0 : (push-mark)
2025 0 : (insert last-command-event))
2026 :
2027 :
2028 : ;;; Buffers Menu
2029 :
2030 : (defcustom buffers-menu-max-size 10
2031 : "Maximum number of entries which may appear on the Buffers menu.
2032 : If this is 10, then only the ten most-recently-selected buffers are shown.
2033 : If this is nil, then all buffers are shown.
2034 : A large number or nil slows down menu responsiveness."
2035 : :type '(choice integer
2036 : (const :tag "All" nil))
2037 : :group 'menu)
2038 :
2039 : (defcustom buffers-menu-buffer-name-length 30
2040 : "Maximum length of the buffer name on the Buffers menu.
2041 : If this is a number, then buffer names are truncated to this length.
2042 : If this is nil, then buffer names are shown in full.
2043 : A large number or nil makes the menu too wide."
2044 : :type '(choice integer
2045 : (const :tag "Full length" nil))
2046 : :group 'menu)
2047 :
2048 : (defcustom buffers-menu-show-directories 'unless-uniquify
2049 : "If non-nil, show directories in the Buffers menu for buffers that have them.
2050 : The special value `unless-uniquify' means that directories will be shown
2051 : unless `uniquify-buffer-name-style' is non-nil (in which case, buffer
2052 : names should include enough of a buffer's directory to distinguish it
2053 : from other buffers).
2054 :
2055 : Setting this variable directly does not take effect until next time the
2056 : Buffers menu is regenerated."
2057 : :set (lambda (symbol value)
2058 : (set symbol value)
2059 : (menu-bar-update-buffers t))
2060 : :initialize 'custom-initialize-default
2061 : :type '(choice (const :tag "Never" nil)
2062 : (const :tag "Unless uniquify is enabled" unless-uniquify)
2063 : (const :tag "Always" t))
2064 : :group 'menu)
2065 :
2066 : (defcustom buffers-menu-show-status t
2067 : "If non-nil, show modified/read-only status of buffers in the Buffers menu.
2068 : Setting this variable directly does not take effect until next time the
2069 : Buffers menu is regenerated."
2070 : :set (lambda (symbol value)
2071 : (set symbol value)
2072 : (menu-bar-update-buffers t))
2073 : :initialize 'custom-initialize-default
2074 : :type 'boolean
2075 : :group 'menu)
2076 :
2077 : (defvar list-buffers-directory nil
2078 : "String to display in buffer listings for buffers not visiting a file.")
2079 : (make-variable-buffer-local 'list-buffers-directory)
2080 :
2081 : (defun menu-bar-select-buffer ()
2082 : (interactive)
2083 0 : (switch-to-buffer last-command-event))
2084 :
2085 : (defun menu-bar-select-frame (frame)
2086 0 : (make-frame-visible frame)
2087 0 : (raise-frame frame)
2088 0 : (select-frame frame))
2089 :
2090 : (defun menu-bar-update-buffers-1 (elt)
2091 10 : (let* ((buf (car elt))
2092 : (file
2093 10 : (and (if (eq buffers-menu-show-directories 'unless-uniquify)
2094 10 : (or (not (boundp 'uniquify-buffer-name-style))
2095 10 : (null uniquify-buffer-name-style))
2096 10 : buffers-menu-show-directories)
2097 0 : (or (buffer-file-name buf)
2098 10 : (buffer-local-value 'list-buffers-directory buf)))))
2099 10 : (when file
2100 10 : (setq file (file-name-directory file)))
2101 10 : (when (and file (> (length file) 20))
2102 10 : (setq file (concat "..." (substring file -17))))
2103 10 : (cons (if buffers-menu-show-status
2104 10 : (let ((mod (if (buffer-modified-p buf) "*" ""))
2105 10 : (ro (if (buffer-local-value 'buffer-read-only buf) "%" "")))
2106 10 : (if file
2107 0 : (format "%s %s%s -- %s" (cdr elt) mod ro file)
2108 10 : (format "%s %s%s" (cdr elt) mod ro)))
2109 0 : (if file
2110 0 : (format "%s -- %s" (cdr elt) file)
2111 10 : (cdr elt)))
2112 10 : buf)))
2113 :
2114 : ;; Used to cache the menu entries for commands in the Buffers menu
2115 : (defvar menu-bar-buffers-menu-command-entries nil)
2116 :
2117 : (defvar menu-bar-select-buffer-function 'switch-to-buffer
2118 : "Function to select the buffer chosen from the `Buffers' menu-bar menu.
2119 : It must accept a buffer as its only required argument.")
2120 :
2121 : (defun menu-bar-buffer-vector (alist)
2122 : ;; turn ((name . buffer) ...) into a menu
2123 1 : (let ((buffers-vec (make-vector (length alist) nil))
2124 1 : (i (length alist)))
2125 1 : (dolist (pair alist)
2126 10 : (setq i (1- i))
2127 10 : (aset buffers-vec i
2128 10 : (cons (car pair)
2129 10 : `(lambda ()
2130 : (interactive)
2131 10 : (funcall menu-bar-select-buffer-function ,(cdr pair))))))
2132 1 : buffers-vec))
2133 :
2134 : (defun menu-bar-update-buffers (&optional force)
2135 : ;; If user discards the Buffers item, play along.
2136 1 : (and (lookup-key (current-global-map) [menu-bar buffer])
2137 1 : (or force (frame-or-buffer-changed-p))
2138 1 : (let ((buffers (buffer-list))
2139 1 : (frames (frame-list))
2140 : buffers-menu)
2141 :
2142 : ;; Make the menu of buffers proper.
2143 1 : (setq buffers-menu
2144 1 : (let ((i 0)
2145 1 : (limit (if (and (integerp buffers-menu-max-size)
2146 1 : (> buffers-menu-max-size 1))
2147 1 : buffers-menu-max-size most-positive-fixnum))
2148 : alist)
2149 : ;; Put into each element of buffer-list
2150 : ;; the name for actual display,
2151 : ;; perhaps truncated in the middle.
2152 11 : (while buffers
2153 20 : (let* ((buf (pop buffers))
2154 10 : (name (buffer-name buf)))
2155 10 : (unless (eq ?\s (aref name 0))
2156 10 : (push (menu-bar-update-buffers-1
2157 10 : (cons buf
2158 10 : (if (and (integerp buffers-menu-buffer-name-length)
2159 10 : (> (length name) buffers-menu-buffer-name-length))
2160 0 : (concat
2161 0 : (substring
2162 0 : name 0 (/ buffers-menu-buffer-name-length 2))
2163 : "..."
2164 0 : (substring
2165 0 : name (- (/ buffers-menu-buffer-name-length 2))))
2166 10 : name)
2167 10 : ))
2168 20 : alist)
2169 : ;; If requested, list only the N most recently
2170 : ;; selected buffers.
2171 10 : (when (= limit (setq i (1+ i)))
2172 10 : (setq buffers nil)))))
2173 1 : (list (menu-bar-buffer-vector alist))))
2174 :
2175 : ;; Make a Frames menu if we have more than one frame.
2176 1 : (when (cdr frames)
2177 0 : (let* ((frames-vec (make-vector (length frames) nil))
2178 : (frames-menu
2179 0 : (cons 'keymap
2180 0 : (list "Select Frame" frames-vec)))
2181 : (i 0))
2182 0 : (dolist (frame frames)
2183 0 : (aset frames-vec i
2184 0 : (cons
2185 0 : (frame-parameter frame 'name)
2186 0 : `(lambda ()
2187 0 : (interactive) (menu-bar-select-frame ,frame))))
2188 0 : (setq i (1+ i)))
2189 : ;; Put it after the normal buffers
2190 0 : (setq buffers-menu
2191 0 : (nconc buffers-menu
2192 0 : `((frames-separator "--")
2193 1 : (frames menu-item "Frames" ,frames-menu))))))
2194 :
2195 : ;; Add in some normal commands at the end of the menu. We use
2196 : ;; the copy cached in `menu-bar-buffers-menu-command-entries'
2197 : ;; if it's been set already. Note that we can't use constant
2198 : ;; lists for the menu-entries, because the low-level menu-code
2199 : ;; modifies them.
2200 1 : (unless menu-bar-buffers-menu-command-entries
2201 0 : (setq menu-bar-buffers-menu-command-entries
2202 0 : (list '(command-separator "--")
2203 0 : (list 'next-buffer
2204 : 'menu-item
2205 : "Next Buffer"
2206 : 'next-buffer
2207 0 : :help "Switch to the \"next\" buffer in a cyclic order")
2208 0 : (list 'previous-buffer
2209 : 'menu-item
2210 : "Previous Buffer"
2211 : 'previous-buffer
2212 0 : :help "Switch to the \"previous\" buffer in a cyclic order")
2213 0 : (list 'select-named-buffer
2214 : 'menu-item
2215 : "Select Named Buffer..."
2216 : 'switch-to-buffer
2217 0 : :help "Prompt for a buffer name, and select that buffer in the current window")
2218 0 : (list 'list-all-buffers
2219 : 'menu-item
2220 : "List All Buffers"
2221 : 'list-buffers
2222 : :help "Pop up a window listing all Emacs buffers"
2223 1 : ))))
2224 1 : (setq buffers-menu
2225 1 : (nconc buffers-menu menu-bar-buffers-menu-command-entries))
2226 :
2227 : ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
2228 : ;; but that did not do the right thing when the [menu-bar buffer]
2229 : ;; entry above had been moved (e.g. to a parent keymap).
2230 1 : (setcdr global-buffers-menu-map (cons "Buffers" buffers-menu)))))
2231 :
2232 : (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2233 :
2234 : (menu-bar-update-buffers)
2235 :
2236 : ;; this version is too slow
2237 : ;;(defun format-buffers-menu-line (buffer)
2238 : ;; "Returns a string to represent the given buffer in the Buffer menu.
2239 : ;;nil means the buffer shouldn't be listed. You can redefine this."
2240 : ;; (if (string-match "\\` " (buffer-name buffer))
2241 : ;; nil
2242 : ;; (with-current-buffer buffer
2243 : ;; (let ((size (buffer-size)))
2244 : ;; (format "%s%s %-19s %6s %-15s %s"
2245 : ;; (if (buffer-modified-p) "*" " ")
2246 : ;; (if buffer-read-only "%" " ")
2247 : ;; (buffer-name)
2248 : ;; size
2249 : ;; mode-name
2250 : ;; (or (buffer-file-name) ""))))))
2251 :
2252 : ;;; Set up a menu bar menu for the minibuffer.
2253 :
2254 : (dolist (map (list minibuffer-local-map
2255 : ;; This shouldn't be necessary, but there's a funny
2256 : ;; bug in keymap.c that I don't understand yet. -stef
2257 : minibuffer-local-completion-map))
2258 : (bindings--define-key map [menu-bar minibuf]
2259 : (cons "Minibuf" (make-sparse-keymap "Minibuf"))))
2260 :
2261 : (let ((map minibuffer-local-completion-map))
2262 : (bindings--define-key map [menu-bar minibuf ?\?]
2263 : '(menu-item "List Completions" minibuffer-completion-help
2264 : :help "Display all possible completions"))
2265 : (bindings--define-key map [menu-bar minibuf space]
2266 : '(menu-item "Complete Word" minibuffer-complete-word
2267 : :help "Complete at most one word"))
2268 : (bindings--define-key map [menu-bar minibuf tab]
2269 : '(menu-item "Complete" minibuffer-complete
2270 : :help "Complete as far as possible")))
2271 :
2272 : (let ((map minibuffer-local-map))
2273 : (bindings--define-key map [menu-bar minibuf quit]
2274 : '(menu-item "Quit" abort-recursive-edit
2275 : :help "Abort input and exit minibuffer"))
2276 : (bindings--define-key map [menu-bar minibuf return]
2277 : '(menu-item "Enter" exit-minibuffer
2278 : :key-sequence "\r"
2279 : :help "Terminate input and exit minibuffer"))
2280 : (bindings--define-key map [menu-bar minibuf isearch-forward]
2281 : '(menu-item "Isearch History Forward" isearch-forward
2282 : :help "Incrementally search minibuffer history forward"))
2283 : (bindings--define-key map [menu-bar minibuf isearch-backward]
2284 : '(menu-item "Isearch History Backward" isearch-backward
2285 : :help "Incrementally search minibuffer history backward"))
2286 : (bindings--define-key map [menu-bar minibuf next]
2287 : '(menu-item "Next History Item" next-history-element
2288 : :help "Put next minibuffer history element in the minibuffer"))
2289 : (bindings--define-key map [menu-bar minibuf previous]
2290 : '(menu-item "Previous History Item" previous-history-element
2291 : :help "Put previous minibuffer history element in the minibuffer")))
2292 :
2293 : (define-minor-mode menu-bar-mode
2294 : "Toggle display of a menu bar on each frame (Menu Bar mode).
2295 : With a prefix argument ARG, enable Menu Bar mode if ARG is
2296 : positive, and disable it otherwise. If called from Lisp, enable
2297 : Menu Bar mode if ARG is omitted or nil.
2298 :
2299 : This command applies to all frames that exist and frames to be
2300 : created in the future."
2301 : :init-value t
2302 : :global t
2303 : ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
2304 : :variable menu-bar-mode
2305 :
2306 : ;; Turn the menu-bars on all frames on or off.
2307 0 : (let ((val (if menu-bar-mode 1 0)))
2308 0 : (dolist (frame (frame-list))
2309 0 : (set-frame-parameter frame 'menu-bar-lines val))
2310 : ;; If the user has given `default-frame-alist' a `menu-bar-lines'
2311 : ;; parameter, replace it.
2312 0 : (if (assq 'menu-bar-lines default-frame-alist)
2313 0 : (setq default-frame-alist
2314 0 : (cons (cons 'menu-bar-lines val)
2315 0 : (assq-delete-all 'menu-bar-lines
2316 0 : default-frame-alist)))))
2317 : ;; Make the message appear when Emacs is idle. We can not call message
2318 : ;; directly. The minor-mode message "Menu Bar mode disabled" comes
2319 : ;; after this function returns, overwriting any message we do here.
2320 0 : (when (and (called-interactively-p 'interactive) (not menu-bar-mode))
2321 0 : (run-with-idle-timer 0 nil 'message
2322 0 : "Menu Bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear.")))
2323 :
2324 : ;;;###autoload
2325 : ;; (This does not work right unless it comes after the above definition.)
2326 : ;; This comment is taken from tool-bar.el near
2327 : ;; (put 'tool-bar-mode ...)
2328 : ;; We want to pretend the menu bar by standard is on, as this will make
2329 : ;; customize consider disabling the menu bar a customization, and save
2330 : ;; that. We could do this for real by setting :init-value above, but
2331 : ;; that would overwrite disabling the menu bar from X resources.
2332 : (put 'menu-bar-mode 'standard-value '(t))
2333 :
2334 : (defun toggle-menu-bar-mode-from-frame (&optional arg)
2335 : "Toggle menu bar on or off, based on the status of the current frame.
2336 : See `menu-bar-mode' for more information."
2337 0 : (interactive (list (or current-prefix-arg 'toggle)))
2338 0 : (if (eq arg 'toggle)
2339 0 : (menu-bar-mode
2340 0 : (if (menu-bar-positive-p
2341 0 : (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines))
2342 0 : 0 1))
2343 0 : (menu-bar-mode arg)))
2344 :
2345 : (declare-function x-menu-bar-open "term/x-win" (&optional frame))
2346 : (declare-function w32-menu-bar-open "term/w32-win" (&optional frame))
2347 :
2348 : (defun lookup-key-ignore-too-long (map key)
2349 : "Call `lookup-key' and convert numeric values to nil."
2350 0 : (let ((binding (lookup-key map key)))
2351 0 : (if (numberp binding) ; `too long'
2352 : nil
2353 0 : binding)))
2354 :
2355 : (defun popup-menu (menu &optional position prefix from-menu-bar)
2356 : "Popup the given menu and call the selected option.
2357 : MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
2358 : `x-popup-menu'.
2359 : The menu is shown at the place where POSITION specifies.
2360 : For the form of POSITION, see `popup-menu-normalize-position'.
2361 : PREFIX is the prefix argument (if any) to pass to the command.
2362 : FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus."
2363 0 : (let* ((map (cond
2364 0 : ((keymapp menu) menu)
2365 0 : ((and (listp menu) (keymapp (car menu))) menu)
2366 0 : (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
2367 0 : (filter (when (symbolp map)
2368 0 : (plist-get (get map 'menu-prop) :filter))))
2369 0 : (if filter (funcall filter (symbol-function map)) map)))))
2370 0 : (frame (selected-frame))
2371 : event cmd)
2372 0 : (if from-menu-bar
2373 0 : (let* ((xy (posn-x-y position))
2374 0 : (menu-symbol (menu-bar-menu-at-x-y (car xy) (cdr xy))))
2375 0 : (setq position (list menu-symbol (list frame '(menu-bar)
2376 0 : xy 0))))
2377 0 : (setq position (popup-menu-normalize-position position)))
2378 : ;; The looping behavior was taken from lmenu's popup-menu-popup
2379 0 : (while (and map (setq event
2380 : ;; map could be a prefix key, in which case
2381 : ;; we need to get its function cell
2382 : ;; definition.
2383 0 : (x-popup-menu position (indirect-function map))))
2384 : ;; Strangely x-popup-menu returns a list.
2385 : ;; mouse-major-mode-menu was using a weird:
2386 : ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
2387 0 : (setq cmd
2388 0 : (cond
2389 0 : ((and from-menu-bar
2390 0 : (consp event)
2391 0 : (numberp (car event))
2392 0 : (numberp (cdr event)))
2393 0 : (let ((x (car event))
2394 0 : (y (cdr event))
2395 : menu-symbol)
2396 0 : (setq menu-symbol (menu-bar-menu-at-x-y x y))
2397 0 : (setq position (list menu-symbol (list frame '(menu-bar)
2398 0 : event 0)))
2399 0 : (setq map
2400 0 : (key-binding (vector 'menu-bar menu-symbol)))))
2401 0 : ((and (not (keymapp map)) (listp map))
2402 : ;; We were given a list of keymaps. Search them all
2403 : ;; in sequence until a first binding is found.
2404 0 : (let ((mouse-click (apply 'vector event))
2405 : binding)
2406 0 : (while (and map (null binding))
2407 0 : (setq binding (lookup-key-ignore-too-long (car map) mouse-click))
2408 0 : (setq map (cdr map)))
2409 0 : binding))
2410 : (t
2411 : ;; We were given a single keymap.
2412 0 : (lookup-key map (apply 'vector event)))))
2413 : ;; Clear out echoing, which perhaps shows a prefix arg.
2414 0 : (message "")
2415 : ;; Maybe try again but with the submap.
2416 0 : (setq map (if (keymapp cmd) cmd)))
2417 : ;; If the user did not cancel by refusing to select,
2418 : ;; and if the result is a command, run it.
2419 0 : (when (and (null map) (commandp cmd))
2420 0 : (setq prefix-arg prefix)
2421 : ;; `setup-specified-language-environment', for instance,
2422 : ;; expects this to be set from a menu keymap.
2423 0 : (setq last-command-event (car (last event)))
2424 : ;; mouse-major-mode-menu was using `command-execute' instead.
2425 0 : (call-interactively cmd))))
2426 :
2427 : (defun popup-menu-normalize-position (position)
2428 : "Convert the POSITION to the form which `popup-menu' expects internally.
2429 : POSITION can be an event, a posn- value, a value having the
2430 : form ((XOFFSET YOFFSET) WINDOW), or nil.
2431 : If nil, the current mouse position is used, or nil if there is no mouse."
2432 0 : (pcase position
2433 : ;; nil -> mouse cursor position
2434 : (`nil
2435 0 : (let ((mp (mouse-pixel-position)))
2436 0 : (list (list (cadr mp) (cddr mp)) (car mp))))
2437 : ;; Value returned from `event-end' or `posn-at-point'.
2438 : ((pred posnp)
2439 0 : (let ((xy (posn-x-y position)))
2440 0 : (list (list (car xy) (cdr xy))
2441 0 : (posn-window position))))
2442 : ;; Event.
2443 : ((pred eventp)
2444 0 : (popup-menu-normalize-position (event-end position)))
2445 0 : (_ position)))
2446 :
2447 : (defcustom tty-menu-open-use-tmm nil
2448 : "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'.
2449 :
2450 : If nil, \\[menu-bar-open] will drop down the menu corresponding to the
2451 : first (leftmost) menu-bar item; you can select other items by typing
2452 : \\[forward-char], \\[backward-char], \\[right-char] and \\[left-char]."
2453 : :type '(choice (const :tag "F10 drops down TTY menus" nil)
2454 : (const :tag "F10 invokes tmm-menubar" t))
2455 : :group 'display
2456 : :version "24.4")
2457 :
2458 : (defvar tty-menu--initial-menu-x 1
2459 : "X coordinate of the first menu-bar menu dropped by F10.
2460 :
2461 : This is meant to be used only for debugging TTY menus.")
2462 :
2463 : (defun menu-bar-open (&optional frame)
2464 : "Start key navigation of the menu bar in FRAME.
2465 :
2466 : This function decides which method to use to access the menu
2467 : depending on FRAME's terminal device. On X displays, it calls
2468 : `x-menu-bar-open'; on Windows, `w32-menu-bar-open'; otherwise it
2469 : calls either `popup-menu' or `tmm-menubar' depending on whether
2470 : `tty-menu-open-use-tmm' is nil or not.
2471 :
2472 : If FRAME is nil or not given, use the selected frame."
2473 : (interactive)
2474 0 : (let ((type (framep (or frame (selected-frame)))))
2475 0 : (cond
2476 0 : ((eq type 'x) (x-menu-bar-open frame))
2477 0 : ((eq type 'w32) (w32-menu-bar-open frame))
2478 0 : ((and (null tty-menu-open-use-tmm)
2479 0 : (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))))
2480 : ;; Make sure the menu bar is up to date. One situation where
2481 : ;; this is important is when this function is invoked by name
2482 : ;; via M-x, in which case the menu bar includes the "Minibuf"
2483 : ;; menu item that should be removed when we exit the minibuffer.
2484 0 : (force-mode-line-update)
2485 0 : (redisplay)
2486 0 : (let* ((x tty-menu--initial-menu-x)
2487 0 : (menu (menu-bar-menu-at-x-y x 0 frame)))
2488 0 : (popup-menu (or
2489 0 : (lookup-key-ignore-too-long
2490 0 : global-map (vector 'menu-bar menu))
2491 0 : (lookup-key-ignore-too-long
2492 0 : (current-local-map) (vector 'menu-bar menu))
2493 0 : (cdar (minor-mode-key-binding (vector 'menu-bar menu)))
2494 0 : (mouse-menu-bar-map))
2495 0 : (posn-at-x-y x 0 nil t) nil t)))
2496 0 : (t (with-selected-frame (or frame (selected-frame))
2497 0 : (tmm-menubar))))))
2498 :
2499 : (global-set-key [f10] 'menu-bar-open)
2500 :
2501 : (defun buffer-menu-open ()
2502 : "Start key navigation of the buffer menu.
2503 : This is the keyboard interface to \\[mouse-buffer-menu]."
2504 : (interactive)
2505 0 : (popup-menu (mouse-buffer-menu-keymap)
2506 0 : (posn-at-x-y 0 0 nil t)))
2507 :
2508 : (global-set-key [C-f10] 'buffer-menu-open)
2509 :
2510 : (defun mouse-buffer-menu-keymap ()
2511 0 : (let* ((menu (mouse-buffer-menu-map))
2512 0 : (km (make-sparse-keymap (pop menu))))
2513 0 : (dolist (item (nreverse menu))
2514 0 : (let* ((name (pop item)))
2515 0 : (define-key km (vector (intern name))
2516 0 : (list name 'keymap name
2517 0 : (menu-bar-buffer-vector item)))))
2518 0 : km))
2519 :
2520 : (defvar tty-menu-navigation-map
2521 : (let ((map (make-sparse-keymap)))
2522 : ;; The next line is disabled because it breaks interpretation of
2523 : ;; escape sequences, produced by TTY arrow keys, as tty-menu-*
2524 : ;; commands. Instead, we explicitly bind some keys to
2525 : ;; tty-menu-exit.
2526 : ;;(define-key map [t] 'tty-menu-exit)
2527 :
2528 : ;; The tty-menu-* are just symbols interpreted by term.c, they are
2529 : ;; not real commands.
2530 : (dolist (bind '((keyboard-quit . tty-menu-exit)
2531 : (keyboard-escape-quit . tty-menu-exit)
2532 : ;; The following two will need to be revised if we ever
2533 : ;; support a right-to-left menu bar.
2534 : (forward-char . tty-menu-next-menu)
2535 : (backward-char . tty-menu-prev-menu)
2536 : (right-char . tty-menu-next-menu)
2537 : (left-char . tty-menu-prev-menu)
2538 : (next-line . tty-menu-next-item)
2539 : (previous-line . tty-menu-prev-item)
2540 : (newline . tty-menu-select)
2541 : (newline-and-indent . tty-menu-select)
2542 : (menu-bar-open . tty-menu-exit)))
2543 : (substitute-key-definition (car bind) (cdr bind)
2544 : map (current-global-map)))
2545 :
2546 : ;; The bindings of menu-bar items are so that clicking on the menu
2547 : ;; bar when a menu is already shown pops down that menu.
2548 : (define-key map [menu-bar t] 'tty-menu-exit)
2549 :
2550 : (define-key map [?\C-r] 'tty-menu-select)
2551 : (define-key map [?\C-j] 'tty-menu-select)
2552 : (define-key map [return] 'tty-menu-select)
2553 : (define-key map [linefeed] 'tty-menu-select)
2554 : (define-key map [mouse-1] 'tty-menu-select)
2555 : (define-key map [drag-mouse-1] 'tty-menu-select)
2556 : (define-key map [mouse-2] 'tty-menu-select)
2557 : (define-key map [drag-mouse-2] 'tty-menu-select)
2558 : (define-key map [mouse-3] 'tty-menu-select)
2559 : (define-key map [drag-mouse-3] 'tty-menu-select)
2560 : (define-key map [wheel-down] 'tty-menu-next-item)
2561 : (define-key map [wheel-up] 'tty-menu-prev-item)
2562 : (define-key map [wheel-left] 'tty-menu-prev-menu)
2563 : (define-key map [wheel-right] 'tty-menu-next-menu)
2564 : ;; The following 4 bindings are for those whose text-mode mouse
2565 : ;; lack the wheel.
2566 : (define-key map [S-mouse-1] 'tty-menu-next-item)
2567 : (define-key map [S-drag-mouse-1] 'tty-menu-next-item)
2568 : (define-key map [S-mouse-2] 'tty-menu-prev-item)
2569 : (define-key map [S-drag-mouse-2] 'tty-menu-prev-item)
2570 : (define-key map [S-mouse-3] 'tty-menu-prev-item)
2571 : (define-key map [S-drag-mouse-3] 'tty-menu-prev-item)
2572 : (define-key map [header-line mouse-1] 'tty-menu-select)
2573 : (define-key map [header-line drag-mouse-1] 'tty-menu-select)
2574 : ;; The down-mouse events must be bound to tty-menu-ignore, so that
2575 : ;; only releasing the mouse button pops up the menu.
2576 : (define-key map [mode-line down-mouse-1] 'tty-menu-ignore)
2577 : (define-key map [mode-line down-mouse-2] 'tty-menu-ignore)
2578 : (define-key map [mode-line down-mouse-3] 'tty-menu-ignore)
2579 : (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore)
2580 : (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore)
2581 : (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore)
2582 : (define-key map [down-mouse-1] 'tty-menu-ignore)
2583 : (define-key map [C-down-mouse-1] 'tty-menu-ignore)
2584 : (define-key map [C-down-mouse-2] 'tty-menu-ignore)
2585 : (define-key map [C-down-mouse-3] 'tty-menu-ignore)
2586 : (define-key map [mouse-movement] 'tty-menu-mouse-movement)
2587 : map)
2588 : "Keymap used while processing TTY menus.")
2589 :
2590 : (provide 'menu-bar)
2591 :
2592 : ;;; menu-bar.el ends here
|