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

3
;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2005, 2006, 2007 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 12 13
;; This file is part of GNU Emacs.

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

;; 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
Erik Naggum's avatar
Erik Naggum committed
23
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
26

27 28
;; Avishai Yacobi suggested some menu rearrangements.

29 30
;;; Commentary:

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

33 34
;;; User options:

Richard M. Stallman's avatar
Richard M. Stallman committed
35
(defcustom buffers-menu-max-size 10
36 37 38
  "*Maximum number of entries which may appear on the Buffers menu.
If this is 10, then only the ten most-recently-selected buffers are shown.
If this is nil, then all buffers are shown.
Richard M. Stallman's avatar
Richard M. Stallman committed
39 40 41 42
A large number or nil slows down menu responsiveness."
  :type '(choice integer
		 (const :tag "All" nil))
  :group 'mouse)
43

44 45 46 47
;; 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")))
48
(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
49 50

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

55
(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu))
56 57
(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
58 59 60 61 62 63 64 65 66
;; This definition is just to show what this looks like.
;; It gets overridden below when menu-bar-update-buffers is called.
(define-key global-map [menu-bar buffer]
  (cons "Buffers" (make-sparse-keymap "Buffers")))
(defvar menu-bar-options-menu (make-sparse-keymap "Options"))
(define-key global-map [menu-bar options]
  (cons "Options" menu-bar-options-menu))
(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
67 68
(defvar menu-bar-file-menu (make-sparse-keymap "File"))
(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
69 70

;; This alias is for compatibility with 19.28 and before.
71
(defvar menu-bar-files-menu menu-bar-file-menu)
72 73 74 75

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

76

77
;; The "File" menu items
78
(define-key menu-bar-file-menu [exit-emacs]
79 80
  '(menu-item "Exit Emacs" save-buffers-kill-emacs
	      :help "Save unsaved buffers, then exit"))
81

82
(define-key menu-bar-file-menu [separator-exit]
83 84
  '("--"))

85 86
;; Don't use delete-frame as event name because that is a special
;; event.
87
(define-key menu-bar-file-menu [delete-this-frame]
88 89 90 91
  '(menu-item "Delete Frame" delete-frame
	      :visible (fboundp 'delete-frame)
	      :enable (delete-frame-enabled-p)
	      :help "Delete currently selected frame"))
92
(define-key menu-bar-file-menu [make-frame-on-display]
93 94 95
  '(menu-item "New Frame on Display..." make-frame-on-display
	      :visible (fboundp 'make-frame-on-display)
	      :help "Open a new frame on another display"))
96
(define-key menu-bar-file-menu [make-frame]
97 98 99 100
  '(menu-item "New Frame" make-frame-command
	      :visible (fboundp 'make-frame-command)
	      :help "Open a new frame"))

101
(define-key menu-bar-file-menu [one-window]
102
  '(menu-item "Remove Splits" delete-other-windows
103
	      :enable (not (one-window-p t nil))
104
	      :help "Selected window grows to fill the whole frame"))
105

106
(define-key menu-bar-file-menu [split-window]
107
  '(menu-item "Split Window" split-window-vertically
108 109
	      :enable (and (menu-bar-menu-frame-live-and-visible-p)
			   (menu-bar-non-minibuffer-window-p))
110
	      :help "Split selected window in two windows"))
111

112
(define-key menu-bar-file-menu [separator-window]
113 114
  '(menu-item "--"))

115
(define-key menu-bar-file-menu [ps-print-region]
116 117 118
  '(menu-item "Postscript Print Region (B+W)" ps-print-region
	      :enable mark-active
	      :help "Pretty-print marked region in black and white to PostScript printer"))
119
(define-key menu-bar-file-menu [ps-print-buffer]
120
  '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer
121
	      :enable (menu-bar-menu-frame-live-and-visible-p)
122
	      :help "Pretty-print current buffer in black and white to PostScript printer"))
123
(define-key menu-bar-file-menu [ps-print-region-faces]
124 125 126
  '(menu-item "Postscript Print Region" ps-print-region-with-faces
	      :enable mark-active
	      :help "Pretty-print marked region to PostScript printer"))
127
(define-key menu-bar-file-menu [ps-print-buffer-faces]
128
  '(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces
129
	      :enable (menu-bar-menu-frame-live-and-visible-p)
130
	      :help "Pretty-print current buffer to PostScript printer"))
131
(define-key menu-bar-file-menu [print-region]
132 133 134
  '(menu-item "Print Region" print-region
	      :enable mark-active
	      :help "Print region between mark and current position"))
135
(define-key menu-bar-file-menu [print-buffer]
136
  '(menu-item "Print Buffer" print-buffer
137
	      :enable (menu-bar-menu-frame-live-and-visible-p)
138 139
	      :help "Print current buffer with page headings"))

140
(define-key menu-bar-file-menu [separator-print]
141
  '(menu-item "--"))
142

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

178
(define-key menu-bar-file-menu [separator-save]
179 180
  '(menu-item "--"))

181 182 183 184 185 186 187 188 189 190 191
(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))))


192
(define-key menu-bar-file-menu [kill-buffer]
193
  '(menu-item "Close" kill-this-buffer
194
	      :enable (kill-this-buffer-enabled-p)
195
	      :help "Discard (kill) current buffer"))
196
(define-key menu-bar-file-menu [insert-file]
197
  '(menu-item "Insert File..." insert-file
198
	      :enable (menu-bar-non-minibuffer-window-p)
199
	      :help "Insert another file into current buffer"))
200
(define-key menu-bar-file-menu [dired]
201
  '(menu-item "Open Directory..." dired
202
	      :enable (menu-bar-non-minibuffer-window-p)
203
	      :help "Read a directory, to operate on its files"))
204
(define-key menu-bar-file-menu [open-file]
205
  '(menu-item "Open File..." menu-find-file-existing
206
	      :enable (menu-bar-non-minibuffer-window-p)
207
	      :help "Read an existing file into an Emacs buffer"))
208
(define-key menu-bar-file-menu [new-file]
209
  '(menu-item "Visit New File..." find-file
210
	      :enable (menu-bar-non-minibuffer-window-p)
211
	      :help "Specify a new file's name, to edit the file"))
212

213

214
;; The "Edit" menu items
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245

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

246 247 248
(defun nonincremental-search-forward (string)
  "Read a string and search 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-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: ")
258
  (setq menu-bar-last-search-type 'string)
259 260 261 262 263 264 265 266
  (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: ")
267
  (setq menu-bar-last-search-type 'regexp)
268 269 270 271 272 273 274 275
  (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: ")
276
  (setq menu-bar-last-search-type 'regexp)
277 278 279 280 281
  (if (equal string "")
      (re-search-backward (car regexp-search-ring))
    (isearch-update-ring string t)
    (re-search-backward string)))

282
(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
283

284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299
;; 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]
  '(menu-item "Backward Regexp..." isearch-backward-regexp
	      :help "Search backwards for a regular expression as you type it"))
(define-key menu-bar-i-search-menu [isearch-forward-regexp]
  '(menu-item "Forward Regexp..." isearch-forward-regexp
	      :help "Search forward for a regular expression as you type it"))
(define-key menu-bar-i-search-menu [isearch-backward]
  '(menu-item "Backward String..." isearch-backward
	      :help "Search backwards for a string as you type it"))
(define-key menu-bar-i-search-menu [isearch-forward]
  '(menu-item "Forward String..." isearch-forward
	      :help "Search forward for a string as you type it"))
300

301

302
(define-key menu-bar-search-menu [i-search]
303
  (list 'menu-item "Incremental Search" menu-bar-i-search-menu))
304
(define-key menu-bar-search-menu [separator-tag-isearch]
305 306
  '(menu-item "--"))

307 308 309 310
(define-key menu-bar-search-menu [tags-continue]
  '(menu-item "Continue Tags Search" tags-loop-continue
	      :help "Continue last tags search operation"))
(define-key menu-bar-search-menu [tags-srch]
311
  '(menu-item "Search tagged files..." tags-search
312 313
	      :help "Search for a regexp in all tagged files"))
(define-key menu-bar-search-menu [separator-tag-search]
314
  '(menu-item "--"))
315

316
(define-key menu-bar-search-menu [repeat-search-back]
317
  '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward
318 319 320 321
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
322
	      :help "Repeat last search backwards"))
323
(define-key menu-bar-search-menu [repeat-search-fwd]
324 325 326 327 328
  '(menu-item "Repeat Forward" nonincremental-repeat-search-forward
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
329
	      :help "Repeat last search forward"))
330 331 332 333 334 335 336 337 338 339
(define-key menu-bar-search-menu [separator-repeat-search]
  '(menu-item "--"))

(define-key menu-bar-search-menu [re-search-backward]
  '(menu-item "Regexp Backwards..." nonincremental-re-search-backward
	      :help "Search backwards for a regular expression"))
(define-key menu-bar-search-menu [re-search-forward]
  '(menu-item "Regexp Forward..." nonincremental-re-search-forward
	      :help "Search forward for a regular expression"))

340
(define-key menu-bar-search-menu [search-backward]
341
  '(menu-item "String Backwards..." nonincremental-search-backward
342
	      :help "Search backwards for a string"))
343
(define-key menu-bar-search-menu [search-forward]
344
  '(menu-item "String Forward..." nonincremental-search-forward
345
	      :help "Search forward for a string"))
346

347 348 349 350 351 352 353 354
;; The Edit->Replace submenu

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

(define-key menu-bar-replace-menu [tags-repl-continue]
  '(menu-item "Continue Replace" tags-loop-continue
	      :help "Continue last tags replace operation"))
(define-key menu-bar-replace-menu [tags-repl]
355
  '(menu-item "Replace in tagged files..." tags-query-replace
356 357 358 359 360 361 362 363 364 365 366 367 368
	      :help "Interactively replace a regexp in all tagged files"))
(define-key menu-bar-replace-menu [separator-replace-tags]
  '(menu-item "--"))

(define-key menu-bar-replace-menu [query-replace-regexp]
  '(menu-item "Replace Regexp..." query-replace-regexp
	      :enable (not buffer-read-only)
	      :help "Replace regular expression interactively, ask about each occurrence"))
(define-key menu-bar-replace-menu [query-replace]
  '(menu-item "Replace String..." query-replace
	      :enable (not buffer-read-only)
	      :help "Replace string interactively, ask about each occurrence"))

369 370
;;; Assemble the top-level Edit menu items.
(define-key menu-bar-edit-menu [props]
371
  '(menu-item "Text Properties" facemenu-menu))
372

373 374 375 376 377 378 379
(define-key menu-bar-edit-menu [fill]
  '(menu-item "Fill" fill-region
	      :enable (and mark-active (not buffer-read-only))
	      :help
	      "Fill text in region to fit between left and right margin"))

(define-key menu-bar-edit-menu [separator-bookmark]
380 381 382
  '(menu-item "--"))

(define-key menu-bar-edit-menu [bookmark]
383
  '(menu-item "Bookmarks" menu-bar-bookmark-map))
384 385 386 387

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

(define-key menu-bar-goto-menu [set-tags-name]
388
  '(menu-item "Set Tags File Name..." visit-tags-table
389 390 391 392 393 394
	      :help "Tell Tags commands which tag table file to use"))

(define-key menu-bar-goto-menu [separator-tag-file]
  '(menu-item "--"))

(define-key menu-bar-goto-menu [apropos-tags]
395
  '(menu-item "Tags Apropos..." tags-apropos
396 397 398
	      :help "Find function/variables whose names match regexp"))
(define-key menu-bar-goto-menu [next-tag-otherw]
  '(menu-item "Next Tag in Other Window"
399
	      menu-bar-next-tag-other-window
400 401
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
402
	      :help "Find next function/variable matching last tag name in another window"))
403 404 405 406 407 408 409 410 411 412 413

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

414 415
(define-key menu-bar-goto-menu [next-tag]
  '(menu-item "Find Next Tag"
416
	      menu-bar-next-tag
417 418
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443
	      :help "Find next function/variable matching last tag name"))
(define-key menu-bar-goto-menu [find-tag-otherw]
  '(menu-item "Find Tag in Other Window..." find-tag-other-window
	      :help "Find function/variable definition in another window"))
(define-key menu-bar-goto-menu [find-tag]
  '(menu-item "Find Tag..." find-tag
	      :help "Find definition of function or variable"))

(define-key menu-bar-goto-menu [separator-tags]
  '(menu-item "--"))

(define-key menu-bar-goto-menu [end-of-buf]
  '(menu-item "Goto End of Buffer" end-of-buffer))
(define-key menu-bar-goto-menu [beg-of-buf]
  '(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
(define-key menu-bar-goto-menu [go-to-pos]
  '(menu-item "Goto Buffer Position..." goto-char
	      :help "Read a number N and go to buffer position N"))
(define-key menu-bar-goto-menu [go-to-line]
  '(menu-item "Goto Line..." goto-line
	      :help "Read a line number and go to that line"))

(define-key menu-bar-edit-menu [goto]
  (list 'menu-item "Go To" menu-bar-goto-menu))

444 445 446
(define-key menu-bar-edit-menu [replace]
  (list 'menu-item "Replace" menu-bar-replace-menu))

447 448 449
(define-key menu-bar-edit-menu [search]
  (list 'menu-item "Search" menu-bar-search-menu))

450 451 452
(define-key menu-bar-edit-menu [separator-search]
  '(menu-item "--"))

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

496

497 498 499
(defun menu-bar-kill-ring-save (beg end)
  (interactive "r")
  (if (mouse-region-match)
500
      (message "Selecting a region with the mouse does `copy' automatically")
501 502
    (kill-ring-save beg end)))

503
;; These are alternative definitions for the cut, paste and copy
504
;; menu items.  Use them if your system expects these to use the clipboard.
505 506 507 508

(put 'clipboard-kill-region 'menu-enable 'mark-active)
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
509 510
     '(or (and (fboundp 'x-selection-exists-p) (x-selection-exists-p))
	  (x-selection-exists-p 'CLIPBOARD)))
511 512

(defun clipboard-yank ()
513
  "Insert the clipboard contents, or the last stretch of killed text."
514
  (interactive "*")
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530
  (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 ()
531 532
  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
533
  (interactive)
534 535 536
  ;; 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]
537
    (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank)))
538
  (define-key menu-bar-edit-menu [copy]
539 540
    (cons "Copy" (cons "Copy text in region to the clipboard"
		       'clipboard-kill-ring-save)))
541
  (define-key menu-bar-edit-menu [cut]
542 543
    (cons "Cut" (cons "Delete text in region and copy it to the clipboard"
		      'clipboard-kill-region)))
544

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

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

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

599
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
600

601 602 603
(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).
604
DOC is the text to use for the menu entry.
605 606
HELP is the text to use for the tooltip.
PROPS are additional properties."
607
  `'(menu-item ,doc ,fname
Stefan Monnier's avatar
Stefan Monnier committed
608
     ,@props
609 610 611 612
     :help ,help
     :button (:toggle . (and (default-boundp ',fname)
			     (default-value ',fname)))))

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

;;; Assemble all the top-level items of the "Options" menu
(define-key menu-bar-options-menu [customize]
641
  (list 'menu-item "Customize Emacs" menu-bar-custom-menu))
642 643 644 645

(defun menu-bar-options-save ()
  "Save current values of Options menu items using Custom."
  (interactive)
646
  (let ((need-save nil))
647 648
    ;; These are set with menu-bar-make-mm-toggle, which does not
    ;; put on a customized-value property.
649 650
    (dolist (elt '(line-number-mode column-number-mode size-indication-mode
		   cua-mode show-paren-mode transient-mark-mode
651
		   blink-cursor-mode display-time-mode display-battery-mode))
652 653
      (and (customize-mark-to-save elt)
	   (setq need-save t)))
654
    ;; These are set with `customize-set-variable'.
655
    (dolist (elt '(scroll-bar-mode
656 657
		   debug-on-quit debug-on-error
		   tooltip-mode menu-bar-mode tool-bar-mode
658
		   save-place uniquify-buffer-name-style fringe-mode
659
		   indicate-empty-lines indicate-buffer-boundaries
660
		   case-fold-search
661
		   current-language-environment default-input-method
662 663 664 665 666 667 668 669 670 671
		   ;; 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)))
672 673 674
    ;; Save if we changed anything.
    (when need-save
      (custom-save-all))))
675 676

(define-key menu-bar-options-menu [save]
677
  '(menu-item "Save Options" menu-bar-options-save
678 679 680 681 682
	      :help "Save options set from the menu above"))

(define-key menu-bar-options-menu [custom-separator]
  '("--"))

683
(define-key menu-bar-options-menu [mouse-set-font]
684
  '(menu-item "Set Font/Fontset..." mouse-set-font
685 686 687
	       :visible (display-multi-font-p)
	       :help "Select a font from list of known fonts/fontsets"))

688 689 690
;; The "Show/Hide" submenu of menu "Options"

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

692
(define-key menu-bar-showhide-menu [column-number-mode]
693
  (menu-bar-make-mm-toggle column-number-mode
694
			   "Column Numbers"
695
			   "Show the current column number in the mode line"))
696 697

(define-key menu-bar-showhide-menu [line-number-mode]
698
  (menu-bar-make-mm-toggle line-number-mode
699
			   "Line Numbers"
700
			   "Show the current line number in the mode line"))
701

702 703 704 705 706
(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"))

707 708 709
(define-key menu-bar-showhide-menu [linecolumn-separator]
  '("--"))

710 711
(define-key menu-bar-showhide-menu [showhide-battery]
  (menu-bar-make-mm-toggle display-battery-mode
712
			   "Battery Status"
713 714
			   "Display battery status information in mode line"))

715
(define-key menu-bar-showhide-menu [showhide-date-time]
Stefan Monnier's avatar
Stefan Monnier committed
716
  (menu-bar-make-mm-toggle display-time-mode
717 718 719
			   "Time, Load and Mail"
			   "Display time, system load averages and \
mail status in mode line"))
720 721 722 723

(define-key menu-bar-showhide-menu [datetime-separator]
  '("--"))

724 725
(define-key menu-bar-showhide-menu [showhide-speedbar]
  '(menu-item "Speedbar" speedbar-frame-mode
726
	      :help "Display a Speedbar quick-navigation frame"
727 728 729
	      :button (:toggle
		       . (and (boundp 'speedbar-frame)
			      (frame-live-p (symbol-value 'speedbar-frame))
730
			      (frame-visible-p
731 732
			       (symbol-value 'speedbar-frame))))))

733
(defvar menu-bar-showhide-fringe-menu (make-sparse-keymap "Fringe"))
734

735 736
(defvar menu-bar-showhide-fringe-ind-menu
  (make-sparse-keymap "Buffer boundaries"))
737

738 739
(defun menu-bar-showhide-fringe-ind-customize ()
  "Show customization buffer for `indicate-buffer-boundaries'."
740
  (interactive)
741
  (customize-variable 'indicate-buffer-boundaries))
742

743
(define-key menu-bar-showhide-fringe-ind-menu [customize]
744
  '(menu-item "Other (Customize)"
745 746 747
	      menu-bar-showhide-fringe-ind-customize
	      :help "Additional choices available through Custom buffer"
	      :visible (display-graphic-p)))
748 749

(defun menu-bar-showhide-fringe-ind-mixed ()
750
  "Display top and bottom indicators in opposite fringes, arrows in right."
751
  (interactive)
752 753
  (customize-set-variable 'indicate-buffer-boundaries
			  '((t . right) (top . left))))
754 755

(define-key menu-bar-showhide-fringe-ind-menu [mixed]
756
  '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed
757 758
	      :help
	      "Show top/bottom indicators in opposite fringes, arrows in right"
759
	      :visible (display-graphic-p)
760 761
	      :button (:radio . (eq indicate-buffer-boundaries
				    '((t . right) (top . left))))))
762 763 764 765

(defun menu-bar-showhide-fringe-ind-box ()
  "Display top and bottom indicators in opposite fringes."
  (interactive)
766 767
  (customize-set-variable 'indicate-buffer-boundaries
			  '((top . left) (bottom . right))))
768 769

(define-key menu-bar-showhide-fringe-ind-menu [box]
770
  '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box
771 772
	      :help "Show top/bottom indicators in opposite fringes, no arrows"
	      :visible (display-graphic-p)
773 774
	      :button (:radio . (eq indicate-buffer-boundaries
				    '((top . left) (bottom . right))))))
775 776

(defun menu-bar-showhide-fringe-ind-right ()
777
  "Display buffer boundaries and arrows in the right fringe."
778
  (interactive)
779
  (customize-set-variable 'indicate-buffer-boundaries 'right))
780 781

(define-key menu-bar-showhide-fringe-ind-menu [right]
782
  '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right
783
	      :help "Show buffer boundaries and arrows in right fringe"
784
	      :visible (display-graphic-p)
785
	      :button (:radio . (eq indicate-buffer-boundaries 'right))))
786 787

(defun menu-bar-showhide-fringe-ind-left ()
788
  "Display buffer boundaries and arrows in the left fringe."
789
  (interactive)
790
  (customize-set-variable 'indicate-buffer-boundaries 'left))
791 792

(define-key menu-bar-showhide-fringe-ind-menu [left]
793
  '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left
794
	      :help "Show buffer boundaries and arrows in left fringe"
795
	      :visible (display-graphic-p)
796
	      :button (:radio . (eq indicate-buffer-boundaries 'left))))
797 798

(defun menu-bar-showhide-fringe-ind-none ()
799
  "Do not display any buffer boundary indicators."
800
  (interactive)
801
  (customize-set-variable 'indicate-buffer-boundaries nil))
802 803

(define-key menu-bar-showhide-fringe-ind-menu [none]
804
  '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none
805
	      :help "Hide all buffer boundary indicators and arrows"
806
	      :visible (display-graphic-p)
807
	      :button (:radio . (eq indicate-buffer-boundaries nil))))
808

809
(define-key menu-bar-showhide-fringe-menu [showhide-fringe-ind]
810
  (list 'menu-item "Buffer Boundaries" menu-bar-showhide-fringe-ind-menu
811 812
	:visible `(display-graphic-p)
	:help "Indicate buffer boundaries in fringe"))
813

814 815
(define-key menu-bar-showhide-fringe-menu [indicate-empty-lines]
  (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
816
			"Empty Line Indicators"
817
			"Indicating of empty lines %s"
818
			"Indicate trailing empty lines in fringe, globally"))
819 820 821 822 823 824 825

(defun menu-bar-showhide-fringe-menu-customize ()
  "Show customization buffer for `fringe-mode'."
  (interactive)
  (customize-variable 'fringe-mode))

(define-key menu-bar-showhide-fringe-menu [customize]
826
  '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
827 828 829 830
	      :help "Detailed customization of fringe"
	      :visible (display-graphic-p)))

(defun menu-bar-showhide-fringe-menu-customize-reset ()
831
  "Reset the fringe mode: display fringes on both sides of a window."
832 833 834 835 836 837 838
  (interactive)
  (customize-set-variable 'fringe-mode nil))

(define-key menu-bar-showhide-fringe-menu [default]
  '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset
	      :help "Default width fringe on both left and right side"
	      :visible (display-graphic-p)
839
	      :button (:radio . (eq fringe-mode nil))))
840 841

(defun menu-bar-showhide-fringe-menu-customize-right ()
842
  "Display fringes only on the right of each window."