Return to ds2texi.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/ds2texi.fs, revision 1.7

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