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