(read_minibuf): Clean up the binding stack if
[bpt/emacs.git] / lisp / menu-bar.el
index 4cbfda6..e78858c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; menu-bar.el --- define a default menu bar.
 
-;; Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 2000, 2001 Free Software Foundation, Inc.
 
 ;; Author: RMS
 ;; Maintainer: FSF
@@ -104,10 +104,17 @@ A large number or nil slows down menu responsiveness."
   '(menu-item "--"))
 
 (define-key menu-bar-files-menu [ps-print-region]
+  '(menu-item "Postscript Print Region (B+W)" ps-print-region
+             :enable mark-active
+             :help "Pretty-print marked region in black and white to PostScript printer"))
+(define-key menu-bar-files-menu [ps-print-buffer]
+  '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer
+             :help "Pretty-print current buffer in black and white to PostScript printer"))
+(define-key menu-bar-files-menu [ps-print-region-faces]
   '(menu-item "Postscript Print Region" ps-print-region-with-faces
              :enable mark-active
              :help "Pretty-print marked region to PostScript printer"))
-(define-key menu-bar-files-menu [ps-print-buffer]
+(define-key menu-bar-files-menu [ps-print-buffer-faces]
   '(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces
              :help "Pretty-print current buffer to PostScript printer"))
 (define-key menu-bar-files-menu [print-region]
@@ -163,7 +170,7 @@ A large number or nil slows down menu responsiveness."
 (define-key menu-bar-files-menu [kill-buffer]
   '(menu-item "Close (current buffer)" kill-this-buffer
              :enable (kill-this-buffer-enabled-p)
-             :help "Discard contents of current buffer"))
+             :help "Discard current buffer"))
 (define-key menu-bar-files-menu [insert-file]
   '(menu-item "Insert File..." insert-file
              :enable (not (window-minibuffer-p
@@ -379,7 +386,7 @@ A large number or nil slows down menu responsiveness."
                           (not buffer-read-only)
                           (not (mouse-region-match)))
              :help
-             "Delete the text in region between mark and current pos"))
+             "Delete the text in region between mark and current position"))
 (defvar yank-menu (cons "Select Yank" nil))
 (fset 'yank-menu (cons 'keymap yank-menu))
 (define-key menu-bar-edit-menu [select-paste]
@@ -393,11 +400,12 @@ A large number or nil slows down menu responsiveness."
 (define-key menu-bar-edit-menu [copy]
   '(menu-item "Copy" menu-bar-kill-ring-save
              :enable mark-active
-             :help "Copy text in region between mark and current pos"))
+             :help "Copy text in region between mark and current position"))
 (define-key menu-bar-edit-menu [cut]
   '(menu-item "Cut" kill-region
              :enable (and mark-active (not buffer-read-only))
-             :help "Cut (kill) text in region between mark and current pos"))
+             :help
+             "Cut (kill) text in region between mark and current position"))
 (define-key menu-bar-edit-menu [undo]
   '(menu-item "Undo" undo
              :enable (and (not buffer-read-only)
@@ -594,7 +602,7 @@ Do the same for the keys of the same name."
   (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
                        "Use Directory Names in Buffer Names"
                        "Directory name in buffer names (uniquify) %s"
-                       nil
+                       "Uniquify a buffer name by adding parent directory names until unique"
                        (require 'uniquify)
                        (setq uniquify-buffer-name-style
                              (if (not uniquify-buffer-name-style)
@@ -640,6 +648,19 @@ Do the same for the keys of the same name."
 \f
 ;; The "Tools" menu items
 
+(defun send-mail-item-name ()
+  (let* ((known-send-mail-commands '((sendmail-user-agent . "sendmail")
+                                    (mh-e-user-agent . "MH")
+                                    (message-user-agent . "Gnus Message")
+                                    (gnus-user-agent . "Gnus")))
+        (name (assq mail-user-agent known-send-mail-commands)))
+    (if name
+       (setq name (cdr name))
+      (setq name (symbol-name mail-user-agent))
+      (if (string-match "\\(.+\\)-user-agent" name)
+         (setq name (match-string 1 name))))
+    name))
+
 (defun read-mail-item-name ()
   (let* ((known-rmail-commands '((rmail . "RMAIL")
                                 (mh-rmail . "MH")
@@ -698,14 +719,18 @@ Do the same for the keys of the same name."
   '(menu-item "Directory Search" eudc-tools-menu
              :help "Query directory servers via LDAP, CCSO PH/QI or BBDB"))
 (define-key menu-bar-tools-menu [compose-mail]
-  '(menu-item "Send Mail" compose-mail
-             :help "Send a mail message"))
+  (list
+   'menu-item `(format "Send Mail (with %s)" (send-mail-item-name))
+   'compose-mail
+   :visible `(and mail-user-agent (not (eq mail-user-agent 'ignore)))
+   :help "Send a mail message"))
 (define-key menu-bar-tools-menu [rmail]
   (list
    'menu-item `(format "Read Mail (with %s)" (read-mail-item-name))
    (lambda ()
      (interactive)
      (call-interactively read-mail-command))
+   :visible `(and read-mail-command (not (eq read-mail-command 'ignore)))
    :help "Read your mail and reply to it"))
 (define-key menu-bar-tools-menu [gnus]
   '(menu-item "Read Net News (Gnus)" gnus
@@ -846,6 +871,15 @@ key (or menu-item)"))
 (define-key menu-bar-help-menu [describe-distribution]
   '(menu-item "Getting New Versions" describe-distribution
              :help "How to get latest versions of Emacs"))
+(define-key menu-bar-help-menu [more]
+  '(menu-item "Find Extra Packages"
+             (lambda ()
+               (interactive)
+               (let (enable-local-variables)
+                 (view-file (expand-file-name "MORE.STUFF"
+                                              data-directory))
+                 (goto-address)))
+             :help "Where to find some extra packages and possible updates"))
 (define-key menu-bar-help-menu [emacs-version]
   '(menu-item "Show Emacs Version" emacs-version))
 (define-key menu-bar-help-menu [sep2]
@@ -864,6 +898,9 @@ key (or menu-item)"))
 (define-key menu-bar-help-menu [report-emacs-bug]
   '(menu-item "Send Bug Report..." report-emacs-bug
              :help "Send e-mail to Emacs maintainers"))
+(define-key menu-bar-help-menu [order-emacs-manuals]
+  '(menu-item "Ordering Manuals" view-order-manuals
+             :help "How to order manuals from the Free Software Foundation"))
 (define-key menu-bar-help-menu [emacs-manual]
   '(menu-item "Read the Emacs Manual"
              (lambda () (interactive) (info "emacs"))))
@@ -958,9 +995,13 @@ key (or menu-item)"))
 
 (defun menu-bar-select-frame ()
   (interactive)
-  (make-frame-visible last-command-event)
-  (raise-frame last-command-event)
-  (select-frame last-command-event))
+  (let (frame)
+    (dolist (f (frame-list))
+      (when (equal last-command-event (frame-parameter f 'name))
+       (setq frame f)))
+  (make-frame-visible frame)
+  (raise-frame frame)
+  (select-frame frame)))
 
 (defun menu-bar-update-buffers-1 (elt)
   (cons (format
@@ -986,10 +1027,10 @@ key (or menu-item)"))
 
 (defvar menu-bar-buffers-menu-list-buffers-entry nil)
 
-(defun menu-bar-update-buffers ()
+(defun menu-bar-update-buffers (&optional force)
   ;; If user discards the Buffers item, play along.
   (and (lookup-key (current-global-map) [menu-bar buffer])
-       (frame-or-buffer-changed-p)
+       (or force (frame-or-buffer-changed-p))
        (let ((buffers (buffer-list))
             (frames (frame-list))
             (maxlen 0)
@@ -1088,7 +1129,7 @@ key (or menu-item)"))
                                (mapcar
                                 (lambda (frame)
                                   (nconc
-                                   (list frame
+                                   (list (frame-parameter frame 'name)
                                          (frame-parameter frame 'name)
                                          (cons nil nil))
                                          'menu-bar-select-frame))
@@ -1124,48 +1165,37 @@ key (or menu-item)"))
 \f
 ;;; 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 'menu-item "List Completions" 'minibuffer-completion-help
-           :help "Display all possible completions"))
-    (define-key map [menu-bar minibuf space]
-      (list 'menu-item "Complete Word" 'minibuffer-complete-word
-           :help "Complete at most one word"))
-    (define-key map [menu-bar minibuf tab]
-      (list 'menu-item "Complete" 'minibuffer-complete
-           :help "Complete as far as possible"))
-    ))
- (list minibuffer-local-must-match-map
-       minibuffer-local-completion-map))
-
-(mapcar
- (function
-  (lambda (map)
-    (define-key map [menu-bar minibuf quit]
-      (list 'menu-item "Quit" 'keyboard-escape-quit
-           :help "Abort input and exit minibuffer"))
-    (define-key map [menu-bar minibuf return]
-      (list 'menu-item "Enter" 'exit-minibuffer
-           :help "Terminate input and exit minibuffer"))
-    ))
- (list minibuffer-local-ns-map
-       minibuffer-local-must-match-map
-       minibuffer-local-isearch-map
-       minibuffer-local-map
-       minibuffer-local-completion-map))
+(dolist (map (list minibuffer-local-ns-map
+                  minibuffer-local-must-match-map
+                  minibuffer-local-isearch-map
+                  minibuffer-local-map
+                  minibuffer-local-completion-map))
+  (define-key map [menu-bar minibuf]
+    (cons "Minibuf" (make-sparse-keymap "Minibuf"))))
+
+(dolist (map (list minibuffer-local-must-match-map
+                  minibuffer-local-completion-map))
+  (define-key map [menu-bar minibuf ?\?]
+    (list 'menu-item "List Completions" 'minibuffer-completion-help
+         :help "Display all possible completions"))
+  (define-key map [menu-bar minibuf space]
+    (list 'menu-item "Complete Word" 'minibuffer-complete-word
+         :help "Complete at most one word"))
+  (define-key map [menu-bar minibuf tab]
+    (list 'menu-item "Complete" 'minibuffer-complete
+         :help "Complete as far as possible")))
+
+(dolist (map (list minibuffer-local-ns-map
+                  minibuffer-local-must-match-map
+                  minibuffer-local-isearch-map
+                  minibuffer-local-map
+                  minibuffer-local-completion-map))
+  (define-key map [menu-bar minibuf quit]
+    (list 'menu-item "Quit" 'keyboard-escape-quit
+         :help "Abort input and exit minibuffer"))
+  (define-key map [menu-bar minibuf return]
+    (list 'menu-item "Enter" 'exit-minibuffer
+         :help "Terminate input and exit minibuffer")))
 \f
 (defcustom menu-bar-mode nil
   "Toggle display of a menu bar on each frame.