Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.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 : | pazsan | 1.2 | script? [IF] |
| 11 : | warnings off | ||
| 12 : | include search-order.fs | ||
| 13 : | include struct.fs | ||
| 14 : | include debugging.fs | ||
| 15 : | [THEN] | ||
| 16 : | |||
| 17 : | anton | 1.1 | 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 : | : emittexi ( c -- ) | ||
| 28 : | >r | ||
| 29 : | s" @{}" r@ scan 0<> | ||
| 30 : | if | ||
| 31 : | [char] @ emit | ||
| 32 : | endif | ||
| 33 : | drop r> emit ; | ||
| 34 : | |||
| 35 : | : typetexi ( addr u -- ) | ||
| 36 : | 0 | ||
| 37 : | ?do | ||
| 38 : | dup c@ emittexi | ||
| 39 : | char+ | ||
| 40 : | loop | ||
| 41 : | drop ; | ||
| 42 : | |||
| 43 : | : print-short ( doc-entry -- ) | ||
| 44 : | >r ." @format" | ||
| 45 : | ." @code{" r@ doc-name 2@ typetexi ." } " | ||
| 46 : | ." @i{" r@ doc-stack-effect 2@ type ." } " | ||
| 47 : | r@ doc-wordset 2@ type ." ``" | ||
| 48 : | r@ doc-pronounciation 2@ type ." ''@end format" cr | ||
| 49 : | rdrop ; | ||
| 50 : | |||
| 51 : | : print-doc ( doc-entry -- ) | ||
| 52 : | >r | ||
| 53 : | r@ print-short | ||
| 54 : | r@ doc-description 2@ dup 0<> | ||
| 55 : | if | ||
| 56 : | type ." @*" cr | ||
| 57 : | else | ||
| 58 : | 2drop cr | ||
| 59 : | endif | ||
| 60 : | rdrop ; | ||
| 61 : | |||
| 62 : | : do-doc ( addr1 u1 addr2 u2 xt -- f ) | ||
| 63 : | \ xt is the word to be executed if addr1 u1 is a string starting | ||
| 64 : | \ with the prefix addr2 u2 and continuing with a word in the | ||
| 65 : | \ wordlist `documentation'. f is true if xt is executed. | ||
| 66 : | >r dup >r | ||
| 67 : | 3 pick over compare 0= | ||
| 68 : | if \ addr2 u2 is a prefix of addr1 u1 | ||
| 69 : | r> /string documentation search-wordlist | ||
| 70 : | if \ the rest of addr1 u1 is in documentation | ||
| 71 : | execute r> execute true | ||
| 72 : | else | ||
| 73 : | rdrop false | ||
| 74 : | endif | ||
| 75 : | else | ||
| 76 : | 2drop 2rdrop false | ||
| 77 : | endif ; | ||
| 78 : | |||
| 79 : | : process-line ( addr u -- ) | ||
| 80 : | 2dup s" doc-" ['] print-doc do-doc 0= | ||
| 81 : | if | ||
| 82 : | 2dup s" short-" ['] print-short do-doc 0= | ||
| 83 : | if | ||
| 84 : | type cr EXIT | ||
| 85 : | endif | ||
| 86 : | endif | ||
| 87 : | 2drop ; | ||
| 88 : | |||
| 89 : | 1024 constant doclinelength | ||
| 90 : | |||
| 91 : | create docline doclinelength chars allot | ||
| 92 : | |||
| 93 : | : ds2texi ( file-id -- ) | ||
| 94 : | >r | ||
| 95 : | begin | ||
| 96 : | docline doclinelength r@ read-line throw | ||
| 97 : | while | ||
| 98 : | dup doclinelength = abort" docline too long" | ||
| 99 : | docline swap process-line | ||
| 100 : | repeat | ||
| 101 : | drop rdrop ; | ||
| 102 : | pazsan | 1.2 | |
| 103 : | script? [IF] | ||
| 104 : | include prims2x.fs | ||
| 105 : | s" primitives.b" ' register-doc process-file | ||
| 106 : | s" gforth.ds" r/o open-file throw ds2texi bye | ||
| 107 : | [THEN] |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |