menu-bar.el 82.3 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

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

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; 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
16 17 18 19 20 21 22

;; 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
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
24

25 26
;; Avishai Yacobi suggested some menu rearrangements.

27 28
;;; Commentary:

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

31 32 33 34
;; 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")))
35
(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
36 37

;; Force Help item to come last, after the major mode's own items.
38 39 40
;; The symbol used to be called `help', but that gets confused with the
;; help key.
(setq menu-bar-final-items '(help-menu))
41

42
(define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu))
43
(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
44
(define-key global-map [menu-bar tools] (cons (purecopy "Tools") menu-bar-tools-menu))
45
;; This definition is just to show what this looks like.
46 47
;; It gets modified in place when menu-bar-update-buffers is called.
(defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
48
(define-key global-map [menu-bar buffer]
49
  (cons (purecopy "Buffers") global-buffers-menu-map))
50 51
(defvar menu-bar-options-menu (make-sparse-keymap "Options"))
(define-key global-map [menu-bar options]
52
  (cons (purecopy "Options") menu-bar-options-menu))
53
(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
54
(define-key global-map [menu-bar edit] (cons (purecopy "Edit") menu-bar-edit-menu))
55
(defvar menu-bar-file-menu (make-sparse-keymap "File"))
56
(define-key global-map [menu-bar file] (cons (purecopy "File") menu-bar-file-menu))
57 58

;; This alias is for compatibility with 19.28 and before.
59
(defvar menu-bar-files-menu menu-bar-file-menu)
60 61 62 63

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

64 65 66
;; From emulation/cua-base.el; used below
(defvar cua-enable-cua-keys)

67

68
;; The "File" menu items
69
(define-key menu-bar-file-menu [exit-emacs]
70 71
  `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal
	      :help ,(purecopy "Save unsaved buffers, then exit")))
72

73
(define-key menu-bar-file-menu [separator-exit]
74
  menu-bar-separator)
75

76 77
;; Don't use delete-frame as event name because that is a special
;; event.
78
(define-key menu-bar-file-menu [delete-this-frame]
79
  `(menu-item ,(purecopy "Delete Frame") delete-frame
80 81
	      :visible (fboundp 'delete-frame)
	      :enable (delete-frame-enabled-p)
82
	      :help ,(purecopy "Delete currently selected frame")))
83
(define-key menu-bar-file-menu [make-frame-on-display]
84
  `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display
85
	      :visible (fboundp 'make-frame-on-display)
86
	      :help ,(purecopy "Open a new frame on another display")))
87
(define-key menu-bar-file-menu [make-frame]
88
  `(menu-item ,(purecopy "New Frame") make-frame-command
89
	      :visible (fboundp 'make-frame-command)
90
	      :help ,(purecopy "Open a new frame")))
91

92
(define-key menu-bar-file-menu [one-window]
93
  `(menu-item ,(purecopy "Remove Splits") delete-other-windows
94
	      :enable (not (one-window-p t nil))
95
	      :help ,(purecopy "Selected window grows to fill the whole frame")))
96

97
(define-key menu-bar-file-menu [split-window]
98
  `(menu-item ,(purecopy "Split Window") split-window-vertically
99 100
	      :enable (and (menu-bar-menu-frame-live-and-visible-p)
			   (menu-bar-non-minibuffer-window-p))
101
	      :help ,(purecopy "Split selected window in two windows")))
102

103
(define-key menu-bar-file-menu [separator-window]
104
  menu-bar-separator)
105

106
(define-key menu-bar-file-menu [ps-print-region]
107
  `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region
108
	      :enable mark-active
109
	      :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer")))
110
(define-key menu-bar-file-menu [ps-print-buffer]
111
  `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer
112
	      :enable (menu-bar-menu-frame-live-and-visible-p)
113
	      :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer")))
114
(define-key menu-bar-file-menu [ps-print-region-faces]
115
  `(menu-item ,(purecopy "Postscript Print Region") ps-print-region-with-faces
116
	      :enable mark-active
117
	      :help ,(purecopy "Pretty-print marked region to PostScript printer")))
118
(define-key menu-bar-file-menu [ps-print-buffer-faces]
119
  `(menu-item ,(purecopy "Postscript Print Buffer") ps-print-buffer-with-faces
120
	      :enable (menu-bar-menu-frame-live-and-visible-p)
121
	      :help ,(purecopy "Pretty-print current buffer to PostScript printer")))
122
(define-key menu-bar-file-menu [print-region]
123
  `(menu-item ,(purecopy "Print Region") print-region
124
	      :enable mark-active
125
	      :help ,(purecopy "Print region between mark and current position")))
126
(define-key menu-bar-file-menu [print-buffer]
127
  `(menu-item ,(purecopy "Print Buffer") print-buffer
128
	      :enable (menu-bar-menu-frame-live-and-visible-p)
129
	      :help ,(purecopy "Print current buffer with page headings")))
130

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

134
(define-key menu-bar-file-menu [recover-session]
135
  `(menu-item ,(purecopy "Recover Crashed Session") recover-session
136
	      :enable (and auto-save-list-file-prefix
137 138 139
			   (file-directory-p
                            (file-name-directory auto-save-list-file-prefix))
                           (directory-files
140 141 142 143 144 145 146
			    (file-name-directory auto-save-list-file-prefix)
			    nil
			    (concat "\\`"
				    (regexp-quote
				     (file-name-nondirectory
				      auto-save-list-file-prefix)))
			    t))
147
	      :help ,(purecopy "Recover edits from a crashed session")))
148
(define-key menu-bar-file-menu [revert-buffer]
149
  `(menu-item ,(purecopy "Revert Buffer") revert-buffer
150 151
	      :enable (or revert-buffer-function
			  revert-buffer-insert-file-contents-function
152
			  (and buffer-file-number
153 154 155
			       (or (buffer-modified-p)
				   (not (verify-visited-file-modtime
					 (current-buffer))))))
156
	      :help ,(purecopy "Re-read current buffer from its file")))
157
(define-key menu-bar-file-menu [write-file]
158
  `(menu-item ,(purecopy "Save As...") write-file
159 160
	      :enable (and (menu-bar-menu-frame-live-and-visible-p)
			   (menu-bar-non-minibuffer-window-p))
161
	      :help ,(purecopy "Write current buffer to another file")))
162
(define-key menu-bar-file-menu [save-buffer]
163
  `(menu-item ,(purecopy "Save") save-buffer
164
	      :enable (and (buffer-modified-p)
165
			   (buffer-file-name)
166
			   (menu-bar-non-minibuffer-window-p))
167
	      :help ,(purecopy "Save current buffer to its file")))
168

169
(define-key menu-bar-file-menu [separator-save]
170
  menu-bar-separator)
171

172 173 174 175 176 177 178 179 180 181 182
(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))))


183
(define-key menu-bar-file-menu [kill-buffer]
184
  `(menu-item ,(purecopy "Close") kill-this-buffer
185
	      :enable (kill-this-buffer-enabled-p)
186
	      :help ,(purecopy "Discard (kill) current buffer")))
187
(define-key menu-bar-file-menu [insert-file]
188
  `(menu-item ,(purecopy "Insert File...") insert-file
189
	      :enable (menu-bar-non-minibuffer-window-p)
190
	      :help ,(purecopy "Insert another file into current buffer")))
191
(define-key menu-bar-file-menu [dired]
192
  `(menu-item ,(purecopy "Open Directory...") dired
193
	      :enable (menu-bar-non-minibuffer-window-p)
194
	      :help ,(purecopy "Read a directory, to operate on its files")))
195
(define-key menu-bar-file-menu [open-file]
196
  `(menu-item ,(purecopy "Open File...") menu-find-file-existing
197
	      :enable (menu-bar-non-minibuffer-window-p)
198
	      :help ,(purecopy "Read an existing file into an Emacs buffer")))
199
(define-key menu-bar-file-menu [new-file]
200
  `(menu-item ,(purecopy "Visit New File...") find-file
201
	      :enable (menu-bar-non-minibuffer-window-p)
202
	      :help ,(purecopy "Specify a new file's name, to edit the file")))
203

204

205
;; The "Edit" menu items
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236

;; 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"))))

237 238 239
(defun nonincremental-search-forward (string)
  "Read a string and search for it nonincrementally."
  (interactive "sSearch for string: ")
240
  (setq menu-bar-last-search-type 'string)
241 242 243 244 245 246 247 248
  (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: ")
249
  (setq menu-bar-last-search-type 'string)
250 251 252 253 254 255 256 257
  (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: ")
258
  (setq menu-bar-last-search-type 'regexp)
259 260 261 262 263 264 265 266
  (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: ")
267
  (setq menu-bar-last-search-type 'regexp)
268 269 270 271 272
  (if (equal string "")
      (re-search-backward (car regexp-search-ring))
    (isearch-update-ring string t)
    (re-search-backward string)))

273
(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
274

275 276 277 278 279
;; 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]
280 281
  `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp
	      :help ,(purecopy "Search backwards for a regular expression as you type it")))
282
(define-key menu-bar-i-search-menu [isearch-forward-regexp]
283 284
  `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp
	      :help ,(purecopy "Search forward for a regular expression as you type it")))
285
(define-key menu-bar-i-search-menu [isearch-backward]
286 287
  `(menu-item ,(purecopy "Backward String...") isearch-backward
	      :help ,(purecopy "Search backwards for a string as you type it")))
288
(define-key menu-bar-i-search-menu [isearch-forward]
289 290
  `(menu-item ,(purecopy "Forward String...") isearch-forward
	      :help ,(purecopy "Search forward for a string as you type it")))
291

292
(define-key menu-bar-search-menu [i-search]
293
  `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu))
294
(define-key menu-bar-search-menu [separator-tag-isearch]
295
  menu-bar-separator)
296

297
(define-key menu-bar-search-menu [tags-continue]
298 299
  `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
	      :help ,(purecopy "Continue last tags search operation")))
300
(define-key menu-bar-search-menu [tags-srch]
301 302
  `(menu-item ,(purecopy "Search Tagged Files...") tags-search
	      :help ,(purecopy "Search for a regexp in all tagged files")))
303
(define-key menu-bar-search-menu [separator-tag-search]
304
  menu-bar-separator)
305

306
(define-key menu-bar-search-menu [repeat-search-back]
307
  `(menu-item ,(purecopy "Repeat Backwards") nonincremental-repeat-search-backward
308 309 310 311
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
312
	      :help ,(purecopy "Repeat last search backwards")))
313
(define-key menu-bar-search-menu [repeat-search-fwd]
314
  `(menu-item ,(purecopy "Repeat Forward") nonincremental-repeat-search-forward
315 316 317 318
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
319
	      :help ,(purecopy "Repeat last search forward")))
320
(define-key menu-bar-search-menu [separator-repeat-search]
321
  menu-bar-separator)
322 323

(define-key menu-bar-search-menu [re-search-backward]
324 325
  `(menu-item ,(purecopy "Regexp Backwards...") nonincremental-re-search-backward
	      :help ,(purecopy "Search backwards for a regular expression")))
326
(define-key menu-bar-search-menu [re-search-forward]
327 328
  `(menu-item ,(purecopy "Regexp Forward...") nonincremental-re-search-forward
	      :help ,(purecopy "Search forward for a regular expression")))
329

330
(define-key menu-bar-search-menu [search-backward]
331 332
  `(menu-item ,(purecopy "String Backwards...") nonincremental-search-backward
	      :help ,(purecopy "Search backwards for a string")))
333
(define-key menu-bar-search-menu [search-forward]
334 335
  `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward
	      :help ,(purecopy "Search forward for a string")))
336

337 338 339 340 341
;; The Edit->Replace submenu

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

(define-key menu-bar-replace-menu [tags-repl-continue]
342 343
  `(menu-item ,(purecopy "Continue Replace") tags-loop-continue
	      :help ,(purecopy "Continue last tags replace operation")))
344
(define-key menu-bar-replace-menu [tags-repl]
345 346
  `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace
	      :help ,(purecopy "Interactively replace a regexp in all tagged files")))
347
(define-key menu-bar-replace-menu [separator-replace-tags]
348
  menu-bar-separator)
349 350

(define-key menu-bar-replace-menu [query-replace-regexp]
351
  `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp
352
	      :enable (not buffer-read-only)
353
	      :help ,(purecopy "Replace regular expression interactively, ask about each occurrence")))
354
(define-key menu-bar-replace-menu [query-replace]
355
  `(menu-item ,(purecopy "Replace String...") query-replace
356
	      :enable (not buffer-read-only)
357
	      :help ,(purecopy "Replace string interactively, ask about each occurrence")))
358

359 360
;;; Assemble the top-level Edit menu items.
(define-key menu-bar-edit-menu [props]
361
  `(menu-item ,(purecopy "Text Properties") facemenu-menu))
362

363
(define-key menu-bar-edit-menu [fill]
364
  `(menu-item ,(purecopy "Fill") fill-region
365 366
	      :enable (and mark-active (not buffer-read-only))
	      :help
367
	      ,(purecopy "Fill text in region to fit between left and right margin")))
368 369

(define-key menu-bar-edit-menu [separator-bookmark]
370
  menu-bar-separator)
371 372

(define-key menu-bar-edit-menu [bookmark]
373
  `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map))
374 375 376 377

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

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

(define-key menu-bar-goto-menu [separator-tag-file]
382
  menu-bar-separator)
383 384

(define-key menu-bar-goto-menu [apropos-tags]
385 386
  `(menu-item ,(purecopy "Tags Apropos...") tags-apropos
	      :help ,(purecopy "Find function/variables whose names match regexp")))
387
(define-key menu-bar-goto-menu [next-tag-otherw]
388
  `(menu-item ,(purecopy "Next Tag in Other Window")
389
	      menu-bar-next-tag-other-window
390 391
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
392
	      :help ,(purecopy "Find next function/variable matching last tag name in another window")))
393 394 395 396 397 398 399 400 401 402 403

(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))

404
(define-key menu-bar-goto-menu [next-tag]
405
  `(menu-item ,(purecopy "Find Next Tag")
406
	      menu-bar-next-tag
407 408
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
409
	      :help ,(purecopy "Find next function/variable matching last tag name")))
410
(define-key menu-bar-goto-menu [find-tag-otherw]
411 412
  `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window
	      :help ,(purecopy "Find function/variable definition in another window")))
413
(define-key menu-bar-goto-menu [find-tag]
414 415
  `(menu-item ,(purecopy "Find Tag...") find-tag
	      :help ,(purecopy "Find definition of function or variable")))
416 417

(define-key menu-bar-goto-menu [separator-tags]
418
  menu-bar-separator)
419 420

(define-key menu-bar-goto-menu [end-of-buf]
421
  `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer))
422
(define-key menu-bar-goto-menu [beg-of-buf]
423
  `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer))
424
(define-key menu-bar-goto-menu [go-to-pos]
425 426
  `(menu-item ,(purecopy "Goto Buffer Position...") goto-char
	      :help ,(purecopy "Read a number N and go to buffer position N")))
427
(define-key menu-bar-goto-menu [go-to-line]
428 429
  `(menu-item ,(purecopy "Goto Line...") goto-line
	      :help ,(purecopy "Read a line number and go to that line")))
430 431

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

434
(define-key menu-bar-edit-menu [replace]
435
  `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu))
436

437
(define-key menu-bar-edit-menu [search]
438
  `(menu-item ,(purecopy "Search") ,menu-bar-search-menu))
439

440
(define-key menu-bar-edit-menu [separator-search]
441
  menu-bar-separator)
442

443
(define-key menu-bar-edit-menu [mark-whole-buffer]
444 445
  `(menu-item ,(purecopy "Select All") mark-whole-buffer
	      :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
446
(define-key menu-bar-edit-menu [clear]
447
  `(menu-item ,(purecopy "Clear") delete-region
448 449 450 451
	      :enable (and mark-active
			   (not buffer-read-only)
			   (not (mouse-region-match)))
	      :help
452
	      ,(purecopy "Delete the text in region between mark and current position")))
453
(defvar yank-menu (cons (purecopy "Select Yank") nil))
454
(fset 'yank-menu (cons 'keymap yank-menu))
455
(define-key menu-bar-edit-menu [paste-from-menu]
456
  `(menu-item ,(purecopy "Paste from Kill Menu") yank-menu
457
	      :enable (and (cdr yank-menu) (not buffer-read-only))
458
	      :help ,(purecopy "Choose a string from the kill ring and paste it")))
459
(define-key menu-bar-edit-menu [paste]
460
  `(menu-item ,(purecopy "Paste") yank
461 462 463 464 465 466 467
	      :enable (and (or
			    ;; Emacs compiled --without-x doesn't have
			    ;; x-selection-exists-p.
			    (and (fboundp 'x-selection-exists-p)
				 (x-selection-exists-p))
			    kill-ring)
			   (not buffer-read-only))
468
	      :help ,(purecopy "Paste (yank) text most recently cut/copied")))
469
(define-key menu-bar-edit-menu [copy]
470
  `(menu-item ,(purecopy "Copy") menu-bar-kill-ring-save
471
	      :enable mark-active
472
	      :help ,(purecopy "Copy text in region between mark and current position")
473
	      :keys ,(purecopy "\\[kill-ring-save]")))
474
(define-key menu-bar-edit-menu [cut]
475
  `(menu-item ,(purecopy "Cut") kill-region
476
	      :enable (and mark-active (not buffer-read-only))
477
	      :help
478
	      ,(purecopy "Cut (kill) text in region between mark and current position")))
479
(define-key menu-bar-edit-menu [undo]
480
  `(menu-item ,(purecopy "Undo") undo
481 482 483
	      :enable (and (not buffer-read-only)
			   (not (eq t buffer-undo-list))
			   (if (eq last-command 'undo)
484
			       (listp pending-undo-list)
485
			     (consp buffer-undo-list)))
486
	      :help ,(purecopy "Undo last operation")))
487

488

489 490 491
(defun menu-bar-kill-ring-save (beg end)
  (interactive "r")
  (if (mouse-region-match)
492
      (message "Selecting a region with the mouse does `copy' automatically")
493 494
    (kill-ring-save beg end)))

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

498 499
(put 'clipboard-kill-region 'menu-enable
     '(and mark-active (not buffer-read-only)))
500 501
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
502 503
     '(and (or (not (fboundp 'x-selection-exists-p))
	       (x-selection-exists-p)
504
	       (x-selection-exists-p 'CLIPBOARD))
505
 	   (not buffer-read-only)))
506 507

(defun clipboard-yank ()
508
  "Insert the clipboard contents, or the last stretch of killed text."
509
  (interactive "*")
510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525
  (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 ()
526 527
  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
528
  (interactive)
529 530 531
  ;; We can't use constant list structure here because it becomes pure,
  ;; and because it gets modified with cache data.
  (define-key menu-bar-edit-menu [paste]
532
    (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank)))
533
  (define-key menu-bar-edit-menu [copy]
534 535
    (cons "Copy" (cons "Copy text in region to the clipboard"
		       'clipboard-kill-ring-save)))
536
  (define-key menu-bar-edit-menu [cut]
537 538
    (cons "Cut" (cons "Delete text in region and copy it to the clipboard"
		      'clipboard-kill-region)))
539

540 541
  ;; These are Sun server keysyms for the Cut, Copy and Paste keys
  ;; (also for XFree86 on Sun keyboard):
542 543 544
  (define-key global-map [f20] 'clipboard-kill-region)
  (define-key global-map [f16] 'clipboard-kill-ring-save)
  (define-key global-map [f18] 'clipboard-yank)
545
  ;; X11R6 versions:
546 547 548
  (define-key global-map [cut] 'clipboard-kill-region)
  (define-key global-map [copy] 'clipboard-kill-ring-save)
  (define-key global-map [paste] 'clipboard-yank))
549

550
;; The "Options" menu items
551 552 553

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

554
(define-key menu-bar-custom-menu [customize-apropos-groups]
555 556
  `(menu-item ,(purecopy "Groups Matching Regexp...") customize-apropos-groups
	      :help ,(purecopy "Browse groups whose names match regexp")))
557
(define-key menu-bar-custom-menu [customize-apropos-faces]
558 559
  `(menu-item ,(purecopy "Faces Matching Regexp...") customize-apropos-faces
	      :help ,(purecopy "Browse faces whose names match regexp")))
560
(define-key menu-bar-custom-menu [customize-apropos-options]
561 562
  `(menu-item ,(purecopy "Options Matching Regexp...") customize-apropos-options
	      :help ,(purecopy "Browse options whose names match regexp")))
563
(define-key menu-bar-custom-menu [customize-apropos]
564 565
  `(menu-item ,(purecopy "Settings Matching Regexp...") customize-apropos
	      :help ,(purecopy "Browse customizable settings whose names match regexp")))
566
(define-key menu-bar-custom-menu [separator-1]
567
  menu-bar-separator)
Richard M. Stallman's avatar
Richard M. Stallman committed
568
(define-key menu-bar-custom-menu [customize-group]
569 570
  `(menu-item ,(purecopy "Specific Group...") customize-group
	      :help ,(purecopy "Customize settings of specific group")))
571
(define-key menu-bar-custom-menu [customize-face]
572 573
  `(menu-item ,(purecopy "Specific Face...") customize-face
	      :help ,(purecopy "Customize attributes of specific face")))
574
(define-key menu-bar-custom-menu [customize-option]
575 576
  `(menu-item ,(purecopy "Specific Option...") customize-option
	      :help ,(purecopy "Customize value of specific option")))
577
(define-key menu-bar-custom-menu [separator-2]
578
  menu-bar-separator)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
579
(define-key menu-bar-custom-menu [customize-changed-options]
580 581
  `(menu-item ,(purecopy "New Options...") customize-changed-options
	      :help ,(purecopy "Options added or changed in recent Emacs versions")))
582
(define-key menu-bar-custom-menu [customize-saved]
583 584
  `(menu-item ,(purecopy "Saved Options") customize-saved
	      :help ,(purecopy "Customize previously saved options")))
585
(define-key menu-bar-custom-menu [separator-3]
586
  menu-bar-separator)
Per Abrahamsen's avatar
Per Abrahamsen committed
587
(define-key menu-bar-custom-menu [customize-browse]
588 589
  `(menu-item ,(purecopy "Browse Customization Groups") customize-browse
	      :help ,(purecopy "Browse all customization groups")))
590
(define-key menu-bar-custom-menu [customize]
591 592
  `(menu-item ,(purecopy "Top-level Customization Group") customize
	      :help ,(purecopy "The master group called `Emacs'")))
593

594
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
595

596 597 598
(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).
599
DOC is the text to use for the menu entry.
600 601
HELP is the text to use for the tooltip.
PROPS are additional properties."
602
  `(list 'menu-item  (purecopy ,doc) ',fname
603
	 ,@(mapcar (lambda (p) (list 'quote p)) props)
604 605 606
	 :help (purecopy ,help)
	 :button '(:toggle . (and (default-boundp ',fname)
				  (default-value ',fname)))))
607

608
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
609
  `(progn
610
     (defun ,name (&optional interactively)
611
       ,(concat "Toggle whether to " (downcase (substring help 0 1))
612
		(substring help 1) ".
613 614 615
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
       (interactive "p")
616
       (if ,(if body `(progn . ,body)
617
	      `(progn
618 619 620 621
		 (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))))))
622 623
	   (message ,message "enabled globally")
  	 (message ,message "disabled globally"))
624 625 626 627
       ;; 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.
628
       (if interactively (customize-mark-as-set ',variable)))
629
     (list 'menu-item (purecopy ,doc) ',name
630 631 632
	   :help (purecopy ,help)
	   :button '(:toggle . (and (default-boundp ',variable)
				    (default-value ',variable))))))
633

634 635 636 637 638
;; Function for setting/saving default font.

(defun menu-set-font ()
  "Interactively select a font and make it the default."
  (interactive)
639
  (let ((font (if (fboundp 'x-select-font)
640
  		  (x-select-font)
641 642 643
  		(mouse-select-font)))
	spec)
    (when font
Chong Yidong's avatar
Chong Yidong committed
644 645 646 647 648 649 650 651
      ;; 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)
652 653 654 655 656 657
      (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))
658 659 660 661 662
      (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))))

663 664


665 666
;;; Assemble all the top-level items of the "Options" menu
(define-key menu-bar-options-menu [customize]
667
  `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu))
668 669 670 671

(defun menu-bar-options-save ()
  "Save current values of Options menu items using Custom."
  (interactive)
672
  (let ((need-save nil))
673 674
    ;; These are set with menu-bar-make-mm-toggle, which does not
    ;; put on a customized-value property.
675 676
    (dolist (elt '(line-number-mode column-number-mode size-indication-mode
		   cua-mode show-paren-mode transient-mark-mode
677
		   blink-cursor-mode display-time-mode display-battery-mode))
678 679
      (and (customize-mark-to-save elt)
	   (setq need-save t)))
680
    ;; These are set with `customize-set-variable'.
681
    (dolist (elt '(scroll-bar-mode
682 683
		   debug-on-quit debug-on-error
		   tooltip-mode menu-bar-mode tool-bar-mode
684
		   save-place uniquify-buffer-name-style fringe-mode
685
		   indicate-empty-lines indicate-buffer-boundaries
686
		   case-fold-search font-use-system-font
687
		   current-language-environment default-input-method
688 689 690 691 692 693 694 695 696 697
		   ;; 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.
		   text-mode-hook))
      (and (get elt 'customized-value)
	   (customize-mark-to-save elt)
	   (setq need-save t)))
698 699 700 701
    (when (get 'default 'customized-face)
      (put 'default 'saved-face (get 'default 'customized-face))
      (put 'default 'customized-face nil)
      (setq need-save t))
702 703 704
    ;; Save if we changed anything.
    (when need-save
      (custom-save-all))))
705 706

(define-key menu-bar-options-menu [save]
707 708
  `(menu-item ,(purecopy "Save Options") menu-bar-options-save
	      :help ,(purecopy "Save options set from the menu above")))
709 710

(define-key menu-bar-options-menu [custom-separator]
711
  menu-bar-separator)
712

713
(define-key menu-bar-options-menu [menu-set-font]
714
  `(menu-item ,(purecopy "Set Default Font...") menu-set-font
715
	      :visible (display-multi-font-p)
716
	      :help ,(purecopy "Select a default font")))