Edinburgh Speech Tools 2.4-release
 
Loading...
Searching...
No Matches
slib_doc.cc
1/*
2 * COPYRIGHT (c) 1988-1994 BY *
3 * PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
4 * See the source file SLIB.C for more information. *
5
6 * Reorganization of files (Mar 1999) by Alan W Black <awb@cstr.ed.ac.uk>
7
8 * Documentation support
9
10*/
11#include <cstdio>
12#include "EST_cutils.h"
13#include "siod.h"
14#include "siodp.h"
15#include "siodeditline.h"
16
17void setdoc(LISP name,LISP doc)
18{
19 /* Set documentation string for name */
20 LISP lpair = assq(name,siod_docstrings);
21 if (lpair == NIL)
22 siod_docstrings = cons(cons(name,doc),siod_docstrings);
23 else
24 {
25 cerr << "SIOD: duplicate builtin function: " <<
26 get_c_string(name) << endl;
27 cerr << "SIOD: probably an error" << endl;
28 CDR(lpair) = doc;
29 }
30}
31
32static LISP siod_doc(LISP args,LISP penv)
33{
34 /* Return documentation string for sym */
35 (void)penv;
36 LISP lpair,val,tmp,code;
38
39 if (TYPE(car(args)) != tc_symbol)
40 return rintern("No documentation available for non-symbol.");
41 tmp = envlookup(car(args),penv);
42 if NNULLP(tmp)
43 val = car(tmp);
44 else
45 val = VCELL(car(args));
46 if EQ(val,unbound_marker)
47 return rintern("Symbol is unbound.");
48 else
49 {
50 var_docstrings = symbol_value(rintern("var-docstrings"),penv);
51 lpair = assq(car(args),var_docstrings);
52 if (lpair)
53 return cdr(lpair);
54 else
55 rintern("No documentation available for symbol.");
56 }
57 switch (TYPE(val))
58 {
59 case tc_subr_0:
60 case tc_subr_1:
61 case tc_subr_2:
62 case tc_subr_3:
63 case tc_subr_4:
64 case tc_lsubr:
65 case tc_fsubr:
66 case tc_msubr:
67 lpair = assq(car(args),siod_docstrings);
68 if (lpair != NIL)
69 return cdr(lpair);
70 else
71 return rintern("No documentation available for builtin function.");
72 break;
73 case tc_closure:
74 code = val->storage_as.closure.code;
75 if ((TYPE(cdr(code)) == tc_cons) &&
76 (TYPE(car(cdr(cdr(code)))) == tc_string))
77 return car(cdr(cdr(code)));
78 else
79 return rintern("No documentation available for user-defined function.");
80 default:
81 return rintern("No documentation available for symbol.");
82 }
83
84 return rintern("No documentation available for symbol.");
85}
86
87static LISP siod_all_function_docstrings(void)
88{
89 // Returns all an assoc list of ALL functions that have any form
90 // of documentation strings, internal functions or user defined.
91 LISP docs = siod_docstrings;
92
93 // But we need user defined function with docstrings too.
94 // The docustring must start with a ( to be included
95 LISP l = oblistvar;
96 LISP code,val;
97
98 // Search the oblist for functions
99 for(;CONSP(l);l=CDR(l))
100 {
101 if (VCELL(car(l)) == NIL) continue;
102 switch(TYPE(VCELL(CAR(l))))
103 {
104 case tc_closure:
105 val = VCELL(CAR(l));
106 code = val->storage_as.closure.code;
107 if ((CONSP(code)) &&
108 (CONSP(cdr(code))) &&
109 (CONSP(cdr(cdr(code)))) &&
110 (TYPE(car(cdr(cdr(code)))) == tc_string))
111 docs = cons(cons(car(l),car(cdr(cdr(code)))),docs);
112 default:
113 continue;
114 }
115 }
116
117 return docs;
118}
119
120static int sort_compare_docstrings(const void *x, const void *y)
121{
122 LISP a=*(LISP *)x;
123 LISP b=*(LISP *)y;
124
125 return EST_strcasecmp(get_c_string(car(a)),get_c_string(car(b)));
126}
127
128static void siod_print_docstring(const char *symname,
129 const char *docstring, FILE *fp)
130{
131 // Print to fp a texinfo list item for this description
132 // Take the first line of the docstring as the label, and also remove
133 // any indentation in the remainder of the lines
134 int i,state;
135 (void)symname;
137 const char *dsc;
138
139 if (ds.contains(make_regex("\\[see .*\\]$")))
140 { // Contains a cross reference so replace it with texi xref command
141 EST_String rest, ref;
142 rest = ds.before(make_regex("\\[see [^\n]*\\]$"));
143 ref = ds.after(rest);
144 ref = ref.after("[see ");
145 ref = ref.before("]");
146 ds = rest + EST_String("[\\@pxref\\{") + ref + EST_String("\\}]");
147 }
148
149 dsc = ds;
150
151 fprintf(fp,"@item ");
152 for (state=0,i=0; dsc[i] != '\0'; i++)
153 {
154 if (((dsc[i] == '@') ||
155 (dsc[i] == '{') ||
156 (dsc[i] == '}')) &&
157 ((i == 0) ||
158 (dsc[i-1] != '\\')))
159 putc('@',fp);
160 if ((dsc[i] == '\\') &&
161 ((dsc[i+1] == '@') ||
162 (dsc[i+1] == '{') ||
163 (dsc[i+1] == '}')))
164 continue;
165 else if (state == 0)
166 {
167 putc(dsc[i],fp);
168 if (dsc[i] == '\n')
169 state = 1;
170 }
171 else if (state == 1)
172 if (dsc[i] != ' ')
173 {
174 putc(dsc[i],fp);
175 state = 0;
176 }
177 }
178 fprintf(fp,"\n");
179}
180
181static LISP siod_sort_and_dump_docstrings(LISP type,LISP filefp)
182{
183 // sort docstrings then dump them to filefp as a texinfo list
185 int num_strings;
186 int i;
187
188 if (streq(get_c_string(type),"function"))
189 docstrings = siod_all_function_docstrings();
190 else if (streq(get_c_string(type),"features"))
191 docstrings = symbol_value(rintern("ff_docstrings"),NIL);
192 else
193 docstrings = symbol_value(rintern("var-docstrings"),NIL);
194
195 num_strings = siod_llength(docstrings);
196 array = walloc(LISP,num_strings);
197 for (l=docstrings,i=0; i < num_strings; i++,l=cdr(l))
198 array[i] = car(l);
199 qsort(array,num_strings,sizeof(LISP),sort_compare_docstrings);
200
201 for (i=0; i < num_strings; i++)
202 siod_print_docstring(get_c_string(car(array[i])),
203 get_c_string(cdr(array[i])),
204 get_c_file(filefp,stdout));
205
206 wfree(array);
207
208 return NIL;
209
210}
211
212const char *siod_docstring(const char *symbol)
213{
214 LISP doc;
215
216 doc = siod_doc(cons(rintern(symbol),NIL),NIL);
217
218 return get_c_string(doc);
219}
220
221const char *siod_manual_sym(const char *symbol)
222{
223 // For siodline
224 LISP info;
225
226 info = leval(cons(rintern("manual-sym"),
227 cons(quote(rintern(symbol)),NIL)),NIL);
228
229 return get_c_string(info);
230}
231
232void siod_saydocstring(const char *symbol)
233{
234 // This isn't guaranteed to work but might be ok sometimes
235
236 leval(cons(rintern("tts_text"),
237 cons(cons(rintern("doc"),cons(rintern(symbol),NIL)),
238 cons(NIL,NIL))),NIL);
239
240}
241
242void init_subrs_doc(void)
243{
244 init_fsubr("doc",siod_doc,
245 "(doc SYMBOL)\n\
246 Return documentation for SYMBOL.");
247 init_subr_2("sort-and-dump-docstrings",siod_sort_and_dump_docstrings,
248 "(sort-and-dump-docstrings DOCSTRINGS FILEFP)\n\
249 DOCSTRINGS is an assoc list of name and document string var-docstrings\n\
250 or func-docstrings. This very individual function sorts the list and \n\
251 prints out the documentation strings as texinfo list members to FILEFP.");
252
253}
EST_String before(int pos, int len=0) const
Part before position.
Definition EST_String.h:286
EST_String after(int pos, int len=1) const
Part after pos+len.
Definition EST_String.h:318