*** empty log message ***
[bpt/emacs.git] / lisp / help.el
index c3dfc51..aa3e7c4 100644 (file)
@@ -151,7 +151,7 @@ Commands:
 (add-hook 'temp-buffer-setup-hook 'help-mode-setup)
 
 (defun help-mode-finish ()
-  (when (eq major-mode 'help-mode) 
+  (when (eq major-mode 'help-mode)
     ;; View mode's read-only status of existing *Help* buffer is lost
     ;; by with-output-to-temp-buffer.
     (toggle-read-only 1)
@@ -274,6 +274,10 @@ If FUNCTION is nil, applies `message' to it, thus printing it."
                     ;; 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))
@@ -357,7 +361,8 @@ For minor modes, see following pages.\n\n"))
          ;; Document a minor mode if it is listed in minor-mode-alist,
          ;; bound locally in this buffer, non-nil, and has a function
          ;; definition.
-         (if (and (symbol-value minor-mode)
+         (if (and (boundp minor-mode)
+                  (symbol-value minor-mode)
                   (fboundp minor-mode))
              (let ((pretty-minor-mode minor-mode))
                (if (string-match "-mode$" (symbol-name minor-mode))
@@ -431,12 +436,19 @@ of the key sequence that ran this command."
 
 (defun view-emacs-news (&optional arg)
   "Display info on recent changes to Emacs.
-With numeric argument display information on correspondingly older changes."
+With numeric argument, display information on correspondingly older changes."
   (interactive "P")
-  (let* ((arg (if arg (prefix-numeric-value arg) 0)))
-    (find-file-read-only
-     (expand-file-name (concat (make-string arg ?O) "NEWS")
-                      data-directory))))
+  (let* ((arg (if arg (prefix-numeric-value arg) 0))
+        (file (cond ((eq arg 0) "NEWS")
+                    ((eq arg 1) "ONEWS")
+                    (t
+                     (nth (- arg 2)
+                          (nreverse (directory-files data-directory
+                                                     nil "^NEWS\\.[0-9]+$"
+                                                     nil)))))))
+    (if file
+       (find-file-read-only (expand-file-name file data-directory))
+      (error "No such old news"))))
 
 (defun view-emacs-FAQ ()
   "Display the Emacs Frequently Asked Questions (FAQ) file."
@@ -525,35 +537,32 @@ C-w Display information on absence of warranty for GNU Emacs."
 (defun function-called-at-point ()
   "Return a function around point or else called by the list containing point.
 If that doesn't give a function, return nil."
-  (let ((stab (syntax-table)))
-    (set-syntax-table emacs-lisp-mode-syntax-table)
-    (unwind-protect
-       (or (condition-case ()
-               (save-excursion
-                 (or (not (zerop (skip-syntax-backward "_w")))
-                     (eq (char-syntax (following-char)) ?w)
-                     (eq (char-syntax (following-char)) ?_)
-                     (forward-sexp -1))
-                 (skip-chars-forward "'")
-                 (let ((obj (read (current-buffer))))
-                   (and (symbolp obj) (fboundp obj) obj)))
-             (error nil))
-           (condition-case ()
-               (save-excursion
-                 (save-restriction
-                   (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
-                   ;; Move up to surrounding paren, then after the open.
-                   (backward-up-list 1)
-                   (forward-char 1)
-                   ;; If there is space here, this is probably something
-                   ;; other than a real Lisp function call, so ignore it.
-                   (if (looking-at "[ \t]")
-                       (error "Probably not a Lisp function call"))
-                   (let (obj)
-                     (setq obj (read (current-buffer)))
-                     (and (symbolp obj) (fboundp obj) obj))))
-             (error nil)))
-      (set-syntax-table stab))))
+  (with-syntax-table emacs-lisp-mode-syntax-table
+    (or (condition-case ()
+           (save-excursion
+             (or (not (zerop (skip-syntax-backward "_w")))
+                 (eq (char-syntax (following-char)) ?w)
+                 (eq (char-syntax (following-char)) ?_)
+                 (forward-sexp -1))
+             (skip-chars-forward "'")
+             (let ((obj (read (current-buffer))))
+               (and (symbolp obj) (fboundp obj) obj)))
+         (error nil))
+       (condition-case ()
+           (save-excursion
+             (save-restriction
+               (narrow-to-region (max (point-min)
+                                      (- (point) 1000)) (point-max))
+               ;; Move up to surrounding paren, then after the open.
+               (backward-up-list 1)
+               (forward-char 1)
+               ;; If there is space here, this is probably something
+               ;; other than a real Lisp function call, so ignore it.
+               (if (looking-at "[ \t]")
+                   (error "Probably not a Lisp function call"))
+               (let ((obj (read (current-buffer))))
+                 (and (symbolp obj) (fboundp obj) obj))))
+         (error nil)))))
 
 (defvar symbol-file-load-history-loaded nil
   "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
@@ -755,19 +764,16 @@ It can also be nil, if the definition is not associated with any file."
   "Return the bound variable symbol found around point.
 Return 0 if there is no such symbol."
   (condition-case ()
-      (let ((stab (syntax-table)))
-       (unwind-protect
-           (save-excursion
-             (set-syntax-table emacs-lisp-mode-syntax-table)
-             (or (not (zerop (skip-syntax-backward "_w")))
-                 (eq (char-syntax (following-char)) ?w)
-                 (eq (char-syntax (following-char)) ?_)
-                 (forward-sexp -1))
-             (skip-chars-forward "'")
-             (let ((obj (read (current-buffer))))
-               (or (and (symbolp obj) (boundp obj) obj)
-                   0)))
-         (set-syntax-table stab)))
+      (with-syntax-table emacs-lisp-mode-syntax-table
+       (save-excursion
+         (or (not (zerop (skip-syntax-backward "_w")))
+             (eq (char-syntax (following-char)) ?w)
+             (eq (char-syntax (following-char)) ?_)
+             (forward-sexp -1))
+         (skip-chars-forward "'")
+         (let ((obj (read (current-buffer))))
+           (or (and (symbolp obj) (boundp obj) obj)
+               0))))
     (error 0)))
 
 (defun help-xref-on-pp (from to)
@@ -784,9 +790,7 @@ Return 0 if there is no such symbol."
               ((looking-at "\"") (forward-sexp 1))
               ((looking-at "#<") (search-forward ">" nil 'move))
               ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
-               (let* ((sym (intern-soft
-                            (buffer-substring (match-beginning 1)
-                                              (match-end 1))))
+               (let* ((sym (intern-soft (match-string 1)))
                       (fn (cond ((fboundp sym) #'describe-function)
                                 ((or (memq sym '(t nil))
                                      (keywordp sym))
@@ -798,10 +802,12 @@ Return 0 if there is no such symbol."
               (t (forward-char 1))))))
       (set-syntax-table ost))))
 
-(defun describe-variable (variable)
+(defun describe-variable (variable &optional buffer)
   "Display the full documentation of VARIABLE (a symbol).
-Returns the documentation as a string, also."
-  (interactive 
+Returns the documentation as a string, also.
+If VARIABLE has a buffer-local value in BUFFER (default to the current buffer),
+it is displayed along with the global value."
+  (interactive
    (let ((v (variable-at-point))
         (enable-recursive-minibuffers t)
         val)
@@ -813,8 +819,11 @@ Returns the documentation as a string, also."
                                (if (symbolp v) (symbol-name v))))
      (list (if (equal val "")
               v (intern val)))))
-  (if (symbolp variable)
-      (let (valvoid)
+  (unless (bufferp buffer) (setq buffer (current-buffer)))
+  (if (not (symbolp variable))
+      (message "You did not specify a variable")
+    (let (valvoid)
+      (with-current-buffer buffer
        (with-output-to-temp-buffer "*Help*"
          (prin1 variable)
          (if (not (boundp variable))
@@ -838,13 +847,16 @@ Returns the documentation as a string, also."
                    (with-current-buffer standard-output
                      (princ "global value is ")
                      (terpri)
+                     ;; Fixme: pp can take an age if you happen to
+                     ;; ask for a very large expression.  We should
+                     ;; probably print it raw once and check it's a
+                     ;; sensible size before prettyprinting.  -- fx
                      (let ((from (point)))
                        (pp val)
                        (help-xref-on-pp from (point))))))
                (terpri)))
          (terpri)
-         (save-current-buffer
-           (set-buffer standard-output)
+         (with-current-buffer standard-output
            (if (> (count-lines (point-min) (point-max)) 10)
                (progn
                  ;; Note that setting the syntax table like below
@@ -863,8 +875,9 @@ Returns the documentation as a string, also."
          (terpri)
          (let ((doc (documentation-property variable 'variable-documentation)))
            (princ (or doc "not documented as a variable.")))
-          (help-setup-xref (list #'describe-variable variable) (interactive-p))
-
+          (help-setup-xref (list #'describe-variable variable (current-buffer))
+                          (interactive-p))
+         
          ;; Make a link to customize if this variable can be customized.
          ;; Note, it is not reliable to test only for a custom-type property
          ;; because those are only present after the var's definition
@@ -878,7 +891,7 @@ Returns the documentation as a string, also."
                (princ (concat "You can " customize-label " this variable."))
                (with-current-buffer "*Help*"
                  (save-excursion
-                   (re-search-backward 
+                   (re-search-backward
                     (concat "\\(" customize-label "\\)") nil t)
                    (help-xref-button 1 (lambda (v)
                                          (if help-xref-stack
@@ -909,8 +922,7 @@ Returns the documentation as a string, also."
          (save-excursion
            (set-buffer standard-output)
            ;; Return the text we displayed.
-           (buffer-string))))
-    (message "You did not specify a variable")))
+           (buffer-string)))))))
 
 (defun describe-bindings (&optional prefix buffer)
   "Show a list of all defined keys, and their definitions.
@@ -1046,6 +1058,14 @@ Must be previously-defined."
 The words preceding the quoted symbol can be used in doc strings to
 distinguish references to variables, functions and symbols.")
 
+(defconst help-xref-mule-regexp nil
+  "Regexp matching doc string references to MULE-related keywords.
+
+It is usually nil, and is temporarily bound to an appropriate regexp
+when help commands related to multilingual environment (e.g.,
+`describe-coding-system') are invoked.")
+
+
 (defconst help-xref-info-regexp
   (purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'")
   "Regexp matching doc string references to an Info node.")
@@ -1074,6 +1094,11 @@ with `help-follow'.  Cross-references have the canonical form `...'
 and the type of reference may be disambiguated by the preceding
 word(s) used in `help-xref-symbol-regexp'.
 
+If the variable `help-xref-mule-regexp' is non-nil, find also
+cross-reference information related to multilingual environment
+\(e.g., coding-systems).  This variable is also used to disambiguate
+the type of reference as the same way as `help-xref-symbol-regexp'.
+
 A special reference `back' is made to return back through a stack of
 help buffers.  Variable `help-back-label' specifies the text for
 that."
@@ -1101,6 +1126,42 @@ that."
                        (setq data (concat "(emacs)" data))))
                    (help-xref-button 1 #'info data
                                      "mouse-2, RET: read this Info node"))))
+             ;; Mule related keywords.  Do this before trying
+             ;; `help-xref-symbol-regexp' because some of Mule
+             ;; keywords have variable or function definitions.
+             (if help-xref-mule-regexp
+                 (save-excursion
+                   (while (re-search-forward help-xref-mule-regexp nil t)
+                     (let* ((data (match-string 7))
+                            (sym (intern-soft data)))
+                       (cond
+                        ((match-string 3) ; coding system
+                         (and sym (coding-system-p sym)
+                              (help-xref-button
+                               7 #'describe-coding-system sym
+                               "mouse-2, RET: describe this coding system")))
+                        ((match-string 4) ; input method
+                         (and (assoc data input-method-alist)
+                              (help-xref-button
+                               7 #'describe-input-method data
+                               "mouse-2, RET: describe this input method")))
+                        ((or (match-string 5) (match-string 6)) ; charset
+                         (and sym (charsetp sym)
+                              (help-xref-button
+                               7 #'describe-character-set sym
+                               "mouse-2, RET: describe this character set")))
+                        ((assoc data input-method-alist)
+                         (help-xref-button
+                          7 #'describe-input-method data
+                          "mouse-2, RET: describe this input method"))
+                        ((and sym (coding-system-p sym))
+                         (help-xref-button
+                          7 #'describe-coding-system sym
+                          "mouse-2, RET: describe this coding system"))
+                        ((and sym (charsetp sym))
+                         (help-xref-button
+                          7 #'describe-character-set sym
+                          "mouse-2, RET: describe this character set")))))))
               ;; Quoted symbols
               (save-excursion
                 (while (re-search-forward help-xref-symbol-regexp nil t)
@@ -1142,7 +1203,7 @@ that."
                          (help-xref-button
                           7 #'describe-face sym)))))))
               ;; An obvious case of a key substitution:
-              (save-excursion              
+              (save-excursion
                 (while (re-search-forward
                        ;; Assume command name is only word characters
                        ;; and dashes to get things like `use M-x foo.'.
@@ -1158,7 +1219,7 @@ that."
                (goto-char (point-min))
                 ;; Find a header and the column at which the command
                 ;; name will be found.
-                (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" 
+                (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
                                           nil t)
                   (let ((col (- (match-end 1) (match-beginning 1))))
                     (while
@@ -1173,7 +1234,7 @@ that."
                                        (looking-at "\\(\\sw\\|-\\)+$"))
                                    (let ((sym (intern-soft (match-string 0))))
                                      (if (fboundp sym)
-                                         (help-xref-button 
+                                         (help-xref-button
                                           0 #'describe-function sym
                                          "mouse-2, RET: describe this function"))))
                               (zerop (forward-line)))))))))
@@ -1221,6 +1282,19 @@ If optional arg HELP-ECHO is supplied, it is used as a help string."
                           (match-end match-number)
                           'face help-highlight-face))))
 
+(defun help-insert-xref-button (string function data &optional help-echo)
+  "Insert STRING and make a hyperlink from cross-reference text on it.
+
+FUNCTION is a function to invoke when the button is activated, applied
+to DATA.  DATA may be a single value or a list.  See `help-make-xrefs'.
+If optional arg HELP-ECHO is supplied, it is used as a help string."
+  (let ((pos (point)))
+    (insert string)
+    (goto-char pos)
+    (search-forward string)
+    (help-xref-button 0 function data help-echo)))
+
+
 \f
 ;; Additional functions for (re-)creating types of help buffers.
 (defun help-xref-interned (symbol)
@@ -1355,23 +1429,6 @@ For the cross-reference format, see `help-make-xrefs'."
 \f
 ;;; Automatic resizing of temporary buffers.
 
-(defcustom temp-buffer-resize-mode nil
-  "Non-nil means resize windows displaying temporary buffers.
-This makes the window the right height for its contents, but never
-more than `temp-buffer-max-height' nor less than `window-min-height'.
-This applies to `help', `apropos' and `completion' buffers, and some others.
-
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `temp-buffer-resize-mode'."
-  :get (lambda (symbol)
-         (and (memq 'resize-temp-buffer-window temp-buffer-show-hook) t))
-  :set (lambda (symbol value)
-         (temp-buffer-resize-mode (if value 1 -1)))
-  :initialize 'custom-initialize-default
-  :type 'boolean
-  :group 'help
-  :version "20.4")
-
 (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
   "*Maximum height of a window displaying a temporary buffer.
 This is the maximum height (in text lines) which `resize-temp-buffer-window'
@@ -1383,25 +1440,19 @@ positive number."
   :group 'help
   :version "20.4")
 
-(defun temp-buffer-resize-mode (arg)
-  "Toggle the mode which that makes windows smaller for temporary buffers.
+(define-minor-mode temp-buffer-resize-mode
+  "Toggle the mode which makes windows smaller for temporary buffers.
 With prefix argument ARG, turn the resizing of windows displaying temporary
 buffers on if ARG is positive or off otherwise.
-See the documentation of the variable `temp-buffer-resize-mode' for
-more information."
-  (interactive "P")
-  (let ((turn-it-on
-         (if (null arg)
-             (not (memq 'resize-temp-buffer-window temp-buffer-show-hook))
-           (> (prefix-numeric-value arg) 0))))
-    (if turn-it-on
-        (progn
-          ;; `help-mode-maybe' may add a `back' button and thus increase the
-          ;; text size, so `resize-temp-buffer-window' must be run *after* it.
-          (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
-          (setq temp-buffer-resize-mode t))
-      (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)
-      (setq temp-buffer-resize-mode nil))))
+This makes the window the right height for its contents, but never
+more than `temp-buffer-max-height' nor less than `window-min-height'.
+This applies to `help', `apropos' and `completion' buffers, and some others."
+  nil nil nil :global t :group 'help
+  (if temp-buffer-resize-mode
+      ;; `help-mode-maybe' may add a `back' button and thus increase the
+      ;; text size, so `resize-temp-buffer-window' must be run *after* it.
+      (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 current window to fit its contents.
@@ -1412,20 +1463,27 @@ out of view."
   (unless (or (one-window-p 'nomini)
               (not (pos-visible-in-window-p (point-min)))
               (/=  (frame-width) (window-width)))
-    (let* ((max-height (if (functionp temp-buffer-max-height)
-                           (funcall temp-buffer-max-height (current-buffer))
-                         temp-buffer-max-height))
-           (win-height (1- (window-height)))
-           (min-height (1- window-min-height))
-           (text-height (count-screen-lines))
-           (new-height (max (min text-height max-height) min-height)))
-      (enlarge-window (- new-height win-height)))))
+    (fit-window-to-buffer
+     (selected-window)
+     (if (functionp temp-buffer-max-height)
+        (funcall temp-buffer-max-height (current-buffer))
+       temp-buffer-max-height))))
 
 ;; `help-manyarg-func-alist' is defined primitively (in doc.c).
 ;; New primitives with `MANY' or `UNEVALLED' arglists should be added
 ;; to this alist.
 ;; The parens and function name are redundant, but it's messy to add
 ;; them in `documentation'.
+
+;; This will find any missing items:
+;; (let (l)
+;;   (mapatoms (lambda (x)
+;;           (if (and (fboundp x)
+;;                    (subrp (symbol-function x))
+;;                    (not (numberp (cdr (subr-arity (symbol-function x)))))
+;;                    (not (assq x help-manyarg-func-alist)))
+;;               (push x l))))
+;;   l)
 (defconst help-manyarg-func-alist
   (purecopy
    '((list . "(list &rest OBJECTS)")
@@ -1448,6 +1506,7 @@ out of view."
      (encode-time
       . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)")
      (insert . "(insert &rest ARGS)")
+     (insert-and-inherit . "(insert-and-inherit &rest ARGS)")
      (insert-before-markers . "(insert-before-markers &rest ARGS)")
      (message . "(message STRING &rest ARGUMENTS)")
      (message-box . "(message-box STRING &rest ARGUMENTS)")
@@ -1497,8 +1556,18 @@ out of view."
      (track-mouse . "(track-mouse BODY ...)")
      (ml-if . "(ml-if COND THEN ELSE...)")
      (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)")
+     (ml-prefix-argument-loop . "(ml-prefix-argument-loop ...)")
      (with-output-to-temp-buffer
         . "(with-output-to-temp-buffer BUFFNAME BODY ...)")
-     (save-window-excursion . "(save-window-excursion BODY ...)"))))
+     (save-window-excursion . "(save-window-excursion BODY ...)")
+     (find-operation-coding-system
+      . "(find-operation-coding-system OPERATION ARGUMENTS ...)")
+     (insert-before-markers-and-inherit
+      . "(insert-before-markers-and-inherit &rest ARGS)"))))
+
+;; Provide this for the sake of define-minor-mode which generates
+;; defcustoms which require 'help'.
+
+(provide 'help)
 
 ;;; help.el ends here