\ docinc 98.10.10 1:36 am NAB \ Based on Erwin Schomburg's work. \ Provides: \ DocIncluded ( c-addr u -- ) \ DocInclude \ DocInclude" " \ DocNeeded ( c-addr u -- ) \ DocNeeds \ DocNeeds" " \ 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 ;