File:
[gforth] /
gforth /
ds2texi.fs
Revision
1.8:
download - view:
text,
annotated -
select for diffs
Mon Oct 16 18:33:06 1995 UTC (28 years, 6 months ago) by
anton
Branches:
MAIN
CVS tags:
HEAD
added answords.fs and strsignal.c
added checking of documenetation of ANS Forth words
Fixed many documentation errors and added some documentation
signal handling now uses strsignal and can handle signals not present on all machines
\ documentation source to texi format converter
\ documentation source can contain lines in the form `doc-word' and
\ `short-word'. These are converted to appropriate full or short
\ (without the description) glossary entries for word.
\ The glossary entries are generated from data present in the wordlist
\ `documentation'. Each word resides there under its own name.
script? [IF]
warnings off
require search-order.fs
require glocals.fs
require float.fs
require struct.fs
require debugging.fs
[THEN]
wordlist constant documentation
struct
2 cells: field doc-name
2 cells: field doc-stack-effect
2 cells: field doc-wordset
2 cells: field doc-pronounciation
2 cells: field doc-description
end-struct doc-entry
create description-buffer 4096 chars allot
: get-description ( -- addr u )
description-buffer
begin
refill
while
source nip
while
source swap >r 2dup r> -rot cmove
chars +
#lf over c! char+
repeat then
description-buffer tuck - ;
: replace-_ ( c-addr u -- )
\ replaces _ with -
chars bounds
+DO
i c@ [char] _ =
if
[char] - i c!
endif
1 chars
+loop ;
: condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
save-string 2dup replace-_ ;
: condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
dup 0=
if
2drop s" unknown"
else
save-string
endif ;
: condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
save-string 2dup replace-_ ;
: make-doc ( -- )
get-current documentation set-current
create
last @ name>string 2, \ name
[char] ) parse save-string 2, \ stack-effect
bl parse-word condition-wordset 2, \ wordset
bl parse-word dup \ pronounciation
if
condition-pronounciation
else
2drop last @ name>string
endif
2,
get-description save-string 2,
set-current ;
: emittexi ( c -- )
>r
s" @{}" r@ scan 0<>
if
[char] @ emit
endif
drop r> emit ;
: typetexi ( addr u -- )
0
?do
dup c@ emittexi
char+
loop
drop ;
: print-short ( doc-entry -- )
>r
." @findex "
r@ doc-name 2@ typetexi
." @var{ " r@ doc-stack-effect 2@ type ." } "
r@ doc-wordset 2@ type
cr
." @format" cr
." @code{" r@ doc-name 2@ typetexi ." } "
." @i{" r@ doc-stack-effect 2@ type ." } "
r@ doc-wordset 2@ type ." ``"
r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
rdrop ;
: print-doc ( doc-entry -- )
>r
r@ print-short
r@ doc-description 2@ dup 0<>
if
." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
else
2drop cr
endif
rdrop ;
: do-doc ( addr1 u1 addr2 u2 xt -- f )
\ xt is the word to be executed if addr1 u1 is a string starting
\ with the prefix addr2 u2 and continuing with a word in the
\ wordlist `documentation'. f is true if xt is executed.
>r dup >r
3 pick over compare 0=
if \ addr2 u2 is a prefix of addr1 u1
r> /string documentation search-wordlist
if \ the rest of addr1 u1 is in documentation
execute r> execute true
else
rdrop false
endif
else
2drop 2rdrop false
endif ;
: process-line ( addr u -- )
2dup s" doc-" ['] print-doc do-doc 0=
if
2dup s" short-" ['] print-short do-doc 0=
if
type cr EXIT
endif
endif
2drop ;
1024 constant doclinelength
create docline doclinelength chars allot
: ds2texi ( file-id -- )
>r
begin
docline doclinelength r@ read-line throw
while
dup doclinelength = abort" docline too long"
docline swap process-line
repeat
drop rdrop ;
: compare-ci ( addr1 u1 addr2 u2 -- n )
\ case insensitive string compare
2 pick swap -
?dup-0=-if
capscomp
else
nip nip nip
0<
if
-1
else
1
endif
endif ;
: answord ( "name wordset pronounciation" -- )
\ check the documentaion of an ans word
name { D: wordname }
name { D: wordset }
name { D: pronounciation }
wordname documentation search-wordlist
if
execute { doc }
wordset doc doc-wordset 2@ compare-ci
if
." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
endif
pronounciation doc doc-pronounciation 2@ compare-ci
if
." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
endif
else
." undocumented: " wordname type cr
endif ;
script? [IF]
require prims2x.fs
s" primitives.b" ' register-doc process-file
require crossdoc.fd
require doc.fd
[THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>