\ docinc 98.10.10 1:36 am NAB
\ Based on Erwin Schomburg's work.
\ Provides:
\ DocIncluded ( c-addr u -- )
\ DocInclude <filename>
\ DocInclude" <filename>"
\ DocNeeded ( c-addr u -- )
\ DocNeeds <filename>
\ DocNeeds" <filename>"
\ Allows source to be included from
\ Doc-format (AportisDOC) files.
\ Compressed files are supported.
\ Doc files may be nested to any
\ reasonable depth.
\ Bookmarks are ignored.
\ Echo ( newsetting -- old ) can be
\ used to control the display of
\ incoming source text.
\ Doc filenames are case-sensitive.
\ Lines up to 120 chars are accepted.
needs doc
decimal
create EvalBuf 120 allot
variable EvalLen
: Evaluate-Buf ( -- )
EvalBuf EvalLen @
\ If echo is set, display the source:
0 echo dup >r if 2dup type cr then
r> echo drop
evaluate 0 EvalLen ! ;
: Eval-Record ( c-addr. u -- )
0 do
2dup i m+ c@a
dup 13 = 3 and - \ cr->lf
dup 9 = 23 and + \ tab->space
dup 10 = if
drop 2>r Evaluate-Buf 2r>
else
\ Add char to eval buffer:
Evalbuf EvalLen @ + c! 1 EvalLen +!
then
loop 2drop ;
variable #records 0 #records !
\ 0 is a sentinel value - Doc files have
\ at least 1 record.
variable record#
wordlist constant needslist
: needed? ( c-addr u -- flag )
needslist search-wordlist
if drop false else true then ;
: DocIncluded ( c-addr u -- )
\ Nest:
\ note: DocDBR is an internal variable
\ from the doc module that holds the
\ currently-open Doc db handle.
DocDBR 2@ 2>r
record# @ >r #records @ >r
\ Add needs entry for file:
2dup needed? if
get-current >r
needslist set-current
2dup (header) postpone ;
r> set-current
then
\ Zero-delimit the filename:
here over + 0 swap c!
tuck here swap move
here swap ( -- z-addr u )
\ Open Doc source file:
DmModeReadOnly rot rot
OpenDocDB 2dup 2>r ( -- dbr. )
\ Evaluate the Doc file:
DmNumRecords dup #records !
( -- #recs )
0 EvalLen !
1 do
i dup record# !
GetRecord
\ Stop at the first bookmark record:
>r 2dup 15 m+ c@a r> swap
if Eval-Record
else drop 2drop leave then
loop ( -- )
\ In case last line doesn't end with LF:
Evaluate-Buf
2r> CloseDocDB
\ Unnest:
r> #records ! r> record# !
2r> DocDBR 2!
\ Get & re-decode previous record:
#records @ if
record# @ GetRecord drop 2drop
then
;
: DocNeeded ( c u -- )
2dup needed?
if DocIncluded else 2drop then ;
: DocInclude ( "name" -- )
0 parse DocIncluded ;
: DocNeeds ( "name" -- )
0 parse DocNeeded ;
: DocInclude" ( "name<">" -- )
[char] " parse DocIncluded ;
: DocNeeds" ( "name<">" -- )
[char] " parse DocNeeded ;