]> code.delx.au - gnu-emacs/blobdiff - lisp/menu-bar.el
(Default Coding Systems): Document find-auto-coding, set-auto-coding, and
[gnu-emacs] / lisp / menu-bar.el
index 6d9e4608186707ee5b5d8dbb5f97b9e3efc1b6b5..24fd88e6819b1e65161e4b7a03f8331dd1faaa59 100644 (file)
@@ -1,7 +1,7 @@
 ;;; menu-bar.el --- define a default menu bar
 
 ;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Author: RMS
 ;; Maintainer: FSF
@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; Avishai Yacobi suggested some menu rearrangements.
 
 
 ;;; Code:
 
-;;; User options:
-
-(defcustom buffers-menu-max-size 10
-  "*Maximum number of entries which may appear on the Buffers menu.
-If this is 10, then only the ten most-recently-selected buffers are shown.
-If this is nil, then all buffers are shown.
-A large number or nil slows down menu responsiveness."
-  :type '(choice integer
-                (const :tag "All" nil))
-  :group 'mouse)
-
 ;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
 ;; definitions made in loaddefs.el.
 (or (lookup-key global-map [menu-bar])
@@ -77,7 +64,7 @@ A large number or nil slows down menu responsiveness."
 \f
 ;; The "File" menu items
 (define-key menu-bar-file-menu [exit-emacs]
-  '(menu-item "Exit Emacs" save-buffers-kill-emacs
+  '(menu-item "Quit" save-buffers-kill-terminal
              :help "Save unsaved buffers, then exit"))
 
 (define-key menu-bar-file-menu [separator-exit]
@@ -453,7 +440,7 @@ A large number or nil slows down menu responsiveness."
 
 (define-key menu-bar-edit-menu [mark-whole-buffer]
   '(menu-item "Select All" mark-whole-buffer
-             :help "Mark the whole buffer for a subsequent cut/copy."))
+             :help "Mark the whole buffer for a subsequent cut/copy"))
 (define-key menu-bar-edit-menu [clear]
   '(menu-item "Clear" delete-region
              :enable (and mark-active
@@ -464,16 +451,18 @@ A large number or nil slows down menu responsiveness."
 (defvar yank-menu (cons "Select Yank" nil))
 (fset 'yank-menu (cons 'keymap yank-menu))
 (define-key menu-bar-edit-menu [paste-from-menu]
-  '(menu-item "Paste from kill menu" yank-menu
+  '(menu-item "Paste from Kill Menu" yank-menu
              :enable (and (cdr yank-menu) (not buffer-read-only))
              :help "Choose a string from the kill ring and paste it"))
 (define-key menu-bar-edit-menu [paste]
   '(menu-item "Paste" yank
-             :enable (and
-                      ;; Emacs compiled --without-x doesn't have
-                      ;; x-selection-exists-p.
-                      (fboundp 'x-selection-exists-p)
-                      (x-selection-exists-p) (not buffer-read-only))
+             :enable (and (or
+                           ;; Emacs compiled --without-x doesn't have
+                           ;; x-selection-exists-p.
+                           (and (fboundp 'x-selection-exists-p)
+                                (x-selection-exists-p))
+                           kill-ring)
+                          (not buffer-read-only))
              :help "Paste (yank) text most recently cut/copied"))
 (define-key menu-bar-edit-menu [copy]
   '(menu-item "Copy" menu-bar-kill-ring-save
@@ -508,10 +497,10 @@ A large number or nil slows down menu responsiveness."
      '(and mark-active (not buffer-read-only)))
 (put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
 (put 'clipboard-yank 'menu-enable
-     '(and (or (and (fboundp 'x-selection-exists-p)
-                   (x-selection-exists-p))
+     '(and (or (not (fboundp 'x-selection-exists-p))
+              (x-selection-exists-p)
               (x-selection-exists-p 'CLIPBOARD))
-          (not buffer-read-only)))
+          (not buffer-read-only)))
 
 (defun clipboard-yank ()
   "Insert the clipboard contents, or the last stretch of killed text."
@@ -640,6 +629,35 @@ by \"Save Options\" in Custom buffers.")
                  :button (:toggle . (and (default-boundp ',variable)
                                         (default-value ',variable))))))
 
+;; Function for setting/saving default font.
+
+(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))))
+
 ;;; Assemble all the top-level items of the "Options" menu
 (define-key menu-bar-options-menu [customize]
   (list 'menu-item "Customize Emacs" menu-bar-custom-menu))
@@ -673,6 +691,10 @@ by \"Save Options\" in Custom buffers.")
       (and (get elt 'customized-value)
           (customize-mark-to-save elt)
           (setq need-save t)))
+    (when (get 'default 'customized-face)
+      (put 'default 'saved-face (get 'default 'customized-face))
+      (put 'default 'customized-face nil)
+      (setq need-save t))
     ;; Save if we changed anything.
     (when need-save
       (custom-save-all))))
@@ -684,10 +706,10 @@ by \"Save Options\" in Custom buffers.")
 (define-key menu-bar-options-menu [custom-separator]
   '("--"))
 
-(define-key menu-bar-options-menu [mouse-set-font]
-  '(menu-item "Set Font/Fontset..." mouse-set-font
-              :visible (display-multi-font-p)
-              :help "Select a font from list of known fonts/fontsets"))
+(define-key menu-bar-options-menu [menu-set-font]
+  '(menu-item "Set Default Font..." menu-set-font
+             :visible (display-multi-font-p)
+             :help "Select a default font"))
 
 ;; The "Show/Hide" submenu of menu "Options"
 
@@ -748,7 +770,11 @@ mail status in mode line"))
   '(menu-item "Other (Customize)"
              menu-bar-showhide-fringe-ind-customize
              :help "Additional choices available through Custom buffer"
-             :visible (display-graphic-p)))
+             :visible (display-graphic-p)
+             :button (:radio . (not (member indicate-buffer-boundaries
+                                            '(nil left right
+                                              ((top . left) (bottom . right))
+                                              ((t . right) (top . left))))))))
 
 (defun menu-bar-showhide-fringe-ind-mixed ()
   "Display top and bottom indicators in opposite fringes, arrows in right."
@@ -761,8 +787,8 @@ mail status in mode line"))
              :help
              "Show top/bottom indicators in opposite fringes, arrows in right"
              :visible (display-graphic-p)
-             :button (:radio . (eq indicate-buffer-boundaries
-                                   '((t . right) (top . left))))))
+             :button (:radio . (equal indicate-buffer-boundaries
+                                      '((t . right) (top . left))))))
 
 (defun menu-bar-showhide-fringe-ind-box ()
   "Display top and bottom indicators in opposite fringes."
@@ -774,8 +800,8 @@ mail status in mode line"))
   '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box
              :help "Show top/bottom indicators in opposite fringes, no arrows"
              :visible (display-graphic-p)
-             :button (:radio . (eq indicate-buffer-boundaries
-                                   '((top . left) (bottom . right))))))
+             :button (:radio . (equal indicate-buffer-boundaries
+                                      '((top . left) (bottom . right))))))
 
 (defun menu-bar-showhide-fringe-ind-right ()
   "Display buffer boundaries and arrows in the right fringe."
@@ -939,7 +965,7 @@ mail status in mode line"))
 
 (define-key menu-bar-showhide-menu [showhide-tool-bar]
   (list 'menu-item "Tool-bar" 'toggle-tool-bar-mode-from-frame
-       :help "Toggle tool-bar on/off"
+       :help "Turn tool-bar on/off"
        :visible `(display-graphic-p)
        :button `(:toggle . (> (frame-parameter nil 'tool-bar-lines) 0))))
 
@@ -1025,7 +1051,7 @@ mail status in mode line"))
   (menu-bar-make-toggle toggle-case-fold-search case-fold-search
            "Case-Insensitive Search"
            "Case-Insensitive Search %s"
-           "Globally ignore letter-case in search"))
+           "Ignore letter-case in search commands"))
 
 (defun menu-bar-text-mode-auto-fill ()
   (interactive)
@@ -1036,18 +1062,58 @@ mail status in mode line"))
   (customize-mark-as-set 'text-mode-hook))
 
 (define-key menu-bar-options-menu [auto-fill-mode]
-  '(menu-item "Word Wrap in Text Modes"
+  '(menu-item "Auto Fill in Text Modes"
               menu-bar-text-mode-auto-fill
-             :help "Automatically fill text between left and right margins (Auto Fill)"
+             :help "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-bar-options-menu [truncate-lines]
-  '(menu-item "Truncate Long Lines in this Buffer"
-             toggle-truncate-lines
-             :help "Truncate long lines on the screen"
-             :button (:toggle . truncate-lines)
-             :enable (menu-bar-menu-frame-live-and-visible-p)))
+
+
+(defvar menu-bar-line-wrapping-menu (make-sparse-keymap "Line Wrapping"))
+
+(define-key menu-bar-line-wrapping-menu [word-wrap]
+  '(menu-item "Word Wrap (Visual Line mode)"
+             (lambda ()
+               (interactive)
+               (unless visual-line-mode
+                 (visual-line-mode 1))
+               (message "Visual-Line mode enabled"))
+             :help "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-bar-line-wrapping-menu [truncate]
+  '(menu-item "Truncate Long Lines"
+             (lambda ()
+               (interactive)
+               (if visual-line-mode (visual-line-mode 0))
+               (setq word-wrap nil)
+               (toggle-truncate-lines 1))
+             :help "Truncate long lines at window edge"
+             :button (:radio . (or truncate-lines
+                                   (truncated-partial-width-window-p)))
+             :visible (menu-bar-menu-frame-live-and-visible-p)
+             :enable (not (truncated-partial-width-window-p))))
+
+(define-key menu-bar-line-wrapping-menu [window-wrap]
+  '(menu-item "Wrap at Window Edge"
+             (lambda () (interactive)
+               (if visual-line-mode (visual-line-mode 0))
+               (setq word-wrap nil)
+               (if truncate-lines (toggle-truncate-lines -1)))
+             :help "Wrap long lines at window edge"
+             :button (:radio . (and (null truncate-lines)
+                                    (not (truncated-partial-width-window-p))
+                                    (not word-wrap)))
+             :visible (menu-bar-menu-frame-live-and-visible-p)
+             :enable (not (truncated-partial-width-window-p))))
+
+(define-key menu-bar-options-menu [line-wrapping]
+  (list 'menu-item "Line Wrapping in this Buffer" menu-bar-line-wrapping-menu))
+
 
 (define-key menu-bar-options-menu [highlight-separator]
   '("--"))
@@ -1132,6 +1198,73 @@ mail status in mode line"))
   '(menu-item "5x5" 5x5
              :help "Fill in all the squares on a 5x5 board"))
 
+(defvar menu-bar-encryption-decryption-menu
+  (make-sparse-keymap "Encryption/Decryption"))
+
+(define-key menu-bar-tools-menu [encryption-decryption]
+  (list 'menu-item "Encryption/Decryption" menu-bar-encryption-decryption-menu))
+
+(define-key menu-bar-tools-menu [separator-encryption-decryption]
+  '("--"))
+
+(define-key menu-bar-encryption-decryption-menu [insert-keys]
+  '(menu-item "Insert Keys" epa-insert-keys
+             :help "Insert public keys after the current point"))
+
+(define-key menu-bar-encryption-decryption-menu [export-keys]
+  '(menu-item "Export Keys" epa-export-keys
+             :help "Export public keys to a file"))
+
+(define-key menu-bar-encryption-decryption-menu [import-keys-region]
+  '(menu-item "Import Keys from Region" epa-import-keys-region
+             :help "Import public keys from the current region"))
+
+(define-key menu-bar-encryption-decryption-menu [import-keys]
+  '(menu-item "Import Keys from File..." epa-import-keys
+             :help "Import public keys from a file"))
+
+(define-key menu-bar-encryption-decryption-menu [list-keys]
+  '(menu-item "List Keys" epa-list-keys
+             :help "Browse your public keyring"))
+
+(define-key menu-bar-encryption-decryption-menu [separator-keys]
+  '("--"))
+
+(define-key menu-bar-encryption-decryption-menu [sign-region]
+  '(menu-item "Sign Region" epa-sign-region
+             :help "Create digital signature of the current region"))
+
+(define-key menu-bar-encryption-decryption-menu [verify-region]
+  '(menu-item "Verify Region" epa-verify-region
+             :help "Verify digital signature of the current region"))
+
+(define-key menu-bar-encryption-decryption-menu [encrypt-region]
+  '(menu-item "Encrypt Region" epa-encrypt-region
+             :help "Encrypt the current region"))
+
+(define-key menu-bar-encryption-decryption-menu [decrypt-region]
+  '(menu-item "Decrypt Region" epa-decrypt-region
+             :help "Decrypt the current region"))
+
+(define-key menu-bar-encryption-decryption-menu [separator-file]
+  '("--"))
+
+(define-key menu-bar-encryption-decryption-menu [sign-file]
+  '(menu-item "Sign File..." epa-sign-file
+             :help "Create digital signature of a file"))
+
+(define-key menu-bar-encryption-decryption-menu [verify-file]
+  '(menu-item "Verify File..." epa-verify-file
+             :help "Verify digital signature of a file"))
+
+(define-key menu-bar-encryption-decryption-menu [encrypt-file]
+  '(menu-item "Encrypt File..." epa-encrypt-file
+             :help "Encrypt a file"))
+
+(define-key menu-bar-encryption-decryption-menu [decrypt-file]
+  '(menu-item "Decrypt File..." epa-decrypt-file
+             :help "Decrypt a file"))
+
 (define-key menu-bar-tools-menu [simple-calculator]
   '(menu-item "Simple Calculator" calculator
              :help "Invoke the Emacs built-in quick calculator"))
@@ -1243,7 +1376,7 @@ mail status in mode line"))
 
 (define-key menu-bar-describe-menu [list-keybindings]
   '(menu-item "List Key Bindings" describe-bindings
-             :help "Display all current keybindings (keyboard shortcuts)"))
+             :help "Display all current key bindings (keyboard shortcuts)"))
 (define-key menu-bar-describe-menu [describe-current-display-table]
   '(menu-item "Describe Display Table" describe-current-display-table
              :help "Describe the current display table"))
@@ -1339,7 +1472,7 @@ key, a click, or a menu-item"))
   '(menu-item "Ordering Manuals" view-order-manuals
              :help "How to order manuals from the Free Software Foundation"))
 (define-key menu-bar-manuals-menu [lookup-subject-in-all-manuals]
-  '(menu-item "Lookup Subject in all manuals..." info-apropos
+  '(menu-item "Lookup Subject in all Manuals..." info-apropos
              :help "Find description of a subject in all installed manuals"))
 (define-key menu-bar-manuals-menu [other-manuals]
   '(menu-item "All Other Manuals (Info)" Info-directory
@@ -1367,14 +1500,14 @@ key, a click, or a menu-item"))
              :help "Show the Emacs license (GPL)"))
 (define-key menu-bar-help-menu [getting-new-versions]
   '(menu-item "Getting New Versions" describe-distribution
-             :help "How to get latest versions of Emacs"))
+             :help "How to get the latest version of Emacs"))
 (defun menu-bar-help-extra-packages ()
   "Display help about some additional packages available for Emacs."
   (interactive)
   (let (enable-local-variables)
     (view-file (expand-file-name "MORE.STUFF"
                                 data-directory))
-    (goto-address)))
+    (goto-address-mode 1)))
 (define-key menu-bar-help-menu [sep2]
   '("--"))
 (define-key menu-bar-help-menu [external-packages]
@@ -1439,9 +1572,13 @@ for the definition of the menu frame."
     (not (window-minibuffer-p (frame-selected-window menu-frame)))))
 
 (defun kill-this-buffer ()     ; for the menu bar
-  "Kill the current buffer."
+  "Kill the current buffer.
+When called in the minibuffer, get out of the minibuffer
+using `abort-recursive-edit'."
   (interactive)
-  (kill-buffer (current-buffer)))
+  (if (menu-bar-non-minibuffer-window-p)
+      (kill-buffer (current-buffer))
+    (abort-recursive-edit)))
 
 (defun kill-this-buffer-enabled-p ()
   (let ((count 0)
@@ -1450,8 +1587,8 @@ for the definition of the menu frame."
       (or (string-match "^ " (buffer-name (car buffers)))
          (setq count (1+ count)))
       (setq buffers (cdr buffers)))
-    (and (menu-bar-non-minibuffer-window-p)
-        (> count 1))))
+    (or (not (menu-bar-non-minibuffer-window-p))
+       (> count 1))))
 
 (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p))
 
@@ -1467,9 +1604,9 @@ for the definition of the menu frame."
     (> count 1)))
 
 (defcustom yank-menu-length 20
-  "*Maximum length to display in the yank-menu."
+  "Maximum length to display in the yank-menu."
   :type 'integer
-  :group 'mouse)
+  :group 'menu)
 
 (defun menu-bar-update-yank-menu (string old)
   (let ((front (car (cdr yank-menu)))
@@ -1506,6 +1643,26 @@ The menu shows all the killed text sequences stored in `kill-ring'."
   (insert last-command-event))
 
 \f
+;;; Buffers Menu
+
+(defcustom buffers-menu-max-size 10
+  "Maximum number of entries which may appear on the Buffers menu.
+If this is 10, then only the ten most-recently-selected buffers are shown.
+If this is nil, then all buffers are shown.
+A large number or nil slows down menu responsiveness."
+  :type '(choice integer
+                (const :tag "All" nil))
+  :group 'menu)
+
+(defcustom buffers-menu-buffer-name-length 30
+  "Maximum length of the buffer name on the Buffers menu.
+If this is a number, then buffer names are truncated to this length.
+If this is nil, then buffer names are shown in full.
+A large number or nil makes the menu too wide."
+  :type '(choice integer
+                (const :tag "Full length" nil))
+  :group 'menu)
+
 (defcustom buffers-menu-show-directories 'unless-uniquify
   "If non-nil, show directories in the Buffers menu for buffers that have them.
 The special value `unless-uniquify' means that directories will be shown
@@ -1537,6 +1694,10 @@ Buffers menu is regenerated."
 
 (defvar list-buffers-directory nil)
 
+(defun menu-bar-select-buffer ()
+  (interactive)
+  (switch-to-buffer last-command-event))
+
 (defun menu-bar-select-frame (frame)
   (make-frame-visible frame)
   (raise-frame frame)
@@ -1593,11 +1754,16 @@ Buffers menu is regenerated."
                      (unless (eq ?\s (aref name 0))
                        (push (menu-bar-update-buffers-1
                               (cons buf
-                                    (if (> (length name) 27)
-                                        (concat (substring name 0 12)
-                                                "..."
-                                                (substring name -12))
-                                      name)))
+                                   (if (and (integerp buffers-menu-buffer-name-length)
+                                            (> (length name) buffers-menu-buffer-name-length))
+                                       (concat
+                                        (substring
+                                         name 0 (/ buffers-menu-buffer-name-length 2))
+                                        "..."
+                                        (substring
+                                         name (- (/ buffers-menu-buffer-name-length 2))))
+                                     name)
+                                    ))
                              alist))))
                 ;; Now make the actual list of items.
                  (let ((buffers-vec (make-vector (length alist) nil))
@@ -1773,20 +1939,24 @@ See `menu-bar-mode' for more information."
     (menu-bar-mode arg)))
 
 (declare-function x-menu-bar-open "term/x-win" (&optional frame))
+(declare-function w32-menu-bar-open "term/w32-win" (&optional frame))
 
 (defun menu-bar-open (&optional frame)
   "Start key navigation of the menu bar in FRAME.
 
 This function decides which method to use to access the menu
 depending on FRAME's terminal device.  On X displays, it calls
-`x-menu-bar-open'; otherwise it calls `tmm-menubar'.
+`x-menu-bar-open'; on Windows, `w32-menu-bar-open' otherwise it
+calls `tmm-menubar'.
 
 If FRAME is nil or not given, use the selected frame."
   (interactive)
-  (if (eq window-system 'x)
-      (x-menu-bar-open frame)
-    (with-selected-frame (or frame (selected-frame))
-      (tmm-menubar))))
+  (let ((type (framep (or frame (selected-frame)))))
+    (cond
+     ((eq type 'x) (x-menu-bar-open frame))
+     ((eq type 'w32) (w32-menu-bar-open frame))
+     (t (with-selected-frame (or frame (selected-frame))
+          (tmm-menubar))))))
 
 (global-set-key [f10] 'menu-bar-open)