1;; texi-docstring-magic.el -- munge internal docstrings into texi
2;;
3;; Keywords: lisp, docs, tex
4;; Author: David Aspinall <da@dcs.ed.ac.uk>
5;; Copyright (C) 1998 David Aspinall
6;; Maintainer:  David Aspinall <da@dcs.ed.ac.uk>
7;;
8;; $Id: texi-docstring-magic.el,v 1.1.1.2 2006/07/17 16:03:50 espie Exp $
9;;
10;; This package is distributed under the terms of the
11;; GNU General Public License, Version 2.
12;; You should have a copy of the GPL with your version of
13;; GNU Emacs or the Texinfo distribution.
14;;
15;;
16;; This package generates Texinfo source fragments from Emacs
17;; docstrings.   This avoids documenting functions and variables
18;; in more than one place, and automatically adds Texinfo markup
19;; to docstrings.
20;;
21;; It relies heavily on you following the Elisp documentation
22;; conventions to produce sensible output, check the Elisp manual
23;; for details.  In brief:
24;;
25;;  * The first line of a docstring should be a complete sentence.
26;;  * Arguments to functions should be written in upper case: ARG1..ARGN
27;;  * User options (variables users may want to set) should have docstrings
28;;    beginning with an asterisk.
29;;
30;; Usage:
31;;
32;;  Write comments of the form:
33;;
34;;    @c TEXI DOCSTRING MAGIC: my-package-function-or-variable-name
35;;
36;;  In your texi source, mypackage.texi.  From within an Emacs session
37;;  where my-package is loaded, visit mypackage.texi and run
38;;  M-x texi-docstring-magic to update all of the documentation strings.
39;;
40;;  This will insert @defopt, @deffn and the like underneath the
41;;  magic comment strings.
42;;
43;;  The default value for user options will be printed.
44;;
45;;  Symbols are recognized if they are defined for faces, functions,
46;;  or variables (in that order).
47;;
48;; Automatic markup rules:
49;;
50;; 1. Indented lines are gathered into @lisp environment.
51;; 2. Pieces of text `stuff' or surrounded in quotes marked up with @samp.
52;; 3. Words *emphasized* are made @strong{emphasized}
53;; 4. Words sym-bol which are symbols become @code{sym-bol}.
54;; 5. Upper cased words ARG corresponding to arguments become @var{arg}.
55;;    In fact, you can any word longer than three letters, so that
56;;    metavariables can be used easily.
57;;    FIXME: to escape this, use `ARG'
58;; 6. Words 'sym which are lisp-quoted are marked with @code{'sym}.
59;;
60;; -----
61;;
62;; Useful key binding when writing Texinfo:
63;;
64;;  (define-key TeXinfo-mode-map "C-cC-d" 'texi-docstring-magic-insert-magic)
65;;
66;; -----
67;;
68;; Useful enhancements to do:
69;;
70;;  * Use customize properties (e.g. group, simple types)
71;;  * Look for a "texi-docstring" property for symbols
72;;    so TeXInfo can be defined directly in case automatic markup
73;;    goes badly wrong.
74;;  * Add tags to special comments so that user can specify face,
75;;    function, or variable binding for a symbol in case more than
76;;    one binding exists.
77;;
78;; ------
79
80(defun texi-docstring-magic-splice-sep (strings sep)
81  "Return concatenation of STRINGS spliced together with separator SEP."
82  (let (str)
83    (while strings
84      (setq str (concat str (car strings)))
85      (if (cdr strings)
86	  (setq str (concat str sep)))
87      (setq strings (cdr strings)))
88    str))
89
90(defconst texi-docstring-magic-munge-table
91  '(;; 1. Indented lines are gathered into @lisp environment.
92    ("\\(^.*\\S-.*$\\)"
93     t
94     (let
95	 ((line (match-string 0 docstring)))
96       (if (eq (char-syntax (string-to-char line)) ?\ )
97	   ;; whitespace
98	   (if in-quoted-region
99	       line
100	     (setq in-quoted-region t)
101	     (concat "@lisp\n" line))
102	 ;; non-white space
103	 (if in-quoted-region
104	     (progn
105	       (setq in-quoted-region nil)
106	       (concat "@end lisp\n" line))
107	   line))))
108    ;; 2. Pieces of text `stuff' or surrounded in quotes
109    ;; are marked up with @samp.  NB: Must be backquote
110    ;; followed by forward quote for this to work.
111    ;; Can't use two forward quotes else problems with
112    ;; symbols.
113    ;; Odd hack: because ' is a word constituent in text/texinfo
114    ;; mode, putting this first enables the recognition of args
115    ;; and symbols put inside quotes.
116    ("\\(`\\([^']+\\)'\\)"
117     t
118     (concat "@samp{" (match-string 2 docstring) "}"))
119    ;; 3. Words *emphasized* are made @strong{emphasized}
120    ("\\(\\*\\(\\w+\\)\\*\\)"
121     t
122     (concat "@strong{" (match-string 2 docstring) "}"))
123    ;; 4. Words sym-bol which are symbols become @code{sym-bol}.
124    ;; Must have at least one hyphen to be recognized,
125    ;; terminated in whitespace, end of line, or punctuation.
126    ;; (Only consider symbols made from word constituents
127    ;; and hyphen.
128    ("\\(\\(\\w+\\-\\(\\w\\|\\-\\)+\\)\\)\\(\\s\)\\|\\s-\\|\\s.\\|$\\)"
129     (or (boundp (intern (match-string 2 docstring)))
130	 (fboundp (intern (match-string 2 docstring))))
131     (concat "@code{" (match-string 2 docstring) "}"
132	     (match-string 4 docstring)))
133    ;; 5. Upper cased words ARG corresponding to arguments become
134    ;; @var{arg}
135    ;; In fact, include any word so long as it is more than 3 characters
136    ;; long.  (Comes after symbols to avoid recognizing the
137    ;; lowercased form of an argument as a symbol)
138    ;; FIXME: maybe we don't want to downcase stuff already
139    ;; inside @samp
140    ;; FIXME: should - terminate?  should _ be included?
141    ("\\([A-Z0-9\\-]+\\)\\(/\\|\)\\|}\\|\\s-\\|\\s.\\|$\\)"
142     (or (> (length (match-string 1 docstring)) 3)
143	 (member (downcase (match-string 1 docstring)) args))
144     (concat "@var{" (downcase (match-string 1 docstring)) "}"
145	     (match-string 2 docstring)))
146
147    ;; 6. Words 'sym which are lisp quoted are
148    ;; marked with @code.
149    ("\\(\\(\\s-\\|^\\)'\\(\\(\\w\\|\\-\\)+\\)\\)\\(\\s\)\\|\\s-\\|\\s.\\|$\\)"
150     t
151     (concat (match-string 2 docstring)
152	     "@code{'" (match-string 3 docstring) "}"
153	     (match-string 5 docstring)))
154    ;; 7,8. Clean up for @lisp environments left with spurious newlines
155    ;; after 1.
156    ("\\(\\(^\\s-*$\\)\n@lisp\\)" t "@lisp")
157    ("\\(\\(^\\s-*$\\)\n@end lisp\\)" t "@end lisp"))
158    "Table of regexp matches and replacements used to markup docstrings.
159Format of table is a list of elements of the form
160   (regexp predicate replacement-form)
161If regexp matches and predicate holds, then replacement-form is
162evaluated to get the replacement for the match.
163predicate and replacement-form can use variables arg,
164and forms such as (match-string 1 docstring)
165Match string 1 is assumed to determine the
166length of the matched item, hence where parsing restarts from.
167The replacement must cover the whole match (match string 0),
168including any whitespace included to delimit matches.")
169
170
171(defun texi-docstring-magic-munge-docstring (docstring args)
172  "Markup DOCSTRING for texi according to regexp matches."
173  (let ((case-fold-search nil))
174    (dolist (test texi-docstring-magic-munge-table docstring)
175      (let ((regexp	(nth 0 test))
176	    (predicate  (nth 1 test))
177	    (replace    (nth 2 test))
178	    (i		0)
179	    in-quoted-region)
180
181	(while (and
182		(< i (length docstring))
183		(string-match regexp docstring i))
184	  (setq i (match-end 1))
185	  (if (eval predicate)
186	      (let* ((origlength  (- (match-end 0) (match-beginning 0)))
187		     (replacement (eval replace))
188		     (newlength   (length replacement)))
189		(setq docstring
190		      (replace-match replacement t t docstring))
191		(setq i (+ i (- newlength origlength))))))
192	(if in-quoted-region
193	    (setq docstring (concat docstring "\n@end lisp"))))))
194  ;; Force a new line after (what should be) the first sentence,
195  ;; if not already a new paragraph.
196  (let*
197      ((pos      (string-match "\n" docstring))
198       (needscr  (and pos
199		      (not (string= "\n"
200				    (substring docstring
201					       (1+ pos)
202					       (+ pos 2)))))))
203    (if (and pos needscr)
204	(concat (substring docstring 0 pos)
205		"@*\n"
206		(substring docstring (1+ pos)))
207      docstring)))
208
209(defun texi-docstring-magic-texi (env grp name docstring args &optional endtext)
210  "Make a texi def environment ENV for entity NAME with DOCSTRING."
211  (concat "@def" env (if grp (concat " " grp) "") " " name
212	  " "
213	  (texi-docstring-magic-splice-sep args " ")
214	  ;; " "
215	  ;; (texi-docstring-magic-splice-sep extras " ")
216	  "\n"
217	  (texi-docstring-magic-munge-docstring docstring args)
218	  "\n"
219	  (or endtext "")
220	  "@end def" env "\n"))
221
222(defun texi-docstring-magic-format-default (default)
223  "Make a default value string for the value DEFAULT.
224Markup as @code{stuff} or @lisp stuff @end lisp."
225  (let ((text       (format "%S" default)))
226    (concat
227     "\nThe default value is "
228     (if (string-match "\n" text)
229	 ;; Carriage return will break @code, use @lisp
230	 (if (stringp default)
231	     (concat "the string: \n@lisp\n" default "\n@end lisp\n")
232	   (concat "the value: \n@lisp\n" text "\n@end lisp\n"))
233       (concat "@code{" text "}.\n")))))
234
235
236(defun texi-docstring-magic-texi-for (symbol)
237  (cond
238   ;; Faces
239   ((find-face symbol)
240    (let*
241	((face	    symbol)
242	 (name      (symbol-name face))
243	 (docstring (or (face-doc-string face)
244			"Not documented."))
245	 (useropt   (eq ?* (string-to-char docstring))))
246      ;; Chop off user option setting
247      (if useropt
248	  (setq docstring (substring docstring 1)))
249      (texi-docstring-magic-texi "fn" "Face" name docstring nil)))
250   ((fboundp symbol)
251    ;; Functions.
252    ;; We don't handle macros,  aliases, or compiled fns properly.
253    (let*
254	((function  symbol)
255	 (name	    (symbol-name function))
256	 (docstring (or (documentation function)
257			"Not documented."))
258	 (def	    (symbol-function function))
259	 (argsyms   (cond ((eq (car-safe def) 'lambda)
260			   (nth 1 def))))
261	 (args	    (mapcar 'symbol-name argsyms)))
262      (if (commandp function)
263	  (texi-docstring-magic-texi "fn" "Command" name docstring args)
264	(texi-docstring-magic-texi "un" nil name docstring args))))
265   ((boundp symbol)
266    ;; Variables.
267    (let*
268	((variable  symbol)
269	 (name      (symbol-name variable))
270	 (docstring (or (documentation-property variable
271						'variable-documentation)
272			"Not documented."))
273	 (useropt   (eq ?* (string-to-char docstring)))
274	 (default   (if useropt
275			(texi-docstring-magic-format-default
276			 (default-value symbol)))))
277      ;; Chop off user option setting
278      (if useropt
279	  (setq docstring (substring docstring 1)))
280      (texi-docstring-magic-texi
281       (if useropt "opt" "var") nil name docstring nil default)))
282   (t
283    (error "Don't know anything about symbol %s" (symbol-name symbol)))))
284
285(defconst texi-docstring-magic-comment
286  "@c TEXI DOCSTRING MAGIC:"
287  "Magic string in a texi buffer expanded into @defopt, or @deffn.")
288
289(defun texi-docstring-magic ()
290  "Update all texi docstring magic annotations in buffer."
291  (interactive)
292  (save-excursion
293    (goto-char (point-min))
294    (let ((magic (concat "^"
295			 (regexp-quote texi-docstring-magic-comment)
296			 "\\s-*\\(\\(\\w\\|\\-\\)+\\)$"))
297	  p
298	  symbol)
299      (while (re-search-forward magic nil t)
300	(setq symbol (intern (match-string 1)))
301	(forward-line)
302	(setq p (point))
303	;; If comment already followed by an environment, delete it.
304	(if (and
305	     (looking-at "@def\\(\\w+\\)\\s-")
306	     (search-forward (concat "@end def" (match-string 1)) nil t))
307	    (progn
308	      (forward-line)
309	      (delete-region p (point))))
310	(insert
311	 (texi-docstring-magic-texi-for symbol))))))
312
313(defun texi-docstring-magic-face-at-point ()
314  (ignore-errors
315    (let ((stab (syntax-table)))
316      (unwind-protect
317	  (save-excursion
318	    (set-syntax-table emacs-lisp-mode-syntax-table)
319	    (or (not (zerop (skip-syntax-backward "_w")))
320		(eq (char-syntax (char-after (point))) ?w)
321		(eq (char-syntax (char-after (point))) ?_)
322		(forward-sexp -1))
323	    (skip-chars-forward "'")
324	    (let ((obj (read (current-buffer))))
325	      (and (symbolp obj) (find-face obj) obj)))
326	(set-syntax-table stab)))))
327
328(defun texi-docstring-magic-insert-magic (symbol)
329  (interactive
330   (let* ((v (or (variable-at-point)
331		 (function-at-point)
332		 (texi-docstring-magic-face-at-point)))
333	  (val (let ((enable-recursive-minibuffers t))
334                 (completing-read
335		  (if v
336		      (format "Magic docstring for symbol (default %s): " v)
337		     "Magic docstring for symbol: ")
338                   obarray '(lambda (sym)
339			      (or (boundp sym)
340				  (fboundp sym)
341				  (find-face sym)))
342		   t nil 'variable-history))))
343     (list (if (equal val "") v (intern val)))))
344  (insert "\n" texi-docstring-magic-comment " " (symbol-name symbol)))
345
346
347(provide 'texi-docstring-magic)
348