menu-bar.el 88.9 KB
Newer Older
1
;;; menu-bar.el --- define a default menu bar
2

3
;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004, 2005,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2006, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
Erik Naggum's avatar
Erik Naggum committed
5

6
;; Author: RMS
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Maintainer: FSF
8
;; Keywords: internal, mouse
9
;; Package: emacs
10

Richard M. Stallman's avatar
Richard M. Stallman committed
11 12
;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
25

26 27
;; Avishai Yacobi suggested some menu rearrangements.

28 29
;;; Commentary:

Erik Naggum's avatar
Erik Naggum committed
30 31
;;; Code:

32 33 34 35
;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
;; definitions made in loaddefs.el.
(or (lookup-key global-map [menu-bar])
    (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
36
(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
37

38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
(if (not (featurep 'ns))
    ;; Force Help item to come last, after the major mode's own items.
    ;; The symbol used to be called `help', but that gets confused with the
    ;; help key.
    (setq menu-bar-final-items '(help-menu))
  (if (eq system-type 'darwin)
      (setq menu-bar-final-items '(buffer services help-menu))
    (setq menu-bar-final-items '(buffer services hide-app quit))
    ;; Add standard top-level items to GNUstep menu.
    (define-key global-map [menu-bar quit]
      `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs
                  :help ,(purecopy "Save unsaved buffers, then exit")))
    (define-key global-map [menu-bar hide-app]
      `(menu-item ,(purecopy "Hide") ns-do-hide-emacs
                  :help ,(purecopy "Hide Emacs"))))
  (define-key global-map [menu-bar services] ; set-up in ns-win
    (cons (purecopy "Services") (make-sparse-keymap "Services"))))

;; If running under GNUstep, "Help" is moved and renamed "Info" (see below).
(or (and (featurep 'ns)
         (not (eq system-type 'darwin)))
    (define-key global-map [menu-bar help-menu]
      (cons (purecopy "Help") menu-bar-help-menu)))
61 62

(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
63 64
(define-key global-map [menu-bar tools]
  (cons (purecopy "Tools") menu-bar-tools-menu))
65
;; This definition is just to show what this looks like.
66 67
;; It gets modified in place when menu-bar-update-buffers is called.
(defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
68
(define-key global-map [menu-bar buffer]
69
  (cons (purecopy "Buffers") global-buffers-menu-map))
70 71
(defvar menu-bar-options-menu (make-sparse-keymap "Options"))
(define-key global-map [menu-bar options]
72
  (cons (purecopy "Options") menu-bar-options-menu))
73
(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
74 75
(define-key global-map [menu-bar edit]
  (cons (purecopy "Edit") menu-bar-edit-menu))
76
(defvar menu-bar-file-menu (make-sparse-keymap "File"))
77 78 79 80 81 82 83 84
(define-key global-map [menu-bar file]
  (cons (purecopy "File") menu-bar-file-menu))

;; Put "Help" menu at the front, called "Info".
(and (featurep 'ns)
     (not (eq system-type 'darwin))
     (define-key global-map [menu-bar help-menu]
       (cons (purecopy "Info") menu-bar-help-menu)))
85

86 87
;; Only declared obsolete (and only made a proper alias) in 23.3.
(define-obsolete-variable-alias 'menu-bar-files-menu 'menu-bar-file-menu "22.1")
88 89 90 91

;; This is referenced by some code below; it is defined in uniquify.el
(defvar uniquify-buffer-name-style)

92 93 94
;; From emulation/cua-base.el; used below
(defvar cua-enable-cua-keys)

95

96
;; The "File" menu items
97
(define-key menu-bar-file-menu [exit-emacs]
98 99
  `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal
	      :help ,(purecopy "Save unsaved buffers, then exit")))
100

101
(define-key menu-bar-file-menu [separator-exit]
102
  menu-bar-separator)
103

104 105
;; Don't use delete-frame as event name because that is a special
;; event.
106
(define-key menu-bar-file-menu [delete-this-frame]
107
  `(menu-item ,(purecopy "Delete Frame") delete-frame
108 109
	      :visible (fboundp 'delete-frame)
	      :enable (delete-frame-enabled-p)
110
	      :help ,(purecopy "Delete currently selected frame")))
111
(define-key menu-bar-file-menu [make-frame-on-display]
112
  `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display
113
	      :visible (fboundp 'make-frame-on-display)
114
	      :help ,(purecopy "Open a new frame on another display")))
115
(define-key menu-bar-file-menu [make-frame]
116
  `(menu-item ,(purecopy "New Frame") make-frame-command
117
	      :visible (fboundp 'make-frame-command)
118
	      :help ,(purecopy "Open a new frame")))
119

120
(define-key menu-bar-file-menu [one-window]
121
  `(menu-item ,(purecopy "Remove Splits") delete-other-windows
122
	      :enable (not (one-window-p t nil))
123
	      :help ,(purecopy "Selected window grows to fill the whole frame")))
124

125
(define-key menu-bar-file-menu [split-window]
126
  `(menu-item ,(purecopy "Split Window") split-window-vertically
127 128
	      :enable (and (menu-bar-menu-frame-live-and-visible-p)
			   (menu-bar-non-minibuffer-window-p))
129
	      :help ,(purecopy "Split selected window in two windows")))
130

131
(define-key menu-bar-file-menu [separator-window]
132
  menu-bar-separator)
133

134
(define-key menu-bar-file-menu [ps-print-region]
135
  `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region
136
	      :enable mark-active
137
	      :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer")))
138
(define-key menu-bar-file-menu [ps-print-buffer]
139
  `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer
140
	      :enable (menu-bar-menu-frame-live-and-visible-p)
141
	      :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer")))
142
(define-key menu-bar-file-menu [ps-print-region-faces]
143
  `(menu-item ,(purecopy "Postscript Print Region") ps-print-region-with-faces
144
	      :enable mark-active
145
	      :help ,(purecopy "Pretty-print marked region to PostScript printer")))
146
(define-key menu-bar-file-menu [ps-print-buffer-faces]
147
  `(menu-item ,(purecopy "Postscript Print Buffer") ps-print-buffer-with-faces
148
	      :enable (menu-bar-menu-frame-live-and-visible-p)
149
	      :help ,(purecopy "Pretty-print current buffer to PostScript printer")))
150
(define-key menu-bar-file-menu [print-region]
151
  `(menu-item ,(purecopy "Print Region") print-region
152
	      :enable mark-active
153
	      :help ,(purecopy "Print region between mark and current position")))
154
(define-key menu-bar-file-menu [print-buffer]
155
  `(menu-item ,(purecopy "Print Buffer") print-buffer
156
	      :enable (menu-bar-menu-frame-live-and-visible-p)
157
	      :help ,(purecopy "Print current buffer with page headings")))
158

159
(define-key menu-bar-file-menu [separator-print]
160
  menu-bar-separator)
161

162
(define-key menu-bar-file-menu [recover-session]
163
  `(menu-item ,(purecopy "Recover Crashed Session") recover-session
164
	      :enable (and auto-save-list-file-prefix
165 166 167
			   (file-directory-p
                            (file-name-directory auto-save-list-file-prefix))
                           (directory-files
168 169 170 171 172 173 174
			    (file-name-directory auto-save-list-file-prefix)
			    nil
			    (concat "\\`"
				    (regexp-quote
				     (file-name-nondirectory
				      auto-save-list-file-prefix)))
			    t))
175
	      :help ,(purecopy "Recover edits from a crashed session")))
176
(define-key menu-bar-file-menu [revert-buffer]
177
  `(menu-item ,(purecopy "Revert Buffer") revert-buffer
178 179
	      :enable (or revert-buffer-function
			  revert-buffer-insert-file-contents-function
180
			  (and buffer-file-number
181 182 183
			       (or (buffer-modified-p)
				   (not (verify-visited-file-modtime
					 (current-buffer))))))
184
	      :help ,(purecopy "Re-read current buffer from its file")))
185
(define-key menu-bar-file-menu [write-file]
186
  `(menu-item ,(purecopy "Save As...") write-file
187 188
	      :enable (and (menu-bar-menu-frame-live-and-visible-p)
			   (menu-bar-non-minibuffer-window-p))
189
	      :help ,(purecopy "Write current buffer to another file")))
190
(define-key menu-bar-file-menu [save-buffer]
191
  `(menu-item ,(purecopy "Save") save-buffer
192
	      :enable (and (buffer-modified-p)
193
			   (buffer-file-name)
194
			   (menu-bar-non-minibuffer-window-p))
195
	      :help ,(purecopy "Save current buffer to its file")))
196

197
(define-key menu-bar-file-menu [separator-save]
198
  menu-bar-separator)
199

200 201 202 203 204 205 206 207 208 209 210
(defun menu-find-file-existing ()
  "Edit the existing file FILENAME."
  (interactive)
  (let* ((mustmatch (not (and (fboundp 'x-uses-old-gtk-dialog)
			      (x-uses-old-gtk-dialog))))
	 (filename (car (find-file-read-args "Find file: " mustmatch))))
    (if mustmatch
	(find-file-existing filename)
      (find-file filename))))


211
(define-key menu-bar-file-menu [kill-buffer]
212
  `(menu-item ,(purecopy "Close") kill-this-buffer
213
	      :enable (kill-this-buffer-enabled-p)
214
	      :help ,(purecopy "Discard (kill) current buffer")))
215
(define-key menu-bar-file-menu [insert-file]
216
  `(menu-item ,(purecopy "Insert File...") insert-file
217
	      :enable (menu-bar-non-minibuffer-window-p)
218
	      :help ,(purecopy "Insert another file into current buffer")))
219
(define-key menu-bar-file-menu [dired]
220
  `(menu-item ,(purecopy "Open Directory...") dired
221
	      :enable (menu-bar-non-minibuffer-window-p)
222
	      :help ,(purecopy "Read a directory, to operate on its files")))
223
(define-key menu-bar-file-menu [open-file]
224
  `(menu-item ,(purecopy "Open File...") menu-find-file-existing
225
	      :enable (menu-bar-non-minibuffer-window-p)
226
	      :help ,(purecopy "Read an existing file into an Emacs buffer")))
227
(define-key menu-bar-file-menu [new-file]
228
  `(menu-item ,(purecopy "Visit New File...") find-file
229
	      :enable (menu-bar-non-minibuffer-window-p)
230
	      :help ,(purecopy "Specify a new file's name, to edit the file")))
231

232

233
;; The "Edit" menu items
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264

;; The "Edit->Search" submenu
(defvar menu-bar-last-search-type nil
  "Type of last non-incremental search command called from the menu.")

(defun nonincremental-repeat-search-forward ()
  "Search forward for the previous search string or regexp."
  (interactive)
  (cond
   ((and (eq menu-bar-last-search-type 'string)
	 search-ring)
    (search-forward (car search-ring)))
   ((and (eq menu-bar-last-search-type 'regexp)
	 regexp-search-ring)
    (re-search-forward (car regexp-search-ring)))
   (t
    (error "No previous search"))))

(defun nonincremental-repeat-search-backward ()
  "Search backward for the previous search string or regexp."
  (interactive)
  (cond
   ((and (eq menu-bar-last-search-type 'string)
	 search-ring)
    (search-backward (car search-ring)))
   ((and (eq menu-bar-last-search-type 'regexp)
	 regexp-search-ring)
    (re-search-backward (car regexp-search-ring)))
   (t
    (error "No previous search"))))

265 266 267
(defun nonincremental-search-forward (string)
  "Read a string and search for it nonincrementally."
  (interactive "sSearch for string: ")
268
  (setq menu-bar-last-search-type 'string)
269 270 271 272 273 274 275 276
  (if (equal string "")
      (search-forward (car search-ring))
    (isearch-update-ring string nil)
    (search-forward string)))

(defun nonincremental-search-backward (string)
  "Read a string and search backward for it nonincrementally."
  (interactive "sSearch for string: ")
277
  (setq menu-bar-last-search-type 'string)
278 279 280 281 282 283 284 285
  (if (equal string "")
      (search-backward (car search-ring))
    (isearch-update-ring string nil)
    (search-backward string)))

(defun nonincremental-re-search-forward (string)
  "Read a regular expression and search for it nonincrementally."
  (interactive "sSearch for regexp: ")
286
  (setq menu-bar-last-search-type 'regexp)
287 288 289 290 291 292 293 294
  (if (equal string "")
      (re-search-forward (car regexp-search-ring))
    (isearch-update-ring string t)
    (re-search-forward string)))

(defun nonincremental-re-search-backward (string)
  "Read a regular expression and search backward for it nonincrementally."
  (interactive "sSearch for regexp: ")
295
  (setq menu-bar-last-search-type 'regexp)
296 297 298 299 300
  (if (equal string "")
      (re-search-backward (car regexp-search-ring))
    (isearch-update-ring string t)
    (re-search-backward string)))

301
(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
302

303 304 305 306 307
;; The Edit->Search->Incremental Search menu
(defvar menu-bar-i-search-menu
  (make-sparse-keymap "Incremental Search"))

(define-key menu-bar-i-search-menu [isearch-backward-regexp]
308 309
  `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp
	      :help ,(purecopy "Search backwards for a regular expression as you type it")))
310
(define-key menu-bar-i-search-menu [isearch-forward-regexp]
311 312
  `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp
	      :help ,(purecopy "Search forward for a regular expression as you type it")))
313
(define-key menu-bar-i-search-menu [isearch-backward]
314 315
  `(menu-item ,(purecopy "Backward String...") isearch-backward
	      :help ,(purecopy "Search backwards for a string as you type it")))
316
(define-key menu-bar-i-search-menu [isearch-forward]
317 318
  `(menu-item ,(purecopy "Forward String...") isearch-forward
	      :help ,(purecopy "Search forward for a string as you type it")))
319

320
(define-key menu-bar-search-menu [i-search]
321
  `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu))
322
(define-key menu-bar-search-menu [separator-tag-isearch]
323
  menu-bar-separator)
324

325
(define-key menu-bar-search-menu [tags-continue]
326 327
  `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
	      :help ,(purecopy "Continue last tags search operation")))
328
(define-key menu-bar-search-menu [tags-srch]
329 330
  `(menu-item ,(purecopy "Search Tagged Files...") tags-search
	      :help ,(purecopy "Search for a regexp in all tagged files")))
331
(define-key menu-bar-search-menu [separator-tag-search]
332
  menu-bar-separator)
333

334
(define-key menu-bar-search-menu [repeat-search-back]
335
  `(menu-item ,(purecopy "Repeat Backwards") nonincremental-repeat-search-backward
336 337 338 339
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
340
	      :help ,(purecopy "Repeat last search backwards")))
341
(define-key menu-bar-search-menu [repeat-search-fwd]
342
  `(menu-item ,(purecopy "Repeat Forward") nonincremental-repeat-search-forward
343 344 345 346
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
347
	      :help ,(purecopy "Repeat last search forward")))
348
(define-key menu-bar-search-menu [separator-repeat-search]
349
  menu-bar-separator)
350 351

(define-key menu-bar-search-menu [re-search-backward]
352 353
  `(menu-item ,(purecopy "Regexp Backwards...") nonincremental-re-search-backward
	      :help ,(purecopy "Search backwards for a regular expression")))
354
(define-key menu-bar-search-menu [re-search-forward]
355 356
  `(menu-item ,(purecopy "Regexp Forward...") nonincremental-re-search-forward
	      :help ,(purecopy "Search forward for a regular expression")))
357

358
(define-key menu-bar-search-menu [search-backward]
359 360
  `(menu-item ,(purecopy "String Backwards...") nonincremental-search-backward
	      :help ,(purecopy "Search backwards for a string")))
361
(define-key menu-bar-search-menu [search-forward]
362 363
  `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward
	      :help ,(purecopy "Search forward for a string")))
364

365 366 367 368 369
;; The Edit->Replace submenu

(defvar menu-bar-replace-menu (make-sparse-keymap "Replace"))

(define-key menu-bar-replace-menu [tags-repl-continue]
370 371
  `(menu-item ,(purecopy "Continue Replace") tags-loop-continue
	      :help ,(purecopy "Continue last tags replace operation")))
372
(define-key menu-bar-replace-menu [tags-repl]
373 374
  `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace
	      :help ,(purecopy "Interactively replace a regexp in all tagged files")))
375
(define-key menu-bar-replace-menu [separator-replace-tags]
376
  menu-bar-separator)
377 378

(define-key menu-bar-replace-menu [query-replace-regexp]
379
  `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp
380
	      :enable (not buffer-read-only)
381
	      :help ,(purecopy "Replace regular expression interactively, ask about each occurrence")))
382
(define-key menu-bar-replace-menu [query-replace]
383
  `(menu-item ,(purecopy "Replace String...") query-replace
384
	      :enable (not buffer-read-only)
385
	      :help ,(purecopy "Replace string interactively, ask about each occurrence")))
386

387 388
;;; Assemble the top-level Edit menu items.
(define-key menu-bar-edit-menu [props]
389
  `(menu-item ,(purecopy "Text Properties") facemenu-menu))
390

391 392 393 394 395
;; ns-win.el said: Add spell for platorm consistency.
(if (featurep 'ns)
    (define-key menu-bar-edit-menu [spell]
      `(menu-item ,(purecopy "Spell") ispell-menu-map)))

396
(define-key menu-bar-edit-menu [fill]
397
  `(menu-item ,(purecopy "Fill") fill-region
398 399
	      :enable (and mark-active (not buffer-read-only))
	      :help
400
	      ,(purecopy "Fill text in region to fit between left and right margin")))
401 402

(define-key menu-bar-edit-menu [separator-bookmark]
403
  menu-bar-separator)
404 405

(define-key menu-bar-edit-menu [bookmark]
406
  `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map))
407 408 409 410

(defvar menu-bar-goto-menu (make-sparse-keymap "Go To"))

(define-key menu-bar-goto-menu [set-tags-name]
411 412
  `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table
	      :help ,(purecopy "Tell Tags commands which tag table file to use")))
413 414

(define-key menu-bar-goto-menu [separator-tag-file]
415
  menu-bar-separator)
416 417

(define-key menu-bar-goto-menu [apropos-tags]
418 419
  `(menu-item ,(purecopy "Tags Apropos...") tags-apropos
	      :help ,(purecopy "Find function/variables whose names match regexp")))
420
(define-key menu-bar-goto-menu [next-tag-otherw]
421
  `(menu-item ,(purecopy "Next Tag in Other Window")
422
	      menu-bar-next-tag-other-window
423 424
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
425
	      :help ,(purecopy "Find next function/variable matching last tag name in another window")))
426 427 428 429 430 431 432 433 434 435 436

(defun menu-bar-next-tag-other-window ()
  "Find the next definition of the tag already specified."
  (interactive)
  (find-tag-other-window nil t))

(defun menu-bar-next-tag ()
  "Find the next definition of the tag already specified."
  (interactive)
  (find-tag nil t))

437
(define-key menu-bar-goto-menu [next-tag]
438
  `(menu-item ,(purecopy "Find Next Tag")
439
	      menu-bar-next-tag
440 441
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
442
	      :help ,(purecopy "Find next function/variable matching last tag name")))
443
(define-key menu-bar-goto-menu [find-tag-otherw]
444 445
  `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window
	      :help ,(purecopy "Find function/variable definition in another window")))
446
(define-key menu-bar-goto-menu [find-tag]
447 448
  `(menu-item ,(purecopy "Find Tag...") find-tag
	      :help ,(purecopy "Find definition of function or variable")))
449 450

(define-key menu-bar-goto-menu [separator-tags]
451
  menu-bar-separator)
452 453

(define-key menu-bar-goto-menu [end-of-buf]
454
  `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer))
455
(define-key menu-bar-goto-menu [beg-of-buf]
456
  `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer))
457
(define-key menu-bar-goto-menu [go-to-pos]
458 459
  `(menu-item ,(purecopy "Goto Buffer Position...") goto-char
	      :help ,(purecopy "Read a number N and go to buffer position N")))
460
(define-key menu-bar-goto-menu [go-to-line]
461 462
  `(menu-item ,(purecopy "Goto Line...") goto-line
	      :help ,(purecopy "Read a line number and go to that line")))
463 464

(define-key menu-bar-edit-menu [goto]
465
  `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu))
466

467
(define-key menu-bar-edit-menu [replace]
468
  `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu))
469

470
(define-key menu-bar-edit-menu [search]
471
  `(menu-item ,(purecopy "Search") ,menu-bar-search-menu))
472

473
(define-key menu-bar-edit-menu [separator-search]
474
  menu-bar-separator)
475

476
(define-key menu-bar-edit-menu [mark-whole-buffer]
477 478
  `(menu-item ,(purecopy "Select All") mark-whole-buffer
	      :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
479
(define-key menu-bar-edit-menu [clear]
480
  `(menu-item ,(purecopy "Clear") delete-region
481
	      :enable (and mark-active
482
			   (not buffer-read-only))
483
	      :help
484
	      ,(purecopy "Delete the text in region between mark and current position")))
485
(defvar yank-menu (cons (purecopy "Select Yank") nil))
486
(fset 'yank-menu (cons 'keymap yank-menu))
487 488 489 490 491 492
(define-key menu-bar-edit-menu (if (featurep 'ns) [select-paste]
                                 [paste-from-menu])
  ;; ns-win.el said: Change text to be more consistent with
  ;; surrounding menu items `paste', etc."
  `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste"
                           "Paste from Kill Menu")) yank-menu
493
	      :enable (and (cdr yank-menu) (not buffer-read-only))
494
	      :help ,(purecopy "Choose a string from the kill ring and paste it")))
495
(define-key menu-bar-edit-menu [paste]
496
  `(menu-item ,(purecopy "Paste") yank
497
	      :enable (and (or
498 499
			    ;; Emacs compiled --without-x (or --with-ns)
			    ;; doesn't have x-selection-exists-p.
500
			    (and (fboundp 'x-selection-exists-p)
Eli Zaretskii's avatar
Eli Zaretskii committed
501
				 (x-selection-exists-p 'CLIPBOARD))
502 503 504
			    (if (featurep 'ns) ; like paste-from-menu
				(cdr yank-menu)
			      kill-ring))
505
			   (not buffer-read-only))
506
	      :help ,(purecopy "Paste (yank) text most recently cut/copied")))
507
(define-key menu-bar-edit-menu [copy]
508 509 510 511
  ;; ns-win.el said: Substitute a Copy function that works better
  ;; under X (for GNUstep).
  `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns)
                                      'ns-copy-including-secondary
512
                                    'kill-ring-save)
513 514 515 516 517
              :enable mark-active
              :help ,(purecopy "Copy text in region between mark and current position")
              :keys ,(purecopy (if (featurep 'ns)
                                   "\\[ns-copy-including-secondary]"
                                 "\\[kill-ring-save]"))))
518
(define-key menu-bar-edit-menu [cut]
519
  `(menu-item ,(purecopy "Cut") kill-region
520
	      :enable (and mark-active (not buffer-read-only))
521
	      :help
522
	      ,(purecopy "Cut (kill) text in region between mark and current position")))
523 524
;; ns-win.el said: Separate undo from cut/paste section.
(if (featurep 'ns)
525 526
    (define-key menu-bar-edit-menu [separator-undo] menu-bar-separator))

527
(define-key menu-bar-edit-menu [undo]
528
  `(menu-item ,(purecopy "Undo") undo
529 530 531
	      :enable (and (not buffer-read-only)
			   (not (eq t buffer-undo-list))
			   (if (eq last-command 'undo)
532
			       (listp pending-undo-list)
533
			     (consp buffer-undo-list)))
534
	      :help ,(purecopy "Undo last operation")))
535

536 537
(define-obsolete-function-alias
  'menu-bar-kill-ring-save 'kill-ring-save "24.1")
538

539
;; These are alternative definitions for the cut, paste and copy
540
;; menu items.  Use them if your system expects these to use the clipboard.
541

542 543
(put 'clipboard-kill-region 'menu-enable
     '(and mark-active (not buffer-read-only)))
544 545
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
546 547
     '(and (or (not (fboundp 'x-selection-exists-p))
	       (x-selection-exists-p)
548
	       (x-selection-exists-p 'CLIPBOARD))
549
 	   (not buffer-read-only)))
550 551

(defun clipboard-yank ()
552
  "Insert the clipboard contents, or the last stretch of killed text."
553
  (interactive "*")
554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569
  (let ((x-select-enable-clipboard t))
    (yank)))

(defun clipboard-kill-ring-save (beg end)
  "Copy region to kill ring, and save in the X clipboard."
  (interactive "r")
  (let ((x-select-enable-clipboard t))
    (kill-ring-save beg end)))

(defun clipboard-kill-region (beg end)
  "Kill the region, and save it in the X clipboard."
  (interactive "r")
  (let ((x-select-enable-clipboard t))
    (kill-region beg end)))

(defun menu-bar-enable-clipboard ()
570 571
  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
572
  (interactive)
573 574
  ;; These are Sun server keysyms for the Cut, Copy and Paste keys
  ;; (also for XFree86 on Sun keyboard):
575 576 577
  (define-key global-map [f20] 'clipboard-kill-region)
  (define-key global-map [f16] 'clipboard-kill-ring-save)
  (define-key global-map [f18] 'clipboard-yank)
578
  ;; X11R6 versions:
579 580 581
  (define-key global-map [cut] 'clipboard-kill-region)
  (define-key global-map [copy] 'clipboard-kill-ring-save)
  (define-key global-map [paste] 'clipboard-yank))
582

583
;; The "Options" menu items
584 585 586

(defvar menu-bar-custom-menu (make-sparse-keymap "Customize"))

587
(define-key menu-bar-custom-menu [customize-apropos-faces]
588 589
  `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces
	      :help ,(purecopy "Browse faces matching a regexp or word list")))
590
(define-key menu-bar-custom-menu [customize-apropos-options]
591 592
  `(menu-item ,(purecopy "Options Matching...") customize-apropos-options
	      :help ,(purecopy "Browse options matching a regexp or word list")))
593
(define-key menu-bar-custom-menu [customize-apropos]
594 595
  `(menu-item ,(purecopy "All Settings Matching...") customize-apropos
	      :help ,(purecopy "Browse customizable settings matching a regexp or word list")))
596
(define-key menu-bar-custom-menu [separator-1]
597
  menu-bar-separator)
Richard M. Stallman's avatar
Richard M. Stallman committed
598
(define-key menu-bar-custom-menu [customize-group]
599 600
  `(menu-item ,(purecopy "Specific Group...") customize-group
	      :help ,(purecopy "Customize settings of specific group")))
601
(define-key menu-bar-custom-menu [customize-face]
602 603
  `(menu-item ,(purecopy "Specific Face...") customize-face
	      :help ,(purecopy "Customize attributes of specific face")))
604
(define-key menu-bar-custom-menu [customize-option]
605 606
  `(menu-item ,(purecopy "Specific Option...") customize-option
	      :help ,(purecopy "Customize value of specific option")))
607
(define-key menu-bar-custom-menu [separator-2]
608
  menu-bar-separator)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
609
(define-key menu-bar-custom-menu [customize-changed-options]
610 611
  `(menu-item ,(purecopy "New Options...") customize-changed-options
	      :help ,(purecopy "Options added or changed in recent Emacs versions")))
612
(define-key menu-bar-custom-menu [customize-saved]
613 614
  `(menu-item ,(purecopy "Saved Options") customize-saved
	      :help ,(purecopy "Customize previously saved options")))
615
(define-key menu-bar-custom-menu [separator-3]
616
  menu-bar-separator)
Per Abrahamsen's avatar
Per Abrahamsen committed
617
(define-key menu-bar-custom-menu [customize-browse]
618 619
  `(menu-item ,(purecopy "Browse Customization Groups") customize-browse
	      :help ,(purecopy "Browse all customization groups")))
620
(define-key menu-bar-custom-menu [customize]
621 622
  `(menu-item ,(purecopy "Top-level Customization Group") customize
	      :help ,(purecopy "The master group called `Emacs'")))
623 624 625
(define-key menu-bar-custom-menu [customize-themes]
  `(menu-item ,(purecopy "Custom Themes") customize-themes
	      :help ,(purecopy "Choose a pre-defined customization theme")))
626

627
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
628

629 630 631
(defmacro menu-bar-make-mm-toggle (fname doc help &optional props)
  "Make a menu-item for a global minor mode toggle.
FNAME is the minor mode's name (variable and function).
632
DOC is the text to use for the menu entry.
633 634
HELP is the text to use for the tooltip.
PROPS are additional properties."
635
  `(list 'menu-item  (purecopy ,doc) ',fname
636
	 ,@(mapcar (lambda (p) (list 'quote p)) props)
637 638 639
	 :help (purecopy ,help)
	 :button '(:toggle . (and (default-boundp ',fname)
				  (default-value ',fname)))))
640

641
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
642
  `(progn
643
     (defun ,name (&optional interactively)
644
       ,(concat "Toggle whether to " (downcase (substring help 0 1))
645
		(substring help 1) ".
646 647 648
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
       (interactive "p")
649
       (if ,(if body `(progn . ,body)
650
	      `(progn
651 652 653 654
		 (custom-load-symbol ',variable)
		 (let ((set (or (get ',variable 'custom-set) 'set-default))
		       (get (or (get ',variable 'custom-get) 'default-value)))
		   (funcall set ',variable (not (funcall get ',variable))))))
655 656
	   (message ,message "enabled globally")
  	 (message ,message "disabled globally"))
657 658 659 660
       ;; The function `customize-mark-as-set' must only be called when
       ;; a variable is set interactively, as the purpose is to mark it as
       ;; a candidate for "Save Options", and we do not want to save options
       ;; the user have already set explicitly in his init file.
661
       (if interactively (customize-mark-as-set ',variable)))
662
     (list 'menu-item (purecopy ,doc) ',name
663 664 665
	   :help (purecopy ,help)
	   :button '(:toggle . (and (default-boundp ',variable)
				    (default-value ',variable))))))
666

667 668 669 670 671
;; Function for setting/saving default font.

(defun menu-set-font ()
  "Interactively select a font and make it the default."
  (interactive)
672
  (let ((font (if (fboundp 'x-select-font)
673
  		  (x-select-font)
674 675 676
  		(mouse-select-font)))
	spec)
    (when font
Chong Yidong's avatar
Chong Yidong committed
677 678 679 680 681 682 683 684
      ;; Be careful here: when set-face-attribute is called for the
      ;; :font attribute, Emacs tries to guess the best matching font
      ;; by examining the other face attributes (Bug#2476).
      (set-face-attribute 'default (selected-frame)
			  :width 'normal
			  :weight 'normal
			  :slant 'normal
			  :font font)
685 686 687 688 689 690
      (let ((font-object (face-attribute 'default :font)))
	(dolist (f (frame-list))
	  (and (not (eq f (selected-frame)))
	       (display-graphic-p f)
	       (set-face-attribute 'default f :font font-object)))
	(set-face-attribute 'default t :font font-object))
691 692 693 694 695
      (setq spec (list (list t (face-attr-construct 'default))))
      (put 'default 'customized-face spec)
      (custom-push-theme 'theme-face 'default 'user 'set spec)
      (put 'default 'face-modified nil))))

696 697


698 699
;;; Assemble all the top-level items of the "Options" menu
(define-key menu-bar-options-menu [customize]
700
  `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu))
701 702 703 704

(defun menu-bar-options-save ()
  "Save current values of Options menu items using Custom."
  (interactive)
705
  (let ((need-save nil))
706 707
    ;; These are set with menu-bar-make-mm-toggle, which does not
    ;; put on a customized-value property.
708 709
    (dolist (elt '(line-number-mode column-number-mode size-indication-mode
		   cua-mode show-paren-mode transient-mark-mode
Glenn Morris's avatar
Glenn Morris committed
710 711 712 713 714 715 716 717 718 719
		   blink-cursor-mode display-time-mode display-battery-mode
		   ;; These are set by other functions that don't set
		   ;; the customized state.  Having them here has the
		   ;; side-effect that turning them off via X
		   ;; resources acts like having customized them, but
		   ;; that seems harmless.
		   menu-bar-mode tool-bar-mode))
      ;; FIXME ? It's a little annoying that running this command
      ;; always loads cua-base, paren, time, and battery, even if they
      ;; have not been customized in any way.  (Due to custom-load-symbol.)
720 721
      (and (customize-mark-to-save elt)
	   (setq need-save t)))
722
    ;; These are set with `customize-set-variable'.
723
    (dolist (elt '(scroll-bar-mode
724
		   debug-on-quit debug-on-error
Glenn Morris's avatar
Glenn Morris committed
725 726
		   ;; Somehow this works, when tool-bar and menu-bar don't.
		   tooltip-mode
727
		   save-place uniquify-buffer-name-style fringe-mode
728
		   indicate-empty-lines indicate-buffer-boundaries
729
		   case-fold-search font-use-system-font
730
		   current-language-environment default-input-method
731 732 733 734 735 736
		   ;; Saving `text-mode-hook' is somewhat questionable,
		   ;; as we might get more than we bargain for, if
		   ;; other code may has added hooks as well.
		   ;; Nonetheless, not saving it would like be confuse
		   ;; more often.
		   ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
737
		   text-mode-hook tool-bar-position))
738 739 740
      (and (get elt 'customized-value)
	   (customize-mark-to-save elt)
	   (setq need-save t)))
741 742 743 744
    (when (get 'default 'customized-face)
      (put 'default 'saved-face (get 'default 'customized-face))
      (put 'default 'customized-face nil)
      (setq need-save t))
745 746 747
    ;; Save if we changed anything.
    (when need-save
      (custom-save-all))))
748

749 750 751 752
(define-key menu-bar-options-menu [package]
  '(menu-item "Manage Emacs Packages" package-list-packages
	      :help "Install or uninstall additional Emacs packages"))

753
(define-key menu-bar-options-menu [save]
754 755
  `(menu-item ,(purecopy "Save Options") menu-bar-options-save
	      :help ,(purecopy "Save options set from the menu above")))
756 757

(define-key menu-bar-options-menu [custom-separator]
758
  menu-bar-separator)
759

760
(define-key menu-bar-options-menu [menu-set-font]
761
  `(menu-item ,(purecopy "Set Default Font...") menu-set-font
762
	      :visible (display-multi-font-p)
763
	      :help ,(purecopy "Select a default font")))
764

765 766 767 768 769 770 771 772
(if (featurep 'system-font-setting)
    (define-key menu-bar-options-menu [menu-system-font]
      (menu-bar-make-toggle toggle-use-system-font font-use-system-font
			    "Use system font"
			    "Use system font: %s"
			    "Use the monospaced font defined by the system")))


773 774 775
;; The "Show/Hide" submenu of menu "Options"

(defvar menu-bar-showhide-menu (make-sparse-keymap "Show/Hide"))
776

777
(define-key menu-bar-showhide-menu [column-number-mode]
778
  (menu-bar-make-mm-toggle column-number-mode
779
			   "Column Numbers"
780
			   "Show the current column number in the mode line"))
781 782

(define-key menu-bar-showhide-menu [line-number-mode]
783
  (menu-bar-make-mm-toggle line-number-mode
784
			   "Line Numbers"
785
			   "Show the current line number in the mode line"))
786

787 788 789 790 791
(define-key menu-bar-showhide-menu [size-indication-mode]
  (menu-bar-make-mm-toggle size-indication-mode
			   "Size Indication"
			   "Show the size of the buffer in the mode line"))

792
(define-key menu-bar-showhide-menu [linecolumn-separator]
793
  menu-bar-separator)
794

795 796
(define-key menu-bar-showhide-menu [showhide-battery]
  (menu-bar-make-mm-toggle display-battery-mode
797
			   "Battery Status"