1 files changed, 563 insertions, 0 deletions

diff --git a/lisp/help-funs.el b/lisp/help-funs.el
new file mode 100644
index 00000000000..6f84bc512bf
--- /dev/null
+++ b/lisp/help-funs.el
@@ -0,0 +1,563 @@
+;;; help-funs.el --- Complex help functions
+
+;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001
+;;   Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: help, internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file contains those help commands which are complicated, and
+;; which may not be used in every session.  For example
+;; `describe-function' will probably be heavily used when doing elisp
+;; programming, but not if just editing C files.  Simpler help commands
+;; are in help.el
+
+;;; Code:
+
+;;;###autoload
+(defun help-with-tutorial (&optional arg)
+  "Select the Emacs learn-by-doing tutorial.
+If there is a tutorial version written in the language
+of the selected language environment, that version is used.
+If there's no tutorial in that language, `TUTORIAL' is selected.
+With arg, you are asked to choose which language."
+  (interactive "P")
+  (let ((lang (if arg
+                  (read-language-name 'tutorial "Language: " "English")
+                (if (get-language-info current-language-environment 'tutorial)
+                    current-language-environment
+                  "English")))
+        file filename)
+    (setq filename (get-language-info lang 'tutorial))
+    (setq file (expand-file-name (concat "~/" filename)))
+    (delete-other-windows)
+    (if (get-file-buffer file)
+        (switch-to-buffer (get-file-buffer file))
+      (switch-to-buffer (create-file-buffer file))
+      (setq buffer-file-name file)
+      (setq default-directory (expand-file-name "~/"))
+      (setq buffer-auto-save-file-name nil)
+      (insert-file-contents (expand-file-name filename data-directory))
+      (goto-char (point-min))
+      (search-forward "\n<<")
+      (beginning-of-line)
+      (delete-region (point) (progn (end-of-line) (point)))
+      (let ((n (- (window-height (selected-window))
+                  (count-lines (point-min) (point))
+                  6)))
+        (if (< n 12)
+            (newline n)
+          ;; Some people get confused by the large gap.
+          (newline (/ n 2))
+          (insert "[Middle of page left blank for didactic purposes.  "
+                  "Text continues below]")
+          (newline (- n (/ n 2)))))
+      (goto-char (point-min))
+      (set-buffer-modified-p nil))))
+
+;;;###autoload
+(defun locate-library (library &optional nosuffix path interactive-call)
+  "Show the precise file name of Emacs library LIBRARY.
+This command searches the directories in `load-path' like `M-x load-library'
+to find the file that `M-x load-library RET LIBRARY RET' would load.
+Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'
+to the specified name LIBRARY.
+
+If the optional third arg PATH is specified, that list of directories
+is used instead of `load-path'.
+
+When called from a program, the file name is normaly returned as a
+string.  When run interactively, the argument INTERACTIVE-CALL is t,
+and the file name is displayed in the echo area."
+  (interactive (list (read-string "Locate library: ")
+                     nil nil
+                     t))
+  (let (result)
+    (catch 'answer
+      (mapc
+       (lambda (dir)
+         (mapc
+          (lambda (suf)
+            (let ((try (expand-file-name (concat library suf) dir)))
+              (and (file-readable-p try)
+                   (null (file-directory-p try))
+                   (progn
+                     (setq result try)
+                     (throw 'answer try)))))
+          (if nosuffix
+              '("")
+            '(".elc" ".el" "")
+            (let ((basic '(".elc" ".el" ""))
+                  (compressed '(".Z" ".gz" "")))
+              ;; If autocompression mode is on,
+              ;; consider all combinations of library suffixes
+              ;; and compression suffixes.
+              (if (rassq 'jka-compr-handler file-name-handler-alist)
+                  (apply 'nconc
+                         (mapcar (lambda (compelt)
+                                   (mapcar (lambda (baselt)
+                                             (concat baselt compelt))
+                                           basic))
+                                 compressed))
+                basic)))))
+       (or path load-path)))
+    (and interactive-call
+         (if result
+             (message "Library is file %s" result)
+           (message "No library %s in search path" library)))
+    result))
+
+
+;; Functions
+
+;;;###autoload
+(defun describe-function (function)
+  "Display the full documentation of FUNCTION (a symbol)."
+  (interactive
+   (let ((fn (function-called-at-point))
+         (enable-recursive-minibuffers t)
+         val)
+     (setq val (completing-read (if fn
+                                    (format "Describe function (default %s): " fn)
+                                  "Describe function: ")
+                                obarray 'fboundp t nil nil (symbol-name fn)))
+     (list (if (equal val "")
+               fn (intern val)))))
+  (if (null function)
+      (message "You didn't specify a function")
+    (with-output-to-temp-buffer "*Help*"
+      (prin1 function)
+      ;; Use " is " instead of a colon so that
+      ;; it is easier to get out the function name using forward-sexp.
+      (princ " is ")
+      (describe-function-1 function nil (interactive-p))
+      (print-help-return-message)
+        (save-excursion
+          (set-buffer standard-output)
+          ;; Return the text we displayed.
+        (buffer-string)))))
+
+(defun describe-function-1 (function parens interactive-p)
+  (let* ((def (if (symbolp function)
+                  (symbol-function function)
+                function))
+         file-name string need-close
+         (beg (if (commandp def) "an interactive " "a ")))
+    (setq string
+          (cond ((or (stringp def)
+                     (vectorp def))
+                 "a keyboard macro")
+                ((subrp def)
+                 (if (eq 'unevalled (cdr (subr-arity def)))
+                     (concat beg "special form")
+                   (concat beg "built-in function")))
+                ((byte-code-function-p def)
+                 (concat beg "compiled Lisp function"))
+                ((symbolp def)
+                 (while (symbolp (symbol-function def))
+                   (setq def (symbol-function def)))
+                 (format "an alias for `%s'" def))
+                ((eq (car-safe def) 'lambda)
+                 (concat beg "Lisp function"))
+                ((eq (car-safe def) 'macro)
+                 "a Lisp macro")
+                ((eq (car-safe def) 'mocklisp)
+                 "a mocklisp function")
+                ((eq (car-safe def) 'autoload)
+                 (setq file-name (nth 1 def))
+                 (format "%s autoloaded %s"
+                         (if (commandp def) "an interactive" "an")
+                         (if (eq (nth 4 def) 'keymap) "keymap"
+                           (if (nth 4 def) "Lisp macro" "Lisp function"))
+                         ))
+                ;; perhaps use keymapp here instead
+                ((eq (car-safe def) 'keymap)
+                 (let ((is-full nil)
+                       (elts (cdr-safe def)))
+                   (while elts
+                     (if (char-table-p (car-safe elts))
+                         (setq is-full t
+                               elts nil))
+                     (setq elts (cdr-safe elts)))
+                   (if is-full
+                       "a full keymap"
+                     "a sparse keymap")))
+                (t "")))
+    (when (and parens (not (equal string "")))
+      (setq need-close t)
+      (princ "("))
+    (princ string)
+    (with-current-buffer "*Help*"
+      (save-excursion
+        (save-match-data
+          (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
+              (help-xref-button 1 'help-function def)))))
+    (or file-name
+        (setq file-name (symbol-file function)))
+    (if file-name
+        (progn
+          (princ " in `")
+          ;; We used to add .el to the file name,
+          ;; but that's completely wrong when the user used load-file.
+          (princ file-name)
+          (princ "'")
+          ;; Make a hyperlink to the library.
+          (with-current-buffer "*Help*"
+            (save-excursion
+              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (help-xref-button 1 'help-function-def function file-name)))))
+    (if need-close (princ ")"))
+    (princ ".")
+    (terpri)
+    (when (commandp function)
+      (let ((keys (where-is-internal
+                   function overriding-local-map nil nil)))
+        (when keys
+          (princ "It is bound to ")
+          ;; FIXME: This list can be very long (f.ex. for self-insert-command).
+          (princ (mapconcat 'key-description keys ", "))
+          (princ ".")
+          (terpri))))
+    ;; Handle symbols aliased to other symbols.
+    (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)))
+    (let ((arglist (cond ((byte-code-function-p def)
+                          (car (append def nil)))
+                         ((eq (car-safe def) 'lambda)
+                          (nth 1 def))
+                         ((and (eq (car-safe def) 'autoload)
+                               (not (eq (nth 4 def) 'keymap)))
+                          (concat "[Arg list not available until "
+                                  "function definition is loaded.]"))
+                         (t t))))
+      (cond ((listp arglist)
+             (princ (cons (if (symbolp function) function "anonymous")
+                          (mapcar (lambda (arg)
+                                    (if (memq arg '(&optional &rest))
+                                        arg
+                                      (intern (upcase (symbol-name arg)))))
+                                  arglist)))
+             (terpri))
+            ((stringp arglist)
+             (princ arglist)
+             (terpri))))
+    (let ((doc (documentation function)))
+      (if doc
+          (progn (terpri)
+                 (princ doc)
+                 (if (subrp def)
+                     (with-current-buffer standard-output
+                       (beginning-of-line)
+                       ;; Builtins get the calling sequence at the end of
+                       ;; the doc string.  Move it to the same place as
+                       ;; for other functions.
+
+                       ;; In cases where `function' has been fset to a
+                       ;; subr we can't search for function's name in
+                       ;; the doc string.  Kluge round that using the
+                       ;; printed representation.  The arg list then
+                       ;; shows the wrong function name, but that
+                       ;; might be a useful hint.
+                       (let* ((rep (prin1-to-string def))
+                              (name (progn
+                                      (string-match " \\([^ ]+\\)>$" rep)
+                                      (match-string 1 rep))))
+                         (if (looking-at (format "(%s[ )]" (regexp-quote name)))
+                             (let ((start (point-marker)))
+                               (goto-char (point-min))
+                               (forward-paragraph)
+                               (insert-buffer-substring (current-buffer) start)
+                               (insert ?\n)
+                               (delete-region (1- start) (point-max)))
+                           (goto-char (point-min))
+                           (forward-paragraph)
+                           (insert
+                            "[Missing arglist.  Please make a bug report.]\n")))
+                       (goto-char (point-max))))
+                 (help-setup-xref (list #'describe-function function)
+                                  interactive-p))
+        (princ "not documented")))))
+
+
+;; Variables
+
+;;;###autoload
+(defun variable-at-point ()
+  "Return the bound variable symbol found around point.
+Return 0 if there is no such symbol."
+  (condition-case ()
+      (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)))
+
+;;;###autoload
+(defun describe-variable (variable &optional buffer)
+  "Display the full documentation of VARIABLE (a symbol).
+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)
+     (setq val (completing-read (if (symbolp v)
+                                    (format
+                                     "Describe variable (default %s): " v)
+                                  "Describe variable: ")
+                                obarray 'boundp t nil nil
+                                (if (symbolp v) (symbol-name v))))
+     (list (if (equal val "")
+               v (intern val)))))
+  (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))
+              (progn
+                (princ " is void")
+                (setq valvoid t))
+            (let ((val (symbol-value variable)))
+              (with-current-buffer standard-output
+                (princ "'s value is ")
+                (terpri)
+                (let ((from (point)))
+                  (pp val)
+                  (help-xref-on-pp from (point))
+                  (if (< (point) (+ from 20))
+                      (save-excursion
+                        (goto-char from)
+                        (delete-char -1)))))))
+          (terpri)
+          (when (local-variable-p variable)
+            (princ (format "Local in buffer %s; " (buffer-name)))
+            (if (not (default-boundp variable))
+                (princ "globally void")
+              (let ((val (default-value variable)))
+                (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))
+                        (if (< (point) (+ from 20))
+                            (save-excursion
+                              (goto-char from)
+                              (delete-char -1)))))))
+            (terpri))
+          (terpri)
+          (with-current-buffer standard-output
+            (when (> (count-lines (point-min) (point-max)) 10)
+              ;; Note that setting the syntax table like below
+              ;; makes forward-sexp move over a `'s' at the end
+              ;; of a symbol.
+              (set-syntax-table emacs-lisp-mode-syntax-table)
+              (goto-char (point-min))
+              (if valvoid
+                  (forward-line 1)
+                (forward-sexp 1)
+                (delete-region (point) (progn (end-of-line) (point)))
+                (insert " value is shown below.\n\n")
+                (save-excursion
+                  (insert "\n\nValue:"))))
+            ;; Add a note for variables that have been make-var-buffer-local.
+            (when (and (local-variable-if-set-p variable)
+                       (or (not (local-variable-p variable))
+                           (with-temp-buffer
+                             (local-variable-if-set-p variable))))
+              (save-excursion
+                (forward-line -1)
+                (insert "Automatically becomes buffer-local when set in any fashion.\n"))))
+          (princ "Documentation:")
+          (terpri)
+          (let ((doc (documentation-property variable 'variable-documentation)))
+            (princ (or doc "not documented as a variable.")))
+          (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
+          ;; has been loaded.
+          (if (or (get variable 'custom-type) ; after defcustom
+                  (get variable 'custom-loads) ; from loaddefs.el
+                  (get variable 'standard-value)) ; from cus-start.el
+              (let ((customize-label "customize"))
+                (terpri)
+                (terpri)
+                (princ (concat "You can " customize-label " this variable."))
+                (with-current-buffer standard-output
+                  (save-excursion
+                    (re-search-backward
+                     (concat "\\(" customize-label "\\)") nil t)
+                    (help-xref-button 1 'help-customize-variable variable)))))
+          ;; Make a hyperlink to the library if appropriate.  (Don't
+          ;; change the format of the buffer's initial line in case
+          ;; anything expects the current format.)
+          (let ((file-name (symbol-file variable)))
+            (when (equal file-name "loaddefs.el")
+              ;; Find the real def site of the preloaded variable.
+              (let ((location
+                     (condition-case nil
+                         (find-variable-noselect variable file-name)
+                       (error nil))))
+                (when location
+                  (with-current-buffer (car location)
+                    (goto-char (cdr location))
+                    (when (re-search-backward
+                           "^;;; Generated autoloads from \\(.*\\)" nil t)
+                      (setq file-name (match-string 1)))))))
+            (when file-name
+              (princ "\n\nDefined in `")
+              (princ file-name)
+              (princ "'.")
+              (with-current-buffer standard-output
+                (save-excursion
+                  (re-search-backward "`\\([^`']+\\)'" nil t)
+                  (help-xref-button 1 'help-variable-def
+                                    variable file-name)))))
+
+          (print-help-return-message)
+          (save-excursion
+            (set-buffer standard-output)
+            ;; Return the text we displayed.
+            (buffer-string)))))))
+
+
+;; `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)")
+     (vector . "(vector &rest OBJECTS)")
+     (make-byte-code . "(make-byte-code &rest ELEMENTS)")
+     (call-process
+      . "(call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)")
+     (call-process-region
+      . "(call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)")
+     (string . "(string &rest CHARACTERS)")
+     (+ . "(+ &rest NUMBERS-OR-MARKERS)")
+     (- . "(- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)")
+     (* . "(* &rest NUMBERS-OR-MARKERS)")
+     (/ . "(/ DIVIDEND DIVISOR &rest DIVISORS)")
+     (max . "(max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
+     (min . "(min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
+     (logand . "(logand &rest INTS-OR-MARKERS)")
+     (logior . "(logior &rest INTS-OR-MARKERS)")
+     (logxor . "(logxor &rest INTS-OR-MARKERS)")
+     (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)")
+     (message-or-box . "(message-or-box STRING &rest ARGUMENTS)")
+     (propertize . "(propertize STRING &rest PROPERTIES)")
+     (format . "(format STRING &rest OBJECTS)")
+     (apply . "(apply FUNCTION &rest ARGUMENTS)")
+     (run-hooks . "(run-hooks &rest HOOKS)")
+     (run-hook-with-args . "(run-hook-with-args HOOK &rest ARGS)")
+     (run-hook-with-args-until-failure
+      . "(run-hook-with-args-until-failure HOOK &rest ARGS)")
+     (run-hook-with-args-until-success
+      . "(run-hook-with-args-until-success HOOK &rest ARGS)")
+     (funcall . "(funcall FUNCTION &rest ARGUMENTS)")
+     (append . "(append &rest SEQUENCES)")
+     (concat . "(concat &rest SEQUENCES)")
+     (vconcat . "(vconcat &rest SEQUENCES)")
+     (nconc . "(nconc &rest LISTS)")
+     (widget-apply . "(widget-apply WIDGET PROPERTY &rest ARGS)")
+     (make-hash-table . "(make-hash-table &rest KEYWORD-ARGS)")
+     (insert-string . "(insert-string &rest ARGS)")
+     (start-process . "(start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)")
+     (setq-default . "(setq-default SYMBOL VALUE [SYMBOL VALUE...])")
+     (save-excursion . "(save-excursion &rest BODY)")
+     (save-current-buffer . "(save-current-buffer &rest BODY)")
+     (save-restriction . "(save-restriction &rest BODY)")
+     (or . "(or CONDITIONS ...)")
+     (and . "(and CONDITIONS ...)")
+     (if . "(if COND THEN ELSE...)")
+     (cond . "(cond CLAUSES...)")
+     (progn . "(progn BODY ...)")
+     (prog1 . "(prog1 FIRST BODY...)")
+     (prog2 . "(prog2 X Y BODY...)")
+     (setq . "(setq SYM VAL SYM VAL ...)")
+     (quote . "(quote ARG)")
+     (function . "(function ARG)")
+     (defun . "(defun NAME ARGLIST [DOCSTRING] BODY...)")
+     (defmacro . "(defmacro NAME ARGLIST [DOCSTRING] BODY...)")
+     (defvar . "(defvar SYMBOL [INITVALUE DOCSTRING])")
+     (defconst . "(defconst SYMBOL INITVALUE [DOCSTRING])")
+     (let* . "(let* VARLIST BODY...)")
+     (let . "(let VARLIST BODY...)")
+     (while . "(while TEST BODY...)")
+     (catch . "(catch TAG BODY...)")
+     (unwind-protect . "(unwind-protect BODYFORM UNWINDFORMS...)")
+     (condition-case . "(condition-case VAR BODYFORM HANDLERS...)")
+     (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 ...)")
+     (find-operation-coding-system
+      . "(find-operation-coding-system OPERATION ARGUMENTS ...)")
+     (insert-before-markers-and-inherit
+      . "(insert-before-markers-and-inherit &rest ARGS)"))))
+
+
+(provide 'help-funs)
+
+;;; help-funs.el ends here
+
+