File: slib_doc.cc

package info (click to toggle)
speech-tools 1:2.5.0-5
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 9,848 kB
  • sloc: cpp: 67,350; ansic: 12,175; sh: 4,047; java: 3,748; makefile: 1,109; lisp: 711; perl: 501; awk: 85; xml: 9
file content (253 lines) | stat: -rw-r--r-- 6,555 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
/*  
 *                   COPYRIGHT (c) 1988-1994 BY                             *
 *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
 *        See the source file SLIB.C for more information.                  *

 * Reorganization of files (Mar 1999) by Alan W Black <awb@cstr.ed.ac.uk>

 * Documentation support

*/
#include <cstdio>
#include "EST_cutils.h"
#include "siod.h"
#include "siodp.h"
#include "siodeditline.h"

void setdoc(LISP name,LISP doc)
{
    /* Set documentation string for name */
    LISP lpair = assq(name,siod_docstrings);
    if (lpair == NIL)
	siod_docstrings = cons(cons(name,doc),siod_docstrings);
    else
    {
	cerr << "SIOD: duplicate builtin function: " <<
	    get_c_string(name) << endl;
	cerr << "SIOD: probably an error" << endl;
	CDR(lpair) = doc;
    }
}

static LISP siod_doc(LISP args,LISP penv)
{
    /* Return documentation string for sym */
    (void)penv;
    LISP lpair,val,tmp,code;
    LISP var_docstrings;

    if (TYPE(car(args)) != tc_symbol)
	return rintern("No documentation available for non-symbol.");
    tmp = envlookup(car(args),penv);
    if NNULLP(tmp) 
	val = car(tmp);
    else
	val = VCELL(car(args));
    if EQ(val,unbound_marker)
	return rintern("Symbol is unbound.");
    else
    {
	var_docstrings = symbol_value(rintern("var-docstrings"),penv);
	lpair = assq(car(args),var_docstrings);
	if (lpair)
	    return cdr(lpair);
	else
	    rintern("No documentation available for symbol.");	    
    }
    switch (TYPE(val))
    {
      case tc_subr_0:
      case tc_subr_1:
      case tc_subr_2:
      case tc_subr_3:
      case tc_subr_4:
      case tc_lsubr:
      case tc_fsubr:
      case tc_msubr:
	lpair = assq(car(args),siod_docstrings);
	if (lpair != NIL)
	    return cdr(lpair);
	else
	    return rintern("No documentation available for builtin function.");
	break;
      case tc_closure:
	code = val->storage_as.closure.code;
	if ((TYPE(cdr(code)) == tc_cons) &&
	    (TYPE(car(cdr(cdr(code)))) == tc_string))
	    return car(cdr(cdr(code)));
	else
	    return rintern("No documentation available for user-defined function.");
      default:
	return rintern("No documentation available for symbol.");
    }
	
    return rintern("No documentation available for symbol.");
}

static LISP siod_all_function_docstrings(void)
{
    // Returns all an assoc list of ALL functions that have any form 
    // of documentation strings, internal functions or user defined.
    LISP docs = siod_docstrings;
    
    // But we need user defined function with docstrings too.
    // The docustring must start with a ( to be included
    LISP l = oblistvar;
    LISP code,val;

    // Search the oblist for functions
    for(;CONSP(l);l=CDR(l))
    {
	if (VCELL(car(l)) == NIL) continue;
	switch(TYPE(VCELL(CAR(l))))
	{
	  case tc_closure:
	    val = VCELL(CAR(l));
	    code = val->storage_as.closure.code;
	    if ((CONSP(code)) &&
		(CONSP(cdr(code))) &&
		(CONSP(cdr(cdr(code)))) &&
		(TYPE(car(cdr(cdr(code)))) == tc_string))
		docs = cons(cons(car(l),car(cdr(cdr(code)))),docs);
	  default:
	    continue;
	}
    }

    return docs;
}

static int sort_compare_docstrings(const void *x, const void *y)
{
    LISP a=*(LISP *)x;
    LISP b=*(LISP *)y;

    return EST_strcasecmp(get_c_string(car(a)),get_c_string(car(b)));
}

static void siod_print_docstring(const char *symname, 
				 const char *docstring, FILE *fp)
{
    // Print to fp a texinfo list item for this description
    // Take the first line of the docstring as the label, and also remove
    // any indentation in the remainder of the lines
    int i,state;
    (void)symname;
    EST_String ds = docstring;
    const char *dsc;

    if (ds.contains(make_regex("\\[see .*\\]$")))
    {   // Contains a cross reference so replace it with texi xref command
	EST_String rest, ref;
	rest = ds.before(make_regex("\\[see [^\n]*\\]$"));
	ref = ds.after(rest);
	ref = ref.after("[see ");
	ref = ref.before("]");
	ds = rest + EST_String("[\\@pxref\\{") + ref + EST_String("\\}]");
    }

    dsc = ds;

    fprintf(fp,"@item ");
    for (state=0,i=0; dsc[i] != '\0'; i++)
    {
	if (((dsc[i] == '@') ||
	     (dsc[i] == '{') ||
	     (dsc[i] == '}')) &&
	    ((i == 0) ||
	     (dsc[i-1] != '\\')))
	    putc('@',fp);
	if ((dsc[i] == '\\') &&
	    ((dsc[i+1] == '@') ||
	     (dsc[i+1] == '{') ||
	     (dsc[i+1] == '}')))
	    continue;
	else if (state == 0)
	{
	    putc(dsc[i],fp);
	    if (dsc[i] == '\n')
		state = 1;
	}
	else if (state == 1)
	    if (dsc[i] != ' ')
	    {
		putc(dsc[i],fp);
		state = 0;
	    }
    }
    fprintf(fp,"\n");
}

static LISP siod_sort_and_dump_docstrings(LISP type,LISP filefp)
{
    // sort docstrings then dump them to filefp as a texinfo list
    LISP *array,l,docstrings;
    int num_strings;
    int i;

    if (streq(get_c_string(type),"function"))
	docstrings = siod_all_function_docstrings();
    else if (streq(get_c_string(type),"features"))
	docstrings = symbol_value(rintern("ff_docstrings"),NIL);
    else
	docstrings = symbol_value(rintern("var-docstrings"),NIL);
	
    num_strings = siod_llength(docstrings);
    array = walloc(LISP,num_strings);
    for (l=docstrings,i=0; i < num_strings; i++,l=cdr(l))
	array[i] = car(l);
    qsort(array,num_strings,sizeof(LISP),sort_compare_docstrings);

    for (i=0; i < num_strings; i++)
	siod_print_docstring(get_c_string(car(array[i])),
			     get_c_string(cdr(array[i])),
			     get_c_file(filefp,stdout));

    wfree(array);

    return NIL;

}

const char *siod_docstring(const char *symbol)
{
    LISP doc;

    doc = siod_doc(cons(rintern(symbol),NIL),NIL);

    return get_c_string(doc);
}

const char *siod_manual_sym(const char *symbol)
{
    // For siodline 
    LISP info;

    info = leval(cons(rintern("manual-sym"),
		      cons(quote(rintern(symbol)),NIL)),NIL);

    return get_c_string(info);
}

void siod_saydocstring(const char *symbol)
{
    // This isn't guaranteed to work but might be ok sometimes

    leval(cons(rintern("tts_text"),
	       cons(cons(rintern("doc"),cons(rintern(symbol),NIL)),
		    cons(NIL,NIL))),NIL);

}

void init_subrs_doc(void)
{
 init_fsubr("doc",siod_doc,
 "(doc SYMBOL)\n\
  Return documentation for SYMBOL.");
 init_subr_2("sort-and-dump-docstrings",siod_sort_and_dump_docstrings,
 "(sort-and-dump-docstrings DOCSTRINGS FILEFP)\n\
  DOCSTRINGS is an assoc list of name and document string var-docstrings\n\
  or func-docstrings.  This very individual function sorts the list and \n\
  prints out the documentation strings as texinfo list members to FILEFP.");

}