* src/eval.c (Fbind_symbol): New function.
[bpt/emacs.git] / lisp / menu-bar.el
index 25e019f..c816488 100644 (file)
@@ -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
 
 (or (lookup-key global-map [menu-bar])
     (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
 
-(if (not (featurep 'ns))
-    ;; 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))
-  (if (eq system-type 'darwin)
-      (setq menu-bar-final-items '(buffer services help-menu))
-    (setq menu-bar-final-items '(buffer services hide-app quit))
-    ;; Add standard top-level items to GNUstep menu.
-    (bindings--define-key global-map [menu-bar quit]
-      '(menu-item "Quit" save-buffers-kill-emacs
-                   :help "Save unsaved buffers, then exit"))
-    (bindings--define-key global-map [menu-bar hide-app]
-      '(menu-item "Hide" ns-do-hide-emacs
-                  :help "Hide Emacs")))
-  (bindings--define-key global-map [menu-bar services] ; Set-up in ns-win.
-    (cons "Services" (make-sparse-keymap "Services"))))
+;; 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))
 
 ;; This definition is just to show what this looks like.
 ;; It gets modified in place when menu-bar-update-buffers is called.
                   :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
   (let ((x-select-enable-clipboard t))
     (yank)))
 
-(defun clipboard-kill-ring-save (beg end)
+(defun clipboard-kill-ring-save (beg end &optional region)
   "Copy region to kill ring, and save in the X clipboard."
-  (interactive "r")
+  (interactive "r\np")
   (let ((x-select-enable-clipboard t))
-    (kill-ring-save beg end)))
+    (kill-ring-save beg end region)))
 
-(defun clipboard-kill-region (beg end)
+(defun clipboard-kill-region (beg end &optional region)
   "Kill the region, and save it in the X clipboard."
-  (interactive "r")
+  (interactive "r\np")
   (let ((x-select-enable-clipboard t))
-    (kill-region beg end)))
+    (kill-region beg end region)))
 
 (defun menu-bar-enable-clipboard ()
   "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
@@ -672,7 +662,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)
@@ -932,7 +922,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)))
 
@@ -1236,10 +1226,9 @@ mail status in mode line"))
        "Use Directory Names in Buffer Names"
        "Directory name in buffer names (uniquify) %s"
        "Uniquify buffer names by adding parent directory names"
-       (require 'uniquify)
        (setq uniquify-buffer-name-style
             (if (not uniquify-buffer-name-style)
-                'forward))))
+                'post-forward-angle-brackets))))
 
     (bindings--define-key menu [edit-options-separator]
       menu-bar-separator)
@@ -1432,6 +1421,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]
@@ -1647,14 +1638,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)
@@ -1682,8 +1665,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"))
@@ -1743,15 +1726,8 @@ key, a click, or a menu-item"))
   (cons "Edit" menu-bar-edit-menu))
 (bindings--define-key global-map [menu-bar file]
   (cons "File" menu-bar-file-menu))
-
-;; Put "Help" menu at the end, or Info at the front.
-;; If running under GNUstep, "Help" is moved and renamed "Info" (see below).
-(if (and (featurep 'ns)
-         (not (eq system-type 'darwin)))
-    (bindings--define-key global-map [menu-bar help-menu]
-      (cons "Info" menu-bar-help-menu))
-  (define-key-after global-map [menu-bar help-menu]
-    (cons (purecopy "Help") menu-bar-help-menu)))
+(bindings--define-key global-map [menu-bar help-menu]
+  (cons (purecopy "Help") menu-bar-help-menu))
 
 (defun menu-bar-menu-frame-live-and-visible-p ()
   "Return non-nil if the menu frame is alive and visible.
@@ -2046,7 +2022,7 @@ It must accept a buffer as its only required argument.")
          ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
          ;; but that did not do the right thing when the [menu-bar buffer]
          ;; entry above had been moved (e.g. to a parent keymap).
-        (setcdr global-buffers-menu-map (cons "Select Buffer" buffers-menu)))))
+        (setcdr global-buffers-menu-map (cons "Buffers" buffers-menu)))))
 
 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
 
@@ -2164,6 +2140,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
@@ -2209,21 +2192,16 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus."
                (setq position (list menu-symbol (list frame '(menu-bar)
                                                 event 0)))
                (setq map
-                     (or
-                      (lookup-key global-map (vector 'menu-bar menu-symbol))
-                      (lookup-key (current-local-map) (vector 'menu-bar
-                                                              menu-symbol))))))
+                     (key-binding (vector 'menu-bar menu-symbol)))))
             ((and (not (keymapp map)) (listp map))
              ;; We were given a list of keymaps.  Search them all
              ;; in sequence until a first binding is found.
              (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)))))
@@ -2261,73 +2239,6 @@ If nil, the current mouse position is used."
      (popup-menu-normalize-position (event-end position)))
     (t position)))
 
-(defvar tty-menu-navigation-map
-  (let ((map (make-sparse-keymap)))
-    ;; The next line is disabled because it breaks interpretation of
-    ;; escape sequences, produced by TTY arrow keys, as tty-menu-*
-    ;; commands.  Instead, we explicitly bind some keys to
-    ;; tty-menu-exit.
-    ;;(define-key map [t] 'tty-menu-exit)
-
-    ;; The tty-menu-* are just symbols interpreted by term.c, they are
-    ;; not real commands.
-    (dolist (bind '((keyboard-quit . tty-menu-exit)
-                    (keyboard-escape-quit . tty-menu-exit)
-                    ;; The following two will need to be revised if we ever
-                    ;; support a right-to-left menu bar.
-                    (forward-char . tty-menu-next-menu)
-                    (backward-char . tty-menu-prev-menu)
-                    (right-char . tty-menu-next-menu)
-                    (left-char . tty-menu-prev-menu)
-                    (next-line . tty-menu-next-item)
-                    (previous-line . tty-menu-prev-item)
-                    (newline . tty-menu-select)
-                    (newline-and-indent . tty-menu-select)))
-      (substitute-key-definition (car bind) (cdr bind)
-                                 map (current-global-map)))
-
-    ;; The bindings of menu-bar items are so that clicking on the menu
-    ;; bar when a menu is already shown pops down that menu.
-    ;; FIXME: we should iterate over all the visible menu-bar items,
-    ;; instead of naming them explicitly here.  Also, this doesn't
-    ;; include items added by current major mode.
-    ;;
-    ;; FIXME: Why not (define-key map [menu-bat t] 'tty-menu-exit) ?  --Stef
-    (dolist (event '(file edit options buffer tools help-menu))
-      (substitute-key-definition
-       (lookup-key (current-global-map) (vector 'menu-bar event))
-       'tty-menu-exit
-       map (current-global-map)))
-
-    (define-key map [?\C-r] 'tty-menu-select)
-    (define-key map [?\C-j] 'tty-menu-select)
-    (define-key map [return] 'tty-menu-select)
-    (define-key map [linefeed] 'tty-menu-select)
-    (define-key map [down-mouse-1] 'tty-menu-select)
-    (define-key map [drag-mouse-1] 'tty-menu-select)
-    (define-key map [mode-line drag-mouse-1] 'tty-menu-select)
-    (define-key map [mode-line down-mouse-1] 'tty-menu-select)
-    (define-key map [header-line mouse-1] 'tty-menu-select)
-    (define-key map [header-line drag-mouse-1] 'tty-menu-select)
-    (define-key map [header-line down-mouse-1] 'tty-menu-select)
-    (define-key map [mode-line mouse-1] 'tty-menu-ignore)
-    (define-key map [mode-line mouse-2] 'tty-menu-ignore)
-    (define-key map [mode-line mouse-3] 'tty-menu-ignore)
-    (define-key map [mode-line C-mouse-1] 'tty-menu-ignore)
-    (define-key map [mode-line C-mouse-2] 'tty-menu-ignore)
-    (define-key map [mode-line C-mouse-3] 'tty-menu-ignore)
-    ;; The mouse events must be bound to tty-menu-ignore, otherwise
-    ;; the initial mouse click will select and immediately pop down
-    ;; the menu.
-    (define-key map [mouse-1] 'tty-menu-ignore)
-    (define-key map [C-mouse-1] 'tty-menu-ignore)
-    (define-key map [C-mouse-2] 'tty-menu-ignore)
-    (define-key map [C-mouse-3] 'tty-menu-ignore)
-    (define-key map [mouse-movement] 'tty-menu-mouse-movement)
-    map)
-  "Keymap used while processing TTY menus.")
-
-
 (defcustom tty-menu-open-use-tmm nil
   "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'.
 
@@ -2361,17 +2272,96 @@ 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))
           (tmm-menubar))))))
 
 (global-set-key [f10] 'menu-bar-open)
 
+(defvar tty-menu-navigation-map
+  (let ((map (make-sparse-keymap)))
+    ;; The next line is disabled because it breaks interpretation of
+    ;; escape sequences, produced by TTY arrow keys, as tty-menu-*
+    ;; commands.  Instead, we explicitly bind some keys to
+    ;; tty-menu-exit.
+    ;;(define-key map [t] 'tty-menu-exit)
+
+    ;; The tty-menu-* are just symbols interpreted by term.c, they are
+    ;; not real commands.
+    (dolist (bind '((keyboard-quit . tty-menu-exit)
+                    (keyboard-escape-quit . tty-menu-exit)
+                    ;; The following two will need to be revised if we ever
+                    ;; support a right-to-left menu bar.
+                    (forward-char . tty-menu-next-menu)
+                    (backward-char . tty-menu-prev-menu)
+                    (right-char . tty-menu-next-menu)
+                    (left-char . tty-menu-prev-menu)
+                    (next-line . tty-menu-next-item)
+                    (previous-line . tty-menu-prev-item)
+                    (newline . tty-menu-select)
+                    (newline-and-indent . tty-menu-select)
+                   (menu-bar-open . tty-menu-exit)))
+      (substitute-key-definition (car bind) (cdr bind)
+                                 map (current-global-map)))
+
+    ;; The bindings of menu-bar items are so that clicking on the menu
+    ;; bar when a menu is already shown pops down that menu.
+    (define-key map [menu-bar t] 'tty-menu-exit)
+
+    (define-key map [?\C-r] 'tty-menu-select)
+    (define-key map [?\C-j] 'tty-menu-select)
+    (define-key map [return] 'tty-menu-select)
+    (define-key map [linefeed] 'tty-menu-select)
+    (define-key map [mouse-1] 'tty-menu-select)
+    (define-key map [drag-mouse-1] 'tty-menu-select)
+    (define-key map [mouse-2] 'tty-menu-select)
+    (define-key map [drag-mouse-2] 'tty-menu-select)
+    (define-key map [mouse-3] 'tty-menu-select)
+    (define-key map [drag-mouse-3] 'tty-menu-select)
+    (define-key map [wheel-down] 'tty-menu-next-item)
+    (define-key map [wheel-up] 'tty-menu-prev-item)
+    (define-key map [wheel-left] 'tty-menu-prev-menu)
+    (define-key map [wheel-right] 'tty-menu-next-menu)
+    ;; The following 4 bindings are for those whose text-mode mouse
+    ;; lack the wheel.
+    (define-key map [S-mouse-1] 'tty-menu-next-item)
+    (define-key map [S-drag-mouse-1] 'tty-menu-next-item)
+    (define-key map [S-mouse-2] 'tty-menu-prev-item)
+    (define-key map [S-drag-mouse-2] 'tty-menu-prev-item)
+    (define-key map [S-mouse-3] 'tty-menu-prev-item)
+    (define-key map [S-drag-mouse-3] 'tty-menu-prev-item)
+    (define-key map [header-line mouse-1] 'tty-menu-select)
+    (define-key map [header-line drag-mouse-1] 'tty-menu-select)
+    ;; The down-mouse events must be bound to tty-menu-ignore, so that
+    ;; only releasing the mouse button pops up the menu.
+    (define-key map [mode-line down-mouse-1] 'tty-menu-ignore)
+    (define-key map [mode-line down-mouse-2] 'tty-menu-ignore)
+    (define-key map [mode-line down-mouse-3] 'tty-menu-ignore)
+    (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore)
+    (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore)
+    (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore)
+    (define-key map [down-mouse-1] 'tty-menu-ignore)
+    (define-key map [C-down-mouse-1] 'tty-menu-ignore)
+    (define-key map [C-down-mouse-2] 'tty-menu-ignore)
+    (define-key map [C-down-mouse-3] 'tty-menu-ignore)
+    (define-key map [mouse-movement] 'tty-menu-mouse-movement)
+    map)
+  "Keymap used while processing TTY menus.")
+
 (provide 'menu-bar)
 
 ;;; menu-bar.el ends here