lisp/menu-bar.el

   1 ;;; menu-bar.el --- define a default menu bar
   2
   3 ;; Copyright (C) 1993-1995, 2000-2011  Free Software Foundation, Inc.
   4
   5 ;; Author: RMS
   6 ;; Maintainer: FSF
   7 ;; Keywords: internal, mouse
   8 ;; Package: emacs
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; 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/>.
  24
  25 ;; Avishai Yacobi suggested some menu rearrangements.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;; This is referenced by some code below; it is defined in uniquify.el
  32 (defvar uniquify-buffer-name-style)
  33
  34 ;; From emulation/cua-base.el; used below
  35 (defvar cua-enable-cua-keys)
  36
  37
  38 ;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
  39 ;; definitions made in loaddefs.el.
  40 (or (lookup-key global-map [menu-bar])
  41     (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
  42
  43 (if (not (featurep 'ns))
  44     ;; Force Help item to come last, after the major mode's own items.
  45     ;; The symbol used to be called `help', but that gets confused with the
  46     ;; help key.
  47     (setq menu-bar-final-items '(help-menu))
  48   (if (eq system-type 'darwin)
  49       (setq menu-bar-final-items '(buffer services help-menu))
  50     (setq menu-bar-final-items '(buffer services hide-app quit))
  51     ;; Add standard top-level items to GNUstep menu.
  52     (define-key global-map [menu-bar quit]
  53       `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs
  54                   :help ,(purecopy "Save unsaved buffers, then exit")))
  55     (define-key global-map [menu-bar hide-app]
  56       `(menu-item ,(purecopy "Hide") ns-do-hide-emacs
  57                   :help ,(purecopy "Hide Emacs"))))
  58   (define-key global-map [menu-bar services] ; set-up in ns-win
  59     (cons (purecopy "Services") (make-sparse-keymap "Services"))))
  60
  61 ;; This definition is just to show what this looks like.
  62 ;; It gets modified in place when menu-bar-update-buffers is called.
  63 (defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
  64
  65 ;; Only declared obsolete (and only made a proper alias) in 23.3.
  66 (define-obsolete-variable-alias
  67   'menu-bar-files-menu 'menu-bar-file-menu "22.1")
  68 (defvar menu-bar-file-menu
  69   (let ((menu (make-sparse-keymap "File")))
  70
  71     ;; The "File" menu items
  72     (define-key menu [exit-emacs]
  73       `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal
  74                   :help ,(purecopy "Save unsaved buffers, then exit")))
  75
  76     (define-key menu [separator-exit]
  77       menu-bar-separator)
  78
  79     ;; Don't use delete-frame as event name because that is a special
  80     ;; event.
  81     (define-key menu [delete-this-frame]
  82       `(menu-item ,(purecopy "Delete Frame") delete-frame
  83                   :visible (fboundp 'delete-frame)
  84                   :enable (delete-frame-enabled-p)
  85                   :help ,(purecopy "Delete currently selected frame")))
  86     (define-key menu [make-frame-on-display]
  87       `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display
  88                   :visible (fboundp 'make-frame-on-display)
  89                   :help ,(purecopy "Open a new frame on another display")))
  90     (define-key menu [make-frame]
  91       `(menu-item ,(purecopy "New Frame") make-frame-command
  92                   :visible (fboundp 'make-frame-command)
  93                   :help ,(purecopy "Open a new frame")))
  94
  95     (define-key menu [one-window]
  96       `(menu-item ,(purecopy "Remove Splits") delete-other-windows
  97                   :enable (not (one-window-p t nil))
  98                   :help ,(purecopy
  99                           "Selected window grows to fill the whole frame")))
 100
 101     (define-key menu [split-window]
 102       `(menu-item ,(purecopy "Split Window") split-window-vertically
 103                   :enable (and (menu-bar-menu-frame-live-and-visible-p)
 104                                (menu-bar-non-minibuffer-window-p))
 105                   :help ,(purecopy "Split selected window in two windows")))
 106
 107     (define-key menu [separator-window]
 108       menu-bar-separator)
 109
 110     (define-key menu [ps-print-region]
 111       `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region
 112                   :enable mark-active
 113                   :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer")))
 114     (define-key menu [ps-print-buffer]
 115       `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer
 116                   :enable (menu-bar-menu-frame-live-and-visible-p)
 117                   :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer")))
 118     (define-key menu [ps-print-region-faces]
 119       `(menu-item ,(purecopy "Postscript Print Region")
 120                   ps-print-region-with-faces
 121                   :enable mark-active
 122                   :help ,(purecopy
 123                           "Pretty-print marked region to PostScript printer")))
 124     (define-key menu [ps-print-buffer-faces]
 125       `(menu-item ,(purecopy "Postscript Print Buffer")
 126                   ps-print-buffer-with-faces
 127                   :enable (menu-bar-menu-frame-live-and-visible-p)
 128                   :help ,(purecopy "Pretty-print current buffer to PostScript printer")))
 129     (define-key menu [print-region]
 130       `(menu-item ,(purecopy "Print Region") print-region
 131                   :enable mark-active
 132                   :help ,(purecopy "Print region between mark and current position")))
 133     (define-key menu [print-buffer]
 134       `(menu-item ,(purecopy "Print Buffer") print-buffer
 135                   :enable (menu-bar-menu-frame-live-and-visible-p)
 136                   :help ,(purecopy "Print current buffer with page headings")))
 137
 138     (define-key menu [separator-print]
 139       menu-bar-separator)
 140
 141     (define-key menu [recover-session]
 142       `(menu-item ,(purecopy "Recover Crashed Session") recover-session
 143                   :enable
 144                   (and auto-save-list-file-prefix
 145                        (file-directory-p
 146                         (file-name-directory auto-save-list-file-prefix))
 147                        (directory-files
 148                         (file-name-directory auto-save-list-file-prefix)
 149                         nil
 150                         (concat "\\`"
 151                                 (regexp-quote
 152                                  (file-name-nondirectory
 153                                   auto-save-list-file-prefix)))
 154                         t))
 155                   :help ,(purecopy "Recover edits from a crashed session")))
 156     (define-key menu [revert-buffer]
 157       `(menu-item ,(purecopy "Revert Buffer") revert-buffer
 158                   :enable (or revert-buffer-function
 159                               revert-buffer-insert-file-contents-function
 160                               (and buffer-file-number
 161                                    (or (buffer-modified-p)
 162                                        (not (verify-visited-file-modtime
 163                                              (current-buffer))))))
 164                   :help ,(purecopy "Re-read current buffer from its file")))
 165     (define-key menu [write-file]
 166       `(menu-item ,(purecopy "Save As...") write-file
 167                   :enable (and (menu-bar-menu-frame-live-and-visible-p)
 168                                (menu-bar-non-minibuffer-window-p))
 169                   :help ,(purecopy "Write current buffer to another file")))
 170     (define-key menu [save-buffer]
 171       `(menu-item ,(purecopy "Save") save-buffer
 172                   :enable (and (buffer-modified-p)
 173                                (buffer-file-name)
 174                                (menu-bar-non-minibuffer-window-p))
 175                   :help ,(purecopy "Save current buffer to its file")))
 176
 177     (define-key menu [separator-save]
 178       menu-bar-separator)
 179
 180
 181     (define-key menu [kill-buffer]
 182       `(menu-item ,(purecopy "Close") kill-this-buffer
 183                   :enable (kill-this-buffer-enabled-p)
 184                   :help ,(purecopy "Discard (kill) current buffer")))
 185     (define-key menu [insert-file]
 186       `(menu-item ,(purecopy "Insert File...") insert-file
 187                   :enable (menu-bar-non-minibuffer-window-p)
 188                   :help ,(purecopy "Insert another file into current buffer")))
 189     (define-key menu [dired]
 190       `(menu-item ,(purecopy "Open Directory...") dired
 191                   :enable (menu-bar-non-minibuffer-window-p)
 192                   :help ,(purecopy
 193                           "Read a directory, to operate on its files")))
 194     (define-key menu [open-file]
 195       `(menu-item ,(purecopy "Open File...") menu-find-file-existing
 196                   :enable (menu-bar-non-minibuffer-window-p)
 197                   :help ,(purecopy
 198                           "Read an existing file into an Emacs buffer")))
 199     (define-key menu [new-file]
 200       `(menu-item ,(purecopy "Visit New File...") find-file
 201                   :enable (menu-bar-non-minibuffer-window-p)
 202                   :help ,(purecopy
 203                           "Specify a new file's name, to edit the file")))
 204
 205     menu))
 206
 207 (defun menu-find-file-existing ()
 208   "Edit the existing file FILENAME."
 209   (interactive)
 210   (let* ((mustmatch (not (and (fboundp 'x-uses-old-gtk-dialog)
 211                               (x-uses-old-gtk-dialog))))
 212          (filename (car (find-file-read-args "Find file: " mustmatch))))
 213     (if mustmatch
 214         (find-file-existing filename)
 215       (find-file filename))))
 216
 217 ;; The "Edit->Search" submenu
 218 (defvar menu-bar-last-search-type nil
 219   "Type of last non-incremental search command called from the menu.")
 220
 221 (defun nonincremental-repeat-search-forward ()
 222   "Search forward for the previous search string or regexp."
 223   (interactive)
 224   (cond
 225    ((and (eq menu-bar-last-search-type 'string)
 226          search-ring)
 227     (search-forward (car search-ring)))
 228    ((and (eq menu-bar-last-search-type 'regexp)
 229          regexp-search-ring)
 230     (re-search-forward (car regexp-search-ring)))
 231    (t
 232     (error "No previous search"))))
 233
 234 (defun nonincremental-repeat-search-backward ()
 235   "Search backward for the previous search string or regexp."
 236   (interactive)
 237   (cond
 238    ((and (eq menu-bar-last-search-type 'string)
 239          search-ring)
 240     (search-backward (car search-ring)))
 241    ((and (eq menu-bar-last-search-type 'regexp)
 242          regexp-search-ring)
 243     (re-search-backward (car regexp-search-ring)))
 244    (t
 245     (error "No previous search"))))
 246
 247 (defun nonincremental-search-forward (string)
 248   "Read a string and search for it nonincrementally."
 249   (interactive "sSearch for string: ")
 250   (setq menu-bar-last-search-type 'string)
 251   (if (equal string "")
 252       (search-forward (car search-ring))
 253     (isearch-update-ring string nil)
 254     (search-forward string)))
 255
 256 (defun nonincremental-search-backward (string)
 257   "Read a string and search backward for it nonincrementally."
 258   (interactive "sSearch for string: ")
 259   (setq menu-bar-last-search-type 'string)
 260   (if (equal string "")
 261       (search-backward (car search-ring))
 262     (isearch-update-ring string nil)
 263     (search-backward string)))
 264
 265 (defun nonincremental-re-search-forward (string)
 266   "Read a regular expression and search for it nonincrementally."
 267   (interactive "sSearch for regexp: ")
 268   (setq menu-bar-last-search-type 'regexp)
 269   (if (equal string "")
 270       (re-search-forward (car regexp-search-ring))
 271     (isearch-update-ring string t)
 272     (re-search-forward string)))
 273
 274 (defun nonincremental-re-search-backward (string)
 275   "Read a regular expression and search backward for it nonincrementally."
 276   (interactive "sSearch for regexp: ")
 277   (setq menu-bar-last-search-type 'regexp)
 278   (if (equal string "")
 279       (re-search-backward (car regexp-search-ring))
 280     (isearch-update-ring string t)
 281     (re-search-backward string)))
 282
 283 ;; The Edit->Search->Incremental Search menu
 284 (defvar menu-bar-i-search-menu
 285   (let ((menu (make-sparse-keymap "Incremental Search")))
 286     (define-key menu [isearch-backward-regexp]
 287       `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp
 288         :help ,(purecopy
 289                 "Search backwards for a regular expression as you type it")))
 290     (define-key menu [isearch-forward-regexp]
 291       `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp
 292         :help ,(purecopy
 293                 "Search forward for a regular expression as you type it")))
 294     (define-key menu [isearch-backward]
 295       `(menu-item ,(purecopy "Backward String...") isearch-backward
 296         :help ,(purecopy "Search backwards for a string as you type it")))
 297     (define-key menu [isearch-forward]
 298       `(menu-item ,(purecopy "Forward String...") isearch-forward
 299         :help ,(purecopy "Search forward for a string as you type it")))
 300     menu))
 301
 302 (defvar menu-bar-search-menu
 303   (let ((menu (make-sparse-keymap "Search")))
 304
 305     (define-key menu [i-search]
 306       `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu))
 307     (define-key menu [separator-tag-isearch]
 308       menu-bar-separator)
 309
 310     (define-key menu [tags-continue]
 311       `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
 312                   :help ,(purecopy "Continue last tags search operation")))
 313     (define-key menu [tags-srch]
 314       `(menu-item ,(purecopy "Search Tagged Files...") tags-search
 315                   :help ,(purecopy "Search for a regexp in all tagged files")))
 316     (define-key menu [separator-tag-search] menu-bar-separator)
 317
 318     (define-key menu [repeat-search-back]
 319       `(menu-item ,(purecopy "Repeat Backwards")
 320                   nonincremental-repeat-search-backward
 321                   :enable (or (and (eq menu-bar-last-search-type 'string)
 322                                    search-ring)
 323                               (and (eq menu-bar-last-search-type 'regexp)
 324                                    regexp-search-ring))
 325                   :help ,(purecopy "Repeat last search backwards")))
 326     (define-key menu [repeat-search-fwd]
 327       `(menu-item ,(purecopy "Repeat Forward")
 328                   nonincremental-repeat-search-forward
 329                   :enable (or (and (eq menu-bar-last-search-type 'string)
 330                                    search-ring)
 331                               (and (eq menu-bar-last-search-type 'regexp)
 332                                    regexp-search-ring))
 333                   :help ,(purecopy "Repeat last search forward")))
 334     (define-key menu [separator-repeat-search]
 335       menu-bar-separator)
 336
 337     (define-key menu [re-search-backward]
 338       `(menu-item ,(purecopy "Regexp Backwards...")
 339                   nonincremental-re-search-backward
 340                   :help ,(purecopy
 341                           "Search backwards for a regular expression")))
 342     (define-key menu [re-search-forward]
 343       `(menu-item ,(purecopy "Regexp Forward...")
 344                   nonincremental-re-search-forward
 345                   :help ,(purecopy "Search forward for a regular expression")))
 346
 347     (define-key menu [search-backward]
 348       `(menu-item ,(purecopy "String Backwards...")
 349                   nonincremental-search-backward
 350                   :help ,(purecopy "Search backwards for a string")))
 351     (define-key menu [search-forward]
 352       `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward
 353                   :help ,(purecopy "Search forward for a string")))
 354     menu))
 355
 356 ;; The Edit->Replace submenu
 357
 358 (defvar menu-bar-replace-menu
 359   (let ((menu (make-sparse-keymap "Replace")))
 360     (define-key menu [tags-repl-continue]
 361       `(menu-item ,(purecopy "Continue Replace") tags-loop-continue
 362                   :help ,(purecopy "Continue last tags replace operation")))
 363     (define-key menu [tags-repl]
 364       `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace
 365         :help ,(purecopy
 366                 "Interactively replace a regexp in all tagged files")))
 367     (define-key menu [separator-replace-tags]
 368       menu-bar-separator)
 369
 370     (define-key menu [query-replace-regexp]
 371       `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp
 372                   :enable (not buffer-read-only)
 373                   :help ,(purecopy "Replace regular expression interactively, ask about each occurrence")))
 374     (define-key menu [query-replace]
 375       `(menu-item ,(purecopy "Replace String...") query-replace
 376         :enable (not buffer-read-only)
 377         :help ,(purecopy
 378                 "Replace string interactively, ask about each occurrence")))
 379     menu))
 380
 381 ;;; Assemble the top-level Edit menu items.
 382 (defvar menu-bar-goto-menu
 383   (let ((menu (make-sparse-keymap "Go To")))
 384
 385     (define-key menu [set-tags-name]
 386       `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table
 387                   :help ,(purecopy "Tell Tags commands which tag table file to use")))
 388
 389     (define-key menu [separator-tag-file]
 390       menu-bar-separator)
 391
 392     (define-key menu [apropos-tags]
 393       `(menu-item ,(purecopy "Tags Apropos...") tags-apropos
 394                   :help ,(purecopy "Find function/variables whose names match regexp")))
 395     (define-key menu [next-tag-otherw]
 396       `(menu-item ,(purecopy "Next Tag in Other Window")
 397                   menu-bar-next-tag-other-window
 398                   :enable (and (boundp 'tags-location-ring)
 399                                (not (ring-empty-p tags-location-ring)))
 400                   :help ,(purecopy "Find next function/variable matching last tag name in another window")))
 401
 402     (define-key menu [next-tag]
 403       `(menu-item ,(purecopy "Find Next Tag")
 404                   menu-bar-next-tag
 405                   :enable (and (boundp 'tags-location-ring)
 406                                (not (ring-empty-p tags-location-ring)))
 407                   :help ,(purecopy "Find next function/variable matching last tag name")))
 408     (define-key menu [find-tag-otherw]
 409       `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window
 410                   :help ,(purecopy "Find function/variable definition in another window")))
 411     (define-key menu [find-tag]
 412       `(menu-item ,(purecopy "Find Tag...") find-tag
 413                   :help ,(purecopy "Find definition of function or variable")))
 414
 415     (define-key menu [separator-tags]
 416       menu-bar-separator)
 417
 418     (define-key menu [end-of-buf]
 419       `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer))
 420     (define-key menu [beg-of-buf]
 421       `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer))
 422     (define-key menu [go-to-pos]
 423       `(menu-item ,(purecopy "Goto Buffer Position...") goto-char
 424                   :help ,(purecopy "Read a number N and go to buffer position N")))
 425     (define-key menu [go-to-line]
 426       `(menu-item ,(purecopy "Goto Line...") goto-line
 427                   :help ,(purecopy "Read a line number and go to that line")))
 428     menu))
 429
 430
 431 (defvar yank-menu (cons (purecopy "Select Yank") nil))
 432 (fset 'yank-menu (cons 'keymap yank-menu))
 433
 434 (defvar menu-bar-edit-menu
 435   (let ((menu (make-sparse-keymap "Edit")))
 436
 437     (define-key menu [props]
 438       `(menu-item ,(purecopy "Text Properties") facemenu-menu))
 439
 440     ;; ns-win.el said: Add spell for platorm consistency.
 441     (if (featurep 'ns)
 442         (define-key menu [spell]
 443           `(menu-item ,(purecopy "Spell") ispell-menu-map)))
 444
 445     (define-key menu [fill]
 446       `(menu-item ,(purecopy "Fill") fill-region
 447                   :enable (and mark-active (not buffer-read-only))
 448                   :help
 449                   ,(purecopy "Fill text in region to fit between left and right margin")))
 450
 451     (define-key menu [separator-bookmark]
 452       menu-bar-separator)
 453
 454     (define-key menu [bookmark]
 455       `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map))
 456
 457     (define-key menu [goto]
 458       `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu))
 459
 460     (define-key menu [replace]
 461       `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu))
 462
 463     (define-key menu [search]
 464       `(menu-item ,(purecopy "Search") ,menu-bar-search-menu))
 465
 466     (define-key menu [separator-search]
 467       menu-bar-separator)
 468
 469     (define-key menu [mark-whole-buffer]
 470       `(menu-item ,(purecopy "Select All") mark-whole-buffer
 471                   :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
 472     (define-key menu [clear]
 473       `(menu-item ,(purecopy "Clear") delete-region
 474                   :enable (and mark-active
 475                                (not buffer-read-only))
 476                   :help
 477                   ,(purecopy "Delete the text in region between mark and current position")))
 478
 479
 480     (define-key menu (if (featurep 'ns) [select-paste]
 481                        [paste-from-menu])
 482       ;; ns-win.el said: Change text to be more consistent with
 483       ;; surrounding menu items `paste', etc."
 484       `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste"
 485                                "Paste from Kill Menu")) yank-menu
 486                                :enable (and (cdr yank-menu) (not buffer-read-only))
 487                                :help ,(purecopy "Choose a string from the kill ring and paste it")))
 488     (define-key menu [paste]
 489       `(menu-item ,(purecopy "Paste") yank
 490                   :enable (and (or
 491                                 ;; Emacs compiled --without-x (or --with-ns)
 492                                 ;; doesn't have x-selection-exists-p.
 493                                 (and (fboundp 'x-selection-exists-p)
 494                                      (x-selection-exists-p 'CLIPBOARD))
 495                                 (if (featurep 'ns) ; like paste-from-menu
 496                                     (cdr yank-menu)
 497                                   kill-ring))
 498                                (not buffer-read-only))
 499                   :help ,(purecopy "Paste (yank) text most recently cut/copied")))
 500     (define-key menu [copy]
 501       ;; ns-win.el said: Substitute a Copy function that works better
 502       ;; under X (for GNUstep).
 503       `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns)
 504                                           'ns-copy-including-secondary
 505                                         'kill-ring-save)
 506                   :enable mark-active
 507                   :help ,(purecopy "Copy text in region between mark and current position")
 508                   :keys ,(purecopy (if (featurep 'ns)
 509                                        "\\[ns-copy-including-secondary]"
 510                                      "\\[kill-ring-save]"))))
 511     (define-key menu [cut]
 512       `(menu-item ,(purecopy "Cut") kill-region
 513                   :enable (and mark-active (not buffer-read-only))
 514                   :help
 515                   ,(purecopy "Cut (kill) text in region between mark and current position")))
 516     ;; ns-win.el said: Separate undo from cut/paste section.
 517     (if (featurep 'ns)
 518         (define-key menu [separator-undo] menu-bar-separator))
 519
 520     (define-key menu [undo]
 521       `(menu-item ,(purecopy "Undo") undo
 522                   :enable (and (not buffer-read-only)
 523                                (not (eq t buffer-undo-list))
 524                                (if (eq last-command 'undo)
 525                                    (listp pending-undo-list)
 526                                  (consp buffer-undo-list)))
 527                   :help ,(purecopy "Undo last operation")))
 528
 529     menu))
 530
 531 (defun menu-bar-next-tag-other-window ()
 532   "Find the next definition of the tag already specified."
 533   (interactive)
 534   (find-tag-other-window nil t))
 535
 536 (defun menu-bar-next-tag ()
 537   "Find the next definition of the tag already specified."
 538   (interactive)
 539   (find-tag nil t))
 540
 541 (define-obsolete-function-alias
 542   'menu-bar-kill-ring-save 'kill-ring-save "24.1")
 543
 544 ;; These are alternative definitions for the cut, paste and copy
 545 ;; menu items.  Use them if your system expects these to use the clipboard.
 546
 547 (put 'clipboard-kill-region 'menu-enable
 548      '(and mark-active (not buffer-read-only)))
 549 (put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
 550 (put 'clipboard-yank 'menu-enable
 551      '(and (or (not (fboundp 'x-selection-exists-p))
 552                (x-selection-exists-p)
 553                (x-selection-exists-p 'CLIPBOARD))
 554            (not buffer-read-only)))
 555
 556 (defun clipboard-yank ()
 557   "Insert the clipboard contents, or the last stretch of killed text."
 558   (interactive "*")
 559   (let ((x-select-enable-clipboard t))
 560     (yank)))
 561
 562 (defun clipboard-kill-ring-save (beg end)
 563   "Copy region to kill ring, and save in the X clipboard."
 564   (interactive "r")
 565   (let ((x-select-enable-clipboard t))
 566     (kill-ring-save beg end)))
 567
 568 (defun clipboard-kill-region (beg end)
 569   "Kill the region, and save it in the X clipboard."
 570   (interactive "r")
 571   (let ((x-select-enable-clipboard t))
 572     (kill-region beg end)))
 573
 574 (defun menu-bar-enable-clipboard ()
 575   "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
 576 Do the same for the keys of the same name."
 577   (interactive)
 578   ;; These are Sun server keysyms for the Cut, Copy and Paste keys
 579   ;; (also for XFree86 on Sun keyboard):
 580   (define-key global-map [f20] 'clipboard-kill-region)
 581   (define-key global-map [f16] 'clipboard-kill-ring-save)
 582   (define-key global-map [f18] 'clipboard-yank)
 583   ;; X11R6 versions:
 584   (define-key global-map [cut] 'clipboard-kill-region)
 585   (define-key global-map [copy] 'clipboard-kill-ring-save)
 586   (define-key global-map [paste] 'clipboard-yank))
 587 \f
 588 ;; The "Options" menu items
 589
 590 (defvar menu-bar-custom-menu
 591   (let ((menu (make-sparse-keymap "Customize")))
 592
 593     (define-key menu [customize-apropos-faces]
 594       `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces
 595                   :help ,(purecopy "Browse faces matching a regexp or word list")))
 596     (define-key menu [customize-apropos-options]
 597       `(menu-item ,(purecopy "Options Matching...") customize-apropos-options
 598                   :help ,(purecopy "Browse options matching a regexp or word list")))
 599     (define-key menu [customize-apropos]
 600       `(menu-item ,(purecopy "All Settings Matching...") customize-apropos
 601                   :help ,(purecopy "Browse customizable settings matching a regexp or word list")))
 602     (define-key menu [separator-1]
 603       menu-bar-separator)
 604     (define-key menu [customize-group]
 605       `(menu-item ,(purecopy "Specific Group...") customize-group
 606                   :help ,(purecopy "Customize settings of specific group")))
 607     (define-key menu [customize-face]
 608       `(menu-item ,(purecopy "Specific Face...") customize-face
 609                   :help ,(purecopy "Customize attributes of specific face")))
 610     (define-key menu [customize-option]
 611       `(menu-item ,(purecopy "Specific Option...") customize-option
 612                   :help ,(purecopy "Customize value of specific option")))
 613     (define-key menu [separator-2]
 614       menu-bar-separator)
 615     (define-key menu [customize-changed-options]
 616       `(menu-item ,(purecopy "New Options...") customize-changed-options
 617                   :help ,(purecopy "Options added or changed in recent Emacs versions")))
 618     (define-key menu [customize-saved]
 619       `(menu-item ,(purecopy "Saved Options") customize-saved
 620                   :help ,(purecopy "Customize previously saved options")))
 621     (define-key menu [separator-3]
 622       menu-bar-separator)
 623     (define-key menu [customize-browse]
 624       `(menu-item ,(purecopy "Browse Customization Groups") customize-browse
 625                   :help ,(purecopy "Browse all customization groups")))
 626     (define-key menu [customize]
 627       `(menu-item ,(purecopy "Top-level Customization Group") customize
 628                   :help ,(purecopy "The master group called `Emacs'")))
 629     (define-key menu [customize-themes]
 630       `(menu-item ,(purecopy "Custom Themes") customize-themes
 631                   :help ,(purecopy "Choose a pre-defined customization theme")))
 632     menu))
 633 ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
 634
 635 (defmacro menu-bar-make-mm-toggle (fname doc help &optional props)
 636   "Make a menu-item for a global minor mode toggle.
 637 FNAME is the minor mode's name (variable and function).
 638 DOC is the text to use for the menu entry.
 639 HELP is the text to use for the tooltip.
 640 PROPS are additional properties."
 641   `(list 'menu-item  (purecopy ,doc) ',fname
 642          ,@(mapcar (lambda (p) (list 'quote p)) props)
 643          :help (purecopy ,help)
 644          :button '(:toggle . (and (default-boundp ',fname)
 645                                   (default-value ',fname)))))
 646
 647 (defmacro menu-bar-make-toggle (name variable doc message help &rest body)
 648   `(progn
 649      (defun ,name (&optional interactively)
 650        ,(concat "Toggle whether to " (downcase (substring help 0 1))
 651                 (substring help 1) ".
 652 In an interactive call, record this option as a candidate for saving
 653 by \"Save Options\" in Custom buffers.")
 654        (interactive "p")
 655        (if ,(if body `(progn . ,body)
 656               `(progn
 657                  (custom-load-symbol ',variable)
 658                  (let ((set (or (get ',variable 'custom-set) 'set-default))
 659                        (get (or (get ',variable 'custom-get) 'default-value)))
 660                    (funcall set ',variable (not (funcall get ',variable))))))
 661            (message ,message "enabled globally")
 662          (message ,message "disabled globally"))
 663        ;; The function `customize-mark-as-set' must only be called when
 664        ;; a variable is set interactively, as the purpose is to mark it as
 665        ;; a candidate for "Save Options", and we do not want to save options
 666        ;; the user have already set explicitly in his init file.
 667        (if interactively (customize-mark-as-set ',variable)))
 668      (list 'menu-item (purecopy ,doc) ',name
 669            :help (purecopy ,help)
 670            :button '(:toggle . (and (default-boundp ',variable)
 671                                     (default-value ',variable))))))
 672
 673 ;; Function for setting/saving default font.
 674
 675 (defun menu-set-font ()
 676   "Interactively select a font and make it the default."
 677   (interactive)
 678   (let ((font (if (fboundp 'x-select-font)
 679                   (x-select-font)
 680                 (mouse-select-font)))
 681         spec)
 682     (when font
 683       ;; Be careful here: when set-face-attribute is called for the
 684       ;; :font attribute, Emacs tries to guess the best matching font
 685       ;; by examining the other face attributes (Bug#2476).
 686       (set-face-attribute 'default (selected-frame)
 687                           :width 'normal
 688                           :weight 'normal
 689                           :slant 'normal
 690                           :font font)
 691       (let ((font-object (face-attribute 'default :font)))
 692         (dolist (f (frame-list))
 693           (and (not (eq f (selected-frame)))
 694                (display-graphic-p f)
 695                (set-face-attribute 'default f :font font-object)))
 696         (set-face-attribute 'default t :font font-object))
 697       (setq spec (list (list t (face-attr-construct 'default))))
 698       (put 'default 'customized-face spec)
 699       (custom-push-theme 'theme-face 'default 'user 'set spec)
 700       (put 'default 'face-modified nil))))
 701
 702 (defun menu-bar-options-save ()
 703   "Save current values of Options menu items using Custom."
 704   (interactive)
 705   (let ((need-save nil))
 706     ;; These are set with menu-bar-make-mm-toggle, which does not
 707     ;; put on a customized-value property.
 708     (dolist (elt '(line-number-mode column-number-mode size-indication-mode
 709                    cua-mode show-paren-mode transient-mark-mode
 710                    blink-cursor-mode display-time-mode display-battery-mode
 711                    ;; These are set by other functions that don't set
 712                    ;; the customized state.  Having them here has the
 713                    ;; side-effect that turning them off via X
 714                    ;; resources acts like having customized them, but
 715                    ;; that seems harmless.
 716                    menu-bar-mode tool-bar-mode))
 717       ;; FIXME ? It's a little annoying that running this command
 718       ;; always loads cua-base, paren, time, and battery, even if they
 719       ;; have not been customized in any way.  (Due to custom-load-symbol.)
 720       (and (customize-mark-to-save elt)
 721            (setq need-save t)))
 722     ;; These are set with `customize-set-variable'.
 723     (dolist (elt '(scroll-bar-mode
 724                    debug-on-quit debug-on-error
 725                    ;; Somehow this works, when tool-bar and menu-bar don't.
 726                    tooltip-mode
 727                    save-place uniquify-buffer-name-style fringe-mode
 728                    indicate-empty-lines indicate-buffer-boundaries
 729                    case-fold-search font-use-system-font
 730                    current-language-environment default-input-method
 731                    ;; Saving `text-mode-hook' is somewhat questionable,
 732                    ;; as we might get more than we bargain for, if
 733                    ;; other code may has added hooks as well.
 734                    ;; Nonetheless, not saving it would like be confuse
 735                    ;; more often.
 736                    ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
 737                    text-mode-hook tool-bar-position))
 738       (and (get elt 'customized-value)
 739            (customize-mark-to-save elt)
 740            (setq need-save t)))
 741     (when (get 'default 'customized-face)
 742       (put 'default 'saved-face (get 'default 'customized-face))
 743       (put 'default 'customized-face nil)
 744       (setq need-save t))
 745     ;; Save if we changed anything.
 746     (when need-save
 747       (custom-save-all))))
 748
 749
 750 ;;; Assemble all the top-level items of the "Options" menu
 751
 752 ;; The "Show/Hide" submenu of menu "Options"
 753
 754 (defun menu-bar-showhide-fringe-ind-customize ()
 755   "Show customization buffer for `indicate-buffer-boundaries'."
 756   (interactive)
 757   (customize-variable 'indicate-buffer-boundaries))
 758
 759 (defun menu-bar-showhide-fringe-ind-mixed ()
 760   "Display top and bottom indicators in opposite fringes, arrows in right."
 761   (interactive)
 762   (customize-set-variable 'indicate-buffer-boundaries
 763                           '((t . right) (top . left))))
 764
 765 (defun menu-bar-showhide-fringe-ind-box ()
 766   "Display top and bottom indicators in opposite fringes."
 767   (interactive)
 768   (customize-set-variable 'indicate-buffer-boundaries
 769                           '((top . left) (bottom . right))))
 770
 771 (defun menu-bar-showhide-fringe-ind-right ()
 772   "Display buffer boundaries and arrows in the right fringe."
 773   (interactive)
 774   (customize-set-variable 'indicate-buffer-boundaries 'right))
 775
 776 (defun menu-bar-showhide-fringe-ind-left ()
 777   "Display buffer boundaries and arrows in the left fringe."
 778   (interactive)
 779   (customize-set-variable 'indicate-buffer-boundaries 'left))
 780
 781 (defun menu-bar-showhide-fringe-ind-none ()
 782   "Do not display any buffer boundary indicators."
 783   (interactive)
 784   (customize-set-variable 'indicate-buffer-boundaries nil))
 785
 786 (defvar menu-bar-showhide-fringe-ind-menu
 787   (let ((menu (make-sparse-keymap "Buffer boundaries")))
 788
 789     (define-key menu [customize]
 790       `(menu-item ,(purecopy "Other (Customize)")
 791                   menu-bar-showhide-fringe-ind-customize
 792                   :help ,(purecopy "Additional choices available through Custom buffer")
 793                   :visible (display-graphic-p)
 794                   :button (:radio . (not (member indicate-buffer-boundaries
 795                                                  '(nil left right
 796                                                    ((top . left) (bottom . right))
 797                                                    ((t . right) (top . left))))))))
 798
 799     (define-key menu [mixed]
 800       `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed
 801                   :help
 802                   ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right")
 803                   :visible (display-graphic-p)
 804                   :button (:radio . (equal indicate-buffer-boundaries
 805                                            '((t . right) (top . left))))))
 806
 807     (define-key menu [box]
 808       `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box
 809                   :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows")
 810                   :visible (display-graphic-p)
 811                   :button (:radio . (equal indicate-buffer-boundaries
 812                                            '((top . left) (bottom . right))))))
 813
 814     (define-key menu [right]
 815       `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right
 816                   :help ,(purecopy "Show buffer boundaries and arrows in right fringe")
 817                   :visible (display-graphic-p)
 818                   :button (:radio . (eq indicate-buffer-boundaries 'right))))
 819
 820     (define-key menu [left]
 821       `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left
 822                   :help ,(purecopy "Show buffer boundaries and arrows in left fringe")
 823                   :visible (display-graphic-p)
 824                   :button (:radio . (eq indicate-buffer-boundaries 'left))))
 825
 826     (define-key menu [none]
 827       `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none
 828                   :help ,(purecopy "Hide all buffer boundary indicators and arrows")
 829                   :visible (display-graphic-p)
 830                   :button (:radio . (eq indicate-buffer-boundaries nil))))
 831     menu))
 832
 833 (defun menu-bar-showhide-fringe-menu-customize ()
 834   "Show customization buffer for `fringe-mode'."
 835   (interactive)
 836   (customize-variable 'fringe-mode))
 837
 838 (defun menu-bar-showhide-fringe-menu-customize-reset ()
 839   "Reset the fringe mode: display fringes on both sides of a window."
 840   (interactive)
 841   (customize-set-variable 'fringe-mode nil))
 842
 843 (defun menu-bar-showhide-fringe-menu-customize-right ()
 844   "Display fringes only on the right of each window."
 845   (interactive)
 846   (require 'fringe)
 847   (customize-set-variable 'fringe-mode '(0 . nil)))
 848
 849 (defun menu-bar-showhide-fringe-menu-customize-left ()
 850   "Display fringes only on the left of each window."
 851   (interactive)
 852   (require 'fringe)
 853   (customize-set-variable 'fringe-mode '(nil . 0)))
 854
 855 (defun menu-bar-showhide-fringe-menu-customize-disable ()
 856   "Do not display window fringes."
 857   (interactive)
 858   (require 'fringe)
 859   (customize-set-variable 'fringe-mode 0))
 860
 861 (defvar menu-bar-showhide-fringe-menu
 862   (let ((menu (make-sparse-keymap "Fringe")))
 863
 864     (define-key menu [showhide-fringe-ind]
 865       `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu
 866                   :visible (display-graphic-p)
 867                   :help ,(purecopy "Indicate buffer boundaries in fringe")))
 868
 869     (define-key menu [indicate-empty-lines]
 870       (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
 871                             "Empty Line Indicators"
 872                             "Indicating of empty lines %s"
 873                             "Indicate trailing empty lines in fringe, globally"))
 874
 875     (define-key menu [customize]
 876       `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize
 877                   :help ,(purecopy "Detailed customization of fringe")
 878                   :visible (display-graphic-p)))
 879
 880     (define-key menu [default]
 881       `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset
 882                   :help ,(purecopy "Default width fringe on both left and right side")
 883                   :visible (display-graphic-p)
 884                   :button (:radio . (eq fringe-mode nil))))
 885
 886     (define-key menu [right]
 887       `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right
 888                   :help ,(purecopy "Fringe only on the right side")
 889                   :visible (display-graphic-p)
 890                   :button (:radio . (equal fringe-mode '(0 . nil)))))
 891
 892     (define-key menu [left]
 893       `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left
 894                   :help ,(purecopy "Fringe only on the left side")
 895                   :visible (display-graphic-p)
 896                   :button (:radio . (equal fringe-mode '(nil . 0)))))
 897
 898     (define-key menu [none]
 899       `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable
 900                   :help ,(purecopy "Turn off fringe")
 901                   :visible (display-graphic-p)
 902                   :button (:radio . (eq fringe-mode 0))))
 903     menu))
 904
 905 (defun menu-bar-right-scroll-bar ()
 906   "Display scroll bars on the right of each window."
 907   (interactive)
 908   (customize-set-variable 'scroll-bar-mode 'right))
 909
 910 (defun menu-bar-left-scroll-bar ()
 911   "Display scroll bars on the left of each window."
 912   (interactive)
 913   (customize-set-variable 'scroll-bar-mode 'left))
 914
 915 (defun menu-bar-no-scroll-bar ()
 916   "Turn off scroll bars."
 917   (interactive)
 918   (customize-set-variable 'scroll-bar-mode nil))
 919
 920 (defvar menu-bar-showhide-scroll-bar-menu
 921   (let ((menu (make-sparse-keymap "Scroll-bar")))
 922
 923     (define-key menu [right]
 924       `(menu-item ,(purecopy "On the Right")
 925                   menu-bar-right-scroll-bar
 926                   :help ,(purecopy "Scroll-bar on the right side")
 927                   :visible (display-graphic-p)
 928                   :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
 929                                                    (frame-parameters))) 'right))))
 930
 931     (define-key menu [left]
 932       `(menu-item ,(purecopy "On the Left")
 933                   menu-bar-left-scroll-bar
 934                   :help ,(purecopy "Scroll-bar on the left side")
 935                   :visible (display-graphic-p)
 936                   :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
 937                                                    (frame-parameters))) 'left))))
 938
 939     (define-key menu [none]
 940       `(menu-item ,(purecopy "None")
 941                   menu-bar-no-scroll-bar
 942                   :help ,(purecopy "Turn off scroll-bar")
 943                   :visible (display-graphic-p)
 944                   :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
 945                                                    (frame-parameters))) nil))))
 946     menu))
 947
 948 (defun menu-bar-frame-for-menubar ()
 949   "Return the frame suitable for updating the menu bar."
 950   (or (and (framep menu-updating-frame)
 951            menu-updating-frame)
 952       (selected-frame)))
 953
 954 (defun menu-bar-positive-p (val)
 955   "Return non-nil iff VAL is a positive number."
 956   (and (numberp val)
 957        (> val 0)))
 958
 959 (defun menu-bar-set-tool-bar-position (position)
 960   (customize-set-variable 'tool-bar-mode t)
 961   (customize-set-variable 'tool-bar-position position))
 962 (defun menu-bar-showhide-tool-bar-menu-customize-disable ()
 963   "Do not display tool bars."
 964   (interactive)
 965   (customize-set-variable 'tool-bar-mode nil))
 966 (defun menu-bar-showhide-tool-bar-menu-customize-enable-left ()
 967   "Display tool bars on the left side."
 968   (interactive)
 969   (menu-bar-set-tool-bar-position 'left))
 970 (defun menu-bar-showhide-tool-bar-menu-customize-enable-right ()
 971   "Display tool bars on the right side."
 972   (interactive)
 973   (menu-bar-set-tool-bar-position 'right))
 974 (defun menu-bar-showhide-tool-bar-menu-customize-enable-top ()
 975   "Display tool bars on the top side."
 976   (interactive)
 977   (menu-bar-set-tool-bar-position 'top))
 978 (defun menu-bar-showhide-tool-bar-menu-customize-enable-bottom ()
 979   "Display tool bars on the bottom side."
 980   (interactive)
 981   (menu-bar-set-tool-bar-position 'bottom))
 982
 983 (when (featurep 'move-toolbar)
 984   (defvar menu-bar-showhide-tool-bar-menu
 985     (let ((menu (make-sparse-keymap "Tool-bar")))
 986
 987       (define-key menu [showhide-tool-bar-left]
 988         `(menu-item ,(purecopy "On the left")
 989                     menu-bar-showhide-tool-bar-menu-customize-enable-left
 990                     :help ,(purecopy "Tool-bar at the left side")
 991                     :visible (display-graphic-p)
 992                     :button
 993                     (:radio . (and tool-bar-mode
 994                                    (eq (frame-parameter
 995                                         (menu-bar-frame-for-menubar)
 996                                         'tool-bar-position)
 997                                        'left)))))
 998
 999       (define-key menu [showhide-tool-bar-right]
1000         `(menu-item ,(purecopy "On the right")
1001                     menu-bar-showhide-tool-bar-menu-customize-enable-right
1002                     :help ,(purecopy "Tool-bar at the right side")
1003                     :visible (display-graphic-p)
1004                     :button
1005                     (:radio . (and tool-bar-mode
1006                                    (eq (frame-parameter
1007                                         (menu-bar-frame-for-menubar)
1008                                         'tool-bar-position)
1009                                        'right)))))
1010
1011       (define-key menu [showhide-tool-bar-bottom]
1012         `(menu-item ,(purecopy "On the bottom")
1013                     menu-bar-showhide-tool-bar-menu-customize-enable-bottom
1014                     :help ,(purecopy "Tool-bar at the bottom")
1015                     :visible (display-graphic-p)
1016                     :button
1017                     (:radio . (and tool-bar-mode
1018                                    (eq (frame-parameter
1019                                         (menu-bar-frame-for-menubar)
1020                                         'tool-bar-position)
1021                                        'bottom)))))
1022
1023       (define-key menu [showhide-tool-bar-top]
1024         `(menu-item ,(purecopy "On the top")
1025                     menu-bar-showhide-tool-bar-menu-customize-enable-top
1026                     :help ,(purecopy "Tool-bar at the top")
1027                     :visible (display-graphic-p)
1028                     :button
1029                     (:radio . (and tool-bar-mode
1030                                    (eq (frame-parameter
1031                                         (menu-bar-frame-for-menubar)
1032                                         'tool-bar-position)
1033                                        'top)))))
1034
1035       (define-key menu [showhide-tool-bar-none]
1036         `(menu-item ,(purecopy "None")
1037                     menu-bar-showhide-tool-bar-menu-customize-disable
1038                     :help ,(purecopy "Turn tool-bar off")
1039                     :visible (display-graphic-p)
1040                     :button (:radio . (eq tool-bar-mode nil))))
1041       menu)))
1042
1043 (defvar menu-bar-showhide-menu
1044   (let ((menu (make-sparse-keymap "Show/Hide")))
1045
1046     (define-key menu [column-number-mode]
1047       (menu-bar-make-mm-toggle column-number-mode
1048                                "Column Numbers"
1049                                "Show the current column number in the mode line"))
1050
1051     (define-key menu [line-number-mode]
1052       (menu-bar-make-mm-toggle line-number-mode
1053                                "Line Numbers"
1054                                "Show the current line number in the mode line"))
1055
1056     (define-key menu [size-indication-mode]
1057       (menu-bar-make-mm-toggle size-indication-mode
1058                                "Size Indication"
1059                                "Show the size of the buffer in the mode line"))
1060
1061     (define-key menu [linecolumn-separator]
1062       menu-bar-separator)
1063
1064     (define-key menu [showhide-battery]
1065       (menu-bar-make-mm-toggle display-battery-mode
1066                                "Battery Status"
1067                                "Display battery status information in mode line"))
1068
1069     (define-key menu [showhide-date-time]
1070       (menu-bar-make-mm-toggle display-time-mode
1071                                "Time, Load and Mail"
1072                                "Display time, system load averages and \
1073 mail status in mode line"))
1074
1075     (define-key menu [datetime-separator]
1076       menu-bar-separator)
1077
1078     (define-key menu [showhide-speedbar]
1079       `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode
1080                   :help ,(purecopy "Display a Speedbar quick-navigation frame")
1081                   :button (:toggle
1082                            . (and (boundp 'speedbar-frame)
1083                                   (frame-live-p (symbol-value 'speedbar-frame))
1084                                   (frame-visible-p
1085                                    (symbol-value 'speedbar-frame))))))
1086
1087     (define-key menu [showhide-fringe]
1088       `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu
1089                   :visible (display-graphic-p)))
1090
1091     (define-key menu [showhide-scroll-bar]
1092       `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu
1093                   :visible (display-graphic-p)))
1094
1095     (define-key menu [showhide-tooltip-mode]
1096       `(menu-item ,(purecopy "Tooltips") tooltip-mode
1097                   :help ,(purecopy "Turn tooltips on/off")
1098                   :visible (and (display-graphic-p) (fboundp 'x-show-tip))
1099                   :button (:toggle . tooltip-mode)))
1100
1101     (define-key menu [menu-bar-mode]
1102       `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame
1103                   :help ,(purecopy "Turn menu-bar on/off")
1104                   :button
1105                   (:toggle . (menu-bar-positive-p
1106                               (frame-parameter (menu-bar-frame-for-menubar)
1107                                                'menu-bar-lines)))))
1108
1109     (if (and (boundp 'menu-bar-showhide-tool-bar-menu)
1110              (keymapp menu-bar-showhide-tool-bar-menu))
1111         (define-key menu [showhide-tool-bar]
1112           `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu
1113                       :visible (display-graphic-p)))
1114       ;; else not tool bar that can move.
1115       (define-key menu [showhide-tool-bar]
1116         `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame
1117                     :help ,(purecopy "Turn tool-bar on/off")
1118                     :visible (display-graphic-p)
1119                     :button
1120                     (:toggle . (menu-bar-positive-p
1121                                 (frame-parameter (menu-bar-frame-for-menubar)
1122                                                  'tool-bar-lines))))))
1123     menu))
1124
1125 (defun menu-bar-text-mode-auto-fill ()
1126   (interactive)
1127   (toggle-text-mode-auto-fill)
1128   ;; This is somewhat questionable, as `text-mode-hook'
1129   ;; might have changed outside customize.
1130   ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
1131   (customize-mark-as-set 'text-mode-hook))
1132
1133
1134 (defvar menu-bar-line-wrapping-menu
1135   (let ((menu (make-sparse-keymap "Line Wrapping")))
1136
1137     (define-key menu [word-wrap]
1138       `(menu-item ,(purecopy "Word Wrap (Visual Line mode)")
1139                   (lambda ()
1140                     (interactive)
1141                     (unless visual-line-mode
1142                       (visual-line-mode 1))
1143                     (message ,(purecopy "Visual-Line mode enabled")))
1144                   :help ,(purecopy "Wrap long lines at word boundaries")
1145                   :button (:radio . (and (null truncate-lines)
1146                                          (not (truncated-partial-width-window-p))
1147                                          word-wrap))
1148                   :visible (menu-bar-menu-frame-live-and-visible-p)))
1149
1150     (define-key menu [truncate]
1151       `(menu-item ,(purecopy "Truncate Long Lines")
1152                   (lambda ()
1153                     (interactive)
1154                     (if visual-line-mode (visual-line-mode 0))
1155                     (setq word-wrap nil)
1156                     (toggle-truncate-lines 1))
1157                   :help ,(purecopy "Truncate long lines at window edge")
1158                   :button (:radio . (or truncate-lines
1159                                         (truncated-partial-width-window-p)))
1160                   :visible (menu-bar-menu-frame-live-and-visible-p)
1161                   :enable (not (truncated-partial-width-window-p))))
1162
1163     (define-key menu [window-wrap]
1164       `(menu-item ,(purecopy "Wrap at Window Edge")
1165                   (lambda () (interactive)
1166                     (if visual-line-mode (visual-line-mode 0))
1167                     (setq word-wrap nil)
1168                     (if truncate-lines (toggle-truncate-lines -1)))
1169                   :help ,(purecopy "Wrap long lines at window edge")
1170                   :button (:radio . (and (null truncate-lines)
1171                                          (not (truncated-partial-width-window-p))
1172                                          (not word-wrap)))
1173                   :visible (menu-bar-menu-frame-live-and-visible-p)
1174                   :enable (not (truncated-partial-width-window-p))))
1175     menu))
1176
1177 (defvar menu-bar-options-menu
1178   (let ((menu (make-sparse-keymap "Options")))
1179     (define-key menu [customize]
1180       `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu))
1181
1182     (define-key menu [package]
1183       '(menu-item "Manage Emacs Packages" package-list-packages
1184         :help "Install or uninstall additional Emacs packages"))
1185
1186     (define-key menu [save]
1187       `(menu-item ,(purecopy "Save Options") menu-bar-options-save
1188                   :help ,(purecopy "Save options set from the menu above")))
1189
1190     (define-key menu [custom-separator]
1191       menu-bar-separator)
1192
1193     (define-key menu [menu-set-font]
1194       `(menu-item ,(purecopy "Set Default Font...") menu-set-font
1195                   :visible (display-multi-font-p)
1196                   :help ,(purecopy "Select a default font")))
1197
1198     (if (featurep 'system-font-setting)
1199         (define-key menu [menu-system-font]
1200           (menu-bar-make-toggle
1201            toggle-use-system-font font-use-system-font
1202            "Use system font"
1203            "Use system font: %s"
1204            "Use the monospaced font defined by the system")))
1205
1206     (define-key menu [showhide]
1207       `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu))
1208
1209     (define-key menu [showhide-separator]
1210       menu-bar-separator)
1211
1212     (define-key menu [mule]
1213       ;; It is better not to use backquote here,
1214       ;; because that makes a bootstrapping problem
1215       ;; if you need to recompile all the Lisp files using interpreted code.
1216       `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap
1217                   ;; Most of the MULE menu actually does make sense in
1218                   ;; unibyte mode, e.g. language selection.
1219                   ;; :visible '(default-value 'enable-multibyte-characters)
1220                   ))
1221     ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
1222     ;;(define-key menu [preferences]
1223     ;;  `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu
1224     ;;        :help ,(purecopy "Toggle important global options")))
1225
1226     (define-key menu [mule-separator]
1227       menu-bar-separator)
1228
1229     (define-key menu [debug-on-quit]
1230       (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
1231                             "Enter Debugger on Quit/C-g" "Debug on Quit %s"
1232                             "Enter Lisp debugger when C-g is pressed"))
1233     (define-key menu [debug-on-error]
1234       (menu-bar-make-toggle toggle-debug-on-error debug-on-error
1235                             "Enter Debugger on Error" "Debug on Error %s"
1236                             "Enter Lisp debugger when an error is signaled"))
1237     (define-key menu [debugger-separator]
1238       menu-bar-separator)
1239
1240     (define-key menu [blink-cursor-mode]
1241       (menu-bar-make-mm-toggle blink-cursor-mode
1242                                "Blinking Cursor"
1243                                "Whether the cursor blinks (Blink Cursor mode)"))
1244     (define-key menu [cursor-separator]
1245       menu-bar-separator)
1246
1247     (define-key menu [save-place]
1248       (menu-bar-make-toggle toggle-save-place-globally save-place
1249                             "Save Place in Files between Sessions"
1250                             "Saving place in files %s"
1251                             "Visit files of previous session when restarting Emacs"
1252                             (require 'saveplace)
1253                             ;; Do it by name, to avoid a free-variable
1254                             ;; warning during byte compilation.
1255                             (set-default
1256                              'save-place (not (symbol-value 'save-place)))))
1257
1258     (define-key menu [uniquify]
1259       (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
1260                             "Use Directory Names in Buffer Names"
1261                             "Directory name in buffer names (uniquify) %s"
1262                             "Uniquify buffer names by adding parent directory names"
1263                             (require 'uniquify)
1264                             (setq uniquify-buffer-name-style
1265                                   (if (not uniquify-buffer-name-style)
1266                                       'forward))))
1267
1268     (define-key menu [edit-options-separator]
1269       menu-bar-separator)
1270     (define-key menu [cua-mode]
1271       (menu-bar-make-mm-toggle cua-mode
1272                                "C-x/C-c/C-v Cut and Paste (CUA)"
1273                                "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
1274                                (:visible (or (not (boundp 'cua-enable-cua-keys))
1275                                              cua-enable-cua-keys))))
1276
1277     (define-key menu [cua-emulation-mode]
1278       (menu-bar-make-mm-toggle cua-mode
1279                                "Shift movement mark region (CUA)"
1280                                "Use shifted movement keys to set and extend the region"
1281                                (:visible (and (boundp 'cua-enable-cua-keys)
1282                                               (not cua-enable-cua-keys)))))
1283
1284     (define-key menu [case-fold-search]
1285       (menu-bar-make-toggle toggle-case-fold-search case-fold-search
1286                             "Case-Insensitive Search"
1287                             "Case-Insensitive Search %s"
1288                             "Ignore letter-case in search commands"))
1289
1290     (define-key menu [auto-fill-mode]
1291       `(menu-item ,(purecopy "Auto Fill in Text Modes")
1292                   menu-bar-text-mode-auto-fill
1293                   :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)")
1294                   :button (:toggle . (if (listp text-mode-hook)
1295                                          (member 'turn-on-auto-fill text-mode-hook)
1296                                        (eq 'turn-on-auto-fill text-mode-hook)))))
1297
1298     (define-key menu [line-wrapping]
1299       `(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu))
1300
1301
1302     (define-key menu [highlight-separator]
1303       menu-bar-separator)
1304     (define-key menu [highlight-paren-mode]
1305       (menu-bar-make-mm-toggle show-paren-mode
1306                                "Paren Match Highlighting"
1307                                "Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
1308     (define-key menu [transient-mark-mode]
1309       (menu-bar-make-mm-toggle transient-mark-mode
1310                                "Active Region Highlighting"
1311                                "Make text in active region stand out in color (Transient Mark mode)"
1312                                (:enable (not cua-mode))))
1313     menu))
1314
1315 \f
1316 ;; The "Tools" menu items
1317
1318 (defun send-mail-item-name ()
1319   (let* ((known-send-mail-commands '((sendmail-user-agent . "sendmail")
1320                                      (mh-e-user-agent . "MH")
1321                                      (message-user-agent . "Gnus Message")
1322                                      (gnus-user-agent . "Gnus")))
1323          (name (assq mail-user-agent known-send-mail-commands)))
1324     (if name
1325         (setq name (cdr name))
1326       (setq name (symbol-name mail-user-agent))
1327       (if (string-match "\\(.+\\)-user-agent" name)
1328           (setq name (match-string 1 name))))
1329     name))
1330
1331 (defun read-mail-item-name ()
1332   (let* ((known-rmail-commands '((rmail . "RMAIL")
1333                                  (mh-rmail . "MH")
1334                                  (gnus . "Gnus")))
1335          (known (assq read-mail-command known-rmail-commands)))
1336     (if known (cdr known) (symbol-name read-mail-command))))
1337
1338 (defvar menu-bar-games-menu
1339   (let ((menu (make-sparse-keymap "Games")))
1340
1341     (define-key menu [zone]
1342       `(menu-item ,(purecopy "Zone Out")  zone
1343                   :help ,(purecopy "Play tricks with Emacs display when Emacs is idle")))
1344     (define-key menu [tetris]
1345       `(menu-item ,(purecopy "Tetris")  tetris
1346                   :help ,(purecopy "Falling blocks game")))
1347     (define-key menu [solitaire]
1348       `(menu-item ,(purecopy "Solitaire")  solitaire
1349                   :help ,(purecopy "Get rid of all the stones")))
1350     (define-key menu [snake]
1351       `(menu-item ,(purecopy "Snake")  snake
1352                   :help ,(purecopy "Move snake around avoiding collisions")))
1353     (define-key menu [pong]
1354       `(menu-item ,(purecopy "Pong") pong
1355                   :help ,(purecopy "Bounce the ball to your opponent")))
1356     (define-key menu [mult]
1357       `(menu-item ,(purecopy "Multiplication Puzzle")  mpuz
1358                   :help ,(purecopy "Exercise brain with multiplication")))
1359     (define-key menu [life]
1360       `(menu-item ,(purecopy "Life")  life
1361                   :help ,(purecopy "Watch how John Conway's cellular automaton evolves")))
1362     (define-key menu [land]
1363       `(menu-item ,(purecopy "Landmark") landmark
1364                   :help ,(purecopy "Watch a neural-network robot learn landmarks")))
1365     (define-key menu [hanoi]
1366       `(menu-item ,(purecopy "Towers of Hanoi") hanoi
1367                   :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs")))
1368     (define-key menu [gomoku]
1369       `(menu-item ,(purecopy "Gomoku")  gomoku
1370                   :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)")))
1371     (define-key menu [bubbles]
1372       `(menu-item ,(purecopy "Bubbles") bubbles
1373                   :help ,(purecopy "Remove all bubbles using the fewest moves")))
1374     (define-key menu [black-box]
1375       `(menu-item ,(purecopy "Blackbox")  blackbox
1376                   :help ,(purecopy "Find balls in a black box by shooting rays")))
1377     (define-key menu [adventure]
1378       `(menu-item ,(purecopy "Adventure")  dunnet
1379                   :help ,(purecopy "Dunnet, a text Adventure game for Emacs")))
1380     (define-key menu [5x5]
1381       `(menu-item ,(purecopy "5x5") 5x5
1382                   :help ,(purecopy "Fill in all the squares on a 5x5 board")))
1383     menu))
1384
1385 (defvar menu-bar-encryption-decryption-menu
1386   (let ((menu (make-sparse-keymap "Encryption/Decryption")))
1387     (define-key menu [insert-keys]
1388       `(menu-item ,(purecopy "Insert Keys") epa-insert-keys
1389                   :help ,(purecopy "Insert public keys after the current point")))
1390
1391     (define-key menu [export-keys]
1392       `(menu-item ,(purecopy "Export Keys") epa-export-keys
1393                   :help ,(purecopy "Export public keys to a file")))
1394
1395     (define-key menu [import-keys-region]
1396       `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region
1397                   :help ,(purecopy "Import public keys from the current region")))
1398
1399     (define-key menu [import-keys]
1400       `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys
1401                   :help ,(purecopy "Import public keys from a file")))
1402
1403     (define-key menu [list-keys]
1404       `(menu-item ,(purecopy "List Keys") epa-list-keys
1405                   :help ,(purecopy "Browse your public keyring")))
1406
1407     (define-key menu [separator-keys]
1408       menu-bar-separator)
1409
1410     (define-key menu [sign-region]
1411       `(menu-item ,(purecopy "Sign Region") epa-sign-region
1412                   :help ,(purecopy "Create digital signature of the current region")))
1413
1414     (define-key menu [verify-region]
1415       `(menu-item ,(purecopy "Verify Region") epa-verify-region
1416                   :help ,(purecopy "Verify digital signature of the current region")))
1417
1418     (define-key menu [encrypt-region]
1419       `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region
1420                   :help ,(purecopy "Encrypt the current region")))
1421
1422     (define-key menu [decrypt-region]
1423       `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region
1424                   :help ,(purecopy "Decrypt the current region")))
1425
1426     (define-key menu [separator-file]
1427       menu-bar-separator)
1428
1429     (define-key menu [sign-file]
1430       `(menu-item ,(purecopy "Sign File...") epa-sign-file
1431                   :help ,(purecopy "Create digital signature of a file")))
1432
1433     (define-key menu [verify-file]
1434       `(menu-item ,(purecopy "Verify File...") epa-verify-file
1435                   :help ,(purecopy "Verify digital signature of a file")))
1436
1437     (define-key menu [encrypt-file]
1438       `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file
1439                   :help ,(purecopy "Encrypt a file")))
1440
1441     (define-key menu [decrypt-file]
1442       `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file
1443                   :help ,(purecopy "Decrypt a file")))
1444
1445     menu))
1446
1447 (defun menu-bar-read-mail ()
1448   "Read mail using `read-mail-command'."
1449   (interactive)
1450   (call-interactively read-mail-command))
1451
1452 (defvar menu-bar-tools-menu
1453   (let ((menu (make-sparse-keymap "Tools")))
1454
1455     (define-key menu [games]
1456       `(menu-item ,(purecopy "Games") ,menu-bar-games-menu))
1457
1458     (define-key menu [separator-games]
1459       menu-bar-separator)
1460
1461     (define-key menu [encryption-decryption]
1462       `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu))
1463
1464     (define-key menu [separator-encryption-decryption]
1465       menu-bar-separator)
1466
1467     (define-key menu [simple-calculator]
1468       `(menu-item ,(purecopy "Simple Calculator") calculator
1469                   :help ,(purecopy "Invoke the Emacs built-in quick calculator")))
1470     (define-key menu [calc]
1471       `(menu-item ,(purecopy "Programmable Calculator") calc
1472                   :help ,(purecopy "Invoke the Emacs built-in full scientific calculator")))
1473     (define-key menu [calendar]
1474       `(menu-item ,(purecopy "Calendar") calendar
1475                   :help ,(purecopy "Invoke the Emacs built-in calendar")))
1476
1477     (define-key menu [separator-net]
1478       menu-bar-separator)
1479
1480     (define-key menu [directory-search]
1481       `(menu-item ,(purecopy "Directory Search") eudc-tools-menu))
1482     (define-key menu [compose-mail]
1483       `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail
1484                   :visible (and mail-user-agent (not (eq mail-user-agent 'ignore)))
1485                   :help ,(purecopy "Send a mail message")))
1486     (define-key menu [rmail]
1487       `(menu-item (format "Read Mail (with %s)" (read-mail-item-name))
1488                   menu-bar-read-mail
1489                   :visible (and read-mail-command
1490                                 (not (eq read-mail-command 'ignore)))
1491                   :help ,(purecopy "Read your mail and reply to it")))
1492
1493     (define-key menu [gnus]
1494       `(menu-item ,(purecopy "Read Net News (Gnus)") gnus
1495                   :help ,(purecopy "Read network news groups")))
1496
1497     (define-key menu [separator-vc]
1498       menu-bar-separator)
1499
1500     (define-key menu [pcl-cvs]
1501       `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu))
1502     (define-key menu [vc] nil) ;Create the place for the VC menu.
1503
1504     (define-key menu [separator-compare]
1505       menu-bar-separator)
1506
1507     (define-key menu [epatch]
1508       `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu))
1509     (define-key menu [ediff-merge]
1510       `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu))
1511     (define-key menu [compare]
1512       `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu))
1513
1514     (define-key menu [separator-spell]
1515       menu-bar-separator)
1516
1517     (define-key menu [spell]
1518       `(menu-item ,(purecopy "Spell Checking") ispell-menu-map))
1519
1520     (define-key menu [separator-prog]
1521       menu-bar-separator)
1522
1523     (define-key menu [semantic]
1524       `(menu-item ,(purecopy "Source Code Parsers (Semantic)")
1525                   semantic-mode
1526                   :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)")
1527                   :button (:toggle . (bound-and-true-p semantic-mode))))
1528
1529     (define-key menu [ede]
1530       `(menu-item ,(purecopy "Project support (EDE)")
1531                   global-ede-mode
1532                   :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)")
1533                   :button (:toggle . (bound-and-true-p global-ede-mode))))
1534
1535     (define-key menu [gdb]
1536       `(menu-item ,(purecopy "Debugger (GDB)...") gdb
1537                   :help ,(purecopy "Debug a program from within Emacs with GDB")))
1538     (define-key menu [shell-on-region]
1539       `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region
1540                   :enable mark-active
1541                   :help ,(purecopy "Pass marked region to a shell command")))
1542     (define-key menu [shell]
1543       `(menu-item ,(purecopy "Shell Command...") shell-command
1544                   :help ,(purecopy "Invoke a shell command and catch its output")))
1545     (define-key menu [compile]
1546       `(menu-item ,(purecopy "Compile...") compile
1547                   :help ,(purecopy "Invoke compiler or Make, view compilation errors")))
1548     (define-key menu [grep]
1549       `(menu-item ,(purecopy "Search Files (Grep)...") grep
1550                   :help ,(purecopy "Search files for strings or regexps (with Grep)")))
1551     menu))
1552 \f
1553 ;; The "Help" menu items
1554
1555 (defvar menu-bar-describe-menu
1556   (let ((menu (make-sparse-keymap "Describe")))
1557
1558     (define-key menu [mule-diag]
1559       `(menu-item ,(purecopy "Show All of Mule Status") mule-diag
1560                   :visible (default-value 'enable-multibyte-characters)
1561                   :help ,(purecopy "Display multilingual environment settings")))
1562     (define-key menu [describe-coding-system-briefly]
1563       `(menu-item ,(purecopy "Describe Coding System (Briefly)")
1564                   describe-current-coding-system-briefly
1565                   :visible (default-value 'enable-multibyte-characters)))
1566     (define-key menu [describe-coding-system]
1567       `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system
1568                   :visible (default-value 'enable-multibyte-characters)))
1569     (define-key menu [describe-input-method]
1570       `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
1571                   :visible (default-value 'enable-multibyte-characters)
1572                   :help ,(purecopy "Keyboard layout for specific input method")))
1573     (define-key menu [describe-language-environment]
1574       `(menu-item ,(purecopy "Describe Language Environment")
1575                   ,describe-language-environment-map))
1576
1577     (define-key menu [separator-desc-mule]
1578       menu-bar-separator)
1579
1580     (define-key menu [list-keybindings]
1581       `(menu-item ,(purecopy "List Key Bindings") describe-bindings
1582                   :help ,(purecopy "Display all current key bindings (keyboard shortcuts)")))
1583     (define-key menu [describe-current-display-table]
1584       `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table
1585                   :help ,(purecopy "Describe the current display table")))
1586     (define-key menu [describe-package]
1587       `(menu-item ,(purecopy "Describe Package...") describe-package
1588                   :help ,(purecopy "Display documentation of a Lisp package")))
1589     (define-key menu [describe-face]
1590       `(menu-item ,(purecopy "Describe Face...") describe-face
1591                   :help ,(purecopy "Display the properties of a face")))
1592     (define-key menu [describe-variable]
1593       `(menu-item ,(purecopy "Describe Variable...") describe-variable
1594                   :help ,(purecopy "Display documentation of variable/option")))
1595     (define-key menu [describe-function]
1596       `(menu-item ,(purecopy "Describe Function...") describe-function
1597                   :help ,(purecopy "Display documentation of function/command")))
1598     (define-key menu [describe-key-1]
1599       `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key
1600                   ;; Users typically don't identify keys and menu items...
1601                   :help ,(purecopy "Display documentation of command bound to a \
1602 key, a click, or a menu-item")))
1603     (define-key menu [describe-mode]
1604       `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode
1605                   :help ,(purecopy "Describe this buffer's major and minor mode")))
1606     menu))
1607
1608 (defun menu-bar-read-lispref ()
1609   "Display the Emacs Lisp Reference manual in Info mode."
1610   (interactive)
1611   (info "elisp"))
1612
1613 (defun menu-bar-read-lispintro ()
1614   "Display the Introduction to Emacs Lisp Programming in Info mode."
1615   (interactive)
1616   (info "eintr"))
1617
1618 (defun search-emacs-glossary ()
1619   "Display the Glossary node of the Emacs manual in Info mode."
1620   (interactive)
1621   (info "(emacs)Glossary"))
1622
1623 (defun emacs-index-search (topic)
1624   "Look up TOPIC in the indices of the Emacs User Manual."
1625   (interactive "sSubject to look up: ")
1626   (info "emacs")
1627   (Info-index topic))
1628
1629 (defun elisp-index-search (topic)
1630   "Look up TOPIC in the indices of the Emacs Lisp Reference Manual."
1631   (interactive "sSubject to look up: ")
1632   (info "elisp")
1633   (Info-index topic))
1634
1635 (defvar menu-bar-search-documentation-menu
1636   (let ((menu (make-sparse-keymap "Search Documentation")))
1637
1638     (define-key menu [search-documentation-strings]
1639       `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation
1640                   :help
1641                   ,(purecopy "Find functions and variables whose doc strings match a regexp")))
1642     (define-key menu [find-any-object-by-name]
1643       `(menu-item ,(purecopy "Find Any Object by Name...") apropos
1644                   :help ,(purecopy "Find symbols of any kind whose names match a regexp")))
1645     (define-key menu [find-option-by-value]
1646       `(menu-item ,(purecopy "Find Options by Value...") apropos-value
1647                   :help ,(purecopy "Find variables whose values match a regexp")))
1648     (define-key menu [find-options-by-name]
1649       `(menu-item ,(purecopy "Find Options by Name...") apropos-variable
1650                   :help ,(purecopy "Find variables whose names match a regexp")))
1651     (define-key menu [find-commands-by-name]
1652       `(menu-item ,(purecopy "Find Commands by Name...") apropos-command
1653                   :help ,(purecopy "Find commands whose names match a regexp")))
1654     (define-key menu [sep1]
1655       menu-bar-separator)
1656     (define-key menu [lookup-command-in-manual]
1657       `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node
1658                   :help ,(purecopy "Display manual section that describes a command")))
1659     (define-key menu [lookup-key-in-manual]
1660       `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node
1661                   :help ,(purecopy "Display manual section that describes a key")))
1662     (define-key menu [lookup-subject-in-elisp-manual]
1663       `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search
1664                   :help ,(purecopy "Find description of a subject in Emacs Lisp manual")))
1665     (define-key menu [lookup-subject-in-emacs-manual]
1666       `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search
1667                   :help ,(purecopy "Find description of a subject in Emacs User manual")))
1668     (define-key menu [emacs-terminology]
1669       `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary
1670                   :help ,(purecopy "Display the Glossary section of the Emacs manual")))
1671     menu))
1672
1673 (defvar menu-bar-manuals-menu
1674   (let ((menu (make-sparse-keymap "More Manuals")))
1675
1676     (define-key menu [man]
1677       `(menu-item ,(purecopy "Read Man Page...") manual-entry
1678                   :help ,(purecopy "Man-page docs for external commands and libraries")))
1679     (define-key menu [sep2]
1680       menu-bar-separator)
1681     (define-key menu [order-emacs-manuals]
1682       `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals
1683                   :help ,(purecopy "How to order manuals from the Free Software Foundation")))
1684     (define-key menu [lookup-subject-in-all-manuals]
1685       `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos
1686                   :help ,(purecopy "Find description of a subject in all installed manuals")))
1687     (define-key menu [other-manuals]
1688       `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory
1689                   :help ,(purecopy "Read any of the installed manuals")))
1690     (define-key menu [emacs-lisp-reference]
1691       `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref
1692                   :help ,(purecopy "Read the Emacs Lisp Reference manual")))
1693     (define-key menu [emacs-lisp-intro]
1694       `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro
1695                   :help ,(purecopy "Read the Introduction to Emacs Lisp Programming")))
1696     menu))
1697
1698 (defun menu-bar-help-extra-packages ()
1699   "Display help about some additional packages available for Emacs."
1700   (interactive)
1701   (let (enable-local-variables)
1702     (view-file (expand-file-name "MORE.STUFF"
1703                                  data-directory))
1704     (goto-address-mode 1)))
1705
1706 (defun help-with-tutorial-spec-language ()
1707   "Use the Emacs tutorial, specifying which language you want."
1708   (interactive)
1709   (help-with-tutorial t))
1710
1711 (defvar menu-bar-help-menu
1712   (let ((menu (make-sparse-keymap "Help")))
1713     (define-key menu [about-gnu-project]
1714       `(menu-item ,(purecopy "About GNU") describe-gnu-project
1715                   :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux")))
1716     (define-key menu [about-emacs]
1717       `(menu-item ,(purecopy "About Emacs") about-emacs
1718                   :help ,(purecopy "Display version number, copyright info, and basic help")))
1719     (define-key menu [sep4]
1720       menu-bar-separator)
1721     (define-key menu [describe-no-warranty]
1722       `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty
1723                   :help ,(purecopy "Explain that Emacs has NO WARRANTY")))
1724     (define-key menu [describe-copying]
1725       `(menu-item ,(purecopy "Copying Conditions") describe-copying
1726                   :help ,(purecopy "Show the Emacs license (GPL)")))
1727     (define-key menu [getting-new-versions]
1728       `(menu-item ,(purecopy "Getting New Versions") describe-distribution
1729                   :help ,(purecopy "How to get the latest version of Emacs")))
1730     (define-key menu [sep2]
1731       menu-bar-separator)
1732     (define-key menu [external-packages]
1733       `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages
1734                   :help ,(purecopy "Lisp packages distributed separately for use in Emacs")))
1735     (define-key menu [find-emacs-packages]
1736       `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword
1737                   :help ,(purecopy "Find built-in packages and features by keyword")))
1738     (define-key menu [more-manuals]
1739       `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu))
1740     (define-key menu [emacs-manual]
1741       `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual
1742                   :help ,(purecopy "Full documentation of Emacs features")))
1743     (define-key menu [describe]
1744       `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu))
1745     (define-key menu [search-documentation]
1746       `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu))
1747     (define-key menu [sep1]
1748       menu-bar-separator)
1749     (define-key menu [emacs-psychotherapist]
1750       `(menu-item ,(purecopy "Emacs Psychotherapist") doctor
1751                   :help ,(purecopy "Our doctor will help you feel better")))
1752     (define-key menu [send-emacs-bug-report]
1753       `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug
1754                   :help ,(purecopy "Send e-mail to Emacs maintainers")))
1755     (define-key menu [emacs-known-problems]
1756       `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems
1757                   :help ,(purecopy "Read about known problems with Emacs")))
1758     (define-key menu [emacs-news]
1759       `(menu-item ,(purecopy "Emacs News") view-emacs-news
1760                   :help ,(purecopy "New features of this version")))
1761     (define-key menu [emacs-faq]
1762       `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ
1763                   :help ,(purecopy "Frequently asked (and answered) questions about Emacs")))
1764
1765     (define-key menu [emacs-tutorial-language-specific]
1766       `(menu-item ,(purecopy "Emacs Tutorial (choose language)...")
1767                   help-with-tutorial-spec-language
1768                   :help ,(purecopy "Learn how to use Emacs (choose a language)")))
1769     (define-key menu [emacs-tutorial]
1770       `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial
1771                   :help ,(purecopy "Learn how to use Emacs")))
1772
1773     ;; In OS X it's in the app menu already.
1774     ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu.
1775     (and (featurep 'ns)
1776          (not (eq system-type 'darwin))
1777          (define-key menu [info-panel]
1778            `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel)))
1779     menu))
1780
1781 (define-key global-map [menu-bar tools]
1782   (cons (purecopy "Tools") menu-bar-tools-menu))
1783 (define-key global-map [menu-bar buffer]
1784   (cons (purecopy "Buffers") global-buffers-menu-map))
1785 (define-key global-map [menu-bar options]
1786   (cons (purecopy "Options") menu-bar-options-menu))
1787 (define-key global-map [menu-bar edit]
1788   (cons (purecopy "Edit") menu-bar-edit-menu))
1789 (define-key global-map [menu-bar file]
1790   (cons (purecopy "File") menu-bar-file-menu))
1791
1792 ;; Put "Help" menu at the end, or Info at the front.
1793 ;; If running under GNUstep, "Help" is moved and renamed "Info" (see below).
1794 (if (and (featurep 'ns)
1795          (not (eq system-type 'darwin)))
1796     (define-key global-map [menu-bar help-menu]
1797       (cons (purecopy "Info") menu-bar-help-menu))
1798   (define-key-after global-map [menu-bar help-menu]
1799     (cons (purecopy "Help") menu-bar-help-menu)))
1800
1801 (defun menu-bar-menu-frame-live-and-visible-p ()
1802   "Return non-nil if the menu frame is alive and visible.
1803 The menu frame is the frame for which we are updating the menu."
1804   (let ((menu-frame (or menu-updating-frame (selected-frame))))
1805     (and (frame-live-p menu-frame)
1806          (frame-visible-p menu-frame))))
1807
1808 (defun menu-bar-non-minibuffer-window-p ()
1809   "Return non-nil if selected window of the menu frame is not a minibuf window.
1810
1811 See the documentation of `menu-bar-menu-frame-live-and-visible-p'
1812 for the definition of the menu frame."
1813   (let ((menu-frame (or menu-updating-frame (selected-frame))))
1814     (not (window-minibuffer-p (frame-selected-window menu-frame)))))
1815
1816 (defun kill-this-buffer ()      ; for the menu bar
1817   "Kill the current buffer.
1818 When called in the minibuffer, get out of the minibuffer
1819 using `abort-recursive-edit'."
1820   (interactive)
1821   (if (menu-bar-non-minibuffer-window-p)
1822       (kill-buffer (current-buffer))
1823     (abort-recursive-edit)))
1824
1825 (defun kill-this-buffer-enabled-p ()
1826   "Return non-nil if the `kill-this-buffer' menu item should be enabled."
1827   (or (not (menu-bar-non-minibuffer-window-p))
1828       (let (found-1)
1829         ;; Instead of looping over entire buffer list, stop once we've
1830         ;; found two "killable" buffers (Bug#8184).
1831         (catch 'found-2
1832           (dolist (buffer (buffer-list))
1833             (unless (string-match-p "^ " (buffer-name buffer))
1834               (if (not found-1)
1835                   (setq found-1 t)
1836                 (throw 'found-2 t))))))))
1837
1838 (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p))
1839
1840 ;; Permit deleting frame if it would leave a visible or iconified frame.
1841 (defun delete-frame-enabled-p ()
1842   "Return non-nil if `delete-frame' should be enabled in the menu bar."
1843   (let ((frames (frame-list))
1844         (count 0))
1845     (while frames
1846       (if (frame-visible-p (car frames))
1847           (setq count (1+ count)))
1848       (setq frames (cdr frames)))
1849     (> count 1)))
1850
1851 (defcustom yank-menu-length 20
1852   "Maximum length to display in the yank-menu."
1853   :type 'integer
1854   :group 'menu)
1855
1856 (defun menu-bar-update-yank-menu (string old)
1857   (let ((front (car (cdr yank-menu)))
1858         (menu-string (if (<= (length string) yank-menu-length)
1859                          string
1860                        (concat
1861                         (substring string 0 (/ yank-menu-length 2))
1862                         "..."
1863                         (substring string (- (/ yank-menu-length 2)))))))
1864     ;; Don't let the menu string be all dashes
1865     ;; because that has a special meaning in a menu.
1866     (if (string-match "\\`-+\\'" menu-string)
1867         (setq menu-string (concat menu-string " ")))
1868     ;; If we're supposed to be extending an existing string, and that
1869     ;; string really is at the front of the menu, then update it in place.
1870     (if (and old (or (eq old (car front))
1871                      (string= old (car front))))
1872         (progn
1873           (setcar front string)
1874           (setcar (cdr front) menu-string))
1875       (setcdr yank-menu
1876               (cons
1877                (cons string (cons menu-string 'menu-bar-select-yank))
1878                (cdr yank-menu)))))
1879   (if (> (length (cdr yank-menu)) kill-ring-max)
1880       (setcdr (nthcdr kill-ring-max yank-menu) nil)))
1881
1882 (put 'menu-bar-select-yank 'apropos-inhibit t)
1883 (defun menu-bar-select-yank ()
1884   "Insert the stretch of previously-killed text selected from menu.
1885 The menu shows all the killed text sequences stored in `kill-ring'."
1886   (interactive "*")
1887   (push-mark (point))
1888   (insert last-command-event))
1889
1890 \f
1891 ;;; Buffers Menu
1892
1893 (defcustom buffers-menu-max-size 10
1894   "Maximum number of entries which may appear on the Buffers menu.
1895 If this is 10, then only the ten most-recently-selected buffers are shown.
1896 If this is nil, then all buffers are shown.
1897 A large number or nil slows down menu responsiveness."
1898   :type '(choice integer
1899                  (const :tag "All" nil))
1900   :group 'menu)
1901
1902 (defcustom buffers-menu-buffer-name-length 30
1903   "Maximum length of the buffer name on the Buffers menu.
1904 If this is a number, then buffer names are truncated to this length.
1905 If this is nil, then buffer names are shown in full.
1906 A large number or nil makes the menu too wide."
1907   :type '(choice integer
1908                  (const :tag "Full length" nil))
1909   :group 'menu)
1910
1911 (defcustom buffers-menu-show-directories 'unless-uniquify
1912   "If non-nil, show directories in the Buffers menu for buffers that have them.
1913 The special value `unless-uniquify' means that directories will be shown
1914 unless `uniquify-buffer-name-style' is non-nil (in which case, buffer
1915 names should include enough of a buffer's directory to distinguish it
1916 from other buffers).
1917
1918 Setting this variable directly does not take effect until next time the
1919 Buffers menu is regenerated."
1920   :set (lambda (symbol value)
1921          (set symbol value)
1922          (menu-bar-update-buffers t))
1923   :initialize 'custom-initialize-default
1924   :type '(choice (const :tag "Never" nil)
1925                  (const :tag "Unless uniquify is enabled" unless-uniquify)
1926                  (const :tag "Always" t))
1927   :group 'menu)
1928
1929 (defcustom buffers-menu-show-status t
1930   "If non-nil, show modified/read-only status of buffers in the Buffers menu.
1931 Setting this variable directly does not take effect until next time the
1932 Buffers menu is regenerated."
1933   :set (lambda (symbol value)
1934          (set symbol value)
1935          (menu-bar-update-buffers t))
1936   :initialize 'custom-initialize-default
1937   :type 'boolean
1938   :group 'menu)
1939
1940 (defvar list-buffers-directory nil
1941   "String to display in buffer listings for buffers not visiting a file.")
1942 (make-variable-buffer-local 'list-buffers-directory)
1943
1944 (defun menu-bar-select-buffer ()
1945   (interactive)
1946   (switch-to-buffer last-command-event))
1947
1948 (defun menu-bar-select-frame (frame)
1949   (make-frame-visible frame)
1950   (raise-frame frame)
1951   (select-frame frame))
1952
1953 (defun menu-bar-update-buffers-1 (elt)
1954   (let* ((buf (car elt))
1955          (file
1956           (and (if (eq buffers-menu-show-directories 'unless-uniquify)
1957                    (or (not (boundp 'uniquify-buffer-name-style))
1958                        (null uniquify-buffer-name-style))
1959                  buffers-menu-show-directories)
1960                (or (buffer-file-name buf)
1961                    (buffer-local-value 'list-buffers-directory buf)))))
1962     (when file
1963       (setq file (file-name-directory file)))
1964     (when (and file (> (length file) 20))
1965       (setq file (concat "..." (substring file -17))))
1966     (cons (if buffers-menu-show-status
1967               (let ((mod (if (buffer-modified-p buf) "*" ""))
1968                     (ro (if (buffer-local-value 'buffer-read-only buf) "%" "")))
1969                 (if file
1970                     (format "%s  %s%s  --  %s" (cdr elt) mod ro file)
1971                   (format "%s  %s%s" (cdr elt) mod ro)))
1972             (if file
1973                 (format "%s  --  %s"  (cdr elt) file)
1974               (cdr elt)))
1975           buf)))
1976
1977 ;; Used to cache the menu entries for commands in the Buffers menu
1978 (defvar menu-bar-buffers-menu-command-entries nil)
1979
1980 (defvar menu-bar-select-buffer-function 'switch-to-buffer
1981   "Function to select the buffer chosen from the `Buffers' menu-bar menu.
1982 It must accept a buffer as its only required argument.")
1983
1984 (defun menu-bar-update-buffers (&optional force)
1985   ;; If user discards the Buffers item, play along.
1986   (and (lookup-key (current-global-map) [menu-bar buffer])
1987        (or force (frame-or-buffer-changed-p))
1988        (let ((buffers (buffer-list))
1989              (frames (frame-list))
1990              buffers-menu)
1991          ;; If requested, list only the N most recently selected buffers.
1992          (if (and (integerp buffers-menu-max-size)
1993                   (> buffers-menu-max-size 1))
1994              (if (> (length buffers) buffers-menu-max-size)
1995                  (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
1996
1997          ;; Make the menu of buffers proper.
1998          (setq buffers-menu
1999                (let (alist)
2000                  ;; Put into each element of buffer-list
2001                  ;; the name for actual display,
2002                  ;; perhaps truncated in the middle.
2003                  (dolist (buf buffers)
2004                    (let ((name (buffer-name buf)))
2005                      (unless (eq ?\s (aref name 0))
2006                        (push (menu-bar-update-buffers-1
2007                               (cons buf
2008                                     (if (and (integerp buffers-menu-buffer-name-length)
2009                                              (> (length name) buffers-menu-buffer-name-length))
2010                                         (concat
2011                                          (substring
2012                                           name 0 (/ buffers-menu-buffer-name-length 2))
2013                                          "..."
2014                                          (substring
2015                                           name (- (/ buffers-menu-buffer-name-length 2))))
2016                                       name)
2017                                     ))
2018                              alist))))
2019                  ;; Now make the actual list of items.
2020                  (let ((buffers-vec (make-vector (length alist) nil))
2021                        (i (length alist)))
2022                    (dolist (pair alist)
2023                      (setq i (1- i))
2024                      (aset buffers-vec i
2025                            (nconc (list (car pair)
2026                                         (cons nil nil))
2027                                   `(lambda ()
2028                                      (interactive)
2029                                      (funcall menu-bar-select-buffer-function ,(cdr pair))))))
2030                    (list buffers-vec))))
2031
2032          ;; Make a Frames menu if we have more than one frame.
2033          (when (cdr frames)
2034            (let* ((frames-vec (make-vector (length frames) nil))
2035                   (frames-menu
2036                    (cons 'keymap
2037                          (list "Select Frame" frames-vec)))
2038                   (i 0))
2039              (dolist (frame frames)
2040                (aset frames-vec i
2041                      (nconc
2042                       (list
2043                        (frame-parameter frame 'name)
2044                        (cons nil nil))
2045                       `(lambda ()
2046                          (interactive) (menu-bar-select-frame ,frame))))
2047                (setq i (1+ i)))
2048              ;; Put it after the normal buffers
2049              (setq buffers-menu
2050                    (nconc buffers-menu
2051                           `((frames-separator "--")
2052                             (frames menu-item "Frames" ,frames-menu))))))
2053
2054          ;; Add in some normal commands at the end of the menu.  We use
2055          ;; the copy cached in `menu-bar-buffers-menu-command-entries'
2056          ;; if it's been set already.  Note that we can't use constant
2057          ;; lists for the menu-entries, because the low-level menu-code
2058          ;; modifies them.
2059          (unless menu-bar-buffers-menu-command-entries
2060            (setq menu-bar-buffers-menu-command-entries
2061                  (list '(command-separator "--")
2062                        (list 'next-buffer
2063                              'menu-item
2064                              "Next Buffer"
2065                              'next-buffer
2066                              :help "Switch to the \"next\" buffer in a cyclic order")
2067                        (list 'previous-buffer
2068                              'menu-item
2069                              "Previous Buffer"
2070                              'previous-buffer
2071                              :help "Switch to the \"previous\" buffer in a cyclic order")
2072                        (list 'select-named-buffer
2073                              'menu-item
2074                              "Select Named Buffer..."
2075                              'switch-to-buffer
2076                              :help "Prompt for a buffer name, and select that buffer in the current window")
2077                        (list 'list-all-buffers
2078                              'menu-item
2079                              "List All Buffers"
2080                              'list-buffers
2081                              :help "Pop up a window listing all Emacs buffers"
2082                              ))))
2083          (setq buffers-menu
2084                (nconc buffers-menu menu-bar-buffers-menu-command-entries))
2085
2086          ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
2087          ;; but that did not do the right thing when the [menu-bar buffer]
2088          ;; entry above had been moved (e.g. to a parent keymap).
2089          (setcdr global-buffers-menu-map (cons "Select Buffer" buffers-menu)))))
2090
2091 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2092
2093 (menu-bar-update-buffers)
2094
2095 ;; this version is too slow
2096 ;;(defun format-buffers-menu-line (buffer)
2097 ;;  "Returns a string to represent the given buffer in the Buffer menu.
2098 ;;nil means the buffer shouldn't be listed.  You can redefine this."
2099 ;;  (if (string-match "\\` " (buffer-name buffer))
2100 ;;      nil
2101 ;;    (with-current-buffer buffer
2102 ;;     (let ((size (buffer-size)))
2103 ;;       (format "%s%s %-19s %6s %-15s %s"
2104 ;;             (if (buffer-modified-p) "*" " ")
2105 ;;             (if buffer-read-only "%" " ")
2106 ;;             (buffer-name)
2107 ;;             size
2108 ;;             mode-name
2109 ;;             (or (buffer-file-name) ""))))))
2110 \f
2111 ;;; Set up a menu bar menu for the minibuffer.
2112
2113 (dolist (map (list minibuffer-local-map
2114                    ;; This shouldn't be necessary, but there's a funny
2115                    ;; bug in keymap.c that I don't understand yet.  -stef
2116                    minibuffer-local-completion-map))
2117   (define-key map [menu-bar minibuf]
2118     (cons (purecopy "Minibuf") (make-sparse-keymap "Minibuf"))))
2119
2120 (let ((map minibuffer-local-completion-map))
2121   (define-key map [menu-bar minibuf ?\?]
2122     `(menu-item ,(purecopy "List Completions") minibuffer-completion-help
2123                 :help ,(purecopy "Display all possible completions")))
2124   (define-key map [menu-bar minibuf space]
2125     `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word
2126                 :help ,(purecopy "Complete at most one word")))
2127   (define-key map [menu-bar minibuf tab]
2128     `(menu-item ,(purecopy "Complete") minibuffer-complete
2129                 :help ,(purecopy "Complete as far as possible"))))
2130
2131 (let ((map minibuffer-local-map))
2132   (define-key map [menu-bar minibuf quit]
2133     `(menu-item ,(purecopy "Quit") abort-recursive-edit
2134                 :help ,(purecopy "Abort input and exit minibuffer")))
2135   (define-key map [menu-bar minibuf return]
2136     `(menu-item ,(purecopy "Enter") exit-minibuffer
2137                 :key-sequence ,(purecopy "\r")
2138                 :help ,(purecopy "Terminate input and exit minibuffer")))
2139   (define-key map [menu-bar minibuf isearch-forward]
2140     `(menu-item ,(purecopy "Isearch History Forward") isearch-forward
2141                 :help ,(purecopy "Incrementally search minibuffer history forward")))
2142   (define-key map [menu-bar minibuf isearch-backward]
2143     `(menu-item ,(purecopy "Isearch History Backward") isearch-backward
2144                 :help ,(purecopy "Incrementally search minibuffer history backward")))
2145   (define-key map [menu-bar minibuf next]
2146     `(menu-item ,(purecopy "Next History Item") next-history-element
2147                 :help ,(purecopy "Put next minibuffer history element in the minibuffer")))
2148   (define-key map [menu-bar minibuf previous]
2149     `(menu-item ,(purecopy "Previous History Item") previous-history-element
2150                 :help ,(purecopy "Put previous minibuffer history element in the minibuffer"))))
2151 \f
2152 (define-minor-mode menu-bar-mode
2153   "Toggle display of a menu bar on each frame.
2154 This command applies to all frames that exist and frames to be
2155 created in the future.
2156 With a numeric argument, if the argument is positive,
2157 turn on menu bars; otherwise, turn off menu bars."
2158   :init-value t
2159   :global t
2160   ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
2161   :variable menu-bar-mode
2162
2163   ;; Turn the menu-bars on all frames on or off.
2164   (let ((val (if menu-bar-mode 1 0)))
2165     (dolist (frame (frame-list))
2166       (set-frame-parameter frame 'menu-bar-lines val))
2167     ;; If the user has given `default-frame-alist' a `menu-bar-lines'
2168     ;; parameter, replace it.
2169     (if (assq 'menu-bar-lines default-frame-alist)
2170         (setq default-frame-alist
2171               (cons (cons 'menu-bar-lines val)
2172                     (assq-delete-all 'menu-bar-lines
2173                                      default-frame-alist)))))
2174   ;; Make the message appear when Emacs is idle.  We can not call message
2175   ;; directly.  The minor-mode message "Menu-bar mode disabled" comes
2176   ;; after this function returns, overwriting any message we do here.
2177   (when (and (called-interactively-p 'interactive) (not menu-bar-mode))
2178     (run-with-idle-timer 0 nil 'message
2179                          "Menu-bar mode disabled.  Use M-x menu-bar-mode to make the menu bar appear.")))
2180
2181 ;;;###autoload
2182 ;; (This does not work right unless it comes after the above definition.)
2183 ;; This comment is taken from tool-bar.el near
2184 ;; (put 'tool-bar-mode ...)
2185 ;; We want to pretend the menu bar by standard is on, as this will make
2186 ;; customize consider disabling the menu bar a customization, and save
2187 ;; that.  We could do this for real by setting :init-value above, but
2188 ;; that would overwrite disabling the menu bar from X resources.
2189 (put 'menu-bar-mode 'standard-value '(t))
2190
2191 (defun toggle-menu-bar-mode-from-frame (&optional arg)
2192   "Toggle menu bar on or off, based on the status of the current frame.
2193 See `menu-bar-mode' for more information."
2194   (interactive (list (or current-prefix-arg 'toggle)))
2195   (if (eq arg 'toggle)
2196       (menu-bar-mode
2197        (if (menu-bar-positive-p
2198             (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines))
2199             0 1))
2200     (menu-bar-mode arg)))
2201
2202 (declare-function x-menu-bar-open "term/x-win" (&optional frame))
2203 (declare-function w32-menu-bar-open "term/w32-win" (&optional frame))
2204
2205 (defun menu-bar-open (&optional frame)
2206   "Start key navigation of the menu bar in FRAME.
2207
2208 This function decides which method to use to access the menu
2209 depending on FRAME's terminal device.  On X displays, it calls
2210 `x-menu-bar-open'; on Windows, `w32-menu-bar-open' otherwise it
2211 calls `tmm-menubar'.
2212
2213 If FRAME is nil or not given, use the selected frame."
2214   (interactive)
2215   (let ((type (framep (or frame (selected-frame)))))
2216     (cond
2217      ((eq type 'x) (x-menu-bar-open frame))
2218      ((eq type 'w32) (w32-menu-bar-open frame))
2219      (t (with-selected-frame (or frame (selected-frame))
2220           (tmm-menubar))))))
2221
2222 (global-set-key [f10] 'menu-bar-open)
2223
2224 (provide 'menu-bar)
2225
2226 ;;; menu-bar.el ends here