File:  [gforth] / gforth / ds2texi.fs
Revision 1.8: download - view: text, annotated - select for diffs
Mon Oct 16 18:33:06 1995 UTC (24 years ago) by anton
Branches: MAIN
CVS tags: HEAD
added answords.fs and strsignal.c
added checking of documenetation of ANS Forth words
Fixed many documentation errors and added some documentation
signal handling now uses strsignal and can handle signals not present on all machines

    1: \ documentation source to texi format converter
    2: 
    3: \ documentation source can contain lines in the form `doc-word' and
    4: \ `short-word'. These are converted to appropriate full or short
    5: \ (without the description) glossary entries for word.
    6: 
    7: \ The glossary entries are generated from data present in the wordlist
    8: \ `documentation'. Each word resides there under its own name.
    9: 
   10: script? [IF]
   11: warnings off
   12: require search-order.fs
   13: require glocals.fs
   14: require float.fs
   15: require struct.fs
   16: require debugging.fs
   17: [THEN]
   18: 
   19: wordlist constant documentation
   20: 
   21: struct
   22:     2 cells: field doc-name
   23:     2 cells: field doc-stack-effect
   24:     2 cells: field doc-wordset
   25:     2 cells: field doc-pronounciation
   26:     2 cells: field doc-description
   27: end-struct doc-entry
   28: 
   29: create description-buffer 4096 chars allot
   30: 
   31: : get-description ( -- addr u )
   32:     description-buffer
   33:     begin
   34: 	refill
   35:     while
   36: 	source nip
   37:     while
   38: 	source swap >r 2dup r> -rot cmove
   39: 	chars +
   40: 	#lf over c! char+
   41:     repeat then
   42:     description-buffer tuck - ;
   43: 
   44: : replace-_ ( c-addr u -- )
   45:     \ replaces _ with -
   46:     chars bounds
   47:     +DO
   48: 	i c@ [char] _ =
   49: 	if
   50: 	    [char] - i c!
   51: 	endif
   52: 	1 chars
   53:     +loop ;
   54:     
   55: : condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
   56:     save-string 2dup replace-_ ;
   57:     
   58: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
   59:     dup 0=
   60:     if
   61: 	2drop s" unknown"
   62:     else
   63: 	save-string
   64:     endif ;
   65: 
   66: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
   67:     save-string 2dup replace-_ ;
   68: 
   69: : make-doc ( -- )
   70:     get-current documentation set-current
   71:     create
   72: 	last @ name>string 2,		\ name
   73: 	[char] ) parse save-string 2,	\ stack-effect
   74: 	bl parse-word condition-wordset 2,	\ wordset
   75: 	bl parse-word dup		\ pronounciation
   76: 	if
   77: 	    condition-pronounciation
   78: 	else
   79: 	    2drop last @ name>string
   80: 	endif
   81: 	2,
   82: 	get-description save-string 2,
   83:     set-current ;
   84: 
   85: : emittexi ( c -- )
   86:     >r
   87:     s" @{}" r@ scan 0<>
   88:     if
   89: 	[char] @ emit
   90:     endif
   91:     drop r> emit ;
   92: 
   93: : typetexi ( addr u -- )
   94:     0
   95:     ?do
   96: 	dup c@ emittexi
   97: 	char+
   98:     loop
   99:     drop ;
  100: 
  101: : print-short ( doc-entry -- )
  102:     >r
  103:     ." @findex "
  104:     r@ doc-name 2@ typetexi
  105:     ."  @var{ " r@ doc-stack-effect 2@ type ."  }  "
  106:     r@ doc-wordset 2@ type
  107:     cr
  108:     ." @format" cr
  109:     ." @code{" r@ doc-name 2@ typetexi ." }       "
  110:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
  111:     r@ doc-wordset 2@ type ."        ``"
  112:     r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
  113:     rdrop ;
  114: 
  115: : print-doc ( doc-entry -- )
  116:     >r
  117:     r@ print-short
  118:     r@ doc-description 2@ dup 0<>
  119:     if
  120: 	." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
  121: 	type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
  122:     else
  123: 	2drop cr
  124:     endif
  125:     rdrop ;
  126: 
  127: : do-doc ( addr1 u1 addr2 u2 xt -- f )
  128:     \ xt is the word to be executed if addr1 u1 is a string starting
  129:     \ with the prefix addr2 u2 and continuing with a word in the
  130:     \ wordlist `documentation'. f is true if xt is executed.
  131:     >r dup >r
  132:     3 pick over compare 0=
  133:     if \ addr2 u2 is a prefix of addr1 u1
  134: 	r> /string documentation search-wordlist
  135: 	if \ the rest of addr1 u1 is in documentation
  136: 	    execute r> execute true
  137: 	else
  138: 	    rdrop false
  139: 	endif
  140:     else
  141: 	2drop 2rdrop false
  142:     endif ;
  143: 
  144: : process-line ( addr u -- )
  145:     2dup s" doc-" ['] print-doc do-doc 0=
  146:     if
  147: 	2dup s" short-" ['] print-short do-doc 0=
  148: 	if
  149: 	    type cr EXIT
  150: 	endif
  151:     endif
  152:     2drop ;
  153: 
  154: 1024 constant doclinelength
  155: 
  156: create docline doclinelength chars allot
  157: 
  158: : ds2texi ( file-id -- )
  159:     >r
  160:     begin
  161: 	docline doclinelength r@ read-line throw
  162:     while
  163: 	dup doclinelength = abort" docline too long"
  164: 	docline swap process-line
  165:     repeat
  166:     drop rdrop ;
  167: 
  168: : compare-ci ( addr1 u1 addr2 u2 -- n )
  169:     \ case insensitive string compare
  170:     2 pick swap -
  171:     ?dup-0=-if
  172:         capscomp
  173:     else
  174: 	nip nip nip
  175: 	0<
  176: 	if
  177: 	    -1
  178: 	else
  179: 	    1
  180: 	endif
  181:     endif  ;
  182: 
  183: : answord ( "name wordset pronounciation" -- )
  184:     \ check the documentaion of an ans word
  185:     name { D: wordname }
  186:     name { D: wordset }
  187:     name { D: pronounciation }
  188:     wordname documentation search-wordlist
  189:     if
  190: 	execute { doc }
  191: 	wordset doc doc-wordset 2@ compare-ci
  192: 	if 
  193: 	    ." wordset: " wordname type ." : '"  doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
  194: 	endif
  195: 	pronounciation doc doc-pronounciation 2@ compare-ci
  196: 	if
  197: 	    ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
  198: 	endif
  199:     else
  200: 	." undocumented: " wordname type cr
  201:     endif ;
  202: 
  203: script? [IF]
  204: require prims2x.fs
  205: s" primitives.b" ' register-doc process-file
  206: require crossdoc.fd
  207: require doc.fd
  208: [THEN]

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>