Return to ds2texi.fs CVS log

Up to [gforth] / gforth

Some more documentation
Added word index
Changed all appearances of GNU Forth to Gforth.

    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:     ." @findex " r@ doc-name 2@ typetexi cr
   81:     rdrop ;
   82: 
   83: : print-doc ( doc-entry -- )
   84:     >r
   85:     r@ print-short
   86:     r@ doc-description 2@ dup 0<>
   87:     if
   88: 	type ." @*" cr
   89:     else
   90: 	2drop cr
   91:     endif
   92:     rdrop ;
   93: 
   94: : do-doc ( addr1 u1 addr2 u2 xt -- f )
   95:     \ xt is the word to be executed if addr1 u1 is a string starting
   96:     \ with the prefix addr2 u2 and continuing with a word in the
   97:     \ wordlist `documentation'. f is true if xt is executed.
   98:     >r dup >r
   99:     3 pick over compare 0=
  100:     if \ addr2 u2 is a prefix of addr1 u1
  101: 	r> /string documentation search-wordlist
  102: 	if \ the rest of addr1 u1 is in documentation
  103: 	    execute r> execute true
  104: 	else
  105: 	    rdrop false
  106: 	endif
  107:     else
  108: 	2drop 2rdrop false
  109:     endif ;
  110: 
  111: : process-line ( addr u -- )
  112:     2dup s" doc-" ['] print-doc do-doc 0=
  113:     if
  114: 	2dup s" short-" ['] print-short do-doc 0=
  115: 	if
  116: 	    type cr EXIT
  117: 	endif
  118:     endif
  119:     2drop ;
  120: 
  121: 1024 constant doclinelength
  122: 
  123: create docline doclinelength chars allot
  124: 
  125: : ds2texi ( file-id -- )
  126:     >r
  127:     begin
  128: 	docline doclinelength r@ read-line throw
  129:     while
  130: 	dup doclinelength = abort" docline too long"
  131: 	docline swap process-line
  132:     repeat
  133:     drop rdrop ;
  134: 
  135: script? [IF]
  136: include prims2x.fs
  137: s" primitives.b" ' register-doc process-file
  138: require doc.fd
  139: require crossdoc.fd
  140: s" gforth.ds" r/o open-file throw ds2texi bye
  141: [THEN]