X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/381c0bfaf2104295f25c4cc0ea68e881ed37170e..8f1e784f19c74702947c99d321d20fd1156b432c:/lisp/menu-bar.el diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index c5f587eb71..6571a4b9d4 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-2014 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 2000-2016 Free Software Foundation, Inc. ;; Author: Richard M. Stallman ;; Maintainer: emacs-devel@gnu.org @@ -218,7 +218,7 @@ (cond ((and (eq menu-bar-last-search-type 'string) search-ring) - (search-forward (car search-ring))) + (nonincremental-search-forward)) ((and (eq menu-bar-last-search-type 'regexp) regexp-search-ring) (re-search-forward (car regexp-search-ring))) @@ -231,30 +231,30 @@ (cond ((and (eq menu-bar-last-search-type 'string) search-ring) - (search-backward (car search-ring))) + (nonincremental-search-backward)) ((and (eq menu-bar-last-search-type 'regexp) regexp-search-ring) (re-search-backward (car regexp-search-ring))) (t (error "No previous search")))) -(defun nonincremental-search-forward (string) +(defun nonincremental-search-forward (&optional string backward) "Read a string and search for it nonincrementally." (interactive "sSearch for string: ") (setq menu-bar-last-search-type 'string) - (if (equal string "") - (search-forward (car search-ring)) - (isearch-update-ring string nil) - (search-forward string))) - -(defun nonincremental-search-backward (string) + ;; Ideally, this whole command would be equivalent to `C-s RET'. + (let ((isearch-forward (not backward)) + (isearch-regexp-function search-default-mode) + (isearch-regexp nil)) + (if (or (equal string "") (not string)) + (funcall (isearch-search-fun-default) (car search-ring)) + (isearch-update-ring string nil) + (funcall (isearch-search-fun-default) string)))) + +(defun nonincremental-search-backward (&optional string) "Read a string and search backward for it nonincrementally." - (interactive "sSearch for string: ") - (setq menu-bar-last-search-type 'string) - (if (equal string "") - (search-backward (car search-ring)) - (isearch-update-ring string nil) - (search-backward string))) + (interactive "sSearch backwards for string: ") + (nonincremental-search-forward string 'backward)) (defun nonincremental-re-search-forward (string) "Read a regular expression and search for it nonincrementally." @@ -373,13 +373,16 @@ (bindings--define-key menu [set-tags-name] '(menu-item "Set Tags File Name..." visit-tags-table - :help "Tell Tags commands which tag table file to use")) + :visible (menu-bar-goto-uses-etags-p) + :help "Tell navigation commands which tag table file to use")) (bindings--define-key menu [separator-tag-file] - menu-bar-separator) + '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p))) (bindings--define-key menu [xref-pop] - '(menu-item "Back..." xref-pop-marker-stack + '(menu-item "Back" xref-pop-marker-stack + :visible (and (featurep 'xref) + (not (xref-marker-stack-empty-p))) :help "Back to the position of the last search")) (bindings--define-key menu [xref-apropos] @@ -409,6 +412,9 @@ :help "Read a line number and go to that line")) menu)) +(defun menu-bar-goto-uses-etags-p () + (or (not (boundp 'xref-backend-functions)) + (eq (car xref-backend-functions) 'etags--xref-backend))) (defvar yank-menu (cons (purecopy "Select Yank") nil)) (fset 'yank-menu (cons 'keymap yank-menu)) @@ -468,13 +474,15 @@ :enable (and (cdr yank-menu) (not buffer-read-only)) :help "Choose a string from the kill ring and paste it")) (bindings--define-key menu [paste] - '(menu-item "Paste" yank - :enable (and (or - (gui-call gui-selection-exists-p 'CLIPBOARD) - (if (featurep 'ns) ; like paste-from-menu - (cdr yank-menu) - kill-ring)) - (not buffer-read-only)) + `(menu-item "Paste" yank + :enable (funcall + ',(lambda () + (and (or + (gui-backend-selection-exists-p 'CLIPBOARD) + (if (featurep 'ns) ; like paste-from-menu + (cdr yank-menu) + kill-ring)) + (not buffer-read-only)))) :help "Paste (yank) text most recently cut/copied")) (bindings--define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better @@ -517,9 +525,12 @@ '(and mark-active (not buffer-read-only))) (put 'clipboard-kill-ring-save 'menu-enable 'mark-active) (put 'clipboard-yank 'menu-enable - '(and (or (gui-call gui-selection-exists-p 'PRIMARY) - (gui-call gui-selection-exists-p 'CLIPBOARD)) - (not buffer-read-only))) + `(funcall ',(lambda () + (and (or (gui-backend-selection-exists-p 'PRIMARY) + (gui-backend-selection-exists-p 'CLIPBOARD)) + (not buffer-read-only))))) + +(defvar gui-select-enable-clipboard) (defun clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." @@ -528,13 +539,17 @@ (yank))) (defun clipboard-kill-ring-save (beg end &optional region) - "Copy region to kill ring, and save in the GUI's clipboard." + "Copy region to kill ring, and save in the GUI's clipboard. +If the optional argument REGION is non-nil, the function ignores +BEG and END, and saves the current region instead." (interactive "r\np") (let ((gui-select-enable-clipboard t)) (kill-ring-save beg end region))) (defun clipboard-kill-region (beg end &optional region) - "Kill the region, and save it in the GUI's clipboard." + "Kill the region, and save it in the GUI's clipboard. +If the optional argument REGION is non-nil, the function ignores +BEG and END, and kills the current region instead." (interactive "r\np") (let ((gui-select-enable-clipboard t)) (kill-region beg end region))) @@ -641,7 +656,9 @@ by \"Save Options\" in Custom buffers.") ;; Function for setting/saving default font. (defun menu-set-font () - "Interactively select a font and make it the default on all existing frames." + "Interactively select a font and make it the default on all frames. + +The selected font will be the default on both the existing and future frames." (interactive) (set-frame-font (if (fboundp 'x-select-font) (x-select-font) @@ -672,7 +689,7 @@ by \"Save Options\" in Custom buffers.") (dolist (elt '(scroll-bar-mode debug-on-quit debug-on-error ;; Somehow this works, when tool-bar and menu-bar don't. - tooltip-mode + tooltip-mode window-divider-mode save-place uniquify-buffer-name-style fringe-mode indicate-empty-lines indicate-buffer-boundaries case-fold-search font-use-system-font @@ -700,6 +717,95 @@ by \"Save Options\" in Custom buffers.") ;; The "Show/Hide" submenu of menu "Options" +(defun menu-bar-window-divider-customize () + "Show customization buffer for `window-divider' group." + (interactive) + (customize-group 'window-divider)) + +(defun menu-bar-bottom-and-right-window-divider () + "Display dividers on the bottom and right of each window." + (interactive) + (customize-set-variable 'window-divider-default-places t) + (window-divider-mode 1)) + +(defun menu-bar-right-window-divider () + "Display dividers only on the right of each window." + (interactive) + (customize-set-variable 'window-divider-default-places 'right-only) + (window-divider-mode 1)) + +(defun menu-bar-bottom-window-divider () + "Display dividers only at the bottom of each window." + (interactive) + (customize-set-variable 'window-divider-default-places 'bottom-only) + (window-divider-mode 1)) + +(defun menu-bar-no-window-divider () + "Do not display window dividers." + (interactive) + (window-divider-mode -1)) + +;; For the radio buttons below we check whether the respective dividers +;; are displayed on the selected frame. This is not fully congruent +;; with `window-divider-mode' but makes the menu entries work also when +;; dividers are displayed by manipulating frame parameters directly. +(defvar menu-bar-showhide-window-divider-menu + (let ((menu (make-sparse-keymap "Window Divider"))) + (bindings--define-key menu [customize] + '(menu-item "Customize" menu-bar-window-divider-customize + :help "Customize window dividers" + :visible (memq (window-system) '(x w32)))) + + (bindings--define-key menu [bottom-and-right] + '(menu-item "Bottom and Right" + menu-bar-bottom-and-right-window-divider + :help "Display window divider on the bottom and right of each window" + :visible (memq (window-system) '(x w32)) + :button (:radio + . (and (window-divider-width-valid-p + (cdr (assq 'bottom-divider-width + (frame-parameters)))) + (window-divider-width-valid-p + (cdr (assq 'right-divider-width + (frame-parameters)))))))) + (bindings--define-key menu [right-only] + '(menu-item "Right Only" + menu-bar-right-window-divider + :help "Display window divider on the right of each window only" + :visible (memq (window-system) '(x w32)) + :button (:radio + . (and (not (window-divider-width-valid-p + (cdr (assq 'bottom-divider-width + (frame-parameters))))) + (window-divider-width-valid-p + (cdr (assq 'right-divider-width + (frame-parameters)))))))) + (bindings--define-key menu [bottom-only] + '(menu-item "Bottom Only" + menu-bar-bottom-window-divider + :help "Display window divider on the bottom of each window only" + :visible (memq (window-system) '(x w32)) + :button (:radio + . (and (window-divider-width-valid-p + (cdr (assq 'bottom-divider-width + (frame-parameters)))) + (not (window-divider-width-valid-p + (cdr (assq 'right-divider-width + (frame-parameters))))))))) + (bindings--define-key menu [no-divider] + '(menu-item "None" + menu-bar-no-window-divider + :help "Do not display window dividers" + :visible (memq (window-system) '(x w32)) + :button (:radio + . (and (not (window-divider-width-valid-p + (cdr (assq 'bottom-divider-width + (frame-parameters))))) + (not (window-divider-width-valid-p + (cdr (assq 'right-divider-width + (frame-parameters))))))))) + menu)) + (defun menu-bar-showhide-fringe-ind-customize () "Show customization buffer for `indicate-buffer-boundaries'." (interactive) @@ -1061,6 +1167,10 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) + (bindings--define-key menu [showhide-window-divider] + `(menu-item "Window Divider" ,menu-bar-showhide-window-divider-menu + :visible (memq (window-system) '(x w32)))) + (bindings--define-key menu [showhide-fringe] `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu :visible (display-graphic-p))) @@ -1144,6 +1254,52 @@ mail status in mode line")) :enable (not (truncated-partial-width-window-p)))) menu)) +(defvar menu-bar-search-options-menu + (let ((menu (make-sparse-keymap "Search Options"))) + + (dolist (x '((character-fold-to-regexp "Fold Characters" "Character folding") + (isearch-symbol-regexp "Whole Symbols" "Whole symbol") + (word-search-regexp "Whole Words" "Whole word"))) + (bindings--define-key menu (vector (nth 0 x)) + `(menu-item ,(nth 1 x) + (lambda () + (interactive) + (setq search-default-mode #',(nth 0 x)) + (message ,(format "%s search enabled" (nth 2 x)))) + :help ,(format "Enable %s search" (downcase (nth 2 x))) + :button (:radio . (eq search-default-mode #',(nth 0 x)))))) + + (bindings--define-key menu [regexp-search] + '(menu-item "Regular Expression" + (lambda () + (interactive) + (setq search-default-mode t) + (message "Regular-expression search enabled")) + :help "Enable regular-expression search" + :button (:radio . (eq search-default-mode t)))) + + (bindings--define-key menu [regular-search] + '(menu-item "Literal Search" + (lambda () + (interactive) + (when search-default-mode + (setq search-default-mode nil) + (when (symbolp search-default-mode) + (message "Literal search enabled")))) + :help "Disable special search modes" + :button (:radio . (not search-default-mode)))) + + (bindings--define-key menu [custom-separator] + menu-bar-separator) + (bindings--define-key menu [case-fold-search] + (menu-bar-make-toggle + toggle-case-fold-search case-fold-search + "Ignore Case" + "Case-Insensitive Search %s" + "Ignore letter-case in search commands")) + + menu)) + (defvar menu-bar-options-menu (let ((menu (make-sparse-keymap "Options"))) (bindings--define-key menu [customize] @@ -1255,12 +1411,9 @@ mail status in mode line")) (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) - (bindings--define-key menu [case-fold-search] - (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")) + (bindings--define-key menu [search-options] + `(menu-item "Default Search Options" + ,menu-bar-search-options-menu)) (bindings--define-key menu [line-wrapping] `(menu-item "Line Wrapping in This Buffer" @@ -1741,12 +1894,14 @@ The menu frame is the frame for which we are updating the menu." (frame-visible-p menu-frame)))) (defun menu-bar-non-minibuffer-window-p () - "Return non-nil if selected window of the menu frame is not a minibuf window. - -See the documentation of `menu-bar-menu-frame-live-and-visible-p' -for the definition of the menu frame." + "Return non-nil if the menu frame's selected window is no minibuffer window. +Return nil if the menu frame is dead or its selected window is a +minibuffer window. The menu frame is the frame for which we are +updating the menu." (let ((menu-frame (or menu-updating-frame (selected-frame)))) - (not (window-minibuffer-p (frame-selected-window menu-frame))))) + (and (frame-live-p menu-frame) + (not (window-minibuffer-p + (frame-selected-window menu-frame)))))) (defun kill-this-buffer () ; for the menu bar "Kill the current buffer. @@ -1941,20 +2096,20 @@ It must accept a buffer as its only required argument.") (let ((buffers (buffer-list)) (frames (frame-list)) buffers-menu) - ;; If requested, list only the N most recently selected buffers. - (if (and (integerp buffers-menu-max-size) - (> buffers-menu-max-size 1)) - (if (> (length buffers) buffers-menu-max-size) - (setcdr (nthcdr buffers-menu-max-size buffers) nil))) ;; Make the menu of buffers proper. (setq buffers-menu - (let (alist) + (let ((i 0) + (limit (if (and (integerp buffers-menu-max-size) + (> buffers-menu-max-size 1)) + buffers-menu-max-size most-positive-fixnum)) + alist) ;; Put into each element of buffer-list ;; the name for actual display, ;; perhaps truncated in the middle. - (dolist (buf buffers) - (let ((name (buffer-name buf))) + (while buffers + (let* ((buf (pop buffers)) + (name (buffer-name buf))) (unless (eq ?\s (aref name 0)) (push (menu-bar-update-buffers-1 (cons buf @@ -1968,7 +2123,11 @@ It must accept a buffer as its only required argument.") name (- (/ buffers-menu-buffer-name-length 2)))) name) )) - alist)))) + alist) + ;; If requested, list only the N most recently + ;; selected buffers. + (when (= limit (setq i (1+ i))) + (setq buffers nil))))) (list (menu-bar-buffer-vector alist)))) ;; Make a Frames menu if we have more than one frame. @@ -2155,8 +2314,8 @@ See `menu-bar-mode' for more information." "Popup the given menu and call the selected option. MENU can be a keymap, an easymenu-style menu or a list of keymaps as for `x-popup-menu'. -The menu is shown at the place where POSITION specifies. About -the form of POSITION, see `popup-menu-normalize-position'. +The menu is shown at the place where POSITION specifies. +For the form of POSITION, see `popup-menu-normalize-position'. PREFIX is the prefix argument (if any) to pass to the command. FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." (let* ((map (cond @@ -2225,9 +2384,9 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." (defun popup-menu-normalize-position (position) "Convert the POSITION to the form which `popup-menu' expects internally. -POSITION can an event, a posn- value, a value having +POSITION can be an event, a posn- value, a value having the form ((XOFFSET YOFFSET) WINDOW), or nil. -If nil, the current mouse position is used." +If nil, the current mouse position is used, or nil if there is no mouse." (pcase position ;; nil -> mouse cursor position (`nil @@ -2241,7 +2400,7 @@ If nil, the current mouse position is used." ;; Event. ((pred eventp) (popup-menu-normalize-position (event-end position))) - (t position))) + (_ position))) (defcustom tty-menu-open-use-tmm nil "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'. @@ -2266,7 +2425,7 @@ 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'; on Windows, `w32-menu-bar-open'; otherwise it calls either `popup-menu' or `tmm-menubar' depending on whether -\`tty-menu-open-use-tmm' is nil or not. +`tty-menu-open-use-tmm' is nil or not. If FRAME is nil or not given, use the selected frame." (interactive)