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

3
;; Copyright (C) 1993,94,1995,2000,01,02,2003  Free Software Foundation, Inc.
Erik Naggum's avatar
Erik Naggum committed
4

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

Richard M. Stallman's avatar
Richard M. Stallman committed
9 10 11 12 13 14 15 16 17 18 19 20 21
;; 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
;; the Free Software Foundation; either version 2, or (at your option)
;; 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
22 23 24
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
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
;;; User options:

Richard M. Stallman's avatar
Richard M. Stallman committed
34
(defcustom buffers-menu-max-size 10
35 36 37
  "*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
38 39 40 41
A large number or nil slows down menu responsiveness."
  :type '(choice integer
		 (const :tag "All" nil))
  :group 'mouse)
42

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

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

54
(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu))
55 56
(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
57 58 59 60 61 62 63 64 65 66 67
;; 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))
(defvar menu-bar-files-menu (make-sparse-keymap "File"))
(define-key global-map [menu-bar files] (cons "File" menu-bar-files-menu))
68 69 70

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

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

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

(define-key menu-bar-files-menu [separator-exit]
  '("--"))

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

100
(define-key menu-bar-files-menu [one-window]
101 102 103
  '(menu-item "Unsplit Windows" delete-other-windows
	      :enable (not (one-window-p t nil))
	      :help "Make selected window fill its frame"))
104 105

(define-key menu-bar-files-menu [split-window]
106 107 108 109 110 111 112
  '(menu-item "Split Window" split-window-vertically
	      :help "Split selected window in two"))

(define-key menu-bar-files-menu [separator-window]
  '(menu-item "--"))

(define-key menu-bar-files-menu [ps-print-region]
113 114 115 116 117 118 119
  '(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"))
(define-key menu-bar-files-menu [ps-print-buffer]
  '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer
	      :help "Pretty-print current buffer in black and white to PostScript printer"))
(define-key menu-bar-files-menu [ps-print-region-faces]
120 121 122
  '(menu-item "Postscript Print Region" ps-print-region-with-faces
	      :enable mark-active
	      :help "Pretty-print marked region to PostScript printer"))
123
(define-key menu-bar-files-menu [ps-print-buffer-faces]
124 125 126 127 128 129 130 131 132 133 134 135
  '(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces
	      :help "Pretty-print current buffer to PostScript printer"))
(define-key menu-bar-files-menu [print-region]
  '(menu-item "Print Region" print-region
	      :enable mark-active
	      :help "Print region between mark and current position"))
(define-key menu-bar-files-menu [print-buffer]
  '(menu-item "Print Buffer" print-buffer
	      :help "Print current buffer with page headings"))

(define-key menu-bar-files-menu [separator-print]
  '(menu-item "--"))
136

137
(define-key menu-bar-files-menu [recover-session]
138 139
  '(menu-item "Recover Crashed Session..." recover-session
	      :enable (and auto-save-list-file-prefix
140 141 142
			   (file-directory-p
                            (file-name-directory auto-save-list-file-prefix))
                           (directory-files
143 144 145 146 147 148 149 150
			    (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"))
151
(define-key menu-bar-files-menu [revert-buffer]
152 153 154
  '(menu-item "Revert Buffer" revert-buffer
	      :enable (or revert-buffer-function
			  revert-buffer-insert-file-contents-function
155
			  (and buffer-file-number
156 157 158 159
			       (or (buffer-modified-p)
				   (not (verify-visited-file-modtime
					 (current-buffer))))))
	      :help "Re-read current buffer from its file"))
160
(define-key menu-bar-files-menu [write-file]
161 162 163 164 165 166 167
  '(menu-item "Save Buffer As..." write-file
	      :enable (not (window-minibuffer-p
			    (frame-selected-window menu-updating-frame)))
	      :help "Write current buffer to another file"))
(define-key menu-bar-files-menu [save-buffer]
  '(menu-item "Save (current buffer)" save-buffer
	      :enable (and (buffer-modified-p)
168
			   (buffer-file-name)
169 170 171 172 173 174 175 176 177 178
			   (not (window-minibuffer-p
				 (frame-selected-window menu-updating-frame))))
	      :help "Save current buffer to its file"))

(define-key menu-bar-files-menu [separator-save]
  '(menu-item "--"))

(define-key menu-bar-files-menu [kill-buffer]
  '(menu-item "Close (current buffer)" kill-this-buffer
	      :enable (kill-this-buffer-enabled-p)
179
	      :help "Discard current buffer"))
180 181 182 183 184 185 186 187 188 189 190 191 192 193
(define-key menu-bar-files-menu [insert-file]
  '(menu-item "Insert File..." insert-file
	      :enable (not (window-minibuffer-p
			    (frame-selected-window menu-updating-frame)))
	      :help "Insert another file into current buffer"))
(define-key menu-bar-files-menu [dired]
  '(menu-item "Open Directory..." dired
	      :help "Read a directory, operate on its files"))
(define-key menu-bar-files-menu [open-file]
  '(menu-item "Open File..." find-file
	      :enable (not (window-minibuffer-p
			    (frame-selected-window menu-updating-frame)))
	      :help "Read a file into an Emacs buffer"))

194

195
;; The "Edit" menu items
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226

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

227 228 229
(defun nonincremental-search-forward (string)
  "Read a string and search for it nonincrementally."
  (interactive "sSearch for string: ")
230
  (setq menu-bar-last-search-type 'string)
231 232 233 234 235 236 237 238
  (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: ")
239
  (setq menu-bar-last-search-type 'string)
240 241 242 243 244 245 246 247
  (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: ")
248
  (setq menu-bar-last-search-type 'regexp)
249 250 251 252 253 254 255 256
  (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: ")
257
  (setq menu-bar-last-search-type 'regexp)
258 259 260 261 262
  (if (equal string "")
      (re-search-backward (car regexp-search-ring))
    (isearch-update-ring string t)
    (re-search-backward string)))

263
(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
264

265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
;; 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"))
281

282

283 284
(define-key menu-bar-search-menu [i-search]
  (list 'menu-item "Incremental Search" menu-bar-i-search-menu
285
	      :help "Incremental Search finds partial matches while you type the search string.\nIt is most convenient from the keyboard.  Try it!"))
286
(define-key menu-bar-search-menu [separator-tag-isearch]
287 288
  '(menu-item "--"))

289 290 291 292 293 294 295
(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]
  '(menu-item "Search tagged files" tags-search
	      :help "Search for a regexp in all tagged files"))
(define-key menu-bar-search-menu [separator-tag-search]
296
  '(menu-item "--"))
297

298
(define-key menu-bar-search-menu [repeat-search-back]
299
  '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward
300 301 302 303
	      :enable (or (and (eq menu-bar-last-search-type 'string)
			       search-ring)
			  (and (eq menu-bar-last-search-type 'regexp)
			       regexp-search-ring))
304
	      :help "Repeat last search backwards"))
305
(define-key menu-bar-search-menu [repeat-search-fwd]
306 307 308 309 310
  '(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))
311
	      :help "Repeat last search forward"))
312 313 314 315 316 317 318 319 320 321
(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"))

322
(define-key menu-bar-search-menu [search-backward]
323
  '(menu-item "String Backwards..." nonincremental-search-backward
324
	      :help "Search backwards for a string"))
325
(define-key menu-bar-search-menu [search-forward]
326
  '(menu-item "String Forward..." nonincremental-search-forward
327
	      :help "Search forward for a string"))
328

329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350
;; 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]
  '(menu-item "Replace in tagged files" tags-query-replace
	      :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"))

351 352 353 354
;;; Assemble the top-level Edit menu items.
(define-key menu-bar-edit-menu [props]
  '(menu-item "Text Properties" facemenu-menu
	      :help "Change properties of text in region"))
355

356 357 358 359 360 361 362
(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]
363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382
  '(menu-item "--"))

(define-key menu-bar-edit-menu [bookmark]
  '(menu-item "Bookmarks" menu-bar-bookmark-map
	      :help "Record positions and jump between them"))

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

(define-key menu-bar-goto-menu [set-tags-name]
  '(menu-item "Set Tags File Name" visit-tags-table
	      :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]
  '(menu-item "Tags Apropos" tags-apropos
	      :help "Find function/variables whose names match regexp"))
(define-key menu-bar-goto-menu [next-tag-otherw]
  '(menu-item "Next Tag in Other Window"
383
	      menu-bar-next-tag-other-window
384 385
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
386
	      :help "Find next function/variable matching last tag name in another window"))
387 388 389 390 391 392 393 394 395 396 397

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

398 399
(define-key menu-bar-goto-menu [next-tag]
  '(menu-item "Find Next Tag"
400
	      menu-bar-next-tag
401 402
	      :enable (and (boundp 'tags-location-ring)
			   (not (ring-empty-p tags-location-ring)))
403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
	      :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))

428 429 430
(define-key menu-bar-edit-menu [replace]
  (list 'menu-item "Replace" menu-bar-replace-menu))

431 432 433
(define-key menu-bar-edit-menu [search]
  (list 'menu-item "Search" menu-bar-search-menu))

434 435 436
(define-key menu-bar-edit-menu [separator-search]
  '(menu-item "--"))

437 438 439
(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."))
440 441 442 443 444 445
(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
446
	      "Delete the text in region between mark and current position"))
447 448
(defvar yank-menu (cons "Select Yank" nil))
(fset 'yank-menu (cons 'keymap yank-menu))
449 450 451
(define-key menu-bar-edit-menu [select-paste]
  '(menu-item "Select and Paste" yank-menu
	      :enable (and (cdr yank-menu) (not buffer-read-only))
452
	      :help "Paste (yank) text cut or copied earlier"))
453 454
(define-key menu-bar-edit-menu [paste]
  '(menu-item "Paste" yank
455 456 457 458 459
	      :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))
460
	      :help "Paste (yank) text most recently cut/copied"))
461 462 463
(define-key menu-bar-edit-menu [copy]
  '(menu-item "Copy" menu-bar-kill-ring-save
	      :enable mark-active
464 465
	      :help "Copy text in region between mark and current position"
	      :keys "\\[kill-ring-save]"))
466 467 468
(define-key menu-bar-edit-menu [cut]
  '(menu-item "Cut" kill-region
	      :enable (and mark-active (not buffer-read-only))
469 470
	      :help
	      "Cut (kill) text in region between mark and current position"))
471 472 473 474 475 476 477 478 479
(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)
			       pending-undo-list
			     (consp buffer-undo-list)))
	      :help "Undo last operation"))

480

481 482 483
(defun menu-bar-kill-ring-save (beg end)
  (interactive "r")
  (if (mouse-region-match)
484
      (message "Selecting a region with the mouse does `copy' automatically")
485 486
    (kill-ring-save beg end)))

487
;; These are alternative definitions for the cut, paste and copy
488
;; menu items.  Use them if your system expects these to use the clipboard.
489 490 491 492

(put 'clipboard-kill-region 'menu-enable 'mark-active)
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
493 494
     '(or (and (fboundp 'x-selection-exists-p) (x-selection-exists-p))
	  (x-selection-exists-p 'CLIPBOARD)))
495 496

(defun clipboard-yank ()
497
  "Insert the clipboard contents, or the last stretch of killed text."
498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514
  (interactive)
  (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 ()
515 516
  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
517
  (interactive)
518 519 520
  ;; 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]
521
    (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank)))
522
  (define-key menu-bar-edit-menu [copy]
523 524
    (cons "Copy" (cons "Copy text in region to the clipboard"
		       'clipboard-kill-ring-save)))
525
  (define-key menu-bar-edit-menu [cut]
526 527
    (cons "Cut" (cons "Delete text in region and copy it to the clipboard"
		      'clipboard-kill-region)))
528 529 530 531 532 533 534 535

  (define-key global-map [f20] 'clipboard-kill-region)
  (define-key global-map [f16] 'clipboard-kill-ring-save)
  (define-key global-map [f18] 'clipboard-yank)
  ;; X11R6 versions
  (define-key global-map [cut] 'clipboard-kill-region)
  (define-key global-map [copy] 'clipboard-kill-ring-save)
  (define-key global-map [paste] 'clipboard-yank))
536

537
;; The "Options" menu items
538 539 540

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

541
(define-key menu-bar-custom-menu [customize-apropos-groups]
542 543
  '(menu-item "Groups Matching Regexp..." customize-apropos-groups
	      :help "Browse groups whose names match regexp"))
544
(define-key menu-bar-custom-menu [customize-apropos-faces]
545 546
  '(menu-item "Faces Matching Regexp..." customize-apropos-faces
	      :help "Browse faces whose names match regexp"))
547
(define-key menu-bar-custom-menu [customize-apropos-options]
548 549
  '(menu-item "Options Matching Regexp..." customize-apropos-options
	      :help "Browse options whose names match regexp"))
550
(define-key menu-bar-custom-menu [customize-apropos]
551 552
  '(menu-item "Settings Matching Regexp..." customize-apropos
	      :help "Browse customizable settings whose names match regexp"))
553
(define-key menu-bar-custom-menu [separator-1]
554
  '("--"))
Richard M. Stallman's avatar
Richard M. Stallman committed
555
(define-key menu-bar-custom-menu [customize-group]
556 557
  '(menu-item "Specific Group..." customize-group
	      :help "Customize settings of specific group"))
558
(define-key menu-bar-custom-menu [customize-face]
559 560
  '(menu-item "Specific Face..." customize-face
	      :help "Customize attributes of specific face"))
561
(define-key menu-bar-custom-menu [customize-option]
562
  '(menu-item "Specific Option..." customize-option
563 564 565
	      :help "Customize value of specific option"))
(define-key menu-bar-custom-menu [separator-2]
  '("--"))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
566
(define-key menu-bar-custom-menu [customize-changed-options]
567 568 569 570 571
  '(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"))
572 573
(define-key menu-bar-custom-menu [separator-3]
  '("--"))
Per Abrahamsen's avatar
Per Abrahamsen committed
574
(define-key menu-bar-custom-menu [customize-browse]
575 576
  '(menu-item "Browse Customization Groups" customize-browse
	      :help "Browse all customization groups"))
577
(define-key menu-bar-custom-menu [customize]
578 579
  '(menu-item "Top-level Customization Group" customize
	      :help "The master group called `Emacs'"))
580

581
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
582

583 584 585 586 587 588
(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).
DOC is the text to use the menu entry.
HELP is the text to use for the tooltip.
PROPS are additional properties."
589
  `'(menu-item ,doc ,fname
590 591 592 593 594
     ,@(if props props)
     :help ,help
     :button (:toggle . (and (default-boundp ',fname)
			     (default-value ',fname)))))

595
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
596 597
  `(progn
     (defun ,name ()
598 599
       ,(concat "Toggle whether to " (downcase (substring help 0 1))
		(substring help 1) ".")
600 601
       (interactive)
       (if ,(if body `(progn . ,body)
602
	      `(progn
603 604 605 606 607
		 (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))))))
	   (message ,message "enabled")
608 609 610 611 612 613 614
  	 (message ,message "disabled"))
       ;; 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.
       (if (interactive-p) (customize-mark-as-set ',variable)))
     '(menu-item ,doc ,name
615
		 :help ,help
616 617
                 :button (:toggle . (and (default-boundp ',variable)
					 (default-value ',variable))))))
618 619 620 621 622

;;; Assemble all the top-level items of the "Options" menu
(define-key menu-bar-options-menu [customize]
  (list 'menu-item "Customize Emacs" menu-bar-custom-menu
	:help "Full customization of every Emacs feature"))
623 624 625 626

(defun menu-bar-options-save ()
  "Save current values of Options menu items using Custom."
  (interactive)
627
  (let ((need-save nil))
628 629 630
    ;; These are set with `customize-set-variable'.
    (dolist (elt '(line-number-mode column-number-mode scroll-bar-mode
		   debug-on-quit debug-on-error menu-bar-mode tool-bar-mode
631
		   save-place uniquify-buffer-name-style fringe-mode
632
		   case-fold-search cua-mode show-paren-mode
633
		   transient-mark-mode global-font-lock-mode
634
		   display-time-mode auto-compression-mode
635
		   current-language-environment default-input-method
636 637 638 639 640 641 642 643 644 645
		   ;; 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)))
646 647 648
    ;; Save if we changed anything.
    (when need-save
      (custom-save-all))))
649 650

(define-key menu-bar-options-menu [save]
651
  '(menu-item "Save Options" menu-bar-options-save
652 653 654 655 656
	      :help "Save options set from the menu above"))

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

657 658 659 660 661
(define-key menu-bar-options-menu [mouse-set-font]
  '(menu-item "Set Font/Fontset" mouse-set-font
	       :visible (display-multi-font-p)
	       :help "Select a font from list of known fonts/fontsets"))

662 663 664
;; The "Show/Hide" submenu of menu "Options"

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

666
(define-key menu-bar-showhide-menu [column-number-mode]
667 668 669
  (menu-bar-make-mm-toggle column-number-mode
			   "Show Column Numbers"
			   "Show the current column number in the mode line"))
670 671

(define-key menu-bar-showhide-menu [line-number-mode]
672 673 674
  (menu-bar-make-mm-toggle line-number-mode
			   "Show Line Numbers"
			   "Show the current line number in the mode line"))
675 676 677 678

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

679 680 681 682 683
(defun showhide-date-time ()
  "Toggle whether to show date and time in the mode-line."
  (interactive)
  (if (display-time-mode)
      (message "Display-time mode enabled.")
684 685
    (message "Display-time mode disabled."))
  (customize-mark-as-set 'display-time-mode))
686 687

(define-key menu-bar-showhide-menu [showhide-date-time]
688
  '(menu-item "Date and Time" showhide-date-time
689
	      :help "Display date and time in the mode line"
690 691 692 693 694
	      :button (:toggle . display-time-mode)))

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

695 696
(define-key menu-bar-showhide-menu [showhide-speedbar]
  '(menu-item "Speedbar" speedbar-frame-mode
697
	      :help "Display a Speedbar quick-navigation frame"
698 699 700
	      :button (:toggle
		       . (and (boundp 'speedbar-frame)
			      (frame-live-p (symbol-value 'speedbar-frame))
701
			      (frame-visible-p
702 703
			       (symbol-value 'speedbar-frame))))))

704
(defvar menu-bar-showhide-fringe-menu (make-sparse-keymap "Fringe"))
705 706 707 708 709 710 711 712 713 714 715 716

(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]
  '(menu-item "Customize" menu-bar-showhide-fringe-menu-customize
	      :help "Detailed customization of fringe"
	      :visible (display-graphic-p)))

(defun menu-bar-showhide-fringe-menu-customize-reset ()
717
  "Reset the fringe mode: display fringes on both sides of a window."
718 719 720
  (interactive)
  (customize-set-variable 'fringe-mode nil))

721 722 723 724
;; The real definition is in fringe.el.
;; This is to prevent errors in the :radio conditions below.
(setq fringe-mode nil)

725 726 727 728
(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)
729
	      :button (:radio . (eq fringe-mode nil))))
730 731

(defun menu-bar-showhide-fringe-menu-customize-left ()
732
  "Display fringes only on the left of each window."
733
  (interactive)
734 735
  (require 'fringe)
  (customize-set-variable 'fringe-mode '(nil . 0)))
736 737 738 739 740

(define-key menu-bar-showhide-fringe-menu [left]
  '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left
	      :help "Fringe only on the left side"
	      :visible (display-graphic-p)
741
	      :button (:radio . (equal fringe-mode '(nil . 0)))))
742 743

(defun menu-bar-showhide-fringe-menu-customize-right ()
744
  "Display fringes only on the right of each window."
745
  (interactive)
746 747
  (require 'fringe)
  (customize-set-variable 'fringe-mode '(0 . nil)))
748 749 750 751 752

(define-key menu-bar-showhide-fringe-menu [right]
  '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right
	      :help "Fringe only on the right side"
	      :visible (display-graphic-p)
753
	      :button (:radio . (equal fringe-mode '(0 . nil)))))
754 755

(defun menu-bar-showhide-fringe-menu-customize-disable ()
756
  "Do not display window fringes."
757
  (interactive)
758 759
  (require 'fringe)
  (customize-set-variable 'fringe-mode 0))
760 761 762 763 764

(define-key menu-bar-showhide-fringe-menu [none]
  '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable
	      :help "Turn off fringe"
	      :visible (display-graphic-p)
765
	      :button (:radio . (eq fringe-mode 0))))
766 767 768 769 770 771

(define-key menu-bar-showhide-menu [showhide-fringe]
  (list 'menu-item "Fringe" menu-bar-showhide-fringe-menu
	:visible `(display-graphic-p)
	:help "Select fringe mode"))

772 773 774
(defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar"))

(define-key menu-bar-showhide-scroll-bar-menu [right]
775
  '(menu-item "On the Right"
776
	      menu-bar-right-scroll-bar
777
	      :help "Scroll-bar on the right side"
778
	      :visible (display-graphic-p)
779 780
	      :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
					       (frame-parameters))) 'right))))
781 782 783 784
(defun menu-bar-right-scroll-bar ()
  "Display scroll bars on the right of each window."
  (interactive)
  (customize-set-variable 'scroll-bar-mode 'right))
785 786

(define-key menu-bar-showhide-scroll-bar-menu [left]
787
  '(menu-item "On the Left"
788
	      menu-bar-left-scroll-bar
789
	      :help "Scroll-bar on the left side"
790
	      :visible (display-graphic-p)
791 792
	      :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
					       (frame-parameters))) 'left))))
793

794 795 796
(defun menu-bar-left-scroll-bar ()
  "Display scroll bars on the left of each window."
  (interactive)
797
  (customize-set-variable 'scroll-bar-mode 'left))
798

799
(define-key menu-bar-showhide-scroll-bar-menu [none]
800
  '(menu-item "None"
801
	      menu-bar-no-scroll-bar
802
	      :help "Turn off scroll-bar"
803
	      :visible (display-graphic-p)
804 805
	      :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
					       (frame-parameters))) nil))))
806

807 808 809 810 811
(defun menu-bar-no-scroll-bar ()
  "Turn off scroll bars."
  (interactive)
  (customize-set-variable 'scroll-bar-mode nil))

812
(define-key menu-bar-showhide-menu [showhide-scroll-bar]
813
  (list 'menu-item "Scroll-bar" menu-bar-showhide-scroll-bar-menu
814
	:visible `(display-graphic-p)
815 816
	:help "Select scroll-bar mode"))

817 818
(define-key menu-bar-showhide-menu [menu-bar-mode]
  '(menu-item "Menu-bar" menu-bar-mode
819 820 821 822
	      :help "Toggle menu-bar on/off"
	      :button (:toggle . menu-bar-mode)))

(define-key menu-bar-showhide-menu [showhide-tool-bar]
823
  (list 'menu-item "Tool-bar" 'tool-bar-mode
824 825 826
	:help "Turn tool-bar on/off"
	:visible `(display-graphic-p)
	:button `(:toggle . tool-bar-mode)))
827 828 829 830 831 832 833 834

(define-key menu-bar-options-menu [showhide]
  (list 'menu-item "Show/Hide" menu-bar-showhide-menu
	:help "Toggle on/off various display features"))

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

835 836 837 838 839
(define-key menu-bar-options-menu [mule]
  ;; It is better not to use backquote here,
  ;; because that makes a bootstrapping problem
  ;; if you need to recompile all the Lisp files using interpreted code.
  (list 'menu-item "Mule (Multilingual Environment)" mule-menu-keymap
840 841 842
;; Most of the MULE menu actually does make sense in unibyte mode,
;; e.g. language selection.
;;;	':visible 'default-enable-multibyte-characters
843 844 845 846 847 848 849
	':help "Default language, encodings, input method"))
;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
;(define-key menu-bar-options-menu [preferences]
;  (list 'menu-item "Preferences" menu-bar-preferences-menu
;	:help "Toggle important global options"))

(define-key menu-bar-options-menu [mule-separator]
850
  '("--"))
851 852 853

(define-key menu-bar-options-menu [debug-on-quit]
  (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
854
			"Enter Debugger on Quit/C-g" "Debug on Quit %s"
855
			"Enter Lisp debugger when C-g is pressed"))
856 857
(define-key menu-bar-options-menu [debug-on-error]
  (menu-bar-make-toggle toggle-debug-on-error debug-on-error
858 859
			"Enter Debugger on Error" "Debug on Error %s"
			"Enter Lisp debugger when an error is signaled"))
860
(define-key menu-bar-options-menu [debugger-separator]
861
  '("--"))
862 863
(define-key menu-bar-options-menu [toggle-auto-compression]
  '(menu-item "Automatic File De/compression"
864
	      auto-compression-mode
865 866 867
	      :help "Transparently decompress compressed files"
	      :button (:toggle . (rassq 'jka-compr-handler
					file-name-handler-alist))))
868

869 870
(define-key menu-bar-options-menu [save-place]
  (menu-bar-make-toggle toggle-save-place-globally save-place
871
			"Save Place in Files between Sessions"
872
			"Saving place in files %s"
873 874 875 876 877 878
			"Visit files of previous session when restarting Emacs"
                        (require 'saveplace)
                        ;; Do it by name, to avoid a free-variable
                        ;; warning during byte compilation.
                        (set-default
                         'save-place (not (symbol-value 'save-place)))))
879

880 881
(define-key menu-bar-options-menu [uniquify]
  (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
882
			"Use Directory Names in Buffer Names"
883
			"Directory name in buffer names (uniquify) %s"
884
			"Uniquify buffer names by adding parent directory names"
885 886 887 888
			(require 'uniquify)
			(setq uniquify-buffer-name-style
			      (if (not uniquify-buffer-name-style)
				  'forward))))
889

890 891
(define-key menu-bar-options-menu [edit-options-separator]
  '("--"))
892
(define-key menu-bar-options-menu [cua-mode]
893 894 895
  (menu-bar-make-mm-toggle cua-mode
			   "CUA-style cut and paste"
			   "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"))
896

897 898
(define-key menu-bar-options-menu [case-fold-search]
  (menu-bar-make-toggle toggle-case-fold-search case-fold-search
899 900
			"Case-Insensitive Search"
			"Case-Insensitive Search %s"
901
			"Ignore letter-case in search"))
902 903 904 905 906 907 908 909 910

(defun menu-bar-text-mode-auto-fill ()
  (interactive)
  (toggle-text-mode-auto-fill)
  ;; This is somewhat questionable, as `text-mode-hook'
  ;; might have changed outside customize.
  ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
  (customize-mark-as-set 'text-mode-hook))

911
(define-key menu-bar-options-menu [auto-fill-mode]
912
  '(menu-item "Word Wrap in Text Modes"
913
              menu-bar-text-mode-auto-fill
914
	      :help "Automatically fill text between left and right margins (Auto Fill)"
915 916 917
              :button (:toggle . (if (listp text-mode-hook)
				     (member 'turn-on-auto-fill text-mode-hook)
				   (eq 'turn-on-auto-fill text-mode-hook)))))
918
(define-key menu-bar-options-menu [truncate-lines]
919
  '(menu-item "Truncate Long Lines in this Buffer"
920
	      toggle-truncate-lines
921 922 923
	      :help "Truncate long lines on the screen"
	      :button (:toggle . truncate-lines)))

924 925 926
(define-key menu-bar-options-menu [highlight-separator]
  '("--"))
(define-key menu-bar-options-menu [highlight-paren-mode]
927 928
  (menu-bar-make-mm-toggle show-paren-mode
			   "Paren Match Highlighting"
929
			   "Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
930
(define-key menu-bar-options-menu [transient-mark-mode]
931 932 933 934
  (menu-bar-make-mm-toggle transient-mark-mode
			   "Active Region Highlighting"
			   "Make text in active region stand out in color (Transient Mark mode)"
			   (:enable (not cua-mode))))
935
(define-key menu-bar-options-menu [toggle-global-lazy-font-lock-mode]
936 937 938
  (menu-bar-make-mm-toggle global-font-lock-mode
			   "Syntax Highlighting"
			   "Colorize text based on language syntax (Global Font Lock mode)"))
939

940

941 942
;; The "Tools" menu items

943 944 945 946 947 948 949 950 951 952 953 954 955
(defun send-mail-item-name ()
  (let* ((known-send-mail-commands '((sendmail-user-agent . "sendmail")
				     (mh-e-user-agent . "MH")
				     (message-user-agent . "Gnus Message")
				     (gnus-user-agent . "Gnus")))
	 (name (assq mail-user-agent known-send-mail-commands)))
    (if name
	(setq name (cdr name))
      (setq name (symbol-name mail-user-agent))
      (if (string-match "\\(.+\\)-user-agent" name)
	  (setq name (match-string 1 name))))
    name))

956 957 958 959 960 961 962
(defun read-mail-item-name ()
  (let* ((known-rmail-commands '((rmail . "RMAIL")
				 (mh-rmail . "MH")
				 (gnus . "Gnus")))
	 (known (assq read-mail-command known-rmail-commands)))
    (if known (cdr known) (symbol-name read-mail-command))))

963 964 965 966 967 968 969 970
(defvar menu-bar-games-menu (make-sparse-keymap "Games"))

(define-key menu-bar-tools-menu [games]
  (list 'menu-item "Games" menu-bar-games-menu))

(define-key menu-bar-tools-menu [separator-games]
  '("--"))

971 972 973
(define-key menu-bar-games-menu [zone]
  '(menu-item "Zone Out"  zone
	      :help "Play tricks with Emacs display when Emacs is idle"))
974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005
(define-key menu-bar-games-menu [yow]
  '(menu-item "Random Quotation"  yow
	      :help "Display a random Zippy quotation"))
(define-key menu-bar-games-menu [tetris]
  '(menu-item "Tetris"  tetris))
(define-key menu-bar-games-menu [solitaire]
  '(menu-item "Solitaire"  solitaire))
(define-key menu-bar-games-menu [snake]
  '(menu-item "Snake"  snake
	      :help "Move snake around avoiding collisions"))
(define-key menu-bar-games-menu [mult]
  '(menu-item "Multiplication Puzzle"  mpuz
	      :help "Excercise brain with multiplication"))
(define-key menu-bar-games-menu [life]
  '(menu-item "Life"  life
	      :help "Watch how John Conway's cellular automaton evolves"))
(define-key menu-bar-games-menu [hanoi]
  '(menu-item "Towers of Hanoi" hanoi
	      :help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
(define-key menu-bar-games-menu [gomoku]
  '(menu-item "Gomoku"  gomoku
	      :help "Mark 5 contiguous squares (like tic-tac-toe)"))
(define-key menu-bar-games-menu [black-box]
  '(menu-item "Blackbox"  blackbox
	      :help "Find balls in a black box by shooting rays"))
(define-key menu-bar-games-menu [adventure]
  '(menu-item "Adventure"  dunnet
	      :help "Dunnet, a text Adventure game for Emacs"))
(define-key menu-bar-games-menu [5x5]
  '(menu-item "5x5" 5x5
	      :help "Fill in all the squares on a 5x5 board"))

1006 1007 1008 1009 1010 1011
(define-key menu-bar-tools-menu [simple-calculator]
  '(menu-item "Simple Calculator" calculator
	      :help "Invoke the Emacs built-in quick calculator"))
(define-key menu-bar-tools-menu [calc]
  '(menu-item "Programmable Calculator" calc
	      :help "Invoke the Emacs built-in full scientific calculator"))
1012
(define-key menu-bar-tools-menu [calendar]
1013
  '(menu-item "Display Calendar" calendar))
1014 1015 1016 1017

(define-key menu-bar-tools-menu [separator-net]
  '("--"))

1018 1019 1020
(define-key menu-bar-tools-menu [directory-search]
  '(menu-item "Directory Search" eudc-tools-menu
	      :help "Query directory servers via LDAP, CCSO PH/QI or BBDB"))