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