Return to ds2texi.fs CVS log

Up to [gforth] / gforth

Added makedoc facility to cross compiler.
Now most doc-* reverences are resolved.

    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: include search-order.fs
   13: include struct.fs
   14: include debugging.fs
   15: [THEN]
   16: 
   17: wordlist constant documentation
   18: 
   19: struct
   20:     2 cells: field doc-name
   21:     2 cells: field doc-stack-effect
   22:     2 cells: field doc-wordset
   23:     2 cells: field doc-pronounciation
   24:     2 cells: field doc-description
   25: end-struct doc-entry
   26: 
   27: create description-buffer 4096 chars allot
   28: 
   29: : get-description ( -- addr u )
   30:     description-buffer
   31:     begin
   32: 	refill
   33:     while
   34: 	source nip
   35:     while
   36: 	source swap >r 2dup r> -rot cmove
   37: 	chars +
   38: 	#lf over c! char+
   39:     repeat then
   40:     description-buffer tuck - ;
   41: 
   42: : make-doc ( -- )
   43:     get-current documentation set-current
   44:     create
   45: 	last @ name>string 2,		\ name
   46: 	[char] ) parse save-string 2,	\ stack-effect
   47: 	bl parse-word save-string 2,	\ wordset
   48: 	bl parse-word dup		\ pronounciation
   49: 	if
   50: 	    save-string
   51: 	else
   52: 	    2drop last @ name>string
   53: 	endif
   54: 	2,
   55: 	get-description save-string 2,
   56:     set-current ;
   57: 
   58: : emittexi ( c -- )
   59:     >r
   60:     s" @{}" r@ scan 0<>
   61:     if
   62: 	[char] @ emit
   63:     endif
   64:     drop r> emit ;
   65: 
   66: : typetexi ( addr u -- )
   67:     0
   68:     ?do
   69: 	dup c@ emittexi
   70: 	char+
   71:     loop
   72:     drop ;
   73: 
   74: : print-short ( doc-entry -- )
   75:     >r ." @format" cr
   76:     ." @code{" r@ doc-name 2@ typetexi ." }       "
   77:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
   78:     r@ doc-wordset 2@ type ."        ``"
   79:     r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
   80:     rdrop ;
   81: 
   82: : print-doc ( doc-entry -- )
   83:     >r
   84:     r@ print-short
   85:     r@ doc-description 2@ dup 0<>
   86:     if
   87: 	type ." @*" cr
   88:     else
   89: 	2drop cr
   90:     endif
   91:     rdrop ;
   92: 
   93: : do-doc ( addr1 u1 addr2 u2 xt -- f )
   94:     \ xt is the word to be executed if addr1 u1 is a string starting
   95:     \ with the prefix addr2 u2 and continuing with a word in the
   96:     \ wordlist `documentation'. f is true if xt is executed.
   97:     >r dup >r
   98:     3 pick over compare 0=
   99:     if \ addr2 u2 is a prefix of addr1 u1
  100: 	r> /string documentation search-wordlist
  101: 	if \ the rest of addr1 u1 is in documentation
  102: 	    execute r> execute true
  103: 	else
  104: 	    rdrop false
  105: 	endif
  106:     else
  107: 	2drop 2rdrop false
  108:     endif ;
  109: 
  110: : process-line ( addr u -- )
  111:     2dup s" doc-" ['] print-doc do-doc 0=
  112:     if
  113: 	2dup s" short-" ['] print-short do-doc 0=
  114: 	if
  115: 	    type cr EXIT
  116: 	endif
  117:     endif
  118:     2drop ;
  119: 
  120: 1024 constant doclinelength
  121: 
  122: create docline doclinelength chars allot
  123: 
  124: : ds2texi ( file-id -- )
  125:     >r
  126:     begin
  127: 	docline doclinelength r@ read-line throw
  128:     while
  129: 	dup doclinelength = abort" docline too long"
  130: 	docline swap process-line
  131:     repeat
  132:     drop rdrop ;
  133: 
  134: script? [IF]
  135: include prims2x.fs
  136: s" primitives.b" ' register-doc process-file
  137: require doc.fd
  138: require crossdoc.fd
  139: s" gforth.ds" r/o open-file throw ds2texi bye
  140: [THEN]