]> code.delx.au - gnu-emacs/blobdiff - lisp/menu-bar.el
* lisp/char-fold.el: Rename from character-fold.el.
[gnu-emacs] / lisp / menu-bar.el
index 5fdb9377a48900b9741476cdb2b70ad1be54c53f..640395e8d7d0778ac33249777a68fb74de0e5f96 100644 (file)
@@ -1,6 +1,6 @@
 ;;; menu-bar.el --- define a default menu bar
 
-;; Copyright (C) 1993-1995, 2000-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2016 Free Software Foundation, Inc.
 
 ;; Author: Richard M. Stallman
 ;; Maintainer: emacs-devel@gnu.org
   (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)))
   (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."
     menu))
 
 (defun menu-bar-goto-uses-etags-p ()
-  (or (not (boundp 'xref-find-function))
-      (eq xref-find-function 'etags-xref-find)))
+  (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))
                   :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
      '(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."
     (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)))
@@ -647,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)
@@ -678,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
@@ -706,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)
@@ -1067,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)))
@@ -1150,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 '((char-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]
@@ -1261,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"
@@ -1949,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
@@ -1976,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.
@@ -2163,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
@@ -2233,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
@@ -2249,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'.
@@ -2274,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)