( docforth JCB 07:31 11/23/10) : parse-word bl word count ; : method> postpone create postpone , postpone does> postpone @ ; immediate \ 0 link \ 1 key \ 2 value : link ( root new -- ) over @ over ! swap ! ; : mapadd ( value key map ) method> 3 cells allocate throw tuck link cell+ tuck ! cell+ ! ; : mapfind ( key map -- key false | value true ) method> begin dup while 2dup cell+ @ = if nip cell+ cell+ @ true exit then @ repeat ; : map here 0 , dup mapadd mapfind ; variable old>in 2variable jam : preserve ( c-addr1 u -- c-addr ) \ save string in an allocated counted string dup 1+ allocate throw dup >r 2dup c! 1+ swap cmove r> ; : cpreserve ( c-addr1 u -- c-addr ) \ like preserve, but uses a cell for length dup cell+ allocate throw dup >r 2dup ! cell+ swap cmove r> ; : ccount ( c-addr -- c-addr1 u ) \ like count, but uses a cell for length dup cell+ swap @ ; : moretib ( -- f ) >in @ #tib @ < ; : skipsp ( -- ) \ skip spaces in TIB begin moretib tib >in @ + c@ bl = and while 1 >in +! repeat ; : wordstr ( "name" -- c-addr u ) skipsp >in @ old>in ! >in @ >r bl word count r> >in ! ; : 2array create 2* cells allot does> swap 2* cells + ; variable htmlfile s" " preserve value htmlfilename : >html ( c-addr u ) \ write string to html htmlfile @ write-file throw ; : >>html ( c-addr u ) \ write line to html htmlfile @ write-line throw ; : u>html ( u -- ) \ write decimal u to the HTML base @ >r decimal 0 <# #s #> >html r> base ! ; 512 constant maxline maxline 2array deco map +xt->uniq xt->uniq map +uniq->fn uniq->fn map +uniq->comment uniq->comment : counter create 100 , does> 1 over +! @ ; counter uniq : anchor ( u -- ) s" " htmlfile @ write-file throw ; : anchor1 ( -- uniq ) uniq htmlfilename over +uniq->fn dup ['] anchor old>in @ deco 2! ; : anchor2 ( uniq c-addr u -- ) get-current search-wordlist 0= throw +xt->uniq ; : anchorit ( c-addr -- ) \ counted string anchor1 swap count anchor2 ; : create-html ( caddr u -- ) 2dup preserve to htmlfilename w/o create-file throw htmlfile ! s" " >>html s" " >>html s" " >>html s" " >>html s" " >>html s"
" >>html ; : close-html s"
" >>html s"