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