ProfitPress Mega CDROM2 Shareware Freeware (MSDOS)(1992)(Eng)

home *** CD-ROM | disk | FTP | other *** search

/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_4.ZIP / TCOMSAMP.ZIP / IND.SEQ < prev next >

Wrap

Text File | 1991-03-14 | 19.1 KB | 448 lines

\ INDEX.SEQ Build an index of hyper text links by Tom Zimmer ' lrhndl alias seqhandle 36 array slook.buf 128 array joined$ defer donfile \ A function to do on all specified files : ?ESC ( -- f1 ) key? if key 27 = else false then ; handle indhndl : search_1file ( n1 -- ) >fadr dir>pad >r here indhndl $>handle indhndl >pathend dup indhndl 1+ - r@ + indhndl c! r> cmove indhndl count + off indhndl hopen 0= indhndl save!> seqhandle ibreset if donfile then indhndl hclose drop restore> seqhandle ; : $fallof ( addr-offile_spec --- ) \ Do something to all files \ matching file_specs. dirseg 0= if drop exit then dup count here c! here count cmove \ need spec at HERE also $getdir \ and read the directory files. #fls if #fls 0 ?do i >fadr 1+ c@l '.' <> if i search_1file then ?esc ?leave loop then ; handle indexhndl 0 value ?exp_tabs 0 value after 0 value before 0 value stopper 0 value fstime 0 value ?global 2variable thisline create crlf$ $0D c,-d $0A c,-d : write.filename ( -- ) fstime ?exit \ put filename in index file " ∙" indexhndl hwrite drop ?global if indhndl count indexhndl hwrite drop else indhndl >pathend" indexhndl hwrite drop then crlf$ 2 indexhndl hwrite drop on> fstime ; : write.onename ( a1 n1 -- ) write.filename indexhndl hwrite drop \ write to file loadline @ \ line where found, 0 <# $0A hold $0D hold \ end line with CRLF #S \ preceeded by the number bl hold #> \ preceeded by a blank indexhndl hwrite drop ; \ write it too. : skip_1word ( a1 n1 -- a2 n2 ) \ skip one word through string begin 2dup bl scan \ find a blank bl skip \ and skip it dup \ any text left while 2swap 2drop repeat 2drop ; \ if any text left, then : ?word.ending ( -- ) \ find a word ending with char in slook.buf thisline 2@ over c@ bl = \ mustn't start with a blank if 2drop else bl skip \ skip leading spaces 2dup slook.buf 1+ c@ scan dup \ did we find delimit char if over 1+ c@ bl = \ does a blank follow char? \ if so then ok, else not if nip - \ parse word before skip_1word dup \ if any text left, then if write.onename \ write name to index else 2drop then else 2drop 2drop then else 2drop 2drop \ discard if not found then then ; : write.1cname ( -- ) thisline 2@ bl skip \ skip leading blanks 2dup '(' scan nip - \ up to "(" begin 2dup bl scan dup \ any blanks? while 2swap 2drop bl skip \ then skip them repeat 2drop write.onename ; \ and write one index name : ?word.C ( -- ) \ find a "C" function name thisline 2@ '(' scan dup \ if we find a ( if 2dup ';' scan nip >r \ and '{' scan nip r> >= \ if { before ; or neither \ is found, then if write.1cname then else 2drop then ; : ?word.prev ( -- ) \ find occurances of slook.buf string and put word \ previous to string in index file with line number. slook.buf count thisline 2@ search nip if thisline 2@ bl skip \ skip those blanks 2dup bl scan nip - \ addr and len of name write.onename \ and write one index name then ; long_branch : ?word.after ( -- ) \ find occurances of slook.buf string and put word \ following string in index file with line number. slook.buf count thisline 2@ 2dup '\' scan nip - \ stop at '\' begin 4dup search \ while found while /string \ strip preceeding text over 1- dup c@ bl = \ preceed with BL swap outbuf = or >r \ or at line start slook.buf c@ /string \ skip search string + leadin bl skip dup r> and \ skip those blanks \ must have text left if \ it anything left 2dup \ -- addr & len of string \ then get word following 2dup bl scan nip - \ addr and len of name write.onename \ and write one index name then repeat drop 2drop 2drop ; : ?word.stline ( -- ) \ find occurance of slook.buf string at line start \ put following string in index file. thisline 2@ 2dup bl scan nip - dup if slook.buf count rot max compare 0= if thisline 2@ bl scan \ find a blank bl skip dup \ skip those blanks if \ if anything left 2dup bl scan nip - \ word following write.onename \ write 1 index name else 2drop then then else 2drop then ; short_branch : search.word ( n1 -- ) 0max 4 min exec: ?word.after ?word.ending ?word.prev ?word.C ?word.stline ; 2variable curspec 32 constant b/tbl 16 constant maxtbl 0 value tblcnt 132 array fl$ b/tbl maxtbl * array wtbl : search.words ( -- ) wtbl b/tbl maxtbl * bounds do i 1+ c@ 0= ?leave i 1+ count slook.buf place i c@ search.word b/tbl +loop ; : nfl$ ( -- a1 ) curspec 2@ bl skip \ skip blanks 2dup bl scan \ find next blank 2dup curspec 2! \ save for next try nip - pad place \ put it in pad pad ; \ ( -- pad ) return pad : 0fl$ ( -- a1 ) fl$ count curspec 2! \ reset to spec's start nfl$ ; \ next spec : ilineread ( -- a1 ) \ index line read, with tab expand lineread \ read a line from file ?exp_tabs 0= ?exit \ leave if not expanding tabs dup count \ through whole line begin $09 scan dup \ look for next tab char while over bl swap c! \ change tab to blank repeat 2drop ; long_branch : next-cmd$ ( a1 n1 -- f1 ) \ find next matching string line \ f1 = true if match begin 2dup ilineread crlf>bl's count bl skip 2dup \ skip leading spcs bl scan nip - \ parse first word rot max caps-comp 0= \ compare strings = outbuf c@ 0= or \ or empty lineread outbuf c@ ';' = \ test for file stop if true or \ say we are done outbuf off \ clear buffer then until 2drop outbuf c@ ; \ true if matched short_branch : find-cmd$ ( a1 n1 -- f1 ) \ find a line starting with string \ a1,n1. f1 = true if matched ibreset 0.0 seqhandle movepointer next-cmd$ ; : after-cmd ( -- a1 n1 ) \ return a1,n1 string after command outbuf count bl skip bl scan \ past first word bl skip ; \ and past any following spcs : read_stopper ( -- ) \ STOPAT \ " STOPAT" find-cmd$ if after-cmd \ -- a1 n1 if c@ =: stopper else drop then then ; : read_before ( -- ) \ BEFORE 64 " BEFORE" find-cmd$ if after-cmd \ -- a1 n1 ""->$ \ -- a1 counted string number? \ -- d1 f1 if over 250 min =: before then 2drop then ; : read_after ( -- ) \ AFTER 35 " AFTER" find-cmd$ if after-cmd \ -- a1 n1 ""->$ \ -- a1 counted string number? \ -- d1 f1 2drop 128 min =: after then ; : read_tabx ( -- ) \ TABX ON " TABX" find-cmd$ if after-cmd \ -- a1 n1 ""->$ 1+ dup \ -- a1 counted string " ON" caps-comp 0= \ if "ON" then expand tabs if drop on> ?exp_tabs exit then " OFF" caps-comp 0= \ if "OFF" then don't expand if off> ?exp_tabs exit then then ; : 1word ( a1 n1 -- a2 n2 a3 n3 ) \ parse out a word bl skip 2dup bl scan 2dup 2>r nip - 2r> 2swap ; : ""->$ ( a1 n1 -- a2 ) \ convert addr & len to counted $ over 1- c! 1- ; : nextword ( a1 n1 -- a2 n2 ) \ skip from current word to next bl scan bl skip ; : read_specs ( -- ) \ SPECS *.SEQ;*.TXT;*.ASM " SPECS" find-cmd$ if after-cmd 2dup bl scan nip - \ get line upto a blank 132 min fl$ place \ move in file search string fl$ count begin ';' scan dup \ scan for ';' while over bl swap c! \ change to blank repeat 2drop fl$ count curspec 2! \ place to start then ; : read_global ( -- ) \ GLOBAL \ " GLOBAL" find-cmd$ if after-cmd 2dup bl scan nip - \ get line upto a blank 63 min startdir place \ move in file search string on> ?global \ do a global edit then ; : get1cmd ( -- ) after-cmd \ -- a1 n1 over c@ '0' - 0 max 9 min \ type 0 to 9 tblcnt b/tbl * wtbl + c! \ set search type '"' scan 1 /string \ skip to search $ 2dup 1 /string \ allow " to follow as legal '"' scan nip - \ get " delim $ b/tbl 2- min \ limit to avail tblcnt b/tbl * wtbl + 1+ place \ move $ into buf incr> tblcnt ; : read_cmds ( -- ) \ TYPE 0 "CONSTANT " " TYPE" find-cmd$ if get1cmd begin " TYPE" next-cmd$ tblcnt maxtbl < and while get1cmd repeat then ; : index_open? ( -- f1 ) \ open and return true, else couldn't " INDEX.CFG" ">$ indexhndl $>handle \ init filename indexhndl hopen \ could we open? if " \NEWZ.CFG" ">$ indexhndl $>handle \ try root if failed above indexhndl hopen 0= else true then ; : cfg-init ( -- ) off> after \ start looking at 0 250 =: before \ look up to char 250 '\' =: stopper \ stop character=\ off> tblcnt \ command count=0 wtbl b/tbl maxtbl * erase \ initialize table off> ?global \ no global searching " \" startdir place ; \ default to whole disk : read_cfg ( -- ) \ read the hypertext word table for \ building the index file. cfg-init index_open? if indexhndl save!> seqhandle read_specs \ read file specifications read_global \ global hyperindex directory read_after \ read where to start in line read_before \ read before limit length read_stopper \ read stop char read_tabx \ file contains tabs read_cmds \ read compiler commands restore> seqhandle indexhndl hclose drop else 0 wtbl c! \ type is zero " °" wtbl 1+ place \ string is "°" then ; : ind.1line ( -- f1 ) outbuf count before min after /string 2dup stopper scan nip - tuck thisline 2! 0> outbuf crlf>bl's 1+ c@ '\' <> and if search.words then ; : index.file ( --- ) 20 10 at seqhandle count type 60 #out @ - 0 max spaces IBRESET 0.0 seqhandle movepointer off> loadline off> fstime 20000 1 do ilineread c@ 0= ?leave ind.1line i 64 and 0= if ?esc ?leave then loop ; : joindir ( dir spec -- filespec ) \ join dir & spec to make \ a complete filespec swap count joined$ place \ lay in dir joined$ count + 1- c@ '\' <> if " \" joined$ +place then count over c@ '\' = if 1 /string then joined$ +place joined$ ; : global_search ( -- ) getdirs begin nextdir dup c@ while dup 0fl$ joindir $fallof begin dup nfl$ dup c@ ?esc 0= and \ leave if ESC pressed while joindir $fallof repeat 2drop repeat drop ; long_branch : bindex ( --- ) savecursor savescr cursor-off 18 8 62 12 box&fill ." Building hyper index file HYPER.NDX... " bcr bcr ." ESC = cancel " " *.TXT" fl$ place read_cfg " HYPER.NDX" ">$ indexhndl $>handle indexhndl hcreate 0= if ['] index.file is donfile ?global if global_search else 0fl$ $fallof begin nfl$ dup c@ ?esc 0= and \ leave if ESC pressed while $fallof repeat drop then crlf$ 2 indexhndl hwrite drop indexhndl hclose drop 1 seconds then restscr restcursor ; : main ( -- ) DECIMAL \ always select decimal INIT-CURSOR \ get intial cursor shape 50 FUDGE ! \ init MS timer, GUESS!! CAPS ON \ ignore cAsE ?DS: SSEG ! \ init search segment DOSIO_INIT \ init EMIT, TYPE & SPACES $FFF0 SET_MEMORY \ default to 64k code space DOS_TO_TIB \ move command tail to TIB COMSPEC_INIT \ init command specification LINEREAD_INIT \ initialize the LINEREAD system. dirinit \ initialize directory words diralloc \ allocate directory name space bindex ;