home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / INDEX.SEQ < prev    next >
Encoding:
Text File  |  1989-04-29  |  2.0 KB  |  54 lines
  1. \ INDEX.SEQ     Build an index of hyper text links      by Tom Zimmer
  2.  
  3.  
  4. only forth also definitions hidden also editor also
  5.  
  6. handle indexhndl        indexhndl !hcb hyper.ndx
  7.  
  8. create crlf$ $0D c, $0A c,
  9.  
  10. : index.fname   ( --- )
  11.                 fstime @ 0=
  12.                 if      ['] hyperchar >body 1 indexhndl hwrite drop
  13.                         seqhandle >pathend" indexhndl hwrite drop
  14.                         crlf$ 2 indexhndl hwrite drop
  15.                         fstime on
  16.                 then    ;
  17.  
  18.  
  19. : index.file    ( --- )
  20.                 IBRESET
  21.                 0.0 seek
  22.                 off> fstime
  23.                 ." ." ?cr
  24.                 10000 1
  25.                 do      lineread c@ 0= ?leave
  26.                         searchsetup search nip
  27.                         if      index.fname
  28.                                 $2020 outbuf count + 2- ! \ terminate bl's
  29.                                 outbuf count 1 -1 d+    \ skip (°)
  30.                                 2dup bl scan nip - 1+   \ addr and len +1
  31.                                 indexhndl hwrite drop   \ write to file
  32.                                 i 0 <# $0A hold $0D hold #S #>
  33.                                                 \ convert to $ + CRLF
  34.                                 indexhndl hwrite drop
  35.                                 ?keypause
  36.                                 PRINTING @ 0= @> statv and
  37.                                 IF <.STAT> THEN
  38.                         then
  39.                 loop    ;
  40.  
  41. : bindex        ( file_spec --- )       \ Print first line of files
  42.                 SAVESTATE
  43.                 ?in-empty               \ if nothing following command
  44.                 if      " *.txt" ">$ $>tib
  45.                         withname off
  46.                 then
  47.                 indexhndl hcreate abort" Couldn't make INDEX file."
  48.                 ['] hyperdest >body 1 slook.buf place
  49.                 ['] index.file fallof
  50.                 crlf$ 2 indexhndl hwrite drop
  51.                 indexhndl hclose drop
  52.                 RESTORESTATE bye ;
  53.  
  54.