X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c3e1d4359ed586fa30ba45e8b9bc8f3a230f130b..bd3e1759259f1f64c7e79d0779c4d156128b83d3:/lisp/menu-bar.el?ds=sidebyside diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 5babb7b19e..986f61e6c5 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -3,7 +3,7 @@ ;; Author: RMS ;; Keywords: internal -;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -21,6 +21,8 @@ ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; Avishai Yacobi suggested some menu rearrangements. + ;;; Code: ;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key @@ -28,118 +30,230 @@ (or (lookup-key global-map [menu-bar]) (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))) (defvar menu-bar-help-menu (make-sparse-keymap "Help")) -;; Put Help item last. -(setq menu-bar-final-items '(help)) -(define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu)) + +;; Force Help item to come last, after the major mode's own items. +;; The symbol used to be called `help', but that gets confused with the +;; help key. +(setq menu-bar-final-items '(help-menu)) + +(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu)) +(defvar menu-bar-search-menu (make-sparse-keymap "Search")) +(define-key global-map [menu-bar search] (cons "Search" menu-bar-search-menu)) (defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) -(defvar menu-bar-file-menu (make-sparse-keymap "File")) -(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) +(defvar menu-bar-tools-menu (make-sparse-keymap "Tools")) +(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) +(defvar menu-bar-files-menu (make-sparse-keymap "Files")) +(define-key global-map [menu-bar files] (cons "Files" menu-bar-files-menu)) + +;; This alias is for compatibility with 19.28 and before. +(defvar menu-bar-file-menu menu-bar-files-menu) (defvar vc-menu-map (make-sparse-keymap "Version Control")) -(define-key menu-bar-file-menu [exit-emacs] - '("Exit Emacs" . save-buffers-kill-emacs)) +(define-key menu-bar-tools-menu [calendar] '("Display Calendar" . calendar)) +(define-key menu-bar-tools-menu [rmail] '("Read Mail" . rmail)) +(define-key menu-bar-tools-menu [gnus] '("Read Net News" . gnus)) -(define-key menu-bar-file-menu [separator-compare] +(define-key menu-bar-tools-menu [separator-vc] '("--")) -(define-key menu-bar-file-menu [epatch] +(define-key menu-bar-tools-menu [vc-menu] + (cons "Version Control" vc-menu-map)) + +(define-key menu-bar-tools-menu [separator-compare] + '("--")) + +(define-key menu-bar-tools-menu [epatch] '("Apply Patch" . menu-bar-epatch-menu)) -(define-key menu-bar-file-menu [ediff] +(define-key menu-bar-tools-menu [ediff-merge] + '("Merge" . menu-bar-ediff-merge-menu)) +(define-key menu-bar-tools-menu [compare] '("Compare" . menu-bar-ediff-menu)) -(define-key menu-bar-file-menu [emerge] '("Emerge" . menu-bar-emerge-menu)) -(define-key menu-bar-file-menu [separator-misc] +(define-key menu-bar-tools-menu [separator-print] + '("--")) + +(put 'print-region 'menu-enable 'mark-active) +(put 'ps-print-region-with-faces 'menu-enable 'mark-active) + +(define-key menu-bar-tools-menu [ps-print-region] + '("Postscript Print Region" . ps-print-region-with-faces)) +(define-key menu-bar-tools-menu [ps-print-buffer] + '("Postscript Print Buffer" . ps-print-buffer-with-faces)) +(define-key menu-bar-tools-menu [print-region] + '("Print Region" . print-region)) +(define-key menu-bar-tools-menu [print-buffer] + '("Print Buffer" . print-buffer)) + +(define-key menu-bar-files-menu [exit-emacs] + '("Exit Emacs" . save-buffers-kill-emacs)) + +(define-key menu-bar-files-menu [separator-exit] '("--")) -(define-key menu-bar-file-menu [calendar] '("Calendar" . calendar)) -(define-key menu-bar-file-menu [rmail] '("Read Mail" . rmail)) -(define-key menu-bar-file-menu [gnus] '("Read Net News" . gnus)) +(define-key menu-bar-files-menu [one-window] + '("One Window" . delete-other-windows)) + +(define-key menu-bar-files-menu [split-window] + '("Split Window" . split-window-vertically)) (if (fboundp 'delete-frame) (progn - (define-key menu-bar-file-menu [separator-frames] - '("--")) - - (define-key menu-bar-file-menu [delete-frame] + ;; Don't use delete-frame as event name + ;; because that is a special event. + (define-key menu-bar-files-menu [delete-this-frame] '("Delete Frame" . delete-frame)) - (define-key menu-bar-file-menu [make-frame-on-display] - '("Make Frame on Display" . make-frame-on-display)) - (define-key menu-bar-file-menu [make-frame] + (define-key menu-bar-files-menu [make-frame-on-display] + '("Open New Display..." . make-frame-on-display)) + (define-key menu-bar-files-menu [make-frame] '("Make New Frame" . make-frame)))) -(define-key menu-bar-file-menu [separator-buffers] +(define-key menu-bar-files-menu [separator-buffers] '("--")) -(define-key menu-bar-file-menu [bookmark] - '("Bookmarks" . menu-bar-bookmark-map)) -(define-key menu-bar-file-menu [print-buffer] - '("Print Buffer" . print-buffer)) -(define-key menu-bar-file-menu [kill-buffer] - '("Kill (Current) Buffer" . kill-this-buffer)) -(define-key menu-bar-file-menu [insert-file] - '("Insert File" . insert-file)) -(define-key menu-bar-file-menu [vc-menu] - (cons "Version Control" vc-menu-map)) -(define-key menu-bar-file-menu [revert-buffer] +(define-key menu-bar-files-menu [kill-buffer] + '("Kill Current Buffer" . kill-this-buffer)) +(define-key menu-bar-files-menu [insert-file] + '("Insert File..." . insert-file)) +(define-key menu-bar-files-menu [revert-buffer] '("Revert Buffer" . revert-buffer)) -(define-key menu-bar-file-menu [write-file] +(define-key menu-bar-files-menu [write-file] '("Save Buffer As..." . write-file)) -(define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer)) -(define-key menu-bar-file-menu [dired] '("Open Directory..." . dired)) -(define-key menu-bar-file-menu [open-file] '("Open File..." . find-file)) +(define-key menu-bar-files-menu [save-buffer] '("Save Buffer" . save-buffer)) +(define-key menu-bar-files-menu [dired] '("Open Directory..." . dired)) +(define-key menu-bar-files-menu [open-file] '("Open File..." . find-file)) -;; This is just one element of the ediff menu--the first. -(define-key menu-bar-ediff-menu [window] - '("This Window And Next Window" . compare-windows)) -(define-key menu-bar-edit-menu [query-replace] - '("Query Replace" . query-replace)) -(define-key menu-bar-edit-menu [re-search-back] - '("Regexp Search Backwards" . re-search-backward)) -(define-key menu-bar-edit-menu [search-back] - '("Search Backwards" . search-backward)) -(define-key menu-bar-edit-menu [re-search-fwd] - '("Regexp Search" . re-search-forward)) -(define-key menu-bar-edit-menu [search-fwd] - '("Search" . search-forward)) - -(define-key menu-bar-edit-menu [separator-misc] +(defun nonincremental-search-forward (string) + "Read a string and search for it nonincrementally." + (interactive "sSearch for string: ") + (if (equal string "") + (search-forward (car search-ring)) + (isearch-update-ring string nil) + (search-forward string))) + +(defun nonincremental-search-backward (string) + "Read a string and search backward for it nonincrementally." + (interactive "sSearch for string: ") + (if (equal string "") + (search-backward (car search-ring)) + (isearch-update-ring string nil) + (search-backward string))) + +(defun nonincremental-re-search-forward (string) + "Read a regular expression and search for it nonincrementally." + (interactive "sSearch for regexp: ") + (if (equal string "") + (re-search-forward (car regexp-search-ring)) + (isearch-update-ring string t) + (re-search-forward string))) + +(defun nonincremental-re-search-backward (string) + "Read a regular expression and search backward for it nonincrementally." + (interactive "sSearch for regexp: ") + (if (equal string "") + (re-search-backward (car regexp-search-ring)) + (isearch-update-ring string t) + (re-search-backward string))) + +(defun nonincremental-repeat-search-forward () + "Search forward for the previous search string." + (interactive) + (search-forward (car search-ring))) + +(defun nonincremental-repeat-search-backward () + "Search backward for the previous search string." + (interactive) + (search-backward (car search-ring))) + +(defun nonincremental-repeat-re-search-forward () + "Search forward for the previous regular expression." + (interactive) + (re-search-forward (car regexp-search-ring))) + +(defun nonincremental-repeat-re-search-backward () + "Search backward for the previous regular expression." + (interactive) + (re-search-backward (car regexp-search-ring))) + +(define-key menu-bar-search-menu [query-replace-regexp] + '("Query Replace Regexp..." . query-replace-regexp)) +(define-key menu-bar-search-menu [query-replace] + '("Query Replace..." . query-replace)) +(define-key menu-bar-search-menu [find-tag] + '("Find Tag..." . find-tag)) +(define-key menu-bar-search-menu [bookmark] + '("Bookmarks" . menu-bar-bookmark-map)) + +(define-key menu-bar-search-menu [separator-search] + '("--")) + +(define-key menu-bar-search-menu [nonincremental-repeat-re-search-back] + '("Repeat Regexp Backwards" . nonincremental-repeat-re-search-backward)) +(define-key menu-bar-search-menu [nonincremental-repeat-search-back] + '("Repeat Backwards" . nonincremental-repeat-search-backward)) +(define-key menu-bar-search-menu [nonincremental-repeat-re-search-fwd] + '("Repeat Regexp" . nonincremental-repeat-re-search-forward)) +(define-key menu-bar-search-menu [nonincremental-repeat-search-fwd] + '("Repeat Search" . nonincremental-repeat-search-forward)) + +(define-key menu-bar-search-menu [separator-repeat] '("--")) -(define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map)) +(define-key menu-bar-search-menu [re-search-back] + '("Regexp Search Backwards..." . nonincremental-re-search-backward)) +(define-key menu-bar-search-menu [search-back] + '("Search Backwards..." . nonincremental-search-backward)) +(define-key menu-bar-search-menu [re-search-fwd] + '("Regexp Search..." . nonincremental-re-search-forward)) +(define-key menu-bar-search-menu [search-fwd] + '("Search..." . nonincremental-search-forward)) + +(if (fboundp 'start-process) + (define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map))) (define-key menu-bar-edit-menu [fill] '("Fill" . fill-region)) +(define-key menu-bar-edit-menu [props] '("Text Properties" . facemenu-menu)) (define-key menu-bar-edit-menu [separator-edit] '("--")) (define-key menu-bar-edit-menu [clear] '("Clear" . delete-region)) -(define-key menu-bar-edit-menu [paste] '("Paste most recent" . yank)) +(define-key menu-bar-edit-menu [paste] '("Paste Most Recent" . yank)) (defvar yank-menu (cons "Select Yank" nil)) (fset 'yank-menu (cons 'keymap yank-menu)) (define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu)) -(define-key menu-bar-edit-menu [copy] '("Copy" . kill-ring-save)) +(define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save)) (define-key menu-bar-edit-menu [cut] '("Cut" . kill-region)) (define-key menu-bar-edit-menu [undo] '("Undo" . undo)) -(put 'fill-region 'menu-enable 'mark-active) -(put 'kill-region 'menu-enable 'mark-active) -(put 'kill-ring-save 'menu-enable 'mark-active) -(put 'yank 'menu-enable '(x-selection-exists-p)) -(put 'yank-menu 'menu-enable '(cdr yank-menu)) -(put 'delete-region 'menu-enable 'mark-active) -(put 'undo 'menu-enable '(if (eq last-command 'undo) - pending-undo-list - (consp buffer-undo-list))) +(defun menu-bar-kill-ring-save (beg end) + (interactive "r") + (if (mouse-region-match) + (message "Select a region with the mouse does `copy' automatically") + (kill-ring-save beg end))) + +(put 'fill-region 'menu-enable '(and mark-active (not buffer-read-only))) +(put 'kill-region 'menu-enable '(and mark-active (not buffer-read-only))) +(put 'menu-bar-kill-ring-save 'menu-enable 'mark-active) +(put 'yank 'menu-enable '(and (x-selection-exists-p) (not buffer-read-only))) +(put 'yank-menu 'menu-enable '(and (cdr yank-menu) (not buffer-read-only))) +(put 'delete-region 'menu-enable '(and mark-active + (not buffer-read-only) + (not (mouse-region-match)))) +(put 'undo 'menu-enable '(and (not buffer-read-only) + (if (eq last-command 'undo) + pending-undo-list + (consp buffer-undo-list)))) (put 'query-replace 'menu-enable '(not buffer-read-only)) +(put 'query-replace-regexp 'menu-enable '(not buffer-read-only)) (autoload 'ispell-menu-map "ispell" nil t 'keymap) ;; These are alternative definitions for the cut, paste and copy -;; menu items. Use them if your system expects these to use the clipboard +;; menu items. Use them if your system expects these to use the clipboard. (put 'clipboard-kill-region 'menu-enable 'mark-active) (put 'clipboard-kill-ring-save 'menu-enable 'mark-active) @@ -188,10 +302,13 @@ Do the same for the keys of the same name." (define-key menu-bar-help-menu [emacs-version] '("Show Version" . emacs-version)) (define-key menu-bar-help-menu [report-emacs-bug] - '("Send Bug Report" . report-emacs-bug)) + '("Send Bug Report..." . report-emacs-bug)) +(define-key menu-bar-help-menu [finder-by-keyword] + '("Find Lisp Packages..." . finder-by-keyword)) (define-key menu-bar-help-menu [emacs-tutorial] '("Emacs Tutorial" . help-with-tutorial)) -(define-key menu-bar-help-menu [man] '("Man..." . manual-entry)) +(define-key menu-bar-help-menu [man] + '("Man..." . manual-entry)) (define-key menu-bar-help-menu [describe-variable] '("Describe Variable..." . describe-variable)) (define-key menu-bar-help-menu [describe-function] @@ -204,9 +321,10 @@ Do the same for the keys of the same name." '("Command Apropos..." . command-apropos)) (define-key menu-bar-help-menu [describe-mode] '("Describe Mode" . describe-mode)) -(define-key menu-bar-help-menu [info] '("Info" . info)) - +(define-key menu-bar-help-menu [info] '("Browse Manuals" . info)) +(define-key menu-bar-help-menu [emacs-faq] '("Emacs FAQ" . view-emacs-FAQ)) (define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news)) + (defun kill-this-buffer () ; for the menubar "Kills the current buffer." (interactive) @@ -219,24 +337,46 @@ Do the same for the keys of the same name." (or (string-match "^ " (buffer-name (car buffers))) (setq count (1+ count))) (setq buffers (cdr buffers))) - (> count 1))) + (and (not (window-minibuffer-p (selected-window))) + (> count 1)))) + +(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) + +(put 'save-buffer 'menu-enable + '(and (buffer-modified-p) + (not (window-minibuffer-p (selected-window))))) + +(put 'write-file 'menu-enable + '(not (window-minibuffer-p (selected-window)))) + +(put 'find-file 'menu-enable + '(not (window-minibuffer-p (selected-window)))) + +(put 'dired 'menu-enable + '(not (window-minibuffer-p (selected-window)))) + +(put 'insert-file 'menu-enable + '(not (window-minibuffer-p (selected-window)))) -(put 'save-buffer 'menu-enable '(buffer-modified-p)) (put 'revert-buffer 'menu-enable '(or revert-buffer-function revert-buffer-insert-file-contents-function (and (buffer-file-name) (or (buffer-modified-p) (not (verify-visited-file-modtime (current-buffer))))))) + ;; Permit deleting frame if it would leave a visible or iconified frame. (put 'delete-frame 'menu-enable - '(let ((frames (frame-list)) - (count 0)) - (while frames - (if (cdr (assq 'visibility (frame-parameters (car frames)))) - (setq count (1+ count))) - (setq frames (cdr frames))) - (> count 1))) -(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) + '(delete-frame-enabled-p)) + +(defun delete-frame-enabled-p () + "Return non-nil if `delete-frame' should be enabled in the menu bar." + (let ((frames (frame-list)) + (count 0)) + (while frames + (if (frame-visible-p (car frames)) + (setq count (1+ count))) + (setq frames (cdr frames))) + (> count 1))) (put 'advertised-undo 'menu-enable '(and (not (eq t buffer-undo-list)) @@ -256,6 +396,10 @@ Do the same for the keys of the same name." (substring string 0 (/ yank-menu-length 2)) "..." (substring string (- (/ yank-menu-length 2))))))) + ;; Don't let the menu string be all dashes + ;; because that has a special meaning in a menu. + (if (string-match "\\`-+\\'" menu-string) + (setq menu-string (concat menu-string " "))) ;; If we're supposed to be extending an existing string, and that ;; string really is at the front of the menu, then update it in place. (if (and old (or (eq old (car front)) @@ -275,9 +419,10 @@ Do the same for the keys of the same name." (push-mark (point)) (insert last-command-event)) -(define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers)) - -(defalias 'menu-bar-buffers (make-sparse-keymap "Buffers")) +;; This definition is just to show what this looks like. +;; It gets overridden below when menu-bar-update-buffers is called. +(define-key global-map [menu-bar buffer] + (cons "Buffers" (make-sparse-keymap "Buffers"))) (defvar buffers-menu-max-size 10 "*Maximum number of entries which may appear on the Buffers menu. @@ -321,6 +466,8 @@ A large number or nil slows down menu responsiveness.") file)) (car elt))) +(defvar menu-bar-buffers-menu-list-buffers-entry nil) + (defun menu-bar-update-buffers () ;; If user discards the Buffers item, play along. (and (lookup-key (current-global-map) [menu-bar buffer]) @@ -378,6 +525,25 @@ A large number or nil slows down menu responsiveness.") (setq maxlen (length (car (car alist)))))) (setq tail (cdr tail))) (setq alist (nreverse alist)) + ;; Make the menu item for list-buffers + ;; or reuse the one we already have. + ;; The advantage in reusing one + ;; is that it already has the keyboard equivalent + ;; cached, so we save the time to look that up again. + (or menu-bar-buffers-menu-list-buffers-entry + (setq menu-bar-buffers-menu-list-buffers-entry + (cons + 'list-buffers + (cons + "" + 'list-buffers)))) + ;; Update the item string for menu's new width. + (setcar (cdr menu-bar-buffers-menu-list-buffers-entry) + (concat (make-string (max (- (/ maxlen 2) 8) 0) + ?\ ) + "List All Buffers")) + ;; Now make the actual list of items, + ;; ending with the list-buffers item. (nconc (mapcar '(lambda (pair) ;; This is somewhat risque, to use ;; the buffer name itself as the event @@ -390,14 +556,7 @@ A large number or nil slows down menu responsiveness.") (cons nil nil)) 'menu-bar-select-buffer)) alist) - (list - (cons - 'list-buffers - (cons - (concat (make-string (max (- (/ maxlen 2) 8) 0) - ?\ ) - "List All Buffers") - 'list-buffers))))))) + (list menu-bar-buffers-menu-list-buffers-entry))))) ;; Make a Frames menu if we have more than one frame. @@ -425,6 +584,8 @@ A large number or nil slows down menu responsiveness.") (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) +(menu-bar-update-buffers) + ;; this version is too slow ;;;(defun format-buffers-menu-line (buffer) ;;; "Returns a string to represent the given buffer in the Buffer menu. @@ -442,6 +603,46 @@ A large number or nil slows down menu responsiveness.") ;;; mode-name ;;; (or (buffer-file-name) "")))))) +;;; Set up a menu bar menu for the minibuffer. + +(mapcar + (function + (lambda (map) + (define-key map [menu-bar minibuf] + (cons "Minibuf" (make-sparse-keymap "Minibuf"))))) + (list minibuffer-local-ns-map + minibuffer-local-must-match-map + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-completion-map)) + +(mapcar + (function + (lambda (map) + (define-key map [menu-bar minibuf ?\?] + '("List Completions" . minibuffer-completion-help)) + (define-key map [menu-bar minibuf space] + '("Complete Word" . minibuffer-complete-word)) + (define-key map [menu-bar minibuf tab] + '("Complete" . minibuffer-complete)) + )) + (list minibuffer-local-must-match-map + minibuffer-local-completion-map)) + +(mapcar + (function + (lambda (map) + (define-key map [menu-bar minibuf quit] + '("Quit" . keyboard-escape-quit)) + (define-key map [menu-bar minibuf return] + '("Enter" . exit-minibuffer)) + )) + (list minibuffer-local-ns-map + minibuffer-local-must-match-map + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-completion-map)) + (defvar menu-bar-mode nil) (defun menu-bar-mode (flag)