Annotation of gforth/ds2texi.fs, revision 1.4

1.1       anton       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: 
1.2       pazsan     10: script? [IF]
                     11: warnings off
                     12: include search-order.fs
                     13: include struct.fs
                     14: include debugging.fs
                     15: [THEN]
                     16: 
1.1       anton      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: 
1.4     ! anton      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: 
1.1       anton      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 -- )
1.3       anton      75:     >r ." @format" cr
1.1       anton      76:     ." @code{" r@ doc-name 2@ typetexi ." }       "
                     77:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
                     78:     r@ doc-wordset 2@ type ."        ``"
1.3       anton      79:     r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.1       anton      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 ;
1.2       pazsan    133: 
                    134: script? [IF]
                    135: include prims2x.fs
                    136: s" primitives.b" ' register-doc process-file
1.4     ! anton     137: require doc.fs
1.2       pazsan    138: s" gforth.ds" r/o open-file throw ds2texi bye
                    139: [THEN]

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