1\ documentation source to texi format converter 2 3\ Copyright (C) 1995,1996,1997,1998,1999,2003,2005,2007,2008 Free Software Foundation, Inc. 4 5\ This file is part of Gforth. 6 7\ Gforth is free software; you can redistribute it and/or 8\ modify it under the terms of the GNU General Public License 9\ as published by the Free Software Foundation, either version 3 10\ of the License, or (at your option) any later version. 11 12\ This program is distributed in the hope that it will be useful, 13\ but WITHOUT ANY WARRANTY; without even the implied warranty of 14\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15\ GNU General Public License for more details. 16 17\ You should have received a copy of the GNU General Public License 18\ along with this program. If not, see http://www.gnu.org/licenses/. 19 20\ documentation source can contain lines in the form `doc-word' and 21\ `short-word'. These are converted to appropriate full or short 22\ (without the description) glossary entries for word. 23 24\ The glossary entries are generated from data present in the wordlist 25\ `documentation'. Each word resides there under its own name. 26 27script? [IF] 28 warnings off 29[THEN] 30 31wordlist constant documentation 32 33struct 34 cell% 2* field doc-name 35 cell% 2* field doc-stack-effect 36 cell% 2* field doc-wordset 37 cell% 2* field doc-pronounciation 38 cell% 2* field doc-description 39end-struct doc-entry 40 41create description-buffer 4096 chars allot 42 43: get-description ( -- addr u ) 44 description-buffer 45 begin 46 refill 47 while 48 source nip 49 while 50 source swap >r 2dup r> -rot cmove 51 chars + 52 #lf over c! char+ 53 repeat then 54 description-buffer tuck - ; 55 56: skip-prefix ( c-addr1 u1 -- c-addr2 u2 ) 57 2dup s" --" string-prefix? 58 IF 59 [char] - skip [char] - scan 1 /string 60 THEN ; 61 62: replace-_ ( c-addr u -- ) 63 \ replaces _ with - 64 chars bounds 65 +DO 66 i c@ [char] _ = 67 if 68 [char] - i c! 69 endif 70 1 chars 71 +loop ; 72 73: condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 ) 74 save-mem 2dup replace-_ ; 75 76: condition-wordset ( c-addr1 u1 -- c-addr2 u2 ) 77 dup 0= 78 if 79 2drop s" unknown" 80 else 81 save-mem 82 endif ; 83 84: condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 ) 85 save-mem 2dup replace-_ ; 86 87: make-doc ( -- ) 88 get-current documentation set-current 89 create 90 latest name>string skip-prefix 2, \ name 91 [char] ) parse save-mem 2, \ stack-effect 92 bl sword condition-wordset 2, \ wordset 93 bl sword dup \ pronounciation 94 if 95 condition-pronounciation 96 else 97 2drop latest name>string skip-prefix 98 endif 99 2, 100 get-description save-mem 2, 101 set-current ; 102 103: emittexi ( c -- ) 104 >r 105 s" @{}" r@ scan 0<> 106 if 107 [char] @ emit 108 endif 109 drop r> emit ; 110 111: typetexi ( addr u -- ) 112 0 113 ?do 114 dup c@ emittexi 115 char+ 116 loop 117 drop ; 118 119: print-short ( doc-entry -- ) 120 >r 121 ." @findex " 122 r@ doc-name 2@ typetexi 123 ." @var{ " r@ doc-stack-effect 2@ type ." } " 124 r@ doc-wordset 2@ type 125 cr 126 ." @cindex " 127 ." @code{" r@ doc-name 2@ typetexi ." }" 128 cr 129 r@ doc-name 2@ drop c@ [char] : <> if 130 \ cut out words starting with :, info-lookup cannot handle them 131 \ !! deal with : by replacing it here and in info-lookup? 132 ." @kindex " 133 r@ doc-name 2@ typetexi 134 cr 135 endif 136 ." @format" cr 137 ." @code{" r@ doc-name 2@ typetexi ." } " 138 ." @i{" r@ doc-stack-effect 2@ type ." } " 139 r@ doc-wordset 2@ type ." ``" 140 r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr 141 rdrop ; 142 143: print-doc ( doc-entry -- ) 144 >r 145 r@ print-short 146 r@ doc-description 2@ dup 0<> 147 if 148 \ ." @iftex" cr ." @vskip-0ex" cr ." @end iftex" cr 149 type cr cr 150 \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr 151 else 152 2drop cr 153 endif 154 rdrop ; 155 156: do-doc ( addr1 u1 addr2 u2 xt -- f ) 157 \ xt is the word to be executed if addr1 u1 is a string starting 158 \ with the prefix addr2 u2 and continuing with a word in the 159 \ wordlist `documentation'. f is true if xt is executed. 160 >r dup >r 161 3 pick over str= 162 if \ addr2 u2 is a prefix of addr1 u1 163 r> /string -trailing documentation search-wordlist 164 if \ the rest of addr1 u1 is in documentation 165 execute r> execute true 166 else 167 rdrop false 168 endif 169 else 170 2drop 2rdrop false 171 endif ; 172 173: process-line ( addr u -- ) 174 2dup s" doc-" ['] print-doc do-doc 0= 175 if 176 2dup s" short-" ['] print-short do-doc 0= 177 if 178 type cr EXIT 179 endif 180 endif 181 2drop ; 182 1831024 constant doclinelength 184 185create docline doclinelength chars allot 186 187: ds2texi ( file-id -- ) 188 >r 189 begin 190 docline doclinelength r@ read-line throw 191 while 192 dup doclinelength = abort" docline too long" 193 docline swap process-line 194 repeat 195 drop rdrop ; 196 197: compare-ci ( addr1 u1 addr2 u2 -- n ) 198 \ case insensitive string compare 199 \ !! works correctly only for comparing for equality 200 2 pick swap - 201 ?dup-0=-if 202 capscomp 203 else 204 nip nip nip 205 0< 206 if 207 -1 208 else 209 1 210 endif 211 endif ; 212 213: answord ( "name wordset pronounciation" -- ) 214 \ check the documentaion of an ans word 215 name { D: wordname } 216 name { D: wordset } 217 name { D: pronounciation } 218 wordname documentation search-wordlist 219 if 220 execute { doc } 221 wordset doc doc-wordset 2@ compare-ci 222 if 223 ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr 224 endif 225 pronounciation doc doc-pronounciation 2@ compare-ci 226 if 227 ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr 228 endif 229 else 230 ." undocumented: " wordname type cr 231 endif ; 232