X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/01633a17e74e638f31ec71c3587481f0084574f2..816cad6e2414474b06ebb4f691fc1bdb9a8953a4:/lisp/menu-bar.el diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 1f9d66f373..5ae5da9aff 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1,9 +1,9 @@ ;;; menu-bar.el --- define a default menu bar -;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc. -;; Author: RMS -;; Maintainer: FSF +;; Author: Richard M. Stallman +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal, mouse ;; Package: emacs @@ -149,8 +149,11 @@ :help "Recover edits from a crashed session")) (bindings--define-key menu [revert-buffer] '(menu-item "Revert Buffer" revert-buffer - :enable (or revert-buffer-function - revert-buffer-insert-file-contents-function + :enable (or (not (eq revert-buffer-function + 'revert-buffer--default)) + (not (eq + revert-buffer-insert-file-contents-function + 'revert-buffer-insert-file-contents--default-function)) (and buffer-file-number (or (buffer-modified-p) (not (verify-visited-file-modtime @@ -467,17 +470,14 @@ [paste-from-menu]) ;; ns-win.el said: Change text to be more consistent with ;; surrounding menu items `paste', etc." - `(menu-item ,(if (featurep 'ns) "Select and Paste" - "Paste from Kill Menu") yank-menu + `(menu-item ,(if (featurep 'ns) "Select and Paste" "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")) (bindings--define-key menu [paste] '(menu-item "Paste" yank :enable (and (or - ;; Emacs compiled --without-x (or --with-ns) - ;; doesn't have x-selection-exists-p. - (and (fboundp 'x-selection-exists-p) - (x-selection-exists-p 'CLIPBOARD)) + (gui-call gui-selection-exists-p 'CLIPBOARD) (if (featurep 'ns) ; like paste-from-menu (cdr yank-menu) kill-ring)) @@ -534,27 +534,26 @@ '(and mark-active (not buffer-read-only))) (put 'clipboard-kill-ring-save 'menu-enable 'mark-active) (put 'clipboard-yank 'menu-enable - '(and (or (not (fboundp 'x-selection-exists-p)) - (x-selection-exists-p) - (x-selection-exists-p 'CLIPBOARD)) + '(and (or (gui-call gui-selection-exists-p 'PRIMARY) + (gui-call gui-selection-exists-p 'CLIPBOARD)) (not buffer-read-only))) (defun clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (yank))) (defun clipboard-kill-ring-save (beg end &optional region) - "Copy region to kill ring, and save in the X clipboard." + "Copy region to kill ring, and save in the GUI's clipboard." (interactive "r\np") - (let ((x-select-enable-clipboard t)) + (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 X clipboard." + "Kill the region, and save it in the GUI's clipboard." (interactive "r\np") - (let ((x-select-enable-clipboard t)) + (let ((gui-select-enable-clipboard t)) (kill-region beg end region))) (defun menu-bar-enable-clipboard () @@ -659,7 +658,7 @@ 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." + "Interactively select a font and make it the default on all existing frames." (interactive) (set-frame-font (if (fboundp 'x-select-font) (x-select-font) @@ -884,8 +883,33 @@ by \"Save Options\" in Custom buffers.") (interactive) (customize-set-variable 'scroll-bar-mode nil)) +(defun menu-bar-horizontal-scroll-bar () + "Display horizontal scroll bars on each window." + (interactive) + (customize-set-variable 'horizontal-scroll-bar-mode t)) + +(defun menu-bar-no-horizontal-scroll-bar () + "Turn off horizontal scroll bars." + (interactive) + (customize-set-variable 'horizontal-scroll-bar-mode nil)) + (defvar menu-bar-showhide-scroll-bar-menu (let ((menu (make-sparse-keymap "Scroll-bar"))) + (bindings--define-key menu [horizontal] + '(menu-item "Horizontal" + menu-bar-horizontal-scroll-bar + :help "Horizontal scroll bar" + :visible (horizontal-scroll-bars-available-p) + :button (:radio . (cdr (assq 'horizontal-scroll-bars + (frame-parameters)))))) + + (bindings--define-key menu [none-horizontal] + '(menu-item "None-horizontal" + menu-bar-no-horizontal-scroll-bar + :help "Turn off horizontal scroll bars" + :visible (horizontal-scroll-bars-available-p) + :button (:radio . (not (cdr (assq 'horizontal-scroll-bars + (frame-parameters))))))) (bindings--define-key menu [right] '(menu-item "On the Right" @@ -893,7 +917,8 @@ by \"Save Options\" in Custom buffers.") :help "Scroll-bar on the right side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) 'right)))) + (frame-parameters))) + 'right)))) (bindings--define-key menu [left] '(menu-item "On the Left" @@ -901,7 +926,8 @@ by \"Save Options\" in Custom buffers.") :help "Scroll-bar on the left side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) 'left)))) + (frame-parameters))) + 'left)))) (bindings--define-key menu [none] '(menu-item "None" @@ -909,7 +935,8 @@ by \"Save Options\" in Custom buffers.") :help "Turn off scroll-bar" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) nil)))) + (frame-parameters))) + nil)))) menu)) (defun menu-bar-frame-for-menubar () @@ -919,7 +946,7 @@ by \"Save Options\" in Custom buffers.") (selected-frame))) (defun menu-bar-positive-p (val) - "Return non-nil iff VAL is a positive number." + "Return non-nil if VAL is a positive number." (and (numberp val) (> val 0))) @@ -1299,9 +1326,6 @@ mail status in mode line")) (bindings--define-key menu [life] '(menu-item "Life" life :help "Watch how John Conway's cellular automaton evolves")) - (bindings--define-key menu [land] - '(menu-item "Landmark" landmark - :help "Watch a neural-network robot learn landmarks")) (bindings--define-key menu [hanoi] '(menu-item "Towers of Hanoi" hanoi :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) @@ -1418,6 +1442,8 @@ mail status in mode line")) (bindings--define-key menu [separator-net] menu-bar-separator) + (bindings--define-key menu [browse-web] + '(menu-item "Browse the Web..." browse-web)) (bindings--define-key menu [directory-search] '(menu-item "Directory Search" eudc-tools-menu)) (bindings--define-key menu [compose-mail] @@ -1633,14 +1659,6 @@ key, a click, or a menu-item")) :help "Read the Introduction to Emacs Lisp Programming")) menu)) -(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-mode 1))) - (defun help-with-tutorial-spec-language () "Use the Emacs tutorial, specifying which language you want." (interactive) @@ -1668,8 +1686,8 @@ key, a click, or a menu-item")) (bindings--define-key menu [sep2] menu-bar-separator) (bindings--define-key menu [external-packages] - '(menu-item "Finding Extra Packages" menu-bar-help-extra-packages - :help "Lisp packages distributed separately for use in Emacs")) + '(menu-item "Finding Extra Packages" view-external-packages + :help "How to get more Lisp packages for use in Emacs")) (bindings--define-key menu [find-emacs-packages] '(menu-item "Search Built-in Packages" finder-by-keyword :help "Find built-in packages and features by keyword")) @@ -1961,11 +1979,10 @@ It must accept a buffer as its only required argument.") (dolist (pair alist) (setq i (1- i)) (aset buffers-vec i - (nconc (list (car pair) - (cons nil nil)) - `(lambda () - (interactive) - (funcall menu-bar-select-buffer-function ,(cdr pair)))))) + (cons (car pair) + `(lambda () + (interactive) + (funcall menu-bar-select-buffer-function ,(cdr pair)))))) (list buffers-vec)))) ;; Make a Frames menu if we have more than one frame. @@ -1977,10 +1994,8 @@ It must accept a buffer as its only required argument.") (i 0)) (dolist (frame frames) (aset frames-vec i - (nconc - (list - (frame-parameter frame 'name) - (cons nil nil)) + (cons + (frame-parameter frame 'name) `(lambda () (interactive) (menu-bar-select-frame ,frame)))) (setq i (1+ i))) @@ -2143,6 +2158,13 @@ See `menu-bar-mode' for more information." (declare-function x-menu-bar-open "term/x-win" (&optional frame)) (declare-function w32-menu-bar-open "term/w32-win" (&optional frame)) +(defun lookup-key-ignore-too-long (map key) + "Call `lookup-key' and convert numeric values to nil." + (let ((binding (lookup-key map key))) + (if (numberp binding) ; `too long' + nil + binding))) + (defun popup-menu (menu &optional position prefix from-menu-bar) "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 @@ -2195,11 +2217,9 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." (let ((mouse-click (apply 'vector event)) binding) (while (and map (null binding)) - (setq binding (lookup-key (car map) mouse-click)) - (if (numberp binding) ; `too long' - (setq binding nil)) + (setq binding (lookup-key-ignore-too-long (car map) mouse-click)) (setq map (cdr map))) - binding)) + binding)) (t ;; We were given a single keymap. (lookup-key map (apply 'vector event))))) @@ -2270,11 +2290,19 @@ If FRAME is nil or not given, use the selected frame." ((eq type 'w32) (w32-menu-bar-open frame)) ((and (null tty-menu-open-use-tmm) (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0)))) + ;; Make sure the menu bar is up to date. One situation where + ;; this is important is when this function is invoked by name + ;; via M-x, in which case the menu bar includes the "Minibuf" + ;; menu item that should be removed when we exit the minibuffer. + (force-mode-line-update) + (redisplay) (let* ((x tty-menu--initial-menu-x) (menu (menu-bar-menu-at-x-y x 0 frame))) (popup-menu (or - (lookup-key global-map (vector 'menu-bar menu)) - (lookup-key (current-local-map) (vector 'menu-bar menu)) + (lookup-key-ignore-too-long + global-map (vector 'menu-bar menu)) + (lookup-key-ignore-too-long + (current-local-map) (vector 'menu-bar menu)) (cdar (minor-mode-key-binding (vector 'menu-bar menu)))) (posn-at-x-y x 0 nil t) nil t))) (t (with-selected-frame (or frame (selected-frame))