\ add links to an HTML file that uses ANS Forth words or ANS Forth
\ section numbers

\ usage: name <filename> slurp-file addlinks

\ at present this is pretty primitive. E.g., it might be extended to
\ also make links out of section numbers and words preceded or
\ followed by punctuation. But where do we draw the line?

\ it is also quite Gforth-dependent

table constant links
\ a TABLE is a case-sensitive wordlist
\ using a case-insensitive wordlist instead of a table should also
\ work ok, if you removed some frequent English words from wordlinks.fs

: lookup-link ( addr1 count1 -- addr2 count2 )
    \ produces the URL for the string in addr1 count1, or 0 0
    links search-wordlist if
	execute
    else
	0 0
    endif ;

: link ( addr1 count "name" -- )
    \ takes the URL for the section NAME
    save-mem create 2,
does> ( -- addr2 count )
    \ returns the URL
    2@ ;

: wordlink ( addr1 count1 "NAME" -- )
    \ takes the section for the word name
    save-mem create 2,
does> ( -- addr2 count2 )
    \ returns the URL
    2@ lookup-link ;

links set-current
include links.fs
include wordlinks.fs
forth definitions

: slurp-file ( c-addr1 u1 -- c-addr2 u2 )
    \ c-addr1 u1 is the filename, c-addr2 u2 is the file's contents
    r/o open-file throw >r
    here -1 r@ read-file throw
    r> close-file throw
    here swap ;

: type-link { d: string -- f }
    string lookup-link dup if
	." <a href=" type ." >" string type ." </a>"
	true
    else
	2drop false
    endif ;

: type-string { d: string -- }
    \ like type, but types a link if there is one
    string type-link if
	EXIT endif
    string 1- + c@ dup [char] , = over [char] . = or if
	string 1- type-link if
	    emit EXIT
	endif
    endif
    drop string type ;

: addlinks ( c-addr u -- )
    \ c-addr u is the input string
    2dup + { end }
    begin { d: rest }
	rest (parse-white) { d: string }
	rest drop string drop over - type \ print white space before string
	string nip
    while
	string type-string
	string + end over -
    repeat ;