X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8678d9e413593b0abab296551a20589745c459da..ef62b23df5a7007c3d8c74dbca87ba83e9da682e:/lisp/menu-bar.el diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 8a33381b61..ec6a4621a4 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1,6 +1,6 @@ ;;; menu-bar.el --- define a default menu bar -;; Copyright (C) 1993-1995, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 2000-2012 Free Software Foundation, Inc. ;; Author: RMS ;; Maintainer: FSF @@ -92,37 +92,45 @@ :visible (fboundp 'make-frame-command) :help ,(purecopy "Open a new frame"))) + (define-key menu [separator-frame] + menu-bar-separator) + (define-key menu [one-window] - `(menu-item ,(purecopy "Remove Splits") delete-other-windows + `(menu-item ,(purecopy "Remove Other Windows") delete-other-windows :enable (not (one-window-p t nil)) - :help ,(purecopy - "Selected window grows to fill the whole frame"))) + :help ,(purecopy "Make selected window fill whole frame"))) + + (define-key menu [new-window-on-right] + `(menu-item ,(purecopy "New Window on Right") split-window-right + :enable (and (menu-bar-menu-frame-live-and-visible-p) + (menu-bar-non-minibuffer-window-p)) + :help ,(purecopy "Make new window on right of selected one"))) - (define-key menu [split-window] - `(menu-item ,(purecopy "Split Window") split-window-vertically + (define-key menu [new-window-below] + `(menu-item ,(purecopy "New Window Below") split-window-below :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Split selected window in two windows"))) + :help ,(purecopy "Make new window below selected one"))) (define-key menu [separator-window] menu-bar-separator) (define-key menu [ps-print-region] - `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region + `(menu-item ,(purecopy "PostScript Print Region (B+W)") ps-print-region :enable mark-active :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer"))) (define-key menu [ps-print-buffer] - `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer + `(menu-item ,(purecopy "PostScript Print Buffer (B+W)") ps-print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer"))) (define-key menu [ps-print-region-faces] - `(menu-item ,(purecopy "Postscript Print Region") + `(menu-item ,(purecopy "PostScript Print Region") ps-print-region-with-faces :enable mark-active :help ,(purecopy "Pretty-print marked region to PostScript printer"))) (define-key menu [ps-print-buffer-faces] - `(menu-item ,(purecopy "Postscript Print Buffer") + `(menu-item ,(purecopy "PostScript Print Buffer") ps-print-buffer-with-faces :enable (menu-bar-menu-frame-live-and-visible-p) :help ,(purecopy "Pretty-print current buffer to PostScript printer"))) @@ -433,11 +441,11 @@ (defvar menu-bar-edit-menu (let ((menu (make-sparse-keymap "Edit"))) - + (define-key menu [props] `(menu-item ,(purecopy "Text Properties") facemenu-menu)) - ;; ns-win.el said: Add spell for platorm consistency. + ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) (define-key menu [spell] `(menu-item ,(purecopy "Spell") ispell-menu-map))) @@ -675,29 +683,10 @@ by \"Save Options\" in Custom buffers.") (defun menu-set-font () "Interactively select a font and make it the default." (interactive) - (let ((font (if (fboundp 'x-select-font) - (x-select-font) - (mouse-select-font))) - spec) - (when font - ;; Be careful here: when set-face-attribute is called for the - ;; :font attribute, Emacs tries to guess the best matching font - ;; by examining the other face attributes (Bug#2476). - (set-face-attribute 'default (selected-frame) - :width 'normal - :weight 'normal - :slant 'normal - :font font) - (let ((font-object (face-attribute 'default :font))) - (dolist (f (frame-list)) - (and (not (eq f (selected-frame))) - (display-graphic-p f) - (set-face-attribute 'default f :font font-object))) - (set-face-attribute 'default t :font font-object)) - (setq spec (list (list t (face-attr-construct 'default)))) - (put 'default 'customized-face spec) - (custom-push-theme 'theme-face 'default 'user 'set spec) - (put 'default 'face-modified nil)))) + (set-frame-font (if (fboundp 'x-select-font) + (x-select-font) + (mouse-select-font)) + nil t)) (defun menu-bar-options-save () "Save current values of Options menu items using Custom." @@ -985,7 +974,7 @@ by \"Save Options\" in Custom buffers.") (let ((menu (make-sparse-keymap "Tool-bar"))) (define-key menu [showhide-tool-bar-left] - `(menu-item ,(purecopy "On the left") + `(menu-item ,(purecopy "On the Left") menu-bar-showhide-tool-bar-menu-customize-enable-left :help ,(purecopy "Tool-bar at the left side") :visible (display-graphic-p) @@ -997,7 +986,7 @@ by \"Save Options\" in Custom buffers.") 'left))))) (define-key menu [showhide-tool-bar-right] - `(menu-item ,(purecopy "On the right") + `(menu-item ,(purecopy "On the Right") menu-bar-showhide-tool-bar-menu-customize-enable-right :help ,(purecopy "Tool-bar at the right side") :visible (display-graphic-p) @@ -1009,7 +998,7 @@ by \"Save Options\" in Custom buffers.") 'right))))) (define-key menu [showhide-tool-bar-bottom] - `(menu-item ,(purecopy "On the bottom") + `(menu-item ,(purecopy "On the Bottom") menu-bar-showhide-tool-bar-menu-customize-enable-bottom :help ,(purecopy "Tool-bar at the bottom") :visible (display-graphic-p) @@ -1021,7 +1010,7 @@ by \"Save Options\" in Custom buffers.") 'bottom))))) (define-key menu [showhide-tool-bar-top] - `(menu-item ,(purecopy "On the top") + `(menu-item ,(purecopy "On the Top") menu-bar-showhide-tool-bar-menu-customize-enable-top :help ,(purecopy "Tool-bar at the top") :visible (display-graphic-p) @@ -1135,17 +1124,18 @@ mail status in mode line")) (let ((menu (make-sparse-keymap "Line Wrapping"))) (define-key menu [word-wrap] - `(menu-item ,(purecopy "Word Wrap (Visual Line mode)") - (lambda () - (interactive) - (unless visual-line-mode - (visual-line-mode 1)) - (message ,(purecopy "Visual-Line mode enabled"))) - :help ,(purecopy "Wrap long lines at word boundaries") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - word-wrap)) - :visible (menu-bar-menu-frame-live-and-visible-p))) + `(menu-item + ,(purecopy "Word Wrap (Visual Line mode)") + (lambda () + (interactive) + (unless visual-line-mode + (visual-line-mode 1)) + (message ,(purecopy "Visual-Line mode enabled"))) + :help ,(purecopy "Wrap long lines at word boundaries") + :button (:radio . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + word-wrap)) + :visible (menu-bar-menu-frame-live-and-visible-p))) (define-key menu [truncate] `(menu-item ,(purecopy "Truncate Long Lines") @@ -1199,7 +1189,7 @@ mail status in mode line")) (define-key menu [menu-system-font] (menu-bar-make-toggle toggle-use-system-font font-use-system-font - "Use system font" + "Use System Font" "Use system font: %s" "Use the monospaced font defined by the system"))) @@ -1238,78 +1228,88 @@ mail status in mode line")) menu-bar-separator) (define-key menu [blink-cursor-mode] - (menu-bar-make-mm-toggle blink-cursor-mode - "Blinking Cursor" - "Whether the cursor blinks (Blink Cursor mode)")) + (menu-bar-make-mm-toggle + blink-cursor-mode + "Blink Cursor" + "Whether the cursor blinks (Blink Cursor mode)")) (define-key menu [cursor-separator] menu-bar-separator) (define-key menu [save-place] - (menu-bar-make-toggle toggle-save-place-globally save-place - "Save Place in Files between Sessions" - "Saving place in files %s" - "Visit files of previous session when restarting Emacs" - (require 'saveplace) - ;; Do it by name, to avoid a free-variable - ;; warning during byte compilation. - (set-default - 'save-place (not (symbol-value 'save-place))))) + (menu-bar-make-toggle + toggle-save-place-globally save-place + "Save Place in Files between Sessions" + "Saving place in files %s" + "Visit files of previous session when restarting Emacs" + (require 'saveplace) + ;; Do it by name, to avoid a free-variable + ;; warning during byte compilation. + (set-default + 'save-place (not (symbol-value 'save-place))))) (define-key menu [uniquify] - (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style - "Use Directory Names in Buffer Names" - "Directory name in buffer names (uniquify) %s" - "Uniquify buffer names by adding parent directory names" - (require 'uniquify) - (setq uniquify-buffer-name-style - (if (not uniquify-buffer-name-style) - 'forward)))) + (menu-bar-make-toggle + toggle-uniquify-buffer-names uniquify-buffer-name-style + "Use Directory Names in Buffer Names" + "Directory name in buffer names (uniquify) %s" + "Uniquify buffer names by adding parent directory names" + (require 'uniquify) + (setq uniquify-buffer-name-style + (if (not uniquify-buffer-name-style) + 'forward)))) (define-key menu [edit-options-separator] menu-bar-separator) (define-key menu [cua-mode] - (menu-bar-make-mm-toggle cua-mode - "C-x/C-c/C-v Cut and Paste (CUA)" - "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste" - (:visible (or (not (boundp 'cua-enable-cua-keys)) - cua-enable-cua-keys)))) + (menu-bar-make-mm-toggle + cua-mode + "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)" + "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste" + (:visible (or (not (boundp 'cua-enable-cua-keys)) + cua-enable-cua-keys)))) (define-key menu [cua-emulation-mode] - (menu-bar-make-mm-toggle cua-mode - "Shift movement mark region (CUA)" - "Use shifted movement keys to set and extend the region" - (:visible (and (boundp 'cua-enable-cua-keys) - (not cua-enable-cua-keys))))) + (menu-bar-make-mm-toggle + cua-mode + "Shift movement mark region (CUA)" + "Use shifted movement keys to set and extend the region" + (:visible (and (boundp 'cua-enable-cua-keys) + (not cua-enable-cua-keys))))) (define-key menu [case-fold-search] - (menu-bar-make-toggle toggle-case-fold-search case-fold-search - "Case-Insensitive Search" - "Case-Insensitive Search %s" - "Ignore letter-case in search commands")) + (menu-bar-make-toggle + toggle-case-fold-search case-fold-search + "Ignore Case for Search" + "Case-Insensitive Search %s" + "Ignore letter-case in search commands")) (define-key menu [auto-fill-mode] - `(menu-item ,(purecopy "Auto Fill in Text Modes") - menu-bar-text-mode-auto-fill - :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") - :button (:toggle . (if (listp text-mode-hook) - (member 'turn-on-auto-fill text-mode-hook) - (eq 'turn-on-auto-fill text-mode-hook))))) + `(menu-item + ,(purecopy "Auto Fill in Text Modes") + menu-bar-text-mode-auto-fill + :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") + :button (:toggle . (if (listp text-mode-hook) + (member 'turn-on-auto-fill text-mode-hook) + (eq 'turn-on-auto-fill text-mode-hook))))) (define-key menu [line-wrapping] - `(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu)) + `(menu-item ,(purecopy "Line Wrapping in This Buffer") + ,menu-bar-line-wrapping-menu)) (define-key menu [highlight-separator] menu-bar-separator) (define-key menu [highlight-paren-mode] - (menu-bar-make-mm-toggle show-paren-mode - "Paren Match Highlighting" - "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) + (menu-bar-make-mm-toggle + show-paren-mode + "Highlight Matching Parentheses" + "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) (define-key menu [transient-mark-mode] - (menu-bar-make-mm-toggle transient-mark-mode - "Active Region Highlighting" - "Make text in active region stand out in color (Transient Mark mode)" - (:enable (not cua-mode)))) + (menu-bar-make-mm-toggle + transient-mark-mode + "Highlight Active Region" + "Make text in active region stand out in color (Transient Mark mode)" + (:enable (not cua-mode)))) menu)) @@ -1634,7 +1634,7 @@ key, a click, or a menu-item"))) (defvar menu-bar-search-documentation-menu (let ((menu (make-sparse-keymap "Search Documentation"))) - + (define-key menu [search-documentation-strings] `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation :help @@ -1752,6 +1752,9 @@ key, a click, or a menu-item"))) (define-key menu [send-emacs-bug-report] `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug :help ,(purecopy "Send e-mail to Emacs maintainers"))) + (define-key menu [emacs-manual-bug] + `(menu-item ,(purecopy "How to Report a Bug") info-emacs-bug + :help ,(purecopy "Read about how to report an Emacs bug"))) (define-key menu [emacs-known-problems] `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems :help ,(purecopy "Read about known problems with Emacs"))) @@ -1823,14 +1826,17 @@ using `abort-recursive-edit'." (abort-recursive-edit))) (defun kill-this-buffer-enabled-p () - (let ((count 0) - (buffers (buffer-list))) - (while buffers - (or (string-match "^ " (buffer-name (car buffers))) - (setq count (1+ count))) - (setq buffers (cdr buffers))) - (or (not (menu-bar-non-minibuffer-window-p)) - (> count 1)))) + "Return non-nil if the `kill-this-buffer' menu item should be enabled." + (or (not (menu-bar-non-minibuffer-window-p)) + (let (found-1) + ;; Instead of looping over entire buffer list, stop once we've + ;; found two "killable" buffers (Bug#8184). + (catch 'found-2 + (dolist (buffer (buffer-list)) + (unless (string-match-p "^ " (buffer-name buffer)) + (if (not found-1) + (setq found-1 t) + (throw 'found-2 t)))))))) (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p)) @@ -1974,6 +1980,10 @@ Buffers menu is regenerated." ;; Used to cache the menu entries for commands in the Buffers menu (defvar menu-bar-buffers-menu-command-entries nil) +(defvar menu-bar-select-buffer-function 'switch-to-buffer + "Function to select the buffer chosen from the `Buffers' menu-bar menu. +It must accept a buffer as its only required argument.") + (defun menu-bar-update-buffers (&optional force) ;; If user discards the Buffers item, play along. (and (lookup-key (current-global-map) [menu-bar buffer]) @@ -2019,7 +2029,7 @@ Buffers menu is regenerated." (cons nil nil)) `(lambda () (interactive) - (switch-to-buffer ,(cdr pair)))))) + (funcall menu-bar-select-buffer-function ,(cdr pair)))))) (list buffers-vec)))) ;; Make a Frames menu if we have more than one frame. @@ -2143,11 +2153,13 @@ Buffers menu is regenerated." :help ,(purecopy "Put previous minibuffer history element in the minibuffer")))) (define-minor-mode menu-bar-mode - "Toggle display of a menu bar on each frame. + "Toggle display of a menu bar on each frame (Menu Bar mode). +With a prefix argument ARG, enable Menu Bar mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +Menu Bar mode if ARG is omitted or nil. + This command applies to all frames that exist and frames to be -created in the future. -With a numeric argument, if the argument is positive, -turn on menu bars; otherwise, turn off menu bars." +created in the future." :init-value t :global t ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.