slib_doc.cc

/*  
 *                   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"

using std::cerr;
using std::endl;

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.");

}