Return to ds2texi.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/ds2texi.fs, revision 1.1

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: 
        !            10: wordlist constant documentation
        !            11: 
        !            12: struct
        !            13:     2 cells: field doc-name
        !            14:     2 cells: field doc-stack-effect
        !            15:     2 cells: field doc-wordset
        !            16:     2 cells: field doc-pronounciation
        !            17:     2 cells: field doc-description
        !            18: end-struct doc-entry
        !            19: 
        !            20: : emittexi ( c -- )
        !            21:     >r
        !            22:     s" @{}" r@ scan 0<>
        !            23:     if
        !            24:        [char] @ emit
        !            25:     endif
        !            26:     drop r> emit ;
        !            27: 
        !            28: : typetexi ( addr u -- )
        !            29:     0
        !            30:     ?do
        !            31:        dup c@ emittexi
        !            32:        char+
        !            33:     loop
        !            34:     drop ;
        !            35: 
        !            36: : print-short ( doc-entry -- )
        !            37:     >r ." @format"
        !            38:     ." @code{" r@ doc-name 2@ typetexi ." }       "
        !            39:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
        !            40:     r@ doc-wordset 2@ type ."        ``"
        !            41:     r@ doc-pronounciation 2@ type ." ''@end format" cr
        !            42:     rdrop ;
        !            43: 
        !            44: : print-doc ( doc-entry -- )
        !            45:     >r
        !            46:     r@ print-short
        !            47:     r@ doc-description 2@ dup 0<>
        !            48:     if
        !            49:        type ." @*" cr
        !            50:     else
        !            51:        2drop cr
        !            52:     endif
        !            53:     rdrop ;
        !            54: 
        !            55: : do-doc ( addr1 u1 addr2 u2 xt -- f )
        !            56:     \ xt is the word to be executed if addr1 u1 is a string starting
        !            57:     \ with the prefix addr2 u2 and continuing with a word in the
        !            58:     \ wordlist `documentation'. f is true if xt is executed.
        !            59:     >r dup >r
        !            60:     3 pick over compare 0=
        !            61:     if \ addr2 u2 is a prefix of addr1 u1
        !            62:        r> /string documentation search-wordlist
        !            63:        if \ the rest of addr1 u1 is in documentation
        !            64:            execute r> execute true
        !            65:        else
        !            66:            rdrop false
        !            67:        endif
        !            68:     else
        !            69:        2drop 2rdrop false
        !            70:     endif ;
        !            71: 
        !            72: : process-line ( addr u -- )
        !            73:     2dup s" doc-" ['] print-doc do-doc 0=
        !            74:     if
        !            75:        2dup s" short-" ['] print-short do-doc 0=
        !            76:        if
        !            77:            type cr EXIT
        !            78:        endif
        !            79:     endif
        !            80:     2drop ;
        !            81: 
        !            82: 1024 constant doclinelength
        !            83: 
        !            84: create docline doclinelength chars allot
        !            85: 
        !            86: : ds2texi ( file-id -- )
        !            87:     >r
        !            88:     begin
        !            89:        docline doclinelength r@ read-line throw
        !            90:     while
        !            91:        dup doclinelength = abort" docline too long"
        !            92:        docline swap process-line
        !            93:     repeat
        !            94:     drop rdrop ;