HideIfDef mode bug fixes and enhancements. This is #2 of 3 patches based
[bpt/emacs.git] / lisp / help.el
index 19cb811..72a9524 100644 (file)
@@ -1,8 +1,8 @@
 ;;; help.el --- help commands for Emacs
 
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 Free Software Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: help, internal
 ;; Package: emacs
 
 ;; `help-window-point-marker' is a marker you can move to a valid
 ;; position of the buffer shown in the help window in order to override
 ;; the standard positioning mechanism (`point-min') chosen by
-;; `with-output-to-temp-buffer'.  `with-help-window' has this point
-;; nowhere before exiting.  Currently used by `view-lossage' to assert
-;; that the last keystrokes are always visible.
+;; `with-output-to-temp-buffer' and `with-temp-buffer-window'.
+;; `with-help-window' has this point nowhere before exiting.  Currently
+;; used by `view-lossage' to assert that the last keystrokes are always
+;; visible.
 (defvar help-window-point-marker (make-marker)
   "Marker to override default `window-point' in help windows.")
 
@@ -131,7 +132,9 @@ This function assumes that `standard-output' is the help buffer.
 It computes a message, and applies the optional argument FUNCTION to it.
 If FUNCTION is nil, it applies `message', thus displaying the message.
 In addition, this function sets up `help-return-method', which see, that
-specifies what to do when the user exits the help buffer."
+specifies what to do when the user exits the help buffer.
+
+Do not call this in the scope of `with-help-window'."
   (and (not (get-buffer-window standard-output))
        (let ((first-message
              (cond ((or
@@ -145,10 +148,6 @@ specifies what to do when the user exits the help buffer."
                     ;; Secondly, the buffer has not been displayed yet,
                     ;; so we don't know whether its frame will be selected.
                     nil)
-                   (display-buffer-reuse-frames
-                    (setq help-return-method (cons (selected-window)
-                                                   'quit-window))
-                    nil)
                    ((not (one-window-p t))
                     (setq help-return-method
                           (cons (selected-window) 'quit-window))
@@ -216,6 +215,7 @@ m           Display documentation of current minor modes and current major mode,
               including their special commands.
 n           Display news of recent Emacs changes.
 p TOPIC     Find packages matching a given topic keyword.
+P PACKAGE   Describe the given Emacs Lisp package.
 r           Display the Emacs manual in Info mode.
 s           Display contents of current syntax table, plus explanations.
 S SYMBOL    Show the section for the given symbol in the on-line manual
@@ -414,12 +414,15 @@ With argument, display info only for the selected version."
 The number of messages retained in that buffer
 is specified by the variable `message-log-max'."
   (interactive)
-  (switch-to-buffer (get-buffer-create "*Messages*")))
+  (with-current-buffer (messages-buffer)
+    (goto-char (point-max))
+    (display-buffer (current-buffer))))
 
 (defun view-order-manuals ()
-  "Display the Emacs ORDERS file."
+  "Display information on how to buy printed copies of Emacs manuals."
   (interactive)
-  (view-help-file "ORDERS"))
+;;  (view-help-file "ORDERS")
+  (info "(emacs)Printed Books"))
 
 (defun view-emacs-FAQ ()
   "Display the Emacs Frequently Asked Questions (FAQ) file."
@@ -437,15 +440,16 @@ is specified by the variable `message-log-max'."
   (interactive)
   (view-help-file "DEBUG"))
 
+;; This used to visit MORE.STUFF; maybe it should just be removed.
 (defun view-external-packages ()
-  "Display external packages and information about Emacs."
+  "Display info on where to get more Emacs packages."
   (interactive)
-  (view-help-file "MORE.STUFF"))
+  (info "(efaq)Packages that do not come with Emacs"))
 
 (defun view-lossage ()
   "Display last 300 input keystrokes.
 
-To record all your input on a file, use `open-dribble-file'."
+To record all your input, use `open-dribble-file'."
   (interactive)
   (help-setup-xref (list #'view-lossage)
                   (called-interactively-p 'interactive))
@@ -469,8 +473,8 @@ To record all your input on a file, use `open-dribble-file'."
 ;; Key bindings
 
 (defun describe-bindings (&optional prefix buffer)
-  "Show a list of all defined keys, and their definitions.
-We put that list in a buffer, and display the buffer.
+  "Display a buffer showing a list of all defined keys, and their definitions.
+The keys are displayed in order of precedence.
 
 The optional argument PREFIX, if non-nil, should be a key sequence;
 then we display only bindings that start with that prefix.
@@ -481,8 +485,11 @@ or a buffer name."
   (or buffer (setq buffer (current-buffer)))
   (help-setup-xref (list #'describe-bindings prefix buffer)
                   (called-interactively-p 'interactive))
-  (with-current-buffer buffer
-    (describe-bindings-internal nil prefix)))
+  (with-help-window (help-buffer)
+    ;; Be aware that `describe-buffer-bindings' puts its output into
+    ;; the current buffer.
+    (with-current-buffer (help-buffer)
+      (describe-buffer-bindings buffer prefix))))
 
 ;; This function used to be in keymap.c.
 (defun describe-bindings-internal (&optional menus prefix)
@@ -493,9 +500,12 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
 \(Ordinarily these are omitted from the output.)
 The optional argument PREFIX, if non-nil, should be a key sequence;
 then we display only bindings that start with that prefix."
+  (declare (obsolete describe-buffer-bindings "24.4"))
   (let ((buf (current-buffer)))
-    (with-help-window "*Help*"
-      (with-current-buffer standard-output
+    (with-help-window (help-buffer)
+      ;; Be aware that `describe-buffer-bindings' puts its output into
+      ;; the current buffer.
+      (with-current-buffer (help-buffer)
        (describe-buffer-bindings buf prefix menus)))))
 
 (defun where-is (definition &optional insert)
@@ -588,6 +598,8 @@ temporarily enables it to allow getting help on disabled items and buttons."
             (setq saved-yank-menu (copy-sequence yank-menu))
             (menu-bar-update-yank-menu "(any string)" nil))
           (setq key (read-key-sequence "Describe key (or click or menu item): "))
+          ;; Clear the echo area message (Bug#7014).
+          (message nil)
           ;; If KEY is a down-event, read and discard the
           ;; corresponding up-event.  Note that there are also
           ;; down-events on scroll bars and mode lines: the actual
@@ -965,7 +977,11 @@ is currently activated with completion."
     result))
 \f
 ;;; Automatic resizing of temporary buffers.
-(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
+(defcustom temp-buffer-max-height
+  (lambda (buffer)
+    (if (eq (selected-window) (frame-root-window))
+       (/ (x-display-pixel-height) (frame-char-height) 2)
+      (/ (- (frame-height) 2) 2)))
   "Maximum height of a window displaying a temporary buffer.
 This is effective only when Temp Buffer Resize mode is enabled.
 The value is the maximum height (in lines) which
@@ -976,19 +992,41 @@ buffer, and should return a positive integer.  At the time the
 function is called, the window to be resized is selected."
   :type '(choice integer function)
   :group 'help
-  :version "20.4")
+  :version "24.3")
+
+(defcustom temp-buffer-max-width
+  (lambda (buffer)
+    (if (eq (selected-window) (frame-root-window))
+       (/ (x-display-pixel-width) (frame-char-width) 2)
+      (/ (- (frame-width) 2) 2)))
+  "Maximum width of a window displaying a temporary buffer.
+This is effective only when Temp Buffer Resize mode is enabled.
+The value is the maximum width (in columns) which
+`resize-temp-buffer-window' will give to a window displaying a
+temporary buffer.  It can also be a function to be called to
+choose the width for such a buffer.  It gets one argument, the
+buffer, and should return a positive integer.  At the time the
+function is called, the window to be resized is selected."
+  :type '(choice integer function)
+  :group 'help
+  :version "24.4")
 
 (define-minor-mode temp-buffer-resize-mode
-  "Toggle auto-shrinking temp buffer windows (Temp Buffer Resize mode).
+  "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
 With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
 is positive, and disable it otherwise.  If called from Lisp,
 enable the mode if ARG is omitted or nil.
 
 When Temp Buffer Resize mode is enabled, the windows in which we
-show a temporary buffer are automatically reduced in height to
+show a temporary buffer are automatically resized in height to
 fit the buffer's contents, but never more than
 `temp-buffer-max-height' nor less than `window-min-height'.
 
+A window is resized only if it has been specially created for the
+buffer.  Windows that have shown another buffer before are not
+resized.  A frame is resized only if `fit-frame-to-buffer' is
+non-nil.
+
 This mode is used by `help', `apropos' and `completion' buffers,
 and some others."
   :global t :group 'help
@@ -998,19 +1036,42 @@ and some others."
       (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
     (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
 
-(defun resize-temp-buffer-window ()
-  "Resize the selected window to fit its contents.
-Will not make it higher than `temp-buffer-max-height' nor smaller
-than `window-min-height'.  Do nothing if the selected window is
-not vertically combined or some of its contents are scrolled out
-of view."
-  (when (and (pos-visible-in-window-p (point-min))
-            (window-combined-p))
-    (fit-window-to-buffer
-     nil
-     (if (functionp temp-buffer-max-height)
-        (funcall temp-buffer-max-height (window-buffer))
-       temp-buffer-max-height))))
+(defun resize-temp-buffer-window (&optional window)
+  "Resize WINDOW to fit its contents.
+WINDOW must be a live window and defaults to the selected one.
+Do not resize if WINDOW was not created by `display-buffer'.
+
+If WINDOW is part of a vertical combination, restrain its new
+size by `temp-buffer-max-height' and do not resize if its minimum
+accessible position is scrolled out of view.  If WINDOW is part
+of a horizontal combination, restrain its new size by
+`temp-buffer-max-width'.  In both cases, the value of the option
+`fit-window-to-buffer-horizontally' can inhibit resizing.
+
+If WINDOW is the root window of its frame, resize the frame
+provided `fit-frame-to-buffer' is non-nil."
+  (setq window (window-normalize-window window t))
+  (let ((height (if (functionp temp-buffer-max-height)
+                   (with-selected-window window
+                     (funcall temp-buffer-max-height (window-buffer)))
+                 temp-buffer-max-height))
+       (width (if (functionp temp-buffer-max-width)
+                  (with-selected-window window
+                    (funcall temp-buffer-max-width (window-buffer)))
+                temp-buffer-max-width))
+       (quit-cadr (cadr (window-parameter window 'quit-restore))))
+    ;; Resize WINDOW iff it was made by `display-buffer'.
+    (when (or (and (eq quit-cadr 'window)
+                  (or (and (window-combined-p window)
+                           (not (eq fit-window-to-buffer-horizontally
+                                    'only))
+                           (pos-visible-in-window-p (point-min) window))
+                      (and (window-combined-p window t)
+                           fit-window-to-buffer-horizontally)))
+             (and (eq quit-cadr 'frame)
+                    fit-frame-to-buffer
+                    (eq window (frame-root-window window))))
+       (fit-window-to-buffer window height nil width))))
 
 ;;; Help windows.
 (defcustom help-window-select 'other
@@ -1063,28 +1124,29 @@ window."
     (message "%s"
      (substitute-command-keys (concat quit-part scroll-part)))))
 
-(defun help-window-setup (help-window)
-  "Set up help window for `with-help-window'.
-HELP-WINDOW is the window used for displaying the help buffer."
-  (let* ((help-buffer (when (window-live-p help-window)
-                       (window-buffer help-window)))
-        (help-setup (when (window-live-p help-window)
-                      (car (window-parameter help-window 'quit-restore)))))
+(defun help-window-setup (window &optional value)
+  "Set up help window WINDOW for `with-help-window'.
+WINDOW is the window used for displaying the help buffer.
+Return VALUE."
+  (let* ((help-buffer (when (window-live-p window)
+                       (window-buffer window)))
+        (help-setup (when (window-live-p window)
+                      (car (window-parameter window 'quit-restore)))))
     (when help-buffer
       ;; Handle `help-window-point-marker'.
       (when (eq (marker-buffer help-window-point-marker) help-buffer)
-       (set-window-point help-window help-window-point-marker)
+       (set-window-point window help-window-point-marker)
        ;; Reset `help-window-point-marker'.
        (set-marker help-window-point-marker nil))
 
       (cond
-       ((or (eq help-window (selected-window))
+       ((or (eq window (selected-window))
            (and (or (eq help-window-select t)
                     (eq help-setup 'frame)
                     (and (eq help-window-select 'other)
-                         (eq (window-frame help-window) (selected-frame))
+                         (eq (window-frame window) (selected-frame))
                          (> (length (window-list nil 'no-mini)) 2)))
-                (select-window help-window)))
+                (select-window window)))
        ;; The help window is or gets selected ...
        (help-window-display-message
         (cond
@@ -1092,12 +1154,12 @@ HELP-WINDOW is the window used for displaying the help buffer."
           ;; ... and is new, ...
           "Type \"q\" to delete help window")
          ((eq help-setup 'frame)
-          "Type \"q\" to delete help frame")
+          "Type \"q\" to quit the help frame")
          ((eq help-setup 'other)
           ;; ... or displayed some other buffer before.
           "Type \"q\" to restore previous buffer"))
-        help-window t))
-       ((and (eq (window-frame help-window) (selected-frame))
+        window t))
+       ((and (eq (window-frame window) (selected-frame))
             (= (length (window-list nil 'no-mini)) 2))
        ;; There are two windows on the help window's frame and the
        ;; other one is the selected one.
@@ -1107,7 +1169,7 @@ HELP-WINDOW is the window used for displaying the help buffer."
           "Type \\[delete-other-windows] to delete the help window")
          ((eq help-setup 'other)
           "Type \"q\" in help window to restore its previous buffer"))
-        help-window 'other))
+        window 'other))
        (t
        ;; The help window is not selected ...
        (help-window-display-message
@@ -1118,40 +1180,44 @@ HELP-WINDOW is the window used for displaying the help buffer."
          ((eq help-setup 'other)
           ;; ... or displayed some other buffer before.
           "Type \"q\" in help window to restore previous buffer"))
-        help-window))))))
+        window))))
+    ;; Return VALUE.
+    value))
 
-;; `with-help-window' is a wrapper for `with-output-to-temp-buffer'
+;; `with-help-window' is a wrapper for `with-temp-buffer-window'
 ;; providing the following additional twists:
 
-;; (1) Issue more accurate messages telling how to scroll and quit the
-;; help window.
+;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and
+;;     adds cross references (via `help-mode-finish').
 
-;; (2) An option (customizable via `help-window-select') to select the
-;; help window automatically.
+;; (2) It issues a message telling how to scroll and quit the help
+;;     window (via `help-window-setup').
 
-;; (3) A marker (`help-window-point-marker') to move point in the help
-;; window to an arbitrary buffer position.
+;; (3) An option (customizable via `help-window-select') to select the
+;;     help window automatically.
 
-;; Note: It's usually always wrong to use `help-print-return-message' in
-;; the body of `with-help-window'.
+;; (4) A marker (`help-window-point-marker') to move point in the help
+;;     window to an arbitrary buffer position.
 (defmacro with-help-window (buffer-name &rest body)
-  "Display buffer with name BUFFER-NAME in a help window evaluating BODY.
-Select help window if the actual value of the user option
+  "Display buffer named BUFFER-NAME in a help window.
+Evaluate the forms in BODY with standard output bound to a buffer
+called BUFFER-NAME (creating it if it does not exist), put that
+buffer in `help-mode', display the buffer in a window (see
+`with-temp-buffer-window' for details) and issue a message how to
+deal with that \"help\" window when it's no more needed.  Select
+the help window if the current value of the user option
 `help-window-select' says so.  Return last value in BODY."
   (declare (indent 1) (debug t))
   `(progn
      ;; Make `help-window-point-marker' point nowhere.  The only place
      ;; where this should be set to a buffer position is within BODY.
      (set-marker help-window-point-marker nil)
-     (let* (help-window
-            (temp-buffer-show-hook
-             (cons (lambda () (setq help-window (selected-window)))
-                   temp-buffer-show-hook)))
-       ;; Return value returned by `with-output-to-temp-buffer'.
-       (prog1
-          (with-output-to-temp-buffer ,buffer-name
-            (progn ,@body))
-        (help-window-setup help-window)))))
+     (let ((temp-buffer-window-setup-hook
+           (cons 'help-mode-setup temp-buffer-window-setup-hook))
+          (temp-buffer-window-show-hook
+           (cons 'help-mode-finish temp-buffer-window-show-hook)))
+       (with-temp-buffer-window
+       ,buffer-name nil 'help-window-setup (progn ,@body)))))
 
 ;; Called from C, on encountering `help-char' when reading a char.
 ;; Don't print to *Help*; that would clobber Help history.
@@ -1161,6 +1227,113 @@ Select help window if the actual value of the user option
     (if (stringp msg)
        (with-output-to-temp-buffer " *Char Help*"
          (princ msg)))))
+
+\f
+;; The following functions used to be in help-fns.el, which is not preloaded.
+;; But for various reasons, they are more widely needed, so they were
+;; moved to this file, which is preloaded.  http://debbugs.gnu.org/17001
+
+(defun help-split-fundoc (docstring def)
+  "Split a function DOCSTRING into the actual doc and the usage info.
+Return (USAGE . DOC) or nil if there's no usage info, where USAGE info
+is a string describing the argument list of DEF, such as
+\"(apply FUNCTION &rest ARGUMENTS)\".
+DEF is the function whose usage we're looking for in DOCSTRING."
+  ;; Functions can get the calling sequence at the end of the doc string.
+  ;; In cases where `function' has been fset to a subr we can't search for
+  ;; function's name in the doc string so we use `fn' as the anonymous
+  ;; function name instead.
+  (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
+    (cons (format "(%s%s"
+                 ;; Replace `fn' with the actual function name.
+                 (if (symbolp def) def "anonymous")
+                 (match-string 1 docstring))
+         (unless (zerop (match-beginning 0))
+            (substring docstring 0 (match-beginning 0))))))
+
+(defun help-add-fundoc-usage (docstring arglist)
+  "Add the usage info to DOCSTRING.
+If DOCSTRING already has a usage info, then just return it unchanged.
+The usage info is built from ARGLIST.  DOCSTRING can be nil.
+ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
+  (unless (stringp docstring) (setq docstring ""))
+  (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)
+          (eq arglist t))
+      docstring
+    (concat docstring
+           (if (string-match "\n?\n\\'" docstring)
+               (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
+             "\n\n")
+           (if (and (stringp arglist)
+                    (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
+               (concat "(fn" (match-string 1 arglist) ")")
+             (format "%S" (help-make-usage 'fn arglist))))))
+
+(defun help-function-arglist (def &optional preserve-names)
+  "Return a formal argument list for the function DEF.
+IF PRESERVE-NAMES is non-nil, return a formal arglist that uses
+the same names as used in the original source code, when possible."
+  ;; Handle symbols aliased to other symbols.
+  (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
+  ;; If definition is a macro, find the function inside it.
+  (if (eq (car-safe def) 'macro) (setq def (cdr def)))
+  (cond
+   ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
+   ((eq (car-safe def) 'lambda) (nth 1 def))
+   ((eq (car-safe def) 'closure) (nth 2 def))
+   ((or (and (byte-code-function-p def) (integerp (aref def 0)))
+        (subrp def))
+    (or (when preserve-names
+          (let* ((doc (condition-case nil (documentation def) (error nil)))
+                 (docargs (if doc (car (help-split-fundoc doc nil))))
+                 (arglist (if docargs
+                              (cdar (read-from-string (downcase docargs)))))
+                 (valid t))
+            ;; Check validity.
+            (dolist (arg arglist)
+              (unless (and (symbolp arg)
+                           (let ((name (symbol-name arg)))
+                             (if (eq (aref name 0) ?&)
+                                 (memq arg '(&rest &optional))
+                               (not (string-match "\\." name)))))
+                (setq valid nil)))
+            (when valid arglist)))
+        (let* ((args-desc (if (not (subrp def))
+                              (aref def 0)
+                            (let ((a (subr-arity def)))
+                              (logior (car a)
+                                      (if (numberp (cdr a))
+                                          (lsh (cdr a) 8)
+                                        (lsh 1 7))))))
+               (max (lsh args-desc -8))
+               (min (logand args-desc 127))
+               (rest (logand args-desc 128))
+               (arglist ()))
+          (dotimes (i min)
+            (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
+          (when (> max min)
+            (push '&optional arglist)
+            (dotimes (i (- max min))
+              (push (intern (concat "arg" (number-to-string (+ 1 i min))))
+                    arglist)))
+          (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
+          (nreverse arglist))))
+   ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
+    "[Arg list not available until function definition is loaded.]")
+   (t t)))
+
+(defun help-make-usage (function arglist)
+  (cons (if (symbolp function) function 'anonymous)
+       (mapcar (lambda (arg)
+                 (if (not (symbolp arg)) arg
+                   (let ((name (symbol-name arg)))
+                     (cond
+                       ((string-match "\\`&" name) arg)
+                       ((string-match "\\`_" name)
+                        (intern (upcase (substring name 1))))
+                       (t (intern (upcase name)))))))
+               arglist)))
+
 \f
 (provide 'help)