lisp/help-fns.el

   1 ;;; help-fns.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) 'autoload)
 167                  (setq file-name (nth 1 def))
 168                  (format "%s autoloaded %s"
 169                          (if (commandp def) "an interactive" "an")
 170                          (if (eq (nth 4 def) 'keymap) "keymap"
 171                            (if (nth 4 def) "Lisp macro" "Lisp function"))
 172                          ))
 173                 ;; perhaps use keymapp here instead
 174                 ((eq (car-safe def) 'keymap)
 175                  (let ((is-full nil)
 176                        (elts (cdr-safe def)))
 177                    (while elts
 178                      (if (char-table-p (car-safe elts))
 179                          (setq is-full t
 180                                elts nil))
 181                      (setq elts (cdr-safe elts)))
 182                    (if is-full
 183                        "a full keymap"
 184                      "a sparse keymap")))
 185                 (t "")))
 186     (princ string)
 187     (with-current-buffer standard-output
 188       (save-excursion
 189         (save-match-data
 190           (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
 191               (help-xref-button 1 'help-function def)))))
 192     (or file-name
 193         (setq file-name (symbol-file function)))
 194     (cond
 195      (file-name
 196           (princ " in `")
 197           ;; We used to add .el to the file name,
 198           ;; but that's completely wrong when the user used load-file.
 199           (princ file-name)
 200           (princ "'")
 201           ;; Make a hyperlink to the library.
 202       (with-current-buffer standard-output
 203             (save-excursion
 204               (re-search-backward "`\\([^`']+\\)'" nil t)
 205           (help-xref-button 1 'help-function-def function file-name)))))
 206     (princ ".")
 207     (terpri)
 208     (when (commandp function)
 209       (let ((keys (where-is-internal
 210                    function overriding-local-map nil nil)))
 211         (when keys
 212           (princ "It is bound to ")
 213           ;; FIXME: This list can be very long (f.ex. for self-insert-command).
 214           (princ (mapconcat 'key-description keys ", "))
 215           (princ ".")
 216           (terpri))))
 217     ;; Handle symbols aliased to other symbols.
 218     (setq def (indirect-function def))
 219     ;; If definition is a macro, find the function inside it.
 220     (if (eq (car-safe def) 'macro)
 221         (setq def (cdr def)))
 222     (let ((arglist (cond ((byte-code-function-p def)
 223                           (car (append def nil)))
 224                          ((eq (car-safe def) 'lambda)
 225                           (nth 1 def))
 226                          ((and (eq (car-safe def) 'autoload)
 227                                (not (eq (nth 4 def) 'keymap)))
 228                           (concat "[Arg list not available until "
 229                                   "function definition is loaded.]"))
 230                          (t t))))
 231       (cond ((listp arglist)
 232              (princ (cons (if (symbolp function) function "anonymous")
 233                           (mapcar (lambda (arg)
 234                                     (if (memq arg '(&optional &rest))
 235                                         arg
 236                                       (intern (upcase (symbol-name arg)))))
 237                                   arglist)))
 238              (terpri))
 239             ((stringp arglist)
 240              (princ arglist)
 241              (terpri))))
 242     (let ((doc (documentation function)))
 243       (if doc
 244           (progn (terpri)
 245                  (princ doc)
 246                  (if (subrp def)
 247                      (with-current-buffer standard-output
 248                        (beginning-of-line)
 249                        ;; Builtins get the calling sequence at the end of
 250                        ;; the doc string.  Move it to the same place as
 251                        ;; for other functions.
 252
 253                        ;; In cases where `function' has been fset to a
 254                        ;; subr we can't search for function's name in
 255                        ;; the doc string.  Kluge round that using the
 256                        ;; printed representation.  The arg list then
 257                        ;; shows the wrong function name, but that
 258                        ;; might be a useful hint.
 259                        (let* ((rep (prin1-to-string def))
 260                               (name (progn
 261                                       (string-match " \\([^ ]+\\)>$" rep)
 262                                       (match-string 1 rep))))
 263                          (if (looking-at (format "(%s[ )]" (regexp-quote name)))
 264                              (let ((start (point-marker)))
 265                                (goto-char (point-min))
 266                                (forward-paragraph)
 267                                (insert-buffer-substring (current-buffer) start)
 268                                (insert ?\n)
 269                                (delete-region (1- start) (point-max)))
 270                            (goto-char (point-min))
 271                            (forward-paragraph)
 272                            (insert
 273                             "[Missing arglist.  Please make a bug report.]\n")))
 274                        (goto-char (point-max)))))
 275         (princ "not documented")))))
 276
 277 \f
 278 ;; Variables
 279
 280 ;;;###autoload
 281 (defun variable-at-point ()
 282   "Return the bound variable symbol found around point.
 283 Return 0 if there is no such symbol."
 284   (condition-case ()
 285       (with-syntax-table emacs-lisp-mode-syntax-table
 286         (save-excursion
 287           (or (not (zerop (skip-syntax-backward "_w")))
 288               (eq (char-syntax (following-char)) ?w)
 289               (eq (char-syntax (following-char)) ?_)
 290               (forward-sexp -1))
 291           (skip-chars-forward "'")
 292           (let ((obj (read (current-buffer))))
 293             (or (and (symbolp obj) (boundp obj) obj)
 294                 0))))
 295     (error 0)))
 296
 297 ;;;###autoload
 298 (defun describe-variable (variable &optional buffer)
 299   "Display the full documentation of VARIABLE (a symbol).
 300 Returns the documentation as a string, also.
 301 If VARIABLE has a buffer-local value in BUFFER (default to the current buffer),
 302 it is displayed along with the global value."
 303   (interactive
 304    (let ((v (variable-at-point))
 305          (enable-recursive-minibuffers t)
 306          val)
 307      (setq val (completing-read (if (symbolp v)
 308                                     (format
 309                                      "Describe variable (default %s): " v)
 310                                   "Describe variable: ")
 311                                 obarray 'boundp t nil nil
 312                                 (if (symbolp v) (symbol-name v))))
 313      (list (if (equal val "")
 314                v (intern val)))))
 315   (unless (bufferp buffer) (setq buffer (current-buffer)))
 316   (if (not (symbolp variable))
 317       (message "You did not specify a variable")
 318     (let (valvoid)
 319       (help-setup-xref (list #'describe-variable variable buffer)
 320                        (interactive-p))
 321       (with-output-to-temp-buffer (help-buffer)
 322       (with-current-buffer buffer
 323           (prin1 variable)
 324           (if (not (boundp variable))
 325               (progn
 326                 (princ " is void")
 327                 (setq valvoid t))
 328             (let ((val (symbol-value variable)))
 329               (with-current-buffer standard-output
 330                 (princ "'s value is ")
 331                 (terpri)
 332                 (let ((from (point)))
 333                   (pp val)
 334                   (help-xref-on-pp from (point))
 335                   (if (< (point) (+ from 20))
 336                       (save-excursion
 337                         (goto-char from)
 338                         (delete-char -1)))))))
 339           (terpri)
 340           (when (local-variable-p variable)
 341             (princ (format "Local in buffer %s; " (buffer-name)))
 342             (if (not (default-boundp variable))
 343                 (princ "globally void")
 344               (let ((val (default-value variable)))
 345                 (with-current-buffer standard-output
 346                   (princ "global value is ")
 347                   (terpri)
 348                   ;; Fixme: pp can take an age if you happen to
 349                   ;; ask for a very large expression.  We should
 350                   ;; probably print it raw once and check it's a
 351                   ;; sensible size before prettyprinting.  -- fx
 352                   (let ((from (point)))
 353                         (pp val)
 354                         (help-xref-on-pp from (point))
 355                         (if (< (point) (+ from 20))
 356                             (save-excursion
 357                               (goto-char from)
 358                               (delete-char -1)))))))
 359             (terpri))
 360           (terpri)
 361           (with-current-buffer standard-output
 362             (when (> (count-lines (point-min) (point-max)) 10)
 363               ;; Note that setting the syntax table like below
 364               ;; makes forward-sexp move over a `'s' at the end
 365               ;; of a symbol.
 366               (set-syntax-table emacs-lisp-mode-syntax-table)
 367               (goto-char (point-min))
 368               (if valvoid
 369                   (forward-line 1)
 370                 (forward-sexp 1)
 371                 (delete-region (point) (progn (end-of-line) (point)))
 372                 (insert " value is shown below.\n\n")
 373                 (save-excursion
 374                   (insert "\n\nValue:"))))
 375             ;; Add a note for variables that have been make-var-buffer-local.
 376             (when (and (local-variable-if-set-p variable)
 377                        (or (not (local-variable-p variable))
 378                            (with-temp-buffer
 379                              (local-variable-if-set-p variable))))
 380               (save-excursion
 381                 (forward-line -1)
 382                 (insert "Automatically becomes buffer-local when set in any fashion.\n"))))
 383           (princ "Documentation:")
 384           (terpri)
 385           (let ((doc (documentation-property variable 'variable-documentation)))
 386             (princ (or doc "not documented as a variable.")))
 387
 388           ;; Make a link to customize if this variable can be customized.
 389           ;; Note, it is not reliable to test only for a custom-type property
 390           ;; because those are only present after the var's definition
 391           ;; has been loaded.
 392           (if (or (get variable 'custom-type) ; after defcustom
 393                   (get variable 'custom-loads) ; from loaddefs.el
 394                   (get variable 'standard-value)) ; from cus-start.el
 395               (let ((customize-label "customize"))
 396                 (terpri)
 397                 (terpri)
 398                 (princ (concat "You can " customize-label " this variable."))
 399                 (with-current-buffer standard-output
 400                   (save-excursion
 401                     (re-search-backward
 402                      (concat "\\(" customize-label "\\)") nil t)
 403                     (help-xref-button 1 'help-customize-variable variable)))))
 404           ;; Make a hyperlink to the library if appropriate.  (Don't
 405           ;; change the format of the buffer's initial line in case
 406           ;; anything expects the current format.)
 407           (let ((file-name (symbol-file variable)))
 408             (when (equal file-name "loaddefs.el")
 409               ;; Find the real def site of the preloaded variable.
 410               (let ((location
 411                      (condition-case nil
 412                          (find-variable-noselect variable file-name)
 413                        (error nil))))
 414                 (when location
 415                   (with-current-buffer (car location)
 416                     (goto-char (cdr location))
 417                     (when (re-search-backward
 418                            "^;;; Generated autoloads from \\(.*\\)" nil t)
 419                       (setq file-name (match-string 1)))))))
 420             (when file-name
 421               (princ "\n\nDefined in `")
 422               (princ file-name)
 423               (princ "'.")
 424               (with-current-buffer standard-output
 425                 (save-excursion
 426                   (re-search-backward "`\\([^`']+\\)'" nil t)
 427                   (help-xref-button 1 'help-variable-def
 428                                     variable file-name)))))
 429
 430           (print-help-return-message)
 431           (save-excursion
 432             (set-buffer standard-output)
 433             ;; Return the text we displayed.
 434             (buffer-string)))))))
 435
 436
 437 ;;;###autoload
 438 (defun describe-syntax (&optional buffer)
 439   "Describe the syntax specifications in the syntax table of BUFFER.
 440 The descriptions are inserted in a help buffer, which is then displayed.
 441 BUFFER defaults to the current buffer."
 442   (interactive)
 443   (setq buffer (or buffer (current-buffer)))
 444   (help-setup-xref (list #'describe-syntax buffer) (interactive-p))
 445   (with-output-to-temp-buffer (help-buffer)
 446     (let ((table (with-current-buffer buffer (syntax-table))))
 447       (with-current-buffer standard-output
 448         (describe-vector table 'internal-describe-syntax-value)
 449         (while (setq table (char-table-parent table))
 450           (insert "\nThe parent syntax table is:")
 451           (describe-vector table 'internal-describe-syntax-value))))))
 452
 453 (defun help-describe-category-set (value)
 454   (insert (cond
 455            ((null value) "default")
 456            ((char-table-p value) "deeper char-table ...")
 457            (t (condition-case err
 458                   (category-set-mnemonics value)
 459                 (error "invalid"))))))
 460
 461 ;;;###autoload
 462 (defun describe-categories (&optional buffer)
 463   "Describe the category specifications in the current category table.
 464 The descriptions are inserted in a buffer, which is then displayed."
 465   (interactive)
 466   (setq buffer (or buffer (current-buffer)))
 467   (help-setup-xref (list #'describe-categories buffer) (interactive-p))
 468   (with-output-to-temp-buffer (help-buffer)
 469     (let ((table (with-current-buffer buffer (category-table))))
 470       (with-current-buffer standard-output
 471         (describe-vector table 'help-describe-category-set)
 472         (let ((docs (char-table-extra-slot table 0)))
 473           (if (or (not (vectorp docs)) (/= (length docs) 95))
 474               (insert "Invalid first extra slot in this char table\n")
 475             (insert "Meanings of mnemonic characters are:\n")
 476             (dotimes (i 95)
 477               (let ((elt (aref docs i)))
 478                 (when elt
 479                   (insert (+ i ?\ ) ": " elt "\n"))))
 480             (while (setq table (char-table-parent table))
 481               (insert "\nThe parent category table is:")
 482               (describe-vector table 'help-describe-category-set))))))))
 483
 484 (provide 'help-fns)
 485
 486 ;;; help-fns.el ends here