1;;; help-fns.el --- Complex help functions
2
3;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001,
4;;   2002, 2003, 2004, 2005, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, 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;; Functions
39
40;;;###autoload
41(defun describe-function (function)
42  "Display the full documentation of FUNCTION (a symbol)."
43  (interactive
44   (let ((fn (function-called-at-point))
45	 (enable-recursive-minibuffers t)
46	 val)
47     (setq val (completing-read (if fn
48				    (format "Describe function (default %s): " fn)
49				  "Describe function: ")
50				obarray 'fboundp t nil nil
51				(and fn (symbol-name fn))))
52     (list (if (equal val "")
53	       fn (intern val)))))
54  (if (null function)
55      (message "You didn't specify a function")
56    (help-setup-xref (list #'describe-function function) (interactive-p))
57    (save-excursion
58      (with-output-to-temp-buffer (help-buffer)
59	(prin1 function)
60	;; Use " is " instead of a colon so that
61	;; it is easier to get out the function name using forward-sexp.
62	(princ " is ")
63	(describe-function-1 function)
64	(print-help-return-message)
65	(with-current-buffer standard-output
66	  ;; Return the text we displayed.
67	  (buffer-string))))))
68
69(defun help-split-fundoc (docstring def)
70  "Split a function DOCSTRING into the actual doc and the usage info.
71Return (USAGE . DOC) or nil if there's no usage info.
72DEF is the function whose usage we're looking for in DOCSTRING."
73  ;; Functions can get the calling sequence at the end of the doc string.
74  ;; In cases where `function' has been fset to a subr we can't search for
75  ;; function's name in the doc string so we use `fn' as the anonymous
76  ;; function name instead.
77  (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
78    (cons (format "(%s%s"
79		  ;; Replace `fn' with the actual function name.
80		  (if (consp def) "anonymous" def)
81		  (match-string 1 docstring))
82	  (substring docstring 0 (match-beginning 0)))))
83
84(defun help-add-fundoc-usage (docstring arglist)
85  "Add the usage info to DOCSTRING.
86If DOCSTRING already has a usage info, then just return it unchanged.
87The usage info is built from ARGLIST.  DOCSTRING can be nil.
88ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
89  (unless (stringp docstring) (setq docstring "Not documented"))
90  (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t))
91      docstring
92    (concat docstring
93	    (if (string-match "\n?\n\\'" docstring)
94		(if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
95	      "\n\n")
96	    (if (and (stringp arglist)
97		     (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
98		(concat "(fn" (match-string 1 arglist) ")")
99	      (format "%S" (help-make-usage 'fn arglist))))))
100
101(defun help-function-arglist (def)
102  ;; Handle symbols aliased to other symbols.
103  (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
104  ;; If definition is a macro, find the function inside it.
105  (if (eq (car-safe def) 'macro) (setq def (cdr def)))
106  (cond
107   ((byte-code-function-p def) (aref def 0))
108   ((eq (car-safe def) 'lambda) (nth 1 def))
109   ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
110    "[Arg list not available until function definition is loaded.]")
111   (t t)))
112
113(defun help-make-usage (function arglist)
114  (cons (if (symbolp function) function 'anonymous)
115	(mapcar (lambda (arg)
116		  (if (not (symbolp arg))
117		      (if (and (consp arg) (symbolp (car arg)))
118			  ;; CL style default values for optional args.
119			  (cons (intern (upcase (symbol-name (car arg))))
120				(cdr arg))
121			arg)
122		    (let ((name (symbol-name arg)))
123		      (if (string-match "\\`&" name) arg
124			(intern (upcase name))))))
125		arglist)))
126
127;; Could be this, if we make symbol-file do the work below.
128;; (defun help-C-file-name (subr-or-var kind)
129;;   "Return the name of the C file where SUBR-OR-VAR is defined.
130;; KIND should be `var' for a variable or `subr' for a subroutine."
131;;   (symbol-file (if (symbolp subr-or-var) subr-or-var
132;; 		 (subr-name subr-or-var))
133;; 	       (if (eq kind 'var) 'defvar 'defun)))
134;;;###autoload
135(defun help-C-file-name (subr-or-var kind)
136  "Return the name of the C file where SUBR-OR-VAR is defined.
137KIND should be `var' for a variable or `subr' for a subroutine."
138  (let ((docbuf (get-buffer-create " *DOC*"))
139	(name (if (eq 'var kind)
140		  (concat "V" (symbol-name subr-or-var))
141		(concat "F" (subr-name subr-or-var)))))
142    (with-current-buffer docbuf
143      (goto-char (point-min))
144      (if (eobp)
145	  (insert-file-contents-literally
146	   (expand-file-name internal-doc-file-name doc-directory)))
147      (let ((file (catch 'loop
148		    (while t
149		      (let ((pnt (search-forward (concat "" name "\n"))))
150			(re-search-backward "S\\(.*\\)")
151			(let ((file (match-string 1)))
152			  (if (member file build-files)
153			      (throw 'loop file)
154			    (goto-char pnt))))))))
155	(if (string-match "\\.\\(o\\|obj\\)\\'" file)
156	    (setq file (replace-match ".c" t t file)))
157	(if (string-match "\\.c\\'" file)
158	    (concat "src/" file)
159	  file)))))
160
161(defface help-argument-name '((((supports :slant italic)) :inherit italic))
162  "Face to highlight argument names in *Help* buffers."
163  :group 'help)
164
165(defun help-default-arg-highlight (arg)
166  "Default function to highlight arguments in *Help* buffers.
167It returns ARG in face `help-argument-name'; ARG is also
168downcased if it displays differently than the default
169face (according to `face-differs-from-default-p')."
170  (propertize (if (face-differs-from-default-p 'help-argument-name)
171                  (downcase arg)
172                arg)
173              'face 'help-argument-name))
174
175(defun help-do-arg-highlight (doc args)
176  (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
177    (modify-syntax-entry ?\- "w")
178    (dolist (arg args doc)
179      (setq doc (replace-regexp-in-string
180                 ;; This is heuristic, but covers all common cases
181                 ;; except ARG1-ARG2
182                 (concat "\\<"                   ; beginning of word
183                         "\\(?:[a-z-]*-\\)?"     ; for xxx-ARG
184                         "\\("
185                         (regexp-quote arg)
186                         "\\)"
187                         "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
188                         "\\(?:-[a-z0-9-]+\\)?"  ; for ARG-xxx, ARG-n
189                         "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
190                         "\\>")                  ; end of word
191                 (help-default-arg-highlight arg)
192                 doc t t 1)))))
193
194(defun help-highlight-arguments (usage doc &rest args)
195  (when usage
196    (with-temp-buffer
197      (insert usage)
198      (goto-char (point-min))
199      (let ((case-fold-search nil)
200            (next (not (or args (looking-at "\\["))))
201            (opt nil))
202        ;; Make a list of all arguments
203        (skip-chars-forward "^ ")
204        (while next
205          (or opt (not (looking-at " &")) (setq opt t))
206          (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
207              (setq next nil)
208            (setq args (cons (match-string 2) args))
209            (when (and opt (string= (match-string 1) "("))
210              ;; A pesky CL-style optional argument with default value,
211              ;; so let's skip over it
212              (search-backward "(")
213              (goto-char (scan-sexps (point) 1)))))
214        ;; Highlight aguments in the USAGE string
215        (setq usage (help-do-arg-highlight (buffer-string) args))
216        ;; Highlight arguments in the DOC string
217        (setq doc (and doc (help-do-arg-highlight doc args))))))
218  ;; Return value is like the one from help-split-fundoc, but highlighted
219  (cons usage doc))
220
221;;;###autoload
222(defun describe-simplify-lib-file-name (file)
223  "Simplify a library name FILE to a relative name, and make it a source file."
224  (if file
225      ;; Try converting the absolute file name to a library name.
226      (let ((libname (file-name-nondirectory file)))
227	;; Now convert that back to a file name and see if we get
228	;; the original one.  If so, they are equivalent.
229	(if (equal file (locate-file libname load-path '("")))
230	    (if (string-match "[.]elc\\'" libname)
231		(substring libname 0 -1)
232	      libname)
233	  file))))
234
235;;;###autoload
236(defun describe-function-1 (function)
237  (let* ((def (if (symbolp function)
238		  (symbol-function function)
239		function))
240	 file-name string
241	 (beg (if (commandp def) "an interactive " "a ")))
242    (setq string
243	  (cond ((or (stringp def)
244		     (vectorp def))
245		 "a keyboard macro")
246		((subrp def)
247		 (if (eq 'unevalled (cdr (subr-arity def)))
248		     (concat beg "special form")
249		   (concat beg "built-in function")))
250		((byte-code-function-p def)
251		 (concat beg "compiled Lisp function"))
252		((symbolp def)
253		 (while (symbolp (symbol-function def))
254		   (setq def (symbol-function def)))
255		 (format "an alias for `%s'" def))
256		((eq (car-safe def) 'lambda)
257		 (concat beg "Lisp function"))
258		((eq (car-safe def) 'macro)
259		 "a Lisp macro")
260		((eq (car-safe def) 'autoload)
261		 (setq file-name (nth 1 def))
262		 (format "%s autoloaded %s"
263			 (if (commandp def) "an interactive" "an")
264			 (if (eq (nth 4 def) 'keymap) "keymap"
265			   (if (nth 4 def) "Lisp macro" "Lisp function"))
266			 ))
267                ((keymapp def)
268                 (let ((is-full nil)
269                       (elts (cdr-safe def)))
270                   (while elts
271                     (if (char-table-p (car-safe elts))
272                         (setq is-full t
273                               elts nil))
274                     (setq elts (cdr-safe elts)))
275                   (if is-full
276                       "a full keymap"
277                     "a sparse keymap")))
278		(t "")))
279    (princ string)
280    (with-current-buffer standard-output
281      (save-excursion
282	(save-match-data
283	  (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
284	      (help-xref-button 1 'help-function def)))))
285    (or file-name
286	(setq file-name (symbol-file function 'defun)))
287    (setq file-name (describe-simplify-lib-file-name file-name))
288    (when (equal file-name "loaddefs.el")
289      ;; Find the real def site of the preloaded function.
290      ;; This is necessary only for defaliases.
291      (let ((location
292	     (condition-case nil
293		 (find-function-search-for-symbol function nil "loaddefs.el")
294	       (error nil))))
295	(when location
296	  (with-current-buffer (car location)
297	    (goto-char (cdr location))
298	    (when (re-search-backward
299		   "^;;; Generated autoloads from \\(.*\\)" nil t)
300	      (setq file-name (match-string 1)))))))
301    (when (and (null file-name) (subrp def))
302      ;; Find the C source file name.
303      (setq file-name (if (get-buffer " *DOC*")
304			  (help-C-file-name def 'subr)
305			'C-source)))
306    (when file-name
307      (princ " in `")
308      ;; We used to add .el to the file name,
309      ;; but that's completely wrong when the user used load-file.
310      (princ (if (eq file-name 'C-source) "C source code" file-name))
311      (princ "'")
312      ;; Make a hyperlink to the library.
313      (with-current-buffer standard-output
314        (save-excursion
315	  (re-search-backward "`\\([^`']+\\)'" nil t)
316	  (help-xref-button 1 'help-function-def function file-name))))
317    (princ ".")
318    (terpri)
319    (when (commandp function)
320      (if (and (eq function 'self-insert-command)
321	       (eq (key-binding "a") 'self-insert-command)
322	       (eq (key-binding "b") 'self-insert-command)
323	       (eq (key-binding "c") 'self-insert-command))
324	  (princ "It is bound to many ordinary text characters.\n")
325	(let* ((remapped (command-remapping function))
326	       (keys (where-is-internal
327		      (or remapped function) overriding-local-map nil nil))
328	       non-modified-keys)
329	  ;; Which non-control non-meta keys run this command?
330	  (dolist (key keys)
331	    (if (member (event-modifiers (aref key 0)) '(nil (shift)))
332		(push key non-modified-keys)))
333	  (when remapped
334	    (princ "It is remapped to `")
335	    (princ (symbol-name remapped))
336	    (princ "'"))
337
338	  (when keys
339	    (princ (if remapped " which is bound to " "It is bound to "))
340	    ;; If lots of ordinary text characters run this command,
341	    ;; don't mention them one by one.
342	    (if (< (length non-modified-keys) 10)
343		(princ (mapconcat 'key-description keys ", "))
344	      (dolist (key non-modified-keys)
345		(setq keys (delq key keys)))
346	      (if keys
347		  (progn
348		    (princ (mapconcat 'key-description keys ", "))
349		    (princ ", and many ordinary text characters"))
350		(princ "many ordinary text characters"))))
351	  (when (or remapped keys non-modified-keys)
352	    (princ ".")
353	    (terpri)))))
354    (let* ((arglist (help-function-arglist def))
355	   (doc (documentation function))
356	   (usage (help-split-fundoc doc function)))
357      (with-current-buffer standard-output
358        ;; If definition is a keymap, skip arglist note.
359        (unless (keymapp def)
360          (let* ((use (cond
361                        (usage (setq doc (cdr usage)) (car usage))
362                        ((listp arglist)
363                         (format "%S" (help-make-usage function arglist)))
364                        ((stringp arglist) arglist)
365                        ;; Maybe the arglist is in the docstring of the alias.
366                        ((let ((fun function))
367                           (while (and (symbolp fun)
368                                       (setq fun (symbol-function fun))
369                                       (not (setq usage (help-split-fundoc
370                                                         (documentation fun)
371                                                         function)))))
372                           usage)
373                         (car usage))
374                        ((or (stringp def)
375                             (vectorp def))
376                         (format "\nMacro: %s" (format-kbd-macro def)))
377                        (t "[Missing arglist.  Please make a bug report.]")))
378                 (high (help-highlight-arguments use doc)))
379            (let ((fill-begin (point)))
380	      (insert (car high) "\n")
381	      (fill-region fill-begin (point)))
382            (setq doc (cdr high))))
383        (let ((obsolete (and
384                         ;; function might be a lambda construct.
385                         (symbolp function)
386                         (get function 'byte-obsolete-info))))
387          (when obsolete
388            (princ "\nThis function is obsolete")
389            (when (nth 2 obsolete)
390              (insert (format " since %s" (nth 2 obsolete))))
391            (insert ";\n"
392                    (if (stringp (car obsolete)) (car obsolete)
393                      (format "use `%s' instead." (car obsolete)))
394                    "\n"))
395          (insert "\n"
396                  (or doc "Not documented.")))))))
397
398
399;; Variables
400
401;;;###autoload
402(defun variable-at-point (&optional any-symbol)
403  "Return the bound variable symbol found at or before point.
404Return 0 if there is no such symbol.
405If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
406  (or (condition-case ()
407	  (with-syntax-table emacs-lisp-mode-syntax-table
408	    (save-excursion
409	      (or (not (zerop (skip-syntax-backward "_w")))
410		  (eq (char-syntax (following-char)) ?w)
411		  (eq (char-syntax (following-char)) ?_)
412		  (forward-sexp -1))
413	      (skip-chars-forward "'")
414	      (let ((obj (read (current-buffer))))
415		(and (symbolp obj) (boundp obj) obj))))
416	(error nil))
417      (let* ((str (find-tag-default))
418	     (sym (if str (intern-soft str))))
419	(if (and sym (or any-symbol (boundp sym)))
420	    sym
421	  (save-match-data
422	    (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
423	      (setq sym (intern-soft (match-string 1 str)))
424	      (and (or any-symbol (boundp sym)) sym)))))
425      0))
426
427;;;###autoload
428(defun describe-variable (variable &optional buffer)
429  "Display the full documentation of VARIABLE (a symbol).
430Returns the documentation as a string, also.
431If VARIABLE has a buffer-local value in BUFFER (default to the current buffer),
432it is displayed along with the global value."
433  (interactive
434   (let ((v (variable-at-point))
435	 (enable-recursive-minibuffers t)
436	 val)
437     (setq val (completing-read (if (symbolp v)
438				    (format
439				     "Describe variable (default %s): " v)
440				  "Describe variable: ")
441				obarray
442				'(lambda (vv)
443				   (or (boundp vv)
444				       (get vv 'variable-documentation)))
445				t nil nil
446				(if (symbolp v) (symbol-name v))))
447     (list (if (equal val "")
448	       v (intern val)))))
449  (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
450  (if (not (symbolp variable))
451      (message "You did not specify a variable")
452    (save-excursion
453      (let* ((valvoid (not (with-current-buffer buffer (boundp variable))))
454	     ;; Extract the value before setting up the output buffer,
455	     ;; in case `buffer' *is* the output buffer.
456	     (val (unless valvoid (buffer-local-value variable buffer)))
457	     val-start-pos)
458	(help-setup-xref (list #'describe-variable variable buffer)
459			 (interactive-p))
460	(with-output-to-temp-buffer (help-buffer)
461	  (with-current-buffer buffer
462	    (prin1 variable)
463	    ;; Make a hyperlink to the library if appropriate.  (Don't
464	    ;; change the format of the buffer's initial line in case
465	    ;; anything expects the current format.)
466	    (let ((file-name (symbol-file variable 'defvar)))
467	      (setq file-name (describe-simplify-lib-file-name file-name))
468	      (when (equal file-name "loaddefs.el")
469		;; Find the real def site of the preloaded variable.
470		(let ((location
471		       (condition-case nil
472			   (find-variable-noselect variable file-name)
473			 (error nil))))
474		  (when location
475		    (with-current-buffer (car location)
476		      (when (cdr location)
477			(goto-char (cdr location)))
478		      (when (re-search-backward
479			     "^;;; Generated autoloads from \\(.*\\)" nil t)
480			(setq file-name (match-string 1)))))))
481	      (when (and (null file-name)
482			 (integerp (get variable 'variable-documentation)))
483		;; It's a variable not defined in Elisp but in C.
484		(setq file-name
485		      (if (get-buffer " *DOC*")
486			  (help-C-file-name variable 'var)
487			'C-source)))
488	      (if file-name
489		  (progn
490		    (princ " is a variable defined in `")
491		    (princ (if (eq file-name 'C-source) "C source code" file-name))
492		    (princ "'.\n")
493		    (with-current-buffer standard-output
494		      (save-excursion
495			(re-search-backward "`\\([^`']+\\)'" nil t)
496			(help-xref-button 1 'help-variable-def
497					  variable file-name)))
498		    (if valvoid
499			(princ "It is void as a variable.")
500		      (princ "Its ")))
501		(if valvoid
502		    (princ " is void as a variable.")
503		  (princ "'s "))))
504	    (if valvoid
505		nil
506	      (with-current-buffer standard-output
507		(setq val-start-pos (point))
508		(princ "value is ")
509		(terpri)
510		(let ((from (point)))
511		  (pp val)
512		  ;; Hyperlinks in variable's value are quite frequently
513		  ;; inappropriate e.g C-h v <RET> features <RET>
514		  ;; (help-xref-on-pp from (point))
515		  (if (< (point) (+ from 20))
516		      (delete-region (1- from) from)))))
517	    (terpri)
518
519	    (when (local-variable-p variable)
520	      (princ (format "%socal in buffer %s; "
521			     (if (get variable 'permanent-local)
522				 "Permanently l" "L")
523			     (buffer-name)))
524	      (if (not (default-boundp variable))
525		  (princ "globally void")
526		(let ((val (default-value variable)))
527		  (with-current-buffer standard-output
528		    (princ "global value is ")
529		    (terpri)
530		    ;; Fixme: pp can take an age if you happen to
531		    ;; ask for a very large expression.  We should
532		    ;; probably print it raw once and check it's a
533		    ;; sensible size before prettyprinting.  -- fx
534		    (let ((from (point)))
535		      (pp val)
536		      ;; See previous comment for this function.
537		      ;; (help-xref-on-pp from (point))
538		      (if (< (point) (+ from 20))
539			  (delete-region (1- from) from)))))))
540	    ;; Add a note for variables that have been make-var-buffer-local.
541	    (when (and (local-variable-if-set-p variable)
542		       (or (not (local-variable-p variable))
543			   (with-temp-buffer
544			     (local-variable-if-set-p variable))))
545	      (princ "\nAutomatically becomes buffer-local when set in any fashion.\n"))
546	    (terpri)
547
548	    ;; If the value is large, move it to the end.
549	    (with-current-buffer standard-output
550	      (when (> (count-lines (point-min) (point-max)) 10)
551		;; Note that setting the syntax table like below
552		;; makes forward-sexp move over a `'s' at the end
553		;; of a symbol.
554		(set-syntax-table emacs-lisp-mode-syntax-table)
555		(goto-char val-start-pos)
556		;; The line below previously read as
557		;; (delete-region (point) (progn (end-of-line) (point)))
558		;; which suppressed display of the buffer local value for
559		;; large values.
560		(when (looking-at "value is") (replace-match ""))
561		(save-excursion
562		  (insert "\n\nValue:")
563		  (set (make-local-variable 'help-button-cache)
564		       (point-marker)))
565		(insert "value is shown ")
566		(insert-button "below"
567			       'action help-button-cache
568			       'follow-link t
569			       'help-echo "mouse-2, RET: show value")
570		(insert ".\n")))
571
572 	    ;; Mention if it's an alias
573            (let* ((alias (condition-case nil
574                             (indirect-variable variable)
575                           (error variable)))
576                   (obsolete (get variable 'byte-obsolete-variable))
577		   (safe-var (get variable 'safe-local-variable))
578                   (doc (or (documentation-property variable 'variable-documentation)
579                            (documentation-property alias 'variable-documentation))))
580              (unless (eq alias variable)
581                (princ (format "\nThis variable is an alias for `%s'.\n" alias)))
582	      (if (or obsolete safe-var)
583		  (terpri))
584
585              (when obsolete
586                (princ "This variable is obsolete")
587                (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
588                (princ ";") (terpri)
589                (princ (if (stringp (car obsolete)) (car obsolete)
590                         (format "use `%s' instead." (car obsolete))))
591                (terpri))
592	      (when safe-var
593		(princ "This variable is safe as a file local variable ")
594		(princ "if its value\nsatisfies the predicate ")
595		(princ (if (byte-code-function-p safe-var)
596			   "which is byte-compiled expression.\n"
597			 (format "`%s'.\n" safe-var))))
598	      (princ "\nDocumentation:\n")
599              (princ (or doc "Not documented as a variable.")))
600	    ;; Make a link to customize if this variable can be customized.
601	    (if (custom-variable-p variable)
602		(let ((customize-label "customize"))
603		  (terpri)
604		  (terpri)
605		  (princ (concat "You can " customize-label " this variable."))
606		  (with-current-buffer standard-output
607		    (save-excursion
608		      (re-search-backward
609		       (concat "\\(" customize-label "\\)") nil t)
610		      (help-xref-button 1 'help-customize-variable variable)))))
611	    (print-help-return-message)
612	    (save-excursion
613	      (set-buffer standard-output)
614	      ;; Return the text we displayed.
615	      (buffer-string))))))))
616
617
618;;;###autoload
619(defun describe-syntax (&optional buffer)
620  "Describe the syntax specifications in the syntax table of BUFFER.
621The descriptions are inserted in a help buffer, which is then displayed.
622BUFFER defaults to the current buffer."
623  (interactive)
624  (setq buffer (or buffer (current-buffer)))
625  (help-setup-xref (list #'describe-syntax buffer) (interactive-p))
626  (with-output-to-temp-buffer (help-buffer)
627    (let ((table (with-current-buffer buffer (syntax-table))))
628      (with-current-buffer standard-output
629	(describe-vector table 'internal-describe-syntax-value)
630	(while (setq table (char-table-parent table))
631	  (insert "\nThe parent syntax table is:")
632	  (describe-vector table 'internal-describe-syntax-value))))))
633
634(defun help-describe-category-set (value)
635  (insert (cond
636	   ((null value) "default")
637	   ((char-table-p value) "deeper char-table ...")
638	   (t (condition-case err
639		  (category-set-mnemonics value)
640		(error "invalid"))))))
641
642;;;###autoload
643(defun describe-categories (&optional buffer)
644  "Describe the category specifications in the current category table.
645The descriptions are inserted in a buffer, which is then displayed.
646If BUFFER is non-nil, then describe BUFFER's category table instead.
647BUFFER should be a buffer or a buffer name."
648  (interactive)
649  (setq buffer (or buffer (current-buffer)))
650  (help-setup-xref (list #'describe-categories buffer) (interactive-p))
651  (with-output-to-temp-buffer (help-buffer)
652    (let ((table (with-current-buffer buffer (category-table))))
653      (with-current-buffer standard-output
654	(describe-vector table 'help-describe-category-set)
655	(let ((docs (char-table-extra-slot table 0)))
656	  (if (or (not (vectorp docs)) (/= (length docs) 95))
657	      (insert "Invalid first extra slot in this char table\n")
658	    (insert "Meanings of mnemonic characters are:\n")
659	    (dotimes (i 95)
660	      (let ((elt (aref docs i)))
661		(when elt
662		  (insert (+ i ?\s) ": " elt "\n"))))
663	    (while (setq table (char-table-parent table))
664	      (insert "\nThe parent category table is:")
665	      (describe-vector table 'help-describe-category-set))))))))
666
667(provide 'help-fns)
668
669;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3
670;;; help-fns.el ends here
671