home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_2.ZIP / FPCSRC.ZIP / INDEX.SEQ < prev    next >
Encoding:
Text File  |  1991-04-05  |  2.1 KB  |  55 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 seqhandle movepointer
  22.                 0.0 filepointer 2!
  23.                 off> fstime
  24.                 ." ." ?cr
  25.                 20000 1
  26.                 do      lineread c@ 0= ?leave
  27.                         searchsetup search nip
  28.                         if      index.fname
  29.                                 $2020 outbuf count + 2- ! \ terminate bl's
  30.                                 outbuf count 1 /string  \ skip (°)
  31.                                 2dup bl scan nip - 1+   \ addr and len +1
  32.                                 indexhndl hwrite drop   \ write to file
  33.                                 i 0 <# $0A hold $0D hold #S #>
  34.                                                 \ convert to $ + CRLF
  35.                                 indexhndl hwrite drop
  36.                                 ?keypause
  37.                                 PRINTING @ 0= @> statv and
  38.                                 IF <.STAT> THEN
  39.                         then
  40.                 loop    ;
  41.  
  42. : bindex        ( file_spec --- )       \ Print first line of files
  43.                 SAVESTATE
  44.                 ?in-empty               \ if nothing following command
  45.                 if      " *.txt" ">$ $>tib
  46.                         withname off
  47.                 then
  48.                 indexhndl hcreate abort" Couldn't make INDEX file."
  49.                 ['] hyperdest >body 1 slook.buf place
  50.                 ['] index.file fallof
  51.                 crlf$ 2 indexhndl hwrite drop
  52.                 indexhndl hclose drop
  53.                 RESTORESTATE bye ;
  54.  
  55.