\ docinc 05.1.24 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

module docinc
expose-module doc

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 ;

public:

: 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
;

public:

: 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 ;

previous
end-module
