Return to ds2texi.fs CVS log

Up to [gforth] / gforth

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]