lisp/help-funs.el

   1 ;;; help-funs.el --- Complex help functions
   2
   3 ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   7 ;; Keywords: help, internal
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This file contains those help commands which are complicated, and
  29 ;; which may not be used in every session.  For example
  30 ;; `describe-function' will probably be heavily used when doing elisp
  31 ;; programming, but not if just editing C files.  Simpler help commands
  32 ;; are in help.el
  33
  34 ;;; Code:
  35
  36 (require 'help-mode)
  37
  38
  39 ;;;###autoload
  40 (defun help-with-tutorial (&optional arg)
  41   "Select the Emacs learn-by-doing tutorial.
  42 If there is a tutorial version written in the language
  43 of the selected language environment, that version is used.
  44 If there's no tutorial in that language, `TUTORIAL' is selected.
  45 With arg, you are asked to choose which language."
  46   (interactive "P")
  47   (let ((lang (if arg
  48                   (read-language-name 'tutorial "Language: " "English")
  49                 (if (get-language-info current-language-environment 'tutorial)
  50                     current-language-environment
  51                   "English")))
  52         file filename)
  53     (setq filename (get-language-info lang 'tutorial))
  54     (setq file (expand-file-name (concat "~/" filename)))
  55     (delete-other-windows)
  56     (if (get-file-buffer file)
  57         (switch-to-buffer (get-file-buffer file))
  58       (switch-to-buffer (create-file-buffer file))
  59       (setq buffer-file-name file)
  60       (setq default-directory (expand-file-name "~/"))
  61       (setq buffer-auto-save-file-name nil)
  62       (insert-file-contents (expand-file-name filename data-directory))
  63       (goto-char (point-min))
  64       (search-forward "\n<<")
  65       (beginning-of-line)
  66       (delete-region (point) (progn (end-of-line) (point)))
  67       (let ((n (- (window-height (selected-window))
  68                   (count-lines (point-min) (point))
  69                   6)))
  70         (if (< n 12)
  71             (newline n)
  72           ;; Some people get confused by the large gap.
  73           (newline (/ n 2))
  74           (insert "[Middle of page left blank for didactic purposes.  "
  75                   "Text continues below]")
  76           (newline (- n (/ n 2)))))
  77       (goto-char (point-min))
  78       (set-buffer-modified-p nil))))
  79
  80 ;;;###autoload
  81 (defun locate-library (library &optional nosuffix path interactive-call)
  82   "Show the precise file name of Emacs library LIBRARY.
  83 This command searches the directories in `load-path' like `M-x load-library'
  84 to find the file that `M-x load-library RET LIBRARY RET' would load.
  85 Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
  86 to the specified name LIBRARY.
  87
  88 If the optional third arg PATH is specified, that list of directories
  89 is used instead of `load-path'.
  90
  91 When called from a program, the file name is normaly returned as a
  92 string.  When run interactively, the argument INTERACTIVE-CALL is t,
  93 and the file name is displayed in the echo area."
  94   (interactive (list (read-string "Locate library: ")
  95                      nil nil
  96                      t))
  97   (catch 'answer
  98     (dolist (dir (or path load-path))
  99       (dolist (suf (append (unless nosuffix load-suffixes) '("")))
 100         (let ((try (expand-file-name (concat library suf) dir)))
 101           (and (file-readable-p try)
 102                (null (file-directory-p try))
 103                (progn
 104                  (if interactive-call
 105                      (message "Library is file %s" (abbreviate-file-name try)))
 106                  (throw 'answer try))))))
 107     (if interactive-call
 108         (message "No library %s in search path" library))
 109     nil))
 110
 111 \f
 112 ;; Functions
 113
 114 ;;;###autoload
 115 (defun describe-function (function)
 116   "Display the full documentation of FUNCTION (a symbol)."
 117   (interactive
 118    (let ((fn (function-called-at-point))
 119          (enable-recursive-minibuffers t)
 120          val)
 121      (setq val (completing-read (if fn
 122                                     (format "Describe function (default %s): " fn)
 123                                   "Describe function: ")
 124                                 obarray 'fboundp t nil nil (symbol-name fn)))
 125      (list (if (equal val "")
 126                fn (intern val)))))
 127   (if (null function)
 128       (message "You didn't specify a function")
 129     (help-setup-xref (list #'describe-function function) (interactive-p))
 130     (with-output-to-temp-buffer (help-buffer)
 131       (prin1 function)
 132       ;; Use " is " instead of a colon so that
 133       ;; it is easier to get out the function name using forward-sexp.
 134       (princ " is ")
 135       (describe-function-1 function)
 136       (print-help-return-message)
 137       (with-current-buffer standard-output
 138         ;; Return the text we displayed.
 139         (buffer-string)))))
 140
 141 ;;;###autoload
 142 (defun describe-function-1 (function)
 143   (let* ((def (if (symbolp function)
 144                   (symbol-function function)
 145                 function))
 146          file-name string
 147          (beg (if (commandp def) "an interactive " "a ")))
 148     (setq string
 149           (cond ((or (stringp def)
 150                      (vectorp def))
 151                  "a keyboard macro")
 152                 ((subrp def)
 153                  (if (eq 'unevalled (cdr (subr-arity def)))
 154                      (concat beg "special form")
 155                    (concat beg "built-in function")))
 156                 ((byte-code-function-p def)
 157                  (concat beg "compiled Lisp function"))
 158                 ((symbolp def)
 159                  (while (symbolp (symbol-function def))
 160                    (setq def (symbol-function def)))
 161                  (format "an alias for `%s'" def))
 162                 ((eq (car-safe def) 'lambda)
 163                  (concat beg "Lisp function"))
 164                 ((eq (car-safe def) 'macro)
 165                  "a Lisp macro")
 166                 ((eq (car-safe def) 'mocklisp)
 167                  "a mocklisp function")
 168                 ((eq (car-safe def) 'autoload)
 169                  (setq file-name (nth 1 def))
 170                  (format "%s autoloaded %s"
 171                          (if (commandp def) "an interactive" "an")
 172                          (if (eq (nth 4 def) 'keymap) "keymap"
 173                            (if (nth 4 def) "Lisp macro" "Lisp function"))
 174                          ))
 175                 ;; perhaps use keymapp here instead
 176                 ((eq (car-safe def) 'keymap)
 177                  (let ((is-full nil)
 178                        (elts (cdr-safe def)))
 179                    (while elts
 180                      (if (char-table-p (car-safe elts))
 181                          (setq is-full t
 182                                elts nil))
 183                      (setq elts (cdr-safe elts)))
 184                    (if is-full
 185                        "a full keymap"
 186                      "a sparse keymap")))
 187                 (t "")))
 188     (princ string)
 189     (with-current-buffer standard-output
 190       (save-excursion
 191         (save-match-data
 192           (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
 193               (help-xref-button 1 'help-function def)))))
 194     (or file-name
 195         (setq file-name (symbol-file function)))
 196     (cond
 197      (file-name
 198           (princ " in `")
 199           ;; We used to add .el to the file name,
 200           ;; but that's completely wrong when the user used load-file.
 201           (princ file-name)
 202           (princ "'")
 203           ;; Make a hyperlink to the library.
 204       (with-current-buffer standard-output
 205             (save-excursion
 206               (re-search-backward "`\\([^`']+\\)'" nil t)
 207           (help-xref-button 1 'help-function-def function file-name)))))
 208     (princ ".")
 209     (terpri)
 210     (when (commandp function)
 211       (let ((keys (where-is-internal
 212                    function overriding-local-map nil nil)))
 213         (when keys
 214           (princ "It is bound to ")
 215           ;; FIXME: This list can be very long (f.ex. for self-insert-command).
 216           (princ (mapconcat 'key-description keys ", "))
 217           (princ ".")
 218           (terpri))))
 219     ;; Handle symbols aliased to other symbols.
 220     (setq def (indirect-function def))
 221     ;; If definition is a macro, find the function inside it.
 222     (if (eq (car-safe def) 'macro)
 223         (setq def (cdr def)))
 224     (let ((arglist (cond ((byte-code-function-p def)
 225                           (car (append def nil)))
 226                          ((eq (car-safe def) 'lambda)
 227                           (nth 1 def))
 228                          ((and (eq (car-safe def) 'autoload)
 229                                (not (eq (nth 4 def) 'keymap)))
 230                           (concat "[Arg list not available until "
 231                                   "function definition is loaded.]"))
 232                          (t t))))
 233       (cond ((listp arglist)
 234              (princ (cons (if (symbolp function) function "anonymous")
 235                           (mapcar (lambda (arg)
 236                                     (if (memq arg '(&optional &rest))
 237                                         arg
 238                                       (intern (upcase (symbol-name arg)))))
 239                                   arglist)))
 240              (terpri))
 241             ((stringp arglist)
 242              (princ arglist)
 243              (terpri))))
 244     (let ((doc (documentation function)))
 245       (if doc
 246           (progn (terpri)
 247                  (princ doc)
 248                  (if (subrp def)
 249                      (with-current-buffer standard-output
 250                        (beginning-of-line)
 251                        ;; Builtins get the calling sequence at the end of
 252                        ;; the doc string.  Move it to the same place as
 253                        ;; for other functions.
 254
 255                        ;; In cases where `function' has been fset to a
 256                        ;; subr we can't search for function's name in
 257                        ;; the doc string.  Kluge round that using the
 258                        ;; printed representation.  The arg list then
 259                        ;; shows the wrong function name, but that
 260                        ;; might be a useful hint.
 261                        (let* ((rep (prin1-to-string def))
 262                               (name (progn
 263                                       (string-match " \\([^ ]+\\)>$" rep)
 264                                       (match-string 1 rep))))
 265                          (if (looking-at (format "(%s[ )]" (regexp-quote name)))
 266                              (let ((start (point-marker)))
 267                                (goto-char (point-min))
 268                                (forward-paragraph)
 269                                (insert-buffer-substring (current-buffer) start)
 270                                (insert ?\n)
 271                                (delete-region (1- start) (point-max)))
 272                            (goto-char (point-min))
 273                            (forward-paragraph)
 274                            (insert
 275                             "[Missing arglist.  Please make a bug report.]\n")))
 276                        (goto-char (point-max)))))
 277         (princ "not documented")))))
 278
 279 \f
 280 ;; Variables
 281
 282 ;;;###autoload
 283 (defun variable-at-point ()
 284   "Return the bound variable symbol found around point.
 285 Return 0 if there is no such symbol."
 286   (condition-case ()
 287       (with-syntax-table emacs-lisp-mode-syntax-table
 288         (save-excursion
 289           (or (not (zerop (skip-syntax-backward "_w")))
 290               (eq (char-syntax (following-char)) ?w)
 291               (eq (char-syntax (following-char)) ?_)
 292               (forward-sexp -1))
 293           (skip-chars-forward "'")
 294           (let ((obj (read (current-buffer))))
 295             (or (and (symbolp obj) (boundp obj) obj)
 296                 0))))
 297     (error 0)))
 298
 299 ;;;###autoload
 300 (defun describe-variable (variable &optional buffer)
 301   "Display the full documentation of VARIABLE (a symbol).
 302 Returns the documentation as a string, also.
 303 If VARIABLE has a buffer-local value in BUFFER (default to the current buffer),
 304 it is displayed along with the global value."
 305   (interactive
 306    (let ((v (variable-at-point))
 307          (enable-recursive-minibuffers t)
 308          val)
 309      (setq val (completing-read (if (symbolp v)
 310                                     (format
 311                                      "Describe variable (default %s): " v)
 312                                   "Describe variable: ")
 313                                 obarray 'boundp t nil nil
 314                                 (if (symbolp v) (symbol-name v))))
 315      (list (if (equal val "")
 316                v (intern val)))))
 317   (unless (bufferp buffer) (setq buffer (current-buffer)))
 318   (if (not (symbolp variable))
 319       (message "You did not specify a variable")
 320     (let (valvoid)
 321       (help-setup-xref (list #'describe-variable variable buffer)
 322                        (interactive-p))
 323       (with-output-to-temp-buffer (help-buffer)
 324       (with-current-buffer buffer
 325           (prin1 variable)
 326           (if (not (boundp variable))
 327               (progn
 328                 (princ " is void")
 329                 (setq valvoid t))
 330             (let ((val (symbol-value variable)))
 331               (with-current-buffer standard-output
 332                 (princ "'s value is ")
 333                 (terpri)
 334                 (let ((from (point)))
 335                   (pp val)
 336                   (help-xref-on-pp from (point))
 337                   (if (< (point) (+ from 20))
 338                       (save-excursion
 339                         (goto-char from)
 340                         (delete-char -1)))))))
 341           (terpri)
 342           (when (local-variable-p variable)
 343             (princ (format "Local in buffer %s; " (buffer-name)))
 344             (if (not (default-boundp variable))
 345                 (princ "globally void")
 346               (let ((val (default-value variable)))
 347                 (with-current-buffer standard-output
 348                   (princ "global value is ")
 349                   (terpri)
 350                   ;; Fixme: pp can take an age if you happen to
 351                   ;; ask for a very large expression.  We should
 352                   ;; probably print it raw once and check it's a
 353                   ;; sensible size before prettyprinting.  -- fx
 354                   (let ((from (point)))
 355                         (pp val)
 356                         (help-xref-on-pp from (point))
 357                         (if (< (point) (+ from 20))
 358                             (save-excursion
 359                               (goto-char from)
 360                               (delete-char -1)))))))
 361             (terpri))
 362           (terpri)
 363           (with-current-buffer standard-output
 364             (when (> (count-lines (point-min) (point-max)) 10)
 365               ;; Note that setting the syntax table like below
 366               ;; makes forward-sexp move over a `'s' at the end
 367               ;; of a symbol.
 368               (set-syntax-table emacs-lisp-mode-syntax-table)
 369               (goto-char (point-min))
 370               (if valvoid
 371                   (forward-line 1)
 372                 (forward-sexp 1)
 373                 (delete-region (point) (progn (end-of-line) (point)))
 374                 (insert " value is shown below.\n\n")
 375                 (save-excursion
 376                   (insert "\n\nValue:"))))
 377             ;; Add a note for variables that have been make-var-buffer-local.
 378             (when (and (local-variable-if-set-p variable)
 379                        (or (not (local-variable-p variable))
 380                            (with-temp-buffer
 381                              (local-variable-if-set-p variable))))
 382               (save-excursion
 383                 (forward-line -1)
 384                 (insert "Automatically becomes buffer-local when set in any fashion.\n"))))
 385           (princ "Documentation:")
 386           (terpri)
 387           (let ((doc (documentation-property variable 'variable-documentation)))
 388             (princ (or doc "not documented as a variable.")))
 389
 390           ;; Make a link to customize if this variable can be customized.
 391           ;; Note, it is not reliable to test only for a custom-type property
 392           ;; because those are only present after the var's definition
 393           ;; has been loaded.
 394           (if (or (get variable 'custom-type) ; after defcustom
 395                   (get variable 'custom-loads) ; from loaddefs.el
 396                   (get variable 'standard-value)) ; from cus-start.el
 397               (let ((customize-label "customize"))
 398                 (terpri)
 399                 (terpri)
 400                 (princ (concat "You can " customize-label " this variable."))
 401                 (with-current-buffer standard-output
 402                   (save-excursion
 403                     (re-search-backward
 404                      (concat "\\(" customize-label "\\)") nil t)
 405                     (help-xref-button 1 'help-customize-variable variable)))))
 406           ;; Make a hyperlink to the library if appropriate.  (Don't
 407           ;; change the format of the buffer's initial line in case
 408           ;; anything expects the current format.)
 409           (let ((file-name (symbol-file variable)))
 410             (when (equal file-name "loaddefs.el")
 411               ;; Find the real def site of the preloaded variable.
 412               (let ((location
 413                      (condition-case nil
 414                          (find-variable-noselect variable file-name)
 415                        (error nil))))
 416                 (when location
 417                   (with-current-buffer (car location)
 418                     (goto-char (cdr location))
 419                     (when (re-search-backward
 420                            "^;;; Generated autoloads from \\(.*\\)" nil t)
 421                       (setq file-name (match-string 1)))))))
 422             (when file-name
 423               (princ "\n\nDefined in `")
 424               (princ file-name)
 425               (princ "'.")
 426               (with-current-buffer standard-output
 427                 (save-excursion
 428                   (re-search-backward "`\\([^`']+\\)'" nil t)
 429                   (help-xref-button 1 'help-variable-def
 430                                     variable file-name)))))
 431
 432           (print-help-return-message)
 433           (save-excursion
 434             (set-buffer standard-output)
 435             ;; Return the text we displayed.
 436             (buffer-string)))))))
 437
 438 \f
 439 ;; `help-manyarg-func-alist' is defined primitively (in doc.c).
 440 ;; New primitives with `MANY' or `UNEVALLED' arglists should be added
 441 ;; to this alist.
 442 ;; The parens and function name are redundant, but it's messy to add
 443 ;; them in `documentation'.
 444
 445 ;; This will find any missing items:
 446 ;; (let (l)
 447 ;;   (mapatoms (lambda (x)
 448 ;;            (if (and (fboundp x)
 449 ;;                     (subrp (symbol-function x))
 450 ;;                     (not (numberp (cdr (subr-arity (symbol-function x)))))
 451 ;;                     (not (assq x help-manyarg-func-alist)))
 452 ;;                (push x l))))
 453 ;;   l)
 454 (defconst help-manyarg-func-alist
 455   (purecopy
 456    '((list . "(list &rest OBJECTS)")
 457      (vector . "(vector &rest OBJECTS)")
 458      (make-byte-code . "(make-byte-code &rest ELEMENTS)")
 459      (call-process
 460       . "(call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)")
 461      (call-process-region
 462       . "(call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)")
 463      (string . "(string &rest CHARACTERS)")
 464      (+ . "(+ &rest NUMBERS-OR-MARKERS)")
 465      (- . "(- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)")
 466      (* . "(* &rest NUMBERS-OR-MARKERS)")
 467      (/ . "(/ DIVIDEND DIVISOR &rest DIVISORS)")
 468      (max . "(max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
 469      (min . "(min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
 470      (logand . "(logand &rest INTS-OR-MARKERS)")
 471      (logior . "(logior &rest INTS-OR-MARKERS)")
 472      (logxor . "(logxor &rest INTS-OR-MARKERS)")
 473      (encode-time
 474       . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)")
 475      (insert . "(insert &rest ARGS)")
 476      (insert-and-inherit . "(insert-and-inherit &rest ARGS)")
 477      (insert-before-markers . "(insert-before-markers &rest ARGS)")
 478      (message . "(message STRING &rest ARGUMENTS)")
 479      (message-box . "(message-box STRING &rest ARGUMENTS)")
 480      (message-or-box . "(message-or-box STRING &rest ARGUMENTS)")
 481      (propertize . "(propertize STRING &rest PROPERTIES)")
 482      (format . "(format STRING &rest OBJECTS)")
 483      (apply . "(apply FUNCTION &rest ARGUMENTS)")
 484      (run-hooks . "(run-hooks &rest HOOKS)")
 485      (run-hook-with-args . "(run-hook-with-args HOOK &rest ARGS)")
 486      (run-hook-with-args-until-failure
 487       . "(run-hook-with-args-until-failure HOOK &rest ARGS)")
 488      (run-hook-with-args-until-success
 489       . "(run-hook-with-args-until-success HOOK &rest ARGS)")
 490      (funcall . "(funcall FUNCTION &rest ARGUMENTS)")
 491      (append . "(append &rest SEQUENCES)")
 492      (concat . "(concat &rest SEQUENCES)")
 493      (vconcat . "(vconcat &rest SEQUENCES)")
 494      (nconc . "(nconc &rest LISTS)")
 495      (widget-apply . "(widget-apply WIDGET PROPERTY &rest ARGS)")
 496      (make-hash-table . "(make-hash-table &rest KEYWORD-ARGS)")
 497      (insert-string . "(insert-string &rest ARGS)")
 498      (start-process . "(start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)")
 499      (setq-default . "(setq-default SYMBOL VALUE [SYMBOL VALUE...])")
 500      (save-excursion . "(save-excursion &rest BODY)")
 501      (save-current-buffer . "(save-current-buffer &rest BODY)")
 502      (save-restriction . "(save-restriction &rest BODY)")
 503      (or . "(or CONDITIONS ...)")
 504      (and . "(and CONDITIONS ...)")
 505      (if . "(if COND THEN ELSE...)")
 506      (cond . "(cond CLAUSES...)")
 507      (progn . "(progn BODY ...)")
 508      (prog1 . "(prog1 FIRST BODY...)")
 509      (prog2 . "(prog2 X Y BODY...)")
 510      (setq . "(setq SYM VAL SYM VAL ...)")
 511      (quote . "(quote ARG)")
 512      (function . "(function ARG)")
 513      (defun . "(defun NAME ARGLIST [DOCSTRING] BODY...)")
 514      (defmacro . "(defmacro NAME ARGLIST [DOCSTRING] BODY...)")
 515      (defvar . "(defvar SYMBOL [INITVALUE DOCSTRING])")
 516      (defconst . "(defconst SYMBOL INITVALUE [DOCSTRING])")
 517      (let* . "(let* VARLIST BODY...)")
 518      (let . "(let VARLIST BODY...)")
 519      (while . "(while TEST BODY...)")
 520      (catch . "(catch TAG BODY...)")
 521      (unwind-protect . "(unwind-protect BODYFORM UNWINDFORMS...)")
 522      (condition-case . "(condition-case VAR BODYFORM HANDLERS...)")
 523      (track-mouse . "(track-mouse BODY ...)")
 524      (ml-if . "(ml-if COND THEN ELSE...)")
 525      (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)")
 526      (ml-prefix-argument-loop . "(ml-prefix-argument-loop ...)")
 527      (with-output-to-temp-buffer
 528          . "(with-output-to-temp-buffer BUFFNAME BODY ...)")
 529      (save-window-excursion . "(save-window-excursion BODY ...)")
 530      (find-operation-coding-system
 531       . "(find-operation-coding-system OPERATION ARGUMENTS ...)")
 532      (insert-before-markers-and-inherit
 533       . "(insert-before-markers-and-inherit &rest ARGS)"))))
 534
 535
 536 (provide 'help-funs)
 537
 538 ;;; help-funs.el ends here
 539
 540