File:  [gforth] / gforth / ds2texi.fs
Revision 1.12: download - view: text, annotated - select for diffs
Sat Feb 1 14:59:28 1997 UTC (22 years, 10 months ago) by anton
Branches: MAIN
CVS tags: HEAD
documentation changes: added chapter on image files; added concept index
bug fixes

    1: \ documentation source to texi format converter
    2: 
    3: \ Copyright (C) 1995 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 2
   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, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: \ documentation source can contain lines in the form `doc-word' and
   22: \ `short-word'. These are converted to appropriate full or short
   23: \ (without the description) glossary entries for word.
   24: 
   25: \ The glossary entries are generated from data present in the wordlist
   26: \ `documentation'. Each word resides there under its own name.
   27: 
   28: script? [IF]
   29: warnings off
   30: require search-order.fs
   31: require glocals.fs
   32: require float.fs
   33: require struct.fs
   34: require debugging.fs
   35: [THEN]
   36: 
   37: wordlist constant documentation
   38: 
   39: struct
   40:     2 cells: field doc-name
   41:     2 cells: field doc-stack-effect
   42:     2 cells: field doc-wordset
   43:     2 cells: field doc-pronounciation
   44:     2 cells: field doc-description
   45: end-struct doc-entry
   46: 
   47: create description-buffer 4096 chars allot
   48: 
   49: : get-description ( -- addr u )
   50:     description-buffer
   51:     begin
   52: 	refill
   53:     while
   54: 	source nip
   55:     while
   56: 	source swap >r 2dup r> -rot cmove
   57: 	chars +
   58: 	#lf over c! char+
   59:     repeat then
   60:     description-buffer tuck - ;
   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: 	last @ name>string 2,		\ name
   91: 	[char] ) parse save-mem 2,	\ stack-effect
   92: 	bl parse-word condition-wordset 2,	\ wordset
   93: 	bl parse-word dup		\ pronounciation
   94: 	if
   95: 	    condition-pronounciation
   96: 	else
   97: 	    2drop last @ name>string
   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:     ." @format" cr
  130:     ." @code{" r@ doc-name 2@ typetexi ." }       "
  131:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
  132:     r@ doc-wordset 2@ type ."        ``"
  133:     r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
  134:     rdrop ;
  135: 
  136: : print-doc ( doc-entry -- )
  137:     >r
  138:     r@ print-short
  139:     r@ doc-description 2@ dup 0<>
  140:     if
  141: 	." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
  142: 	type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
  143:     else
  144: 	2drop cr
  145:     endif
  146:     rdrop ;
  147: 
  148: : do-doc ( addr1 u1 addr2 u2 xt -- f )
  149:     \ xt is the word to be executed if addr1 u1 is a string starting
  150:     \ with the prefix addr2 u2 and continuing with a word in the
  151:     \ wordlist `documentation'. f is true if xt is executed.
  152:     >r dup >r
  153:     3 pick over compare 0=
  154:     if \ addr2 u2 is a prefix of addr1 u1
  155: 	r> /string documentation search-wordlist
  156: 	if \ the rest of addr1 u1 is in documentation
  157: 	    execute r> execute true
  158: 	else
  159: 	    rdrop false
  160: 	endif
  161:     else
  162: 	2drop 2rdrop false
  163:     endif ;
  164: 
  165: : process-line ( addr u -- )
  166:     2dup s" doc-" ['] print-doc do-doc 0=
  167:     if
  168: 	2dup s" short-" ['] print-short do-doc 0=
  169: 	if
  170: 	    type cr EXIT
  171: 	endif
  172:     endif
  173:     2drop ;
  174: 
  175: 1024 constant doclinelength
  176: 
  177: create docline doclinelength chars allot
  178: 
  179: : ds2texi ( file-id -- )
  180:     >r
  181:     begin
  182: 	docline doclinelength r@ read-line throw
  183:     while
  184: 	dup doclinelength = abort" docline too long"
  185: 	docline swap process-line
  186:     repeat
  187:     drop rdrop ;
  188: 
  189: : compare-ci ( addr1 u1 addr2 u2 -- n )
  190:     \ case insensitive string compare
  191:     2 pick swap -
  192:     ?dup-0=-if
  193:         capscomp
  194:     else
  195: 	nip nip nip
  196: 	0<
  197: 	if
  198: 	    -1
  199: 	else
  200: 	    1
  201: 	endif
  202:     endif  ;
  203: 
  204: : answord ( "name wordset pronounciation" -- )
  205:     \ check the documentaion of an ans word
  206:     name { D: wordname }
  207:     name { D: wordset }
  208:     name { D: pronounciation }
  209:     wordname documentation search-wordlist
  210:     if
  211: 	execute { doc }
  212: 	wordset doc doc-wordset 2@ compare-ci
  213: 	if 
  214: 	    ." wordset: " wordname type ." : '"  doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
  215: 	endif
  216: 	pronounciation doc doc-pronounciation 2@ compare-ci
  217: 	if
  218: 	    ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
  219: 	endif
  220:     else
  221: 	." undocumented: " wordname type cr
  222:     endif ;

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