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

3
;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc.
Erik Naggum's avatar
Erik Naggum committed
4

5
;; Author: Richard M. Stallman
6
;; Maintainer: emacs-devel@gnu.org
7
;; Keywords: internal, mouse
8
;; Package: emacs
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 35 36 37
;; This is referenced by some code below; it is defined in uniquify.el
(defvar uniquify-buffer-name-style)

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


38 39 40 41
;; 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")))
42

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

48
;; This definition is just to show what this looks like.
49 50
;; It gets modified in place when menu-bar-update-buffers is called.
(defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
51

52
;; Only declared obsolete (and only made a proper alias) in 23.3.
53 54 55 56 57 58
(define-obsolete-variable-alias
  'menu-bar-files-menu 'menu-bar-file-menu "22.1")
(defvar menu-bar-file-menu
  (let ((menu (make-sparse-keymap "File")))

    ;; The "File" menu items
59 60 61
    (bindings--define-key menu [exit-emacs]
      '(menu-item "Quit" save-buffers-kill-terminal
                  :help "Save unsaved buffers, then exit"))
62

63
    (bindings--define-key menu [separator-exit]
64 65 66 67
      menu-bar-separator)

    ;; Don't use delete-frame as event name because that is a special
    ;; event.
68 69
    (bindings--define-key menu [delete-this-frame]
      '(menu-item "Delete Frame" delete-frame
70 71
                  :visible (fboundp 'delete-frame)
                  :enable (delete-frame-enabled-p)
72 73 74
                  :help "Delete currently selected frame"))
    (bindings--define-key menu [make-frame-on-display]
      '(menu-item "New Frame on Display..." make-frame-on-display
75
                  :visible (fboundp 'make-frame-on-display)
76 77 78
                  :help "Open a new frame on another display"))
    (bindings--define-key menu [make-frame]
      '(menu-item "New Frame" make-frame-command
79
                  :visible (fboundp 'make-frame-command)
80
                  :help "Open a new frame"))
81

82
    (bindings--define-key menu [separator-frame]
83 84
      menu-bar-separator)

85 86
    (bindings--define-key menu [one-window]
      '(menu-item "Remove Other Windows" delete-other-windows
87
                  :enable (not (one-window-p t nil))
88
                  :help "Make selected window fill whole frame"))
89

90 91
    (bindings--define-key menu [new-window-on-right]
      '(menu-item "New Window on Right" split-window-right
92 93
                  :enable (and (menu-bar-menu-frame-live-and-visible-p)
                               (menu-bar-non-minibuffer-window-p))
94
                  :help "Make new window on right of selected one"))
95

96 97
    (bindings--define-key menu [new-window-below]
      '(menu-item "New Window Below" split-window-below
98 99
                  :enable (and (menu-bar-menu-frame-live-and-visible-p)
                               (menu-bar-non-minibuffer-window-p))
100
                  :help "Make new window below selected one"))
101

102
    (bindings--define-key menu [separator-window]
103 104
      menu-bar-separator)

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

132
    (bindings--define-key menu [separator-print]
133 134
      menu-bar-separator)

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

174
    (bindings--define-key menu [separator-save]
175 176 177
      menu-bar-separator)


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

    menu))
200

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

211 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 237 238 239 240
;; 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"))))

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

277 278
;; The Edit->Search->Incremental Search menu
(defvar menu-bar-i-search-menu
279
  (let ((menu (make-sparse-keymap "Incremental Search")))
280 281 282 283 284 285 286 287 288 289 290 291
    (bindings--define-key menu [isearch-backward-regexp]
      '(menu-item "Backward Regexp..." isearch-backward-regexp
        :help "Search backwards for a regular expression as you type it"))
    (bindings--define-key menu [isearch-forward-regexp]
      '(menu-item "Forward Regexp..." isearch-forward-regexp
        :help "Search forward for a regular expression as you type it"))
    (bindings--define-key menu [isearch-backward]
      '(menu-item "Backward String..." isearch-backward
        :help "Search backwards for a string as you type it"))
    (bindings--define-key menu [isearch-forward]
      '(menu-item "Forward String..." isearch-forward
        :help "Search forward for a string as you type it"))
292 293 294 295 296
    menu))

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

297 298 299
    (bindings--define-key menu [i-search]
      `(menu-item "Incremental Search" ,menu-bar-i-search-menu))
    (bindings--define-key menu [separator-tag-isearch]
300 301
      menu-bar-separator)

302 303 304 305 306 307 308
    (bindings--define-key menu [tags-continue]
      '(menu-item "Continue Tags Search" tags-loop-continue
                  :help "Continue last tags search operation"))
    (bindings--define-key menu [tags-srch]
      '(menu-item "Search Tagged Files..." tags-search
                  :help "Search for a regexp in all tagged files"))
    (bindings--define-key menu [separator-tag-search] menu-bar-separator)
309

310 311
    (bindings--define-key menu [repeat-search-back]
      '(menu-item "Repeat Backwards"
312 313 314 315 316
                  nonincremental-repeat-search-backward
                  :enable (or (and (eq menu-bar-last-search-type 'string)
                                   search-ring)
                              (and (eq menu-bar-last-search-type 'regexp)
                                   regexp-search-ring))
317 318 319
                  :help "Repeat last search backwards"))
    (bindings--define-key menu [repeat-search-fwd]
      '(menu-item "Repeat Forward"
320 321 322 323 324
                  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))
325 326
                  :help "Repeat last search forward"))
    (bindings--define-key menu [separator-repeat-search]
327 328
      menu-bar-separator)

329 330
    (bindings--define-key menu [re-search-backward]
      '(menu-item "Regexp Backwards..."
331
                  nonincremental-re-search-backward
332 333 334
                  :help "Search backwards for a regular expression"))
    (bindings--define-key menu [re-search-forward]
      '(menu-item "Regexp Forward..."
335
                  nonincremental-re-search-forward
336
                  :help "Search forward for a regular expression"))
337

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

347 348
;; The Edit->Replace submenu

349 350
(defvar menu-bar-replace-menu
  (let ((menu (make-sparse-keymap "Replace")))
351 352 353 354 355 356 357
    (bindings--define-key menu [tags-repl-continue]
      '(menu-item "Continue Replace" tags-loop-continue
                  :help "Continue last tags replace operation"))
    (bindings--define-key menu [tags-repl]
      '(menu-item "Replace in Tagged Files..." tags-query-replace
        :help "Interactively replace a regexp in all tagged files"))
    (bindings--define-key menu [separator-replace-tags]
358 359
      menu-bar-separator)

360 361
    (bindings--define-key menu [query-replace-regexp]
      '(menu-item "Replace Regexp..." query-replace-regexp
362
                  :enable (not buffer-read-only)
363 364 365
                  :help "Replace regular expression interactively, ask about each occurrence"))
    (bindings--define-key menu [query-replace]
      '(menu-item "Replace String..." query-replace
366
        :enable (not buffer-read-only)
367
        :help "Replace string interactively, ask about each occurrence"))
368
    menu))
369

370
;;; Assemble the top-level Edit menu items.
371 372 373
(defvar menu-bar-goto-menu
  (let ((menu (make-sparse-keymap "Go To")))

374 375 376
    (bindings--define-key menu [set-tags-name]
      '(menu-item "Set Tags File Name..." visit-tags-table
                  :help "Tell Tags commands which tag table file to use"))
377

378
    (bindings--define-key menu [separator-tag-file]
379 380
      menu-bar-separator)

381 382 383 384 385
    (bindings--define-key menu [apropos-tags]
      '(menu-item "Tags Apropos..." tags-apropos
                  :help "Find function/variables whose names match regexp"))
    (bindings--define-key menu [next-tag-otherw]
      '(menu-item "Next Tag in Other Window"
386 387 388
                  menu-bar-next-tag-other-window
                  :enable (and (boundp 'tags-location-ring)
                               (not (ring-empty-p tags-location-ring)))
389
                  :help "Find next function/variable matching last tag name in another window"))
390

391 392
    (bindings--define-key menu [next-tag]
      '(menu-item "Find Next Tag"
393 394 395
                  menu-bar-next-tag
                  :enable (and (boundp 'tags-location-ring)
                               (not (ring-empty-p tags-location-ring)))
396 397 398 399 400 401 402 403 404
                  :help "Find next function/variable matching last tag name"))
    (bindings--define-key menu [find-tag-otherw]
      '(menu-item "Find Tag in Other Window..." find-tag-other-window
                  :help "Find function/variable definition in another window"))
    (bindings--define-key menu [find-tag]
      '(menu-item "Find Tag..." find-tag
                  :help "Find definition of function or variable"))

    (bindings--define-key menu [separator-tags]
405 406
      menu-bar-separator)

407 408 409 410 411 412 413 414 415 416
    (bindings--define-key menu [end-of-buf]
      '(menu-item "Goto End of Buffer" end-of-buffer))
    (bindings--define-key menu [beg-of-buf]
      '(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
    (bindings--define-key menu [go-to-pos]
      '(menu-item "Goto Buffer Position..." goto-char
                  :help "Read a number N and go to buffer position N"))
    (bindings--define-key menu [go-to-line]
      '(menu-item "Goto Line..." goto-line
                  :help "Read a line number and go to that line"))
417
    menu))
418 419


420 421
(defvar yank-menu (cons (purecopy "Select Yank") nil))
(fset 'yank-menu (cons 'keymap yank-menu))
422

423 424
(defvar menu-bar-edit-menu
  (let ((menu (make-sparse-keymap "Edit")))
425

426 427
    (bindings--define-key menu [props]
      `(menu-item "Text Properties" facemenu-menu))
428

Paul Eggert's avatar
Paul Eggert committed
429
    ;; ns-win.el said: Add spell for platform consistency.
430
    (if (featurep 'ns)
431 432
        (bindings--define-key menu [spell]
          `(menu-item "Spell" ispell-menu-map)))
433

434 435
    (bindings--define-key menu [fill]
      `(menu-item "Fill" fill-region
436 437
                  :enable (and mark-active (not buffer-read-only))
                  :help
438
                  "Fill text in region to fit between left and right margin"))
439

440
    (bindings--define-key menu [separator-bookmark]
441 442
      menu-bar-separator)

443 444
    (bindings--define-key menu [bookmark]
      `(menu-item "Bookmarks" menu-bar-bookmark-map))
445

446 447
    (bindings--define-key menu [goto]
      `(menu-item "Go To" ,menu-bar-goto-menu))
448

449 450
    (bindings--define-key menu [replace]
      `(menu-item "Replace" ,menu-bar-replace-menu))
451

452 453
    (bindings--define-key menu [search]
      `(menu-item "Search" ,menu-bar-search-menu))
454

455
    (bindings--define-key menu [separator-search]
456 457
      menu-bar-separator)

458 459 460 461 462
    (bindings--define-key menu [mark-whole-buffer]
      '(menu-item "Select All" mark-whole-buffer
                  :help "Mark the whole buffer for a subsequent cut/copy"))
    (bindings--define-key menu [clear]
      '(menu-item "Clear" delete-region
463 464 465
                  :enable (and mark-active
                               (not buffer-read-only))
                  :help
466
                  "Delete the text in region between mark and current position"))
467 468


469
    (bindings--define-key menu (if (featurep 'ns) [select-paste]
470 471 472
                       [paste-from-menu])
      ;; ns-win.el said: Change text to be more consistent with
      ;; surrounding menu items `paste', etc."
473 474
      `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
                  yank-menu
475 476 477 478
                  :enable (and (cdr yank-menu) (not buffer-read-only))
                  :help "Choose a string from the kill ring and paste it"))
    (bindings--define-key menu [paste]
      '(menu-item "Paste" yank
479
                  :enable (and (or
480
                                (gui-call gui-selection-exists-p 'CLIPBOARD)
481 482 483 484
                                (if (featurep 'ns) ; like paste-from-menu
                                    (cdr yank-menu)
                                  kill-ring))
                               (not buffer-read-only))
485 486
                  :help "Paste (yank) text most recently cut/copied"))
    (bindings--define-key menu [copy]
487 488
      ;; ns-win.el said: Substitute a Copy function that works better
      ;; under X (for GNUstep).
489 490 491
      `(menu-item "Copy" ,(if (featurep 'ns)
                              'ns-copy-including-secondary
                            'kill-ring-save)
492
                  :enable mark-active
493 494 495 496 497 498
                  :help "Copy text in region between mark and current position"
                  :keys ,(if (featurep 'ns)
                             "\\[ns-copy-including-secondary]"
                           "\\[kill-ring-save]")))
    (bindings--define-key menu [cut]
      '(menu-item "Cut" kill-region
499 500
                  :enable (and mark-active (not buffer-read-only))
                  :help
501
                  "Cut (kill) text in region between mark and current position"))
502 503
    ;; ns-win.el said: Separate undo from cut/paste section.
    (if (featurep 'ns)
504
        (bindings--define-key menu [separator-undo] menu-bar-separator))
505

506 507
    (bindings--define-key menu [undo]
      '(menu-item "Undo" undo
508 509 510 511 512
                  :enable (and (not buffer-read-only)
                               (not (eq t buffer-undo-list))
                               (if (eq last-command 'undo)
                                   (listp pending-undo-list)
                                 (consp buffer-undo-list)))
513
                  :help "Undo last operation"))
514 515

    menu))
516 517 518 519 520 521 522 523 524 525 526

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

527 528
(define-obsolete-function-alias
  'menu-bar-kill-ring-save 'kill-ring-save "24.1")
529

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

533 534
(put 'clipboard-kill-region 'menu-enable
     '(and mark-active (not buffer-read-only)))
535 536
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
537 538
     '(and (or (gui-call gui-selection-exists-p 'PRIMARY)
	       (gui-call gui-selection-exists-p 'CLIPBOARD))
539
 	   (not buffer-read-only)))
540 541

(defun clipboard-yank ()
542
  "Insert the clipboard contents, or the last stretch of killed text."
543
  (interactive "*")
Stefan Monnier's avatar
Stefan Monnier committed
544
  (let ((gui-select-enable-clipboard t))
545 546
    (yank)))

547
(defun clipboard-kill-ring-save (beg end &optional region)
Stefan Monnier's avatar
Stefan Monnier committed
548
  "Copy region to kill ring, and save in the GUI's clipboard."
549
  (interactive "r\np")
Stefan Monnier's avatar
Stefan Monnier committed
550
  (let ((gui-select-enable-clipboard t))
551
    (kill-ring-save beg end region)))
552

553
(defun clipboard-kill-region (beg end &optional region)
Stefan Monnier's avatar
Stefan Monnier committed
554
  "Kill the region, and save it in the GUI's clipboard."
555
  (interactive "r\np")
Stefan Monnier's avatar
Stefan Monnier committed
556
  (let ((gui-select-enable-clipboard t))
557
    (kill-region beg end region)))
558 559

(defun menu-bar-enable-clipboard ()
560 561
  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
562
  (interactive)
563 564
  ;; These are Sun server keysyms for the Cut, Copy and Paste keys
  ;; (also for XFree86 on Sun keyboard):
565 566 567
  (define-key global-map [f20] 'clipboard-kill-region)
  (define-key global-map [f16] 'clipboard-kill-ring-save)
  (define-key global-map [f18] 'clipboard-yank)
568
  ;; X11R6 versions:
569 570 571
  (define-key global-map [cut] 'clipboard-kill-region)
  (define-key global-map [copy] 'clipboard-kill-ring-save)
  (define-key global-map [paste] 'clipboard-yank))
572

573
;; The "Options" menu items
574

575 576 577
(defvar menu-bar-custom-menu
  (let ((menu (make-sparse-keymap "Customize")))

578 579 580 581 582 583 584 585 586 587
    (bindings--define-key menu [customize-apropos-faces]
      '(menu-item "Faces Matching..." customize-apropos-faces
                  :help "Browse faces matching a regexp or word list"))
    (bindings--define-key menu [customize-apropos-options]
      '(menu-item "Options Matching..." customize-apropos-options
                  :help "Browse options matching a regexp or word list"))
    (bindings--define-key menu [customize-apropos]
      '(menu-item "All Settings Matching..." customize-apropos
                  :help "Browse customizable settings matching a regexp or word list"))
    (bindings--define-key menu [separator-1]
588
      menu-bar-separator)
589 590 591 592 593 594 595 596 597 598
    (bindings--define-key menu [customize-group]
      '(menu-item "Specific Group..." customize-group
                  :help "Customize settings of specific group"))
    (bindings--define-key menu [customize-face]
      '(menu-item "Specific Face..." customize-face
                  :help "Customize attributes of specific face"))
    (bindings--define-key menu [customize-option]
      '(menu-item "Specific Option..." customize-option
                  :help "Customize value of specific option"))
    (bindings--define-key menu [separator-2]
599
      menu-bar-separator)
600 601 602 603 604 605 606
    (bindings--define-key menu [customize-changed-options]
      '(menu-item "New Options..." customize-changed-options
                  :help "Options added or changed in recent Emacs versions"))
    (bindings--define-key menu [customize-saved]
      '(menu-item "Saved Options" customize-saved
                  :help "Customize previously saved options"))
    (bindings--define-key menu [separator-3]
607
      menu-bar-separator)
608 609 610 611 612 613 614 615 616
    (bindings--define-key menu [customize-browse]
      '(menu-item "Browse Customization Groups" customize-browse
                  :help "Browse all customization groups"))
    (bindings--define-key menu [customize]
      '(menu-item "Top-level Customization Group" customize
                  :help "The master group called `Emacs'"))
    (bindings--define-key menu [customize-themes]
      '(menu-item "Custom Themes" customize-themes
                  :help "Choose a pre-defined customization theme"))
617
    menu))
618
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
619

620 621 622
(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).
623
DOC is the text to use for the menu entry.
624 625
HELP is the text to use for the tooltip.
PROPS are additional properties."
626 627 628 629 630
  `'(menu-item ,doc ,fname
	       ,@props
	       :help ,help
	       :button (:toggle . (and (default-boundp ',fname)
				       (default-value ',fname)))))
631

632
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
633
  `(progn
634
     (defun ,name (&optional interactively)
635
       ,(concat "Toggle whether to " (downcase (substring help 0 1))
636
		(substring help 1) ".
637 638 639
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
       (interactive "p")
640
       (if ,(if body `(progn . ,body)
641
	      `(progn
642 643 644 645
		 (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))))))
646 647
	   (message ,message "enabled globally")
  	 (message ,message "disabled globally"))
648 649 650 651
       ;; 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.
652
       (if interactively (customize-mark-as-set ',variable)))
653 654 655 656
     '(menu-item ,doc ,name
		 :help ,help
		 :button (:toggle . (and (default-boundp ',variable)
					 (default-value ',variable))))))
657

658 659 660
;; Function for setting/saving default font.

(defun menu-set-font ()
661
  "Interactively select a font and make it the default on all existing frames."
662
  (interactive)
663 664 665 666
  (set-frame-font (if (fboundp 'x-select-font)
		      (x-select-font)
		    (mouse-select-font))
		  nil t))
667

668 669 670
(defun menu-bar-options-save ()
  "Save current values of Options menu items using Custom."
  (interactive)
671
  (let ((need-save nil))
672 673
    ;; These are set with menu-bar-make-mm-toggle, which does not
    ;; put on a customized-value property.
674 675
    (dolist (elt '(line-number-mode column-number-mode size-indication-mode
		   cua-mode show-paren-mode transient-mark-mode
Glenn Morris's avatar
Glenn Morris committed
676 677 678 679 680 681 682 683 684 685
		   blink-cursor-mode display-time-mode display-battery-mode
		   ;; These are set by other functions that don't set
		   ;; the customized state.  Having them here has the
		   ;; side-effect that turning them off via X
		   ;; resources acts like having customized them, but
		   ;; that seems harmless.
		   menu-bar-mode tool-bar-mode))
      ;; FIXME ? It's a little annoying that running this command
      ;; always loads cua-base, paren, time, and battery, even if they
      ;; have not been customized in any way.  (Due to custom-load-symbol.)
686 687
      (and (customize-mark-to-save elt)
	   (setq need-save t)))
688
    ;; These are set with `customize-set-variable'.
689
    (dolist (elt '(scroll-bar-mode
690
		   debug-on-quit debug-on-error
Glenn Morris's avatar
Glenn Morris committed
691 692
		   ;; Somehow this works, when tool-bar and menu-bar don't.
		   tooltip-mode
693
		   save-place uniquify-buffer-name-style fringe-mode
694
		   indicate-empty-lines indicate-buffer-boundaries
695
		   case-fold-search font-use-system-font
696
		   current-language-environment default-input-method
697 698 699 700 701 702
		   ;; 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.
703
		   text-mode-hook tool-bar-position))
704 705 706
      (and (get elt 'customized-value)
	   (customize-mark-to-save elt)
	   (setq need-save t)))
707 708 709 710
    (when (get 'default 'customized-face)
      (put 'default 'saved-face (get 'default 'customized-face))
      (put 'default 'customized-face nil)
      (setq need-save t))
711 712 713
    ;; Save if we changed anything.
    (when need-save
      (custom-save-all))))
714

715

716
;;; Assemble all the top-level items of the "Options" menu
717

718 719
;; The "Show/Hide" submenu of menu "Options"

720 721
(defun menu-bar-showhide-fringe-ind-customize ()
  "Show customization buffer for `indicate-buffer-boundaries'."
722
  (interactive)
723
  (customize-variable 'indicate-buffer-boundaries))
724 725

(defun menu-bar-showhide-fringe-ind-mixed ()
726
  "Display top and bottom indicators in opposite fringes, arrows in right."
727
  (interactive)
728 729
  (customize-set-variable 'indicate-buffer-boundaries
			  '((t . right) (top . left))))
730 731 732 733

(defun menu-bar-showhide-fringe-ind-box ()
  "Display top and bottom indicators in opposite fringes."
  (interactive)
734 735
  (customize-set-variable 'indicate-buffer-boundaries
			  '((top . left) (bottom . right))))
736 737

(defun menu-bar-showhide-fringe-ind-right ()
738
  "Display buffer boundaries and arrows in the right fringe."
739
  (interactive)
740
  (customize-set-variable 'indicate-buffer-boundaries 'right))
741 742

(defun menu-bar-showhide-fringe-ind-left ()
743
  "Display buffer boundaries and arrows in the left fringe."
744
  (interactive)
745
  (customize-set-variable 'indicate-buffer-boundaries 'left))
746 747

(defun menu-bar-showhide-fringe-ind-none ()
748
  "Do not display any buffer boundary indicators."
749
  (interactive)
750
  (customize-set-variable 'indicate-buffer-boundaries nil))
751

752 753 754
(defvar menu-bar-showhide-fringe-ind-menu
  (let ((menu (make-sparse-keymap "Buffer boundaries")))

755 756
    (bindings--define-key menu [customize]
      '(menu-item "Other (Customize)"
757
                  menu-bar-showhide-fringe-ind-customize
758
                  :help "Additional choices available through Custom buffer"
759 760 761 762 763 764
                  :visible (display-graphic-p)
                  :button (:radio . (not (member indicate-buffer-boundaries
                                                 '(nil left right
                                                   ((top . left) (bottom . right))
                                                   ((t . right) (top . left))))))))

765 766
    (bindings--define-key menu [mixed]
      '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed
767
                  :help
768
                  "Show top/bottom indicators in opposite fringes, arrows in right"
769 770 771 772
                  :visible (display-graphic-p)
                  :button (:radio . (equal indicate-buffer-boundaries
                                           '((t . right) (top . left))))))

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

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

786 787 788
    (bindings--define-key menu [left]
      '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left
                  :help "Show buffer boundaries and arrows in left fringe"
789 790 791
                  :visible (display-graphic-p)
                  :button (:radio . (eq indicate-buffer-boundaries 'left))))

792 793 794
    (bindings--define-key menu [none]
      '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none
                  :help "Hide all buffer boundary indicators and arrows"
795 796 797
                  :visible (display-graphic-p)
                  :button (:radio . (eq indicate-buffer-boundaries nil))))
    menu))
798 799 800 801 802 803 804

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

(defun menu-bar-showhide-fringe-menu-customize-reset ()
805
  "Reset the fringe mode: display fringes on both sides of a window."
806 807 808 809
  (interactive)
  (customize-set-variable 'fringe-mode nil))

(defun menu-bar-showhide-fringe-menu-customize-right ()
810
  "Display fringes only on the right of each window."
811
  (interactive)
812 813
  (require 'fringe)
  (customize-set-variable 'fringe-mode '(0 . nil)))
814

815 816 817 818 819 820
(defun menu-bar-showhide-fringe-menu-customize-left ()
  "Display fringes only on the left of each window."
  (interactive)
  (require 'fringe)
  (customize-set-variable 'fringe-mode '(nil . 0)))

821
(defun menu-bar-showhide-fringe-menu-customize-disable ()
822
  "Do not display window fringes."
823
  (interactive)
824 825
  (require 'fringe)
  (customize-set-variable 'fringe-mode 0))
826

827 828 829
(defvar menu-bar-showhide-fringe-menu
  (let ((menu (make-sparse-keymap "Fringe")))

830 831
    (bindings--define-key menu [showhide-fringe-ind]
      `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu
832
                  :visible (display-graphic-p)
833
                  :help "Indicate buffer boundaries in fringe"))
834

835
    (bindings--define-key menu [indicate-empty-lines]
836 837 838 839 840
      (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
                            "Empty Line Indicators"
                            "Indicating of empty lines %s"
                            "Indicate trailing empty lines in fringe, globally"))

841 842 843
    (bindings--define-key menu [customize]
      '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
                  :help "Detailed customization of fringe"
844 845
                  :visible (display-graphic-p)))

846 847 848
    (bindings--define-key menu [default]
      '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset
                  :help "Default width fringe on both left and right side"
849 850 851
                  :visible (display-graphic-p)
                  :button (:radio . (eq fringe-mode nil))))

852 853 854
    (bindings--define-key menu [right]
      '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right
                  :help "Fringe only on the right side"
855 856 857
                  :visible (display-graphic-p)
                  :button (:radio . (equal fringe-mode '(0 . nil)))))

858 859 860
    (bindings--define-key menu [left]
      '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left
                  :help "Fringe only on the left side"
861 862 863
                  :visible (display-graphic-p)
                  :button (:radio . (equal fringe-mode '(nil . 0)))))

864 865 866
    (bindings--define-key menu [none]
      '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable
                  :help "Turn off fringe"
867 868 869 870
                  :visible (display-graphic-p)
                  :button (:radio . (eq fringe-mode 0))))
    menu))

871 872 873 874
(defun menu-bar-right-scroll-bar ()
  "Display scroll bars on the right of each window."
  (interactive)
  (customize-set-variable 'scroll-bar-mode 'right))
875

876 877 878
(defun menu-bar-left-scroll-bar ()
  "Display scroll bars on the left of each window."
  (interactive)
879
  (customize-set-variable 'scroll-bar-mode 'left))
880