X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/02cbe062bee38a6705bafb1699d77e3c44cfafcf..cb83c00bd13b63c0d0752698e4ad441968bc04ac:/lisp/menu-bar.el diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 36cf45b55c..93dd551fdd 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -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 . ;; Avishai Yacobi suggested some menu rearrangements. @@ -30,17 +28,6 @@ ;;; 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]) @@ -78,6 +65,7 @@ A large number or nil slows down menu responsiveness." ;; The "File" menu items (define-key menu-bar-file-menu [exit-emacs] '(menu-item "Exit Emacs" save-buffers-kill-emacs + :keys "C-x C-c" :help "Save unsaved buffers, then exit")) (define-key menu-bar-file-menu [separator-exit] @@ -309,7 +297,7 @@ A large number or nil slows down menu responsiveness." '(menu-item "Continue Tags Search" tags-loop-continue :help "Continue last tags search operation")) (define-key menu-bar-search-menu [tags-srch] - '(menu-item "Search tagged files..." tags-search + '(menu-item "Search Tagged Files..." tags-search :help "Search for a regexp in all tagged files")) (define-key menu-bar-search-menu [separator-tag-search] '(menu-item "--")) @@ -353,7 +341,7 @@ A large number or nil slows down menu responsiveness." '(menu-item "Continue Replace" tags-loop-continue :help "Continue last tags replace operation")) (define-key menu-bar-replace-menu [tags-repl] - '(menu-item "Replace in tagged files..." tags-query-replace + '(menu-item "Replace in Tagged Files..." tags-query-replace :help "Interactively replace a regexp in all tagged files")) (define-key menu-bar-replace-menu [separator-replace-tags] '(menu-item "--")) @@ -640,6 +628,22 @@ 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 + (set-face-attribute 'default nil :font font) + (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 +677,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 +692,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 +756,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 +773,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 +786,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." @@ -1025,7 +1037,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 +1048,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] '("--")) @@ -1096,12 +1148,17 @@ mail status in mode line")) '(menu-item "Zone Out" zone :help "Play tricks with Emacs display when Emacs is idle")) (define-key menu-bar-games-menu [tetris] - '(menu-item "Tetris" tetris)) + '(menu-item "Tetris" tetris + :help "Falling blocks game")) (define-key menu-bar-games-menu [solitaire] - '(menu-item "Solitaire" solitaire)) + '(menu-item "Solitaire" solitaire + :help "Get rid of all the stones")) (define-key menu-bar-games-menu [snake] '(menu-item "Snake" snake :help "Move snake around avoiding collisions")) +(define-key menu-bar-games-menu [pong] + '(menu-item "Pong" pong + :help "Bounce the ball to your opponent")) (define-key menu-bar-games-menu [mult] '(menu-item "Multiplication Puzzle" mpuz :help "Exercise brain with multiplication")) @@ -1114,6 +1171,9 @@ mail status in mode line")) (define-key menu-bar-games-menu [gomoku] '(menu-item "Gomoku" gomoku :help "Mark 5 contiguous squares (like tic-tac-toe)")) +(define-key menu-bar-games-menu [bubbles] + '(menu-item "Bubbles" bubbles + :help "Remove all bubbles using the fewest moves")) (define-key menu-bar-games-menu [black-box] '(menu-item "Blackbox" blackbox :help "Find balls in a black box by shooting rays")) @@ -1124,6 +1184,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")) @@ -1344,7 +1471,7 @@ key, a click, or a menu-item")) :help "Read the Introduction to Emacs Lisp Programming")) (define-key menu-bar-help-menu [about-gnu-project] - '(menu-item "About GNU" describe-project + '(menu-item "About GNU" describe-gnu-project :help "About the GNU System, GNU Project, and GNU/Linux")) (define-key menu-bar-help-menu [about-emacs] '(menu-item "About Emacs" about-emacs @@ -1431,9 +1558,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) @@ -1442,8 +1573,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)) @@ -1461,7 +1592,7 @@ for the definition of the menu frame." (defcustom yank-menu-length 20 "*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))) @@ -1498,6 +1629,26 @@ The menu shows all the killed text sequences stored in `kill-ring'." (insert last-command-event)) +;;; 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 @@ -1529,23 +1680,14 @@ Buffers menu is regenerated." (defvar list-buffers-directory nil) -(defvar menu-bar-update-buffers-maxbuf) - (defun menu-bar-select-buffer () (interactive) (switch-to-buffer last-command-event)) -(defun menu-bar-select-frame () - (interactive) - (let (frame) - (dolist (f (frame-list)) - (when (equal last-command-event (frame-parameter f 'name)) - (setq frame f))) - ;; FRAME can be nil when user specifies the selected frame. - (setq frame (or frame (selected-frame))) - (make-frame-visible frame) - (raise-frame frame) - (select-frame frame))) +(defun menu-bar-select-frame (frame) + (make-frame-visible frame) + (raise-frame frame) + (select-frame frame)) (defun menu-bar-update-buffers-1 (elt) (let* ((buf (car elt)) @@ -1589,60 +1731,55 @@ Buffers menu is regenerated." ;; Make the menu of buffers proper. (setq buffers-menu - (let* ((buffer-list - (mapcar 'list buffers)) - (menu-bar-update-buffers-maxbuf 0) - alist) + (let (alist) ;; Put into each element of buffer-list ;; the name for actual display, ;; perhaps truncated in the middle. - (dolist (buf buffer-list) - (let ((name (buffer-name (car buf)))) - (setcdr buf - (if (> (length name) 27) - (concat (substring name 0 12) + (dolist (buf buffers) + (let ((name (buffer-name buf))) + (unless (eq ?\s (aref name 0)) + (push (menu-bar-update-buffers-1 + (cons buf + (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 -12)) - name)))) - ;; Compute the maximum length of any name. - (dolist (buf buffer-list) - (unless (eq ?\s (aref (cdr buf) 0)) - (setq menu-bar-update-buffers-maxbuf - (max menu-bar-update-buffers-maxbuf - (length (cdr buf)))))) - ;; Set ALIST to an alist of the form - ;; ITEM-STRING . BUFFER - (dolist (buf buffer-list) - (unless (eq ?\s (aref (cdr buf) 0)) - (push (menu-bar-update-buffers-1 buf) alist))) - ;; Now make the actual list of items, and add - ;; some miscellaneous buffer commands to the end. - (mapcar (lambda (pair) - ;; This is somewhat risque, to use - ;; the buffer name itself as the event - ;; type to define, but it works. - ;; It would not work to use the buffer - ;; since a buffer as an event has its - ;; own meaning. - (nconc (list (buffer-name (cdr pair)) - (car pair) + (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)) + (i (length alist))) + (dolist (pair alist) + (setq i (1- i)) + (aset buffers-vec i + (nconc (list (car pair) (cons nil nil)) - 'menu-bar-select-buffer)) - (nreverse alist)))) + `(lambda () + (interactive) + (switch-to-buffer ,(cdr pair)))))) + (list buffers-vec)))) ;; Make a Frames menu if we have more than one frame. (when (cdr frames) - (let ((frames-menu - (cons 'keymap - (cons "Select Frame" - (mapcar - (lambda (frame) - (nconc - (list (frame-parameter frame 'name) - (frame-parameter frame 'name) - (cons nil nil)) - 'menu-bar-select-frame)) - frames))))) + (let* ((frames-vec (make-vector (length frames) nil)) + (frames-menu + (cons 'keymap + (list "Select Frame" frames-vec))) + (i 0)) + (dolist (frame frames) + (aset frames-vec i + (nconc + (list + (frame-parameter frame 'name) + (cons nil nil)) + `(lambda () + (interactive) (menu-bar-select-frame ,frame)))) + (setq i (1+ i))) ;; Put it after the normal buffers (setq buffers-menu (nconc buffers-menu @@ -1729,11 +1866,24 @@ Buffers menu is regenerated." (let ((map minibuffer-local-map)) (define-key map [menu-bar minibuf quit] - (list 'menu-item "Quit" 'keyboard-escape-quit + (list 'menu-item "Quit" 'abort-recursive-edit :help "Abort input and exit minibuffer")) (define-key map [menu-bar minibuf return] (list 'menu-item "Enter" 'exit-minibuffer - :help "Terminate input and exit minibuffer"))) + :key-sequence "\r" + :help "Terminate input and exit minibuffer")) + (define-key map [menu-bar minibuf isearch-forward] + (list 'menu-item "Isearch History Forward" 'isearch-forward + :help "Incrementally search minibuffer history forward")) + (define-key map [menu-bar minibuf isearch-backward] + (list 'menu-item "Isearch History Backward" 'isearch-backward + :help "Incrementally search minibuffer history backward")) + (define-key map [menu-bar minibuf next] + (list 'menu-item "Next History Item" 'next-history-element + :help "Put next minibuffer history element in the minibuffer")) + (define-key map [menu-bar minibuf previous] + (list 'menu-item "Previous History Item" 'previous-history-element + :help "Put previous minibuffer history element in the minibuffer"))) ;;;###autoload ;; This comment is taken from tool-bar.el near @@ -1744,7 +1894,6 @@ Buffers menu is regenerated." ;; that would overwrite disabling the tool bar from X resources. (put 'menu-bar-mode 'standard-value '(t)) -;;;###autoload (define-minor-mode menu-bar-mode "Toggle display of a menu bar on each frame. This command applies to all frames that exist and frames to be @@ -1776,20 +1925,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)