home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / goswish5.zip / MKDCT.CMD < prev    next >
OS/2 REXX Batch file  |  1999-02-17  |  55KB  |  1,860 lines
  1. /* create a "description cache" for use by the GoSWISH script */
  2.  
  3. /* Note:
  4.  by default, files are assumed to be non-html text files. 
  5.  Exceptions:
  6.     Files with extensions in the Htmls list are assumed to be HTML documents
  7.     Files with extensions that appear in the NoContents variable 
  8.       (either the user-set NoContents variable, or the NoContents entry
  9.        in the  Swish Configuration file) are assumed to be non-text files.
  10.       (descriptions are not generated for non-text files)
  11. */
  12.  
  13.  
  14. /* -------- User Changable Parameters   -------------*/
  15.  
  16.  
  17. /* Files with these extensions are assumed to be HTML files */
  18. htmls=" HTM HTML SHTML SHTM SHT HTML-SSI HTM-SSI  "
  19.  
  20. /* Files with these extensions are assumed to NOT  be plain-text files --
  21. THIS IS ONLY USED if you are using the "list of URLS" option --
  22. if you are reading from a SWISH index, the NOCONTENTS parameter is used */
  23. nocontents="JPG GIF ZIP XBM "
  24.  
  25. /* Directory specific "description files". These should contain
  26.  descriptions of files within the directory. */
  27. descript_file="DESCRIBE.TXT"
  28.  
  29.  
  30. /* the default SWISH configuration file */
  31. defcon="SAMPLES.CON"
  32.  
  33. /* the default list of urls (text mode) */
  34. deftxt="SRCHCSH.IN"
  35.  
  36. /* the default "description-cache" file */
  37. defdesc="SAMPLES.DCT"
  38.  
  39. /* the default "WWW" (HTML) directory */
  40. defdir="\WWW"
  41.  
  42. /* the default "directory specific file-description file" */
  43. defdescribe='DESCRIBE.TXT'
  44.  
  45.  
  46. /* This is the character used to signal "continuation of a description"
  47. I.e. (assuming continuation_flag='|'
  48. FOOBAR.TXT   This is the descripton of foobar.txt
  49.  |           And this is the second line.
  50. Note that the | should be the first non space character */
  51. continuation_flag='|'
  52.  
  53.  
  54. /* -------- End of User Changable Parameters   -------------*/
  55.  
  56. crlf='0d0a'x
  57.  
  58. call initit
  59.  
  60. say "      "cy_ye ' This is the GoSWISH "description-cache file creator". ' normal
  61. say " "
  62. say ' This program requires either a SWISH index file, or a "list of URLS".'
  63. say " "
  64.  
  65. aa=yesno(' Create (C), or modify (M), a description cache','CREATE MODIFY')
  66.  
  67. if aa=1 then do
  68.    call editit
  69.    say " bye "
  70.    exit
  71. end  /* Do */
  72.  
  73. aa=yesno(" Use a SWISH index (S), or a text index (T) ",'SWISH TEXT')
  74.  
  75. dtype=yesno(' Create a regular (R), or a structured (S) ".DCT" file ','Regular Structured')
  76.  
  77. if aa=0 then
  78.   call get_confile
  79. else
  80.   call get_txtfile
  81.  
  82. call get_filelist_info
  83. call get_outname
  84.  
  85. say reverse "  ------------------------------ " normal
  86. say " Saving descriptions for " filelist.0 " files "
  87.  
  88. latestd.=''
  89. latestd.!dir=' '         /* used to retain most recent dir-specific desc file */
  90. desc.0=filelist.0
  91. do m=1 to desc.0
  92.    desc.m=translate(filelist.m.!original,'/','\')
  93.    desc.m.!title=filelist.m.!title
  94.    desc.m.!size=filelist.m.!size
  95.    desc.m.!summary=strip(make_summary(filelist.m,filelist.m.!type,2))
  96.    desc.m.!sumtype=yaman  /*0-none, 1=created, 2=from dir-specific desc file 3=entered by hand*/
  97.    if (m//1000)=1 then say "::reading "m" ) "left(desc.m,min(length(desc.m),100))
  98. end /* do */
  99.  
  100.  
  101.  
  102. if dtype=0 then do      /* regular */
  103.   div=' &^%^& '
  104.   div2=' #$*~~#$* '
  105.   allf=""
  106.   foo=stream(outname,'c','open write')
  107.   if translate(foo)<>'READY:' then do
  108.      say "ERROR: could not open " outname
  109.      exit
  110.   end /* do */
  111.   do ii=1 to desc.0
  112.      aa=desc.ii.!sumtype||div||desc.ii||div||desc.ii.!title||div||desc.ii.!size|| , 
  113.         div||desc.ii.!summary
  114.     allf=allf||aa
  115.     if ii<>desc.0 then allf=allf||div2
  116.     if length(allf)>10000 then do 
  117.        aba=charout(outname,allf)
  118.        allf=''
  119.     end 
  120.     if (ii//1000)=1 then say "::writing entry # "ii
  121.   end /* do */
  122.   if length(allf)>0 then aba=charout(outname,allf)
  123.  
  124.   sike=stream(outname,'c','close')
  125.   if translate(sike)="READY:" then
  126.     say "Description cache file "outname " successfully written."
  127.   else
  128.     say  " Problem writing description cache file "outname 
  129.   sike=stream(outname,'c','close')
  130. end
  131. else do
  132.   foo=build_desc_cache(outname,'Descriptions from 'daindx,1)
  133.   if foo=1 then 
  134.     say "Description cache file "outname " successfully written."
  135.   else
  136.     say  " Problem writing description cache file "outname 
  137. end
  138.  
  139.  
  140. exit
  141.  
  142.  
  143.  
  144.  
  145. /**************************/
  146. get_outname:
  147. say reverse "  ------------------------------ " normal
  148. n2:
  149.  
  150. say " Enter the name to use for the "DCT" file:  "
  151. call charout ,' (default= ' defdesc ')' bold '  ? ' normal
  152. pull outname ; if outname="" then outname=defdesc
  153. if fdescribe="?" then do
  154.    say ' This ".DCT" (description-cache file) is used to store the file summaries'
  155.    say ' You can include a reference to this file in the "search form" documents that'  
  156.    say ' use the "search documents" mode of GoSwish '
  157.    say ' (such as the "search form" documents generated by the "create index" mode of GoSWISH)'
  158.    signal n4a
  159. end  /* Do */
  160.  
  161. outname=strip(outname)
  162.  
  163. adir=filespec('D',outname)||filespec('P',outname)
  164. if adir="" then adir=directory()
  165. if dir_exists(strip(adir,'t','\'))=0 then do
  166.    say "    Could not find directory: " reverse adir normal
  167.    say "    Please re-enter .... "
  168.    signal n2
  169. end
  170. if pos('.',outname)=0 then outname=outname'.dct'
  171.  
  172.  
  173. /* rename prior dct file */
  174. if stream(outname,'c','query exists')<>'' then do
  175.   iii=lastpos('.',outname)
  176.   if iii=0 then do
  177.      bkfile=outname'.bak'
  178.   end /* do */
  179.   else do
  180.      bkfile=left(outname,iii)||'bak'
  181.   end /* do */
  182.  
  183.   say "Backing up old version to: "bkfile
  184.   yow=sysfiledelete(bkfile)
  185.   buzz=charin(outname,1,stream(outname,'c','query size'))
  186.   foo=charout(bkfile,buzz,1)
  187.   foo=stream(bkfile,'c','close')
  188.   foo=stream(outname,'c','close')
  189.   foo=sysfiledelete(outname)
  190.   if foo<>0 then do
  191.      say 'Problem ('foo') could not delete old version of ' outname 
  192.      exit
  193.   end /* do */
  194. end                     /* backing up old version */
  195.  
  196. n4a:
  197. say " "
  198. say ' Enter the  name  of the "directory specific" 'bold' file-description file. 'normal
  199. call charout ,' (default= ' defdescribe ', ?=HELP, .=None)' bold '  ? ' normal
  200. pull fdescribe ; if fdescribe="" then fdescribe=defdescribe
  201. else
  202. if fdescribe="?" then do
  203.    say ' The "directory specific"' bold' file-description file'normal' is used to assign '
  204.    say " explicit descriptions to any file.  "
  205.    say ' For all files being "described", a 'bold' file-description file'normal " in it's " bold"own"normal
  206.    say " directory is examined; and if a matching entry is found,  the associated"
  207.    say " description is used."
  208.    say " Entries in the file-description file should be organized as:"
  209.    say "     FILE1.xxx a description "
  210.    say " Examples: "
  211.    say cy_ye "     " normal " file2.yyy  This is the YYY file "
  212.    say cy_ye "     " normal " foobar.htm  This is the classic FOOBAR file. In this case we use"
  213.    say "          | a 2 line description (the | is  a continuation flag)"
  214.    signal n4a
  215. end  /* Do */
  216. fdescribe=translate(fdescribe,'\','/')
  217. if pos('\',fdescribe)>0 then do
  218.    say " The file-description file is " bold" directory-specific "normal
  219.    say " Please reenter (and do NOT include a path) "
  220.    signal n4a
  221. end
  222.  
  223.  
  224. return 0
  225.  
  226. /**************************/
  227. /* read swish configuration and index files */
  228. get_confile:
  229. say reverse "  ------------------------------ " normal
  230. n2a:
  231.  
  232. do forever              /* loop in case of ? response */
  233.   say " Enter the fully qualifed name of the reference SWISH configuration file."
  234.   call charout , ' (?=list files, default=' defcon ')' bold '   ? ' normal
  235.   pull aconfile ; aconfile=strip(aconfile)
  236.   if aconfile="" then 
  237.      confile=defcon
  238.   else
  239.      confile=aconfile
  240.   if abbrev(confile,"?")=1 then do
  241.        thisdir=directory()
  242.        say 
  243.        say reverse ' List of files in: ' normal bold thisdir normal
  244.        do while queued()>0
  245.             pull .
  246.        end /* do */
  247.        parse var aconfile "?" aget . ; aget=strip(aget)
  248.        if aget="" then aget="*.*"
  249.       '@DIR /b  '||strip(thisdir,'t','\')'\'aget ' | rxqueue'
  250.       foo=show_dir_queue('*')
  251.       iterate
  252.   end /* do */
  253.   if confile='' then iterate
  254.   if stream(confile,'c','query exists')='' then do
  255.       say bold"Sorry,"normal" no such file: "confile
  256.       iterate
  257.   end /* do */
  258.   leave
  259. end /* do */
  260.  
  261. /* now get info */
  262. foo=afileread(confile)
  263. if clines.0=0 then do
  264.    say "    Could not find configuration file: " reverse confile normal
  265.    say "    Please re-enter .... "
  266.    signal n2a
  267. end
  268.  
  269. /* find the IndexFile entry, and the ReplaceRules entries. */
  270. nreps=0 ; nocontents=' '
  271. do mm=1 to clines.0
  272.    aline=strip(translate(clines.mm))
  273.    select  
  274.       when  abbrev(aline,'INDEXFILE')=1 then do
  275.           parse var aline . daindx . ; daindx=strip(daindx)
  276.       end
  277.       when abbrev(aline,'REPLACERULES') then do
  278.           nreps=nreps+1 ; aline=translate(aline,' ','"'||"'")
  279.           parse var aline  . . reprules.nreps.!original reprules.nreps.!new .
  280.       end
  281.       when abbrev(aline,'NOCONTENTS')=1 then do
  282.           parse var aline . nocontents . ; nocontents=strip(nocontents)
  283.       end
  284.       otherwise nop
  285.     end
  286. end  /* Do */
  287.  
  288. daindx0=stream(daindx,'c','query exists')
  289. if daindx0=" " then do
  290.    say " Problem: could not find SWISH index file: " daindx
  291.    exit
  292. end
  293. say "Using SWISH index file: "daindx
  294. do mm=1 to nreps
  295.    a1=reprules.mm.!Orig ; a2=reprules.mm.!new
  296.    reprules.mm.!orig=strip(translate(a1))
  297.    reprules.mm.!new=strip(translate(a2))
  298. end /* do */
  299. reprules.0=nreps
  300.  
  301. call get_swifile                /* read the swish index file, get file names */
  302. say "# files to index:: " nfiles
  303. return nfiles
  304.  
  305.  
  306. /**************************/
  307. /* read text (user created) configuration and index files */
  308. get_txtfile:
  309. say reverse "  ------------------------------ " normal
  310. n3a:
  311.  
  312. say " Enter a text file containing a list of URLs (? for HELP) "
  313. call charout , ' (default=' deftxt ')' bold '   ? ' normal
  314. pull txtfile
  315. if txtfile="" then txtfile=deftxt
  316. if  txtfile="?" then do
  317.   say "    Each line of the file should contain entries of the form: "
  318.   say cy_ye "  " normal ' relative_url  "Short Description "  size filename '
  319.   say " Where: "
  320.   say "  " bold " relative_url "normal "is required. It is used as the link to the file. "
  321.   say "  " bold ' "short description" ' normal ' is optional. If included, it must be within "'
  322.   say "  " bold " size  "normal" is optional; it's the size in bytes "
  323.   say "   " bold  "filename" normal 'is optional. It is the fully qualified name of the file.'
  324.   say "       If not specified,  the URL is assumed to refer to a file that is "
  325.   say "       relative to the WWW (HTML) directory "
  326.   say bold "Examples: " normal
  327.   say cy_ye "  " normal '/samples/SAMPMBOX.HTM "Sample Message Sender for SRE-http" 1390 '
  328.   say cy_ye "  " normal '/samples/SAMPOPT1.HTM "Sample of OPTIONS Keyphrase for SRE-http" 2728'
  329.   say " "
  330.   signal n3a
  331. end
  332.  
  333. /* now get info */
  334. foo=afileread(txtfile)
  335. if clines.0=0 then do
  336.    say "    Could not find list of URLS: " reverse txtfile normal
  337.    say "    Please re-enter .... "
  338.    signal n3a
  339. end
  340.  
  341.  
  342. n3b:
  343. say " Enter the name of the WWW (HTML)  directory: "
  344. call charout , ' (default=' defdir ')' bold '   ? ' normal
  345. pull datadir
  346. if datadir=""  then datadir=defdir
  347. datadir=strip(datadir,'t','\')
  348. if dir_exists(datadir)=0 then do
  349.   say " Could not find directory: " datadir
  350.   signal n3b
  351. end
  352. /* process file list */
  353. Say " Processing " txtfile
  354. nfiles=0
  355. do nf=1 to clines.0
  356.    baa=clines.nf
  357.    if baa=" " | abbrev(strip(baa),';')=1 then iterate
  358.    nfiles=nfiles+1
  359.    parse var baa aa  '"' atitle '"' asize absfile .
  360.    afil=translate(strip(word(aa,1)))
  361.    filelist.nfiles.!original=afil
  362.    filelist.nfiles.!title=atitle
  363.    filelist.nfiles.!size=asize
  364.  
  365.    if absfile <> " " then 
  366.       filelist.nfiles=absfile
  367.    else
  368.        filelist.nfiles=datadir||strip(aa,'l','\')
  369.    filelist.nfiles=translate(filelist.nfiles,'\','/')
  370.    if filelist.nfiles.!size=" " | datatype(filelist.nfiles.!size)<>"NUM" then do
  371.       filelist.nfiles.!size=dosdir(filelist.nfiles,'S')
  372.   end
  373.  
  374.  
  375. end /* do */
  376. filelist.0=nfiles
  377. return nfiles
  378.  
  379.  
  380.  
  381.  
  382. /****************************/
  383. /* given a filefilst, get descriptions */
  384. get_filelist_info:
  385. /* determine type of file: 2=text, 1=html, 0=non-text */
  386. htmls=translate(translate(htmls),' ','.')
  387. nocontents=translate(translate(nocontents),' ','.')
  388.  
  389. do mm=1 to filelist.0
  390.    aff=filelist.mm
  391.    filelist.mm.!type=2               /* assume it's text */
  392.    foo=lastpos('.',aff)
  393.    if foo=0 then iterate
  394.  
  395.    anext=strip(translate(substr(aff,foo+1)))
  396.    if wordpos(anext,htmls)>0 then do
  397.         filelist.mm.!type=1
  398.         iterate
  399.    end
  400.    if wordpos(anext,nocontents)>0 then filelist.mm.!type=0
  401.  
  402. end /* do */
  403.  
  404. return 0
  405.  
  406.  
  407.  
  408. /* -------------------- */
  409. /*********************************/
  410. /* rudimentary edit of a description file */
  411.  
  412. editit:
  413. say " "
  414. say reverse "  ------------------------------ " normal
  415. iff=1
  416.  
  417. n2b:
  418. do forever
  419.    say " Enter the name of the description-cache file you want to modify."
  420.    call charout ,' (?=list files, default= ' defdesc ')' bold '  ? ' normal
  421.    pull aa ; aa=strip(aa)
  422.    if aa="" then do
  423.        outname=defdesc
  424.        leave
  425.    end 
  426.    if abbrev(aa,"?")=1 then do
  427.        thisdir=directory()
  428.        say 
  429.        say reverse ' List of files in: ' normal bold thisdir normal
  430.        do while queued()>0
  431.             pull .
  432.        end /* do */
  433.        parse var aa "?" aget . ; aget=strip(aget)
  434.        if aget="" then aget="*.*"
  435.       '@DIR /b  '||strip(thisdir,'t','\')'\'aget ' | rxqueue'
  436.       foo=show_dir_queue('*')
  437.       iterate
  438.    end /* do */
  439.    outname=aa
  440.    if pos('.',outname)=0 then outname=strip(outname)||'.dct'
  441.    leave
  442. end /* do */
  443. outname=strip(outname)
  444.  
  445. if stream(outname,'c','query exists')='' then  do
  446.    say "    Could not find description cache file: " reverse outname normal
  447.    say "    Please re-enter .... "
  448.    signal n2b
  449. end
  450.  
  451. newtype=yesno(' Save as a regular (R), or a structured (S) .DCT file ','Regular Structured')
  452.  
  453. if newtype=1 then do
  454.    say bold"Enter 80 character description of this index"normal
  455.    call charout,"   "reverse"?"normal
  456.    parse pull dctindx.!message
  457.    say "Message: " dctindx.!message
  458. end
  459.  
  460. /* is it a regular or a structured dct file */
  461. div=' &^%^& ' 
  462. div2=' #$*~~#$* '
  463. adfil=strip(outname)
  464. ii=0
  465. goofy=charin(adfil,1,10)
  466. if abbrev(goofy,'#GOSWISH')=1 then do
  467.   say ' Reading a structured DCT file '
  468.  
  469.    istat=load_desc_cache(adfil)
  470.    if istat<0 then do                   /* problem reading structured dct file */
  471.       astats.1 = "Not a GoSWISH descriptive-summaries cache file"
  472.       astats.2 = "File corrupted (problem with terminiator) "
  473.       astats.3 = "Corrupted GoSWISH description-cache file (improper termination of index) "
  474.       astat=strip(abs(istat))
  475.       Say "Error: " astats.astat
  476.       exit
  477.    end
  478.  
  479.    say  outname " has: # records= " dctindx.0 ', key length: ' dctindx.!keylen', offset= 'dctindx.!Offset 
  480.    say "Message: " dctindx.!message
  481.  
  482.    incache=DCTINDX.0 
  483.    cache_type=2 ; scachename=adfil
  484. end                /*  structured dct */
  485. else do            /* regular dct */
  486.   say ' Reading a regular DCT file '
  487.    goofy=charin(adfil,1,stream(adfil,'c','query size'))
  488.    i1=1 ; lengoofy=length(goofy) ;isleave=0
  489.    do  forever
  490.        i2=pos(div2,goofy,i1)
  491.        if i2=0 then do
  492.           isleave=1
  493.           i2=lengoofy
  494.        end /* do */
  495.        aa=substr(goofy,i1,i2-i1)
  496.        i1=i2+length(div2)
  497.        ii=ii+1 ; desc.0=ii
  498.        if (ii//500)=1 then say "... reading entry #" ii
  499.        parse var aa desc.ii.!sumtype (div) desc.ii (div) desc.ii.!title (div) ,
  500.                   desc.ii.!size (div) desc.ii.!SUMMARY
  501.        if (isleave=1) then leave
  502.    end                   /* read lines from descirpfile */
  503.    cache_type=1
  504.   say " ... "ii " entries found."
  505. end                  /* regular dct */
  506.  
  507. if cache_type=2 then do  /* copy structured dct to dcache */
  508.   bodyat=dctindx.!offset+1
  509.   fsize=stream(scachename,'c','query size')
  510.   goofy=charin(scachename,bodyat,1+fsize-(bodyat+8))
  511.   div5='05'x
  512.   i1=1 ;ii=0 ;leaveit=0
  513.   do  forever
  514.       ii=ii+1  
  515.       if (ii//1000)=1 then say " ... reading entry #"ii 
  516.  
  517.       do rr=1 to 6              /* six items per entry */
  518.         i2=pos(div5,goofy,i1)
  519.         if i2=0 then do 
  520.              leaveit=1
  521.              leave
  522.         end /* do */
  523.         abb.rr=substr(goofy,i1,i2-i1)
  524.         i1=i2+1
  525.       end /* do */
  526.       if leaveit=1 then leave
  527.       desc.ii.!sumtype=abb.2 ; desc.ii=abb.3
  528.       desc.ii.!title=abb.4  ; desc.ii.!size=abb.5
  529.       desc.ii.!summary=abb.6
  530.  
  531.       dcachel.II=desc.II
  532.      
  533. /*      parse var goofy dlen (div5) desc.ii.!sumtype (div5) desc.ii (div5) desc.ii.!title (div5) ,
  534.                      desc.ii.!size (div5) desc.ii.!summary (div5) goofy */
  535.   end
  536.   desc.0=DCTINDX.0 ; DCACHEL=0=desc.0
  537.   drop goofy
  538. end /* do */
  539.  
  540. if cache_type=1 then do
  541.     do mm=1 to desc.0          /* copy urls to  a url array */
  542.         dcachel.mm=desc.mm
  543.     end /* do */
  544.     dcachel.0=desc.0
  545.     incache=desc.0
  546. end /* do */
  547.  
  548. asknams:
  549. if yesno(' Would you like to list the names of these entries ')=1 then do
  550.     SAY "              " CY_YE " File Name    ::     Title  " normal
  551.    iat=1
  552.    do forever
  553.          iat=show_entries(iat)
  554.          if iat>desc.0 then leave
  555.          call charout , cy_ye ' (hit any key to continue, X stop) ' normal
  556.         foo=sysgetkey("noecho") ; say " "
  557.         IF translate(FOO)='X' then LEAVE
  558.      end
  559. end
  560.  
  561. sq=1
  562. do forever
  563.     thedef=desc.iff
  564.     if iff=1 | isq=1 then do
  565.        say " Currently viewing "iff " of "desc.0 " entries."
  566.       say   " Enter the " reverse " name " normal " you wish to modify. Or, "
  567.       say bold "  Space=modify, UP and DOWN arrow= previous and next, ESC=Exit "
  568.       say      '  ?=Help, Ctrl-Z=abort,  nn = to entry #nn, @=view neighborhood ' normal
  569.     end
  570.     isq=0
  571. /* find record for thedef */
  572.    call charout, bold||iff||')'||normal
  573.     todo=translate(stringin2(thedef,iff))
  574.     if length(todo)=0 then do
  575.           iff=min(iff+1,desc.0)
  576.           iterate
  577.     end
  578.     if d2c(27)=todo then do
  579.         say
  580.         rt=yesno("Review\Save&Exit\Quit",'Review Save Quit')
  581.         if rt="2" then exit
  582.         if rt=1 then leave
  583.         signal asknams
  584.     end 
  585.     if d2c(26)=todo then exit
  586.  
  587.     todo=strip(todo)
  588.     if todo='?' then do
  589.          say
  590.         isq=1 ; iterate
  591.     end
  592.     if todo="<" | todo=',' then do 
  593.           iff=max(iff-1,1)
  594.           iterate
  595.     end
  596.     if datatype(todo)='NUM' then do
  597.         iff=max(min(todo,desc.0),1)
  598.         iterate
  599.     end /* do */
  600.     if todo='@' then do
  601.        say 
  602.        ifoo=show_entries(iff-8)
  603.        iterate
  604.     end /* do */
  605.  
  606.     if todo='' then todo=thedef         /* lookup an entry */
  607.     iff2=0
  608.     do ll=1 to desc.0
  609.        if pos(todo,desc.ll)>0 then do
  610.              iff2=ll
  611.              leave
  612.        end /* do */
  613.    end /* do */
  614.    if iff2=0 then do
  615.         say " No entry for: " todo ; say
  616.         iterate
  617.     end  /* Do */
  618.     iff=iff2
  619.     say " "
  620.     say cy_ye " .......................... " normal
  621.     say reverse desc.iff normal  " ( size= " desc.iff.!size
  622.     say bold "Title:" normal desc.iff.!title
  623.  
  624.     ogit=desc.iff.!sumtype
  625.     dathing=''
  626.     select
  627.        when ogit=0 then say " "
  628.        when ogit=2 then say bold 'Summary derived from directory-specific descriptions file'normal
  629.        when ogit=3 then say "Summary specified by administrator"
  630.       otherwise    say bold" Summary generated from file contents"normal
  631.     end  /* select */
  632.     if ogit<>0 then do
  633.       dathing=desc.iff.!summary
  634.       dathing=fixda(dathing)
  635.     end
  636.     say dathing
  637.  
  638.     say cy_ye " .......................... " normal
  639.     which=yesno("Change the summary? ")
  640.     if which=1 then do
  641.        say " Enter new descriptive summary: "
  642.        dathing=getda()
  643.        desc.iff.!summary=dathing
  644.        desc.iff.!sumtype=3
  645.    end
  646. end
  647.  
  648. iii=lastpos('.',outname)
  649. if iii=0 then do
  650.    bkfile=outname'.bak'
  651. end /* do */
  652. else do
  653.    bkfile=left(outname,iii)||'bak'
  654. end /* do */
  655.  
  656. say "Backing up old version to: "bkfile
  657. yow=sysfiledelete(bkfile)
  658. buzz=charin(outname,1,stream(outname,'c','query size'))
  659. foo=charout(bkfile,buzz,1)
  660. foo=stream(bkfile,'c','close')
  661. foo=stream(outname,'c','close')
  662. foo=sysfiledelete(outname)
  663. if foo<>0 then do
  664.    say 'Problem ('foo') could not delete old version of ' outname 
  665.    exit
  666. end /* do */
  667.  
  668.  
  669. dds.0="Regular" ;dds.1="Structured"
  670. say " Saving Changes to "dds.newtype " DCT file = " outname
  671.  
  672. if newtype=1 then do
  673.    foo=build_desc_cache(outname,dctindx.!message,1)
  674.    if foo=1 then 
  675.       say "Description cache file "outname " successfully written."
  676.    else
  677.       say  " Problem writing description cache file "outname 
  678. end
  679. else do                 /* regulare */
  680.   allf=''
  681.   do ii=1 to desc.0
  682.      aa=desc.ii.!sumtype||div||desc.ii||div||desc.ii.!title||div||desc.ii.!size|| , 
  683.         div||desc.ii.!summary
  684.      allf=allf||aa
  685.      if ii<>desc.0 then allf=allf||div2
  686.   end /* do */
  687.   fo=stream(outname,'c','close')
  688.   sike=charout(outname,allf,1)
  689.   if sike<>0 then 
  690.       say "Problem: "sike". Could not write new version of "outname
  691.   else
  692.       say "Description cache file "outname " successfully written."
  693. end /* do */
  694.  
  695. exit                            /******* END OF EDITIT *******/
  696.  
  697.  
  698.  
  699.  
  700.  
  701. getda:
  702.  
  703. say " Enter several lines of text, a blank lines signals end "
  704. poo=""
  705. do forever
  706.    call charout ," ? "
  707.       parse pull astuff
  708.    if astuff="" then leave
  709.    if poo='' then
  710.       poo=astuff
  711.    else
  712.       poo=poo||crlf||astuff
  713. end
  714. return poo
  715.  
  716.  
  717. fixda:procedure expose crlf
  718. parse arg dathing
  719.  
  720. dathing=space(translate(dathing,' ','090a0d001a'x))
  721. aa="" ; ict=0
  722. mxsize=75
  723. mxsize=mxsize-5
  724. do mm=1 to words(dathing)
  725.   aw=word(dathing,mm)
  726.   if ict+length(aw)>mxsize then do
  727.      aa=aa||crlf
  728.      ict=0
  729.    end
  730.    aa=aa||' '||aw
  731.    ict=ict+length(aw)+1
  732. end
  733. return aa
  734.  
  735. /* -------------------- */
  736. /* choose between 3 alternatives (by default,a yes or no ), 
  737. return 1 if yes (or the first alternative in the altans list) */
  738. yesno:procedure expose normal reverse bold
  739. parse arg amessage , altans
  740. if altans<>"" then do
  741.    w1=strip(word(altans,1))
  742.    w2=strip(word(altans,2))
  743.    if words(altans)>2 then w3=strip(word(altans,3))
  744.    a1=left(w1,1) ; a2=left(w2,1) ; a3=left(w3,1)
  745.    a1a=substr(w1,2) ; a2a=substr(w2,2) ; a3a=substr(w3,2)
  746.    aynn='  '||bold||a1||normal||a1a||'\'||bold||a2||normal||a2a
  747.    if words(altans)>2 then aynn=aynn'\'||bold||a3||normal||a3a
  748. end
  749. else do
  750.     a2='Y' ; a2a='es'
  751.     a1='N' ; a1a='o'
  752.     aynn='  '||bold||a1||normal||a1a||'\'||bold||a2||normal||a2a
  753. end  /* Do */
  754.  
  755. do forever
  756.  foo1=normal||reverse||amessage||normal||aynn||' 'normal
  757.  call charout,foo1
  758.  anans=translate(sysgetkey('echo'))
  759.  if abbrev(anans,a1)=1 then do
  760.     say
  761.     return 0
  762.  end
  763.  if abbrev(anans,a2)=1 then do
  764.     say
  765.     return 1
  766.  end
  767.  if abbrev(anans,a3)=1 then do
  768.      say
  769.      return 2
  770.  end
  771.  call charout,'0d'x
  772. end
  773.  
  774.  
  775. /*********/
  776. /* show stuff in queue as a list */
  777. show_dir_queue:procedure expose qlist.
  778. parse arg lookfor
  779.   nq=queued()
  780.   ibs=0 ; mxlen=0
  781.   do ii=1 to nq
  782.      pull aa
  783.      if pos(lookfor,aa)=0 & lookfor<>'*' then iterate
  784.        ibs=ibs+1
  785.        blist.ibs=aa
  786.        mxlen=max(length(aa),mxlen)
  787.     end /* do */
  788. arf=""
  789. do il=1 to ibs
  790.    anam=blist.il
  791.    arf=arf||left(anam,mxlen+2)
  792.    if length(arf)+mxlen+2>75  then do
  793.         say arf
  794.         arf=""
  795.    end /* do */
  796. end /* do */
  797. if length(arf)>1 then say arf
  798. say
  799. return 1
  800.  
  801.  
  802.  
  803.  
  804. /*********************************************************/
  805. /* read swish file, create a file list (uses reprules found in con file */
  806. get_swifile:
  807.  
  808. nfiles=get_swish_filelist(daindx)
  809. if nfiles<1 then do
  810.    foo=is_error("Error: not a swish index file: "nfiles)
  811.    return 0
  812. end
  813.  
  814. /* convert url style names back to original files */
  815. do nf=1 to nfiles
  816.    afil=filelist.nf.!original
  817.    do il=1 to reprules.0        /* convert to fully qualified names */
  818.        if abbrev(afil,reprules.il.!new)=1 then do
  819.              aa=reprules.il.!original
  820.              bb=substr(afil,1+length(reprules.il.!new))
  821.              aa=aa||bb
  822.              leave
  823.        end  /* Do */
  824.    end /* do */
  825.    filelist.nf=translate(aa,'\','/')
  826. end /* do */
  827. return nfiles
  828.  
  829.  
  830. /***********************/
  831. /* read entry names (files, or replacerule'd files, from a 1.3 swish index.  
  832. Call as
  833.  nfiles=get_swish_filelist(swish_index_file)
  834. where
  835.  nfiles: # of files or an error code
  836. and
  837.  filelist. is an "expose" stem containing these entries (in "reverse" order),
  838.  with tails
  839.    n.!original -- the entry name in the index
  840.    n.!title    -- it's title
  841.    n.!size     -- it's size
  842. and with 
  843.   filelist.0=nfiles (assuming no error, else filelist.0=0)
  844.  
  845. The error codes are:
  846.  -1  -- could not file swish_index_file
  847.  -2  -- is not a swish_index_file (first line does not look like "# SWISH format 1.3" 
  848.  -3  -- could not find file count in swish_index_file
  849.  -4  -- could not open swish_index_file
  850.  -5  -- not a proper 1.3 or 1.2 index file (did not end in a '0a'x)
  851.  -6  -- file does not contain nfile entries 
  852.  -7  -- file contains nfiles-1 entries, but could not find nfile'th entry
  853.  -8  -- it's a swish index, but not a 1.1, 1.2 or a 1.3 swish index
  854.  -9  -- same as -8
  855. */
  856.  
  857. get_swish_filelist:procedure expose filelist.
  858. parse arg filename
  859. cr='0a'x
  860. filelist.0=0
  861. filelen=stream(filename,'c','query size')
  862. if filelen=0 | filelen='' then return -1
  863. aa=stream(filename,'c','open read')
  864. if translate(aa)<>'READY:' then return '-4 '
  865.  
  866. chunk=charin(filename,1,min(filelen,1000))
  867.  
  868. parse var chunk  aline (cr) chunk
  869.  
  870. parse upper var aline a1 a2 a3 verswi dpg 
  871. verswi=strip(verswi)
  872. if strip(a2)<>'SWISH' | strip(a3)<>'FORMAT' then return -2  /* not a swish file,give up*/
  873. nfiles=0
  874. do mm=1 to 100       /* read lines until you find # Counts: 6193 words, 100 files */
  875.    parse var chunk aline (cr) chunk
  876.    parse upper var aline . a1 . ',' a2 .
  877.    if a1="COUNTS:" then do
  878.         nfiles=a2
  879.         leave
  880.    end /* do */
  881. end /* do */
  882. if nfiles=0 then return -3  
  883.  
  884. say "SWISH ver "verswi " file " filename " has " nfiles " entries "
  885.  
  886. if verswi=1.1 then signal is11
  887. if verswi=1.2 then signal is12
  888.  
  889. if wordpos(verswi,'1.2 1.3')=0 then return -9
  890.  
  891. /* try this sized chunk, up it if not big enough */
  892. perfile=220  
  893.  
  894.  
  895. tryagain:               /* jump here to try again */
  896. nget=perfile*nfiles
  897.  
  898. ifrom=max(1,1+filelen-nget)             /* get chunk starting here */
  899. chunk=charin(filename,ifrom,nget)
  900. if right(chunk,1)<>'0a'x then return  -5  /* 1.3 always ends in '0a'x */
  901. nget2=length(chunk)
  902.  
  903. ii=lastpos('0a'x,chunk,nget2-1)    /* get beyoud property names */
  904. ii2=lastpos('0a'x,chunk,ii-1)     /* and some other number stuff */
  905. /* now scan back in chunk, parsing on '0000'x (which seems to signal "end of entry" */
  906. do jj=1 to nfiles-1
  907.    ii2=lastpos('0000'x,chunk,ii2-1)
  908.    if ii2=0 then do                     /* perhaps didn't get enough info ? */
  909.         if ifrom=1 then return -6      /* can't get more? give up */
  910.         perfile=perfile*2               /* so get a bigger chunk this time */
  911.         leave
  912.    end /* do */
  913.    kj=pos('0a'x,chunk,ii2+1)
  914.    baa=substr(chunk,ii2,kj-ii2)
  915.    baa=strip(translate(baa,' ','00090d0a'x))
  916.    parse var baa aa  '"' atitle '"' asize .
  917.    filelist.jj.!original=translate(strip(aa))
  918.    filelist.jj.!title=atitle
  919.    filelist.jj.!size=asize
  920. end /* do */
  921. if ii2=0 then signal tryagain   /* rexx can be buggy when signaling from a do loop */
  922.  
  923. /* last one is tricky -- can't search for 0000 */
  924. do forever                      /* exit via a return or a signal */
  925.    ii2=lastpos('0a'x,chunk,ii2-2)
  926.    if ii2=0 then do                     /* perhaps didn't get enough info ? */
  927.         if ifrom=1 then return -7      /* can't get more? give up */
  928.         perfile=perfile*2               /* so get a bigger chunk this time */
  929.         leave
  930.    end /* do */
  931.    isa=c2d(substr(chunk,ii2+1,1))
  932.    if isa>31 then do 
  933.        kj=pos('0a'x,chunk,ii2+1)
  934.        baa=substr(chunk,ii2,kj-ii2)
  935.        baa=strip(translate(baa,' ','00090d0a'x))
  936.        parse var baa aa  '"' atitle '"' asize .
  937.        filelist.nfiles.!original=translate(strip(aa))
  938.        filelist.nfiles.!title=atitle
  939.        filelist.nfiles.!size=asize
  940.        filelist.0=nfiles
  941.        return nfiles
  942.    end
  943. end /* do */
  944. signal tryagain                 /* only way to get here is by ii2=0 */
  945.  
  946.  
  947. /* ----------------------- */
  948. is11:           /* jump here if 1.1 format */
  949. /* count lines in the file */
  950. call linein filename,1,0
  951. ndo=0
  952. do until lines(filename)=0
  953.    foo=linein(filename)
  954.    ndo=ndo+1
  955. end /* do */
  956. /* now get the lines ndo-nfiles to ndo-1 */
  957. call linein filename,1,0
  958. i1=1
  959. do ij=1 to ndo-(i1+nfiles)
  960.    foo=linein(filename)
  961. end /* do */
  962.  
  963. do nf=1 to nfiles         /* extract the filenames */
  964.    baa=linein(filename)
  965.    baa=strip(translate(baa,' ','00090d0a'x))
  966.    parse var baa aa  '"' atitle '"' asize .
  967.    afil=translate(strip(word(aa,1)))
  968.    filelist.nf.!original=afil
  969.    filelist.nf.!title=atitle
  970.    filelist.nf.!size=asize
  971. end /* do */
  972. filelist.0=nfiles
  973. return nfiles
  974.  
  975.  
  976. /* ----------------------- */
  977. is12:           /* jump here if 1.2 format */
  978. /* count lines in the file */
  979. call linein filename,1,0
  980. ndo=0
  981. do until lines(filename)=0
  982.    foo=linein(filename)
  983.    ndo=ndo+1
  984. end /* do */
  985. /* now get the lines ndo-nfiles to ndo-1 */
  986. call linein filename,1,0
  987. i1=1
  988. do ij=1 to (ndo-1)-(i1+nfiles)
  989.    foo=linein(filename)
  990. end /* do */
  991.  
  992. do nf=1 to nfiles         /* extract the filenames */
  993.    baa=linein(filename)
  994.    baa=strip(translate(baa,' ','00090d0a'x))
  995.    parse var baa aa  '"' atitle '"' asize .
  996.    afil=translate(strip(word(aa,1)))
  997.    filelist.nf.!original=afil
  998.    filelist.nf.!title=atitle
  999.    filelist.nf.!size=asize
  1000. end /* do */
  1001. filelist.0=nfiles
  1002. return nfiles
  1003.  
  1004.  
  1005.  
  1006. /***************/
  1007. /* ------------------------------------- */
  1008. /* create summary info: from explicit description in fdescribe (DESCRIBE.TXT)
  1009.    or by parsing contents of file
  1010. afilename: fully qualified filename to investigate
  1011. atype: 1- html, 2-non-html text, 0-non text (of file)
  1012. asummary: 1- pre-existent only (in describe.txt), 
  1013.           2-create if necessary
  1014.  
  1015. returns a text or html summary, or a numeric code:
  1016. 1= File not available
  1017. 2= Summary not available
  1018. 3= Explicit summary not available
  1019. 4= Error in routine -- no summary available
  1020.  
  1021. yaman is also returned:
  1022.  0-no description, 1=created, 2=explicit (from describe.txt, or <META> ) 
  1023.  
  1024. */
  1025.  
  1026. make_summary:procedure  expose yaman atitle asize fdescribe latestd. comment_flag continuation_flag  swish_version
  1027.  
  1028. parse arg afilename,atype,asummary
  1029.  
  1030. gmess.1=' File not available'
  1031. gmess.2=' Summary not available'
  1032. gmess.3=' Summary  not available'
  1033. gmess.4=' No summary available'
  1034.  
  1035.  
  1036. yaman=0
  1037. eek=stream(afilename,'c','query exists')   /* check for existence*/
  1038.  
  1039. if eek="" then return gmess.4            /* error */
  1040.  
  1041. /* check in directory-specific description file (I.E.; describe.txt) */
  1042. if fdescribe<>" " then do
  1043.  checkd=filespec('d',afilename)||filespec('p',afilename)
  1044.  checkd=translate(checkd,'\','/')
  1045.  checkd=strip(checkd,'t,','\')||'\'
  1046.  if checkd<> latestd.!dir then do 
  1047.     call make_desc(checkd)      /* saves latestd.filename=a summary */
  1048.     latestd.!dir=checkd
  1049.  end
  1050.  
  1051.  fnm=strip(translate(filespec('n',afilename)))   /* check the descriptions, and return match if found */
  1052.  if latestd.fnm<>'' then do              /* got a match, use it */
  1053.      yaman=2
  1054.      return latestd.fnm
  1055.  end /* do */
  1056. end             /* check description file */
  1057.  
  1058.  
  1059. /* no directory-specific summary -- perhaps create summary from file contents ? */
  1060. select
  1061.   when atype=0 | asummary<2 then    /* not text, or not "create description */
  1062.       return gmess.2
  1063.  
  1064.   when atype=2 then do   /* non-html text, create mode */
  1065.        alen=min(chars(afilename),300)
  1066.        stuff=charin(afilename,1,alen)
  1067.        fpp=stream(afilename,'c','close')
  1068.        yaman=1
  1069.        wow=replacestrg(wow,'&','&','ALL')
  1070.        wow=replacestrg(stuff,'<','<','ALL')
  1071.        wow=replacestrg(wow,'>','>','ALL')
  1072.        wow=replacestrg(wow,'"','"','ALL')
  1073.        return wow
  1074.   end
  1075.  
  1076.   when atype=1 then do                  /* html text, create mode */
  1077.      alen=min(chars(afilename),10000)
  1078.      stuff=charin(afilename,1,alen)
  1079.      fpp=stream(afilename,'c','close')
  1080.      stuff=space(translate(stuff,' ','00090a0d1a1b'x))
  1081.      wow=look_header(afilename)
  1082.      if wow<>0 then do
  1083.          yaman=2
  1084.         return wow
  1085.      end  /* Do */
  1086.  
  1087.     if wow=0 & asummary<>2 then 
  1088.        return gmess.4
  1089.  
  1090.     WOW=LOOK_HTAG()                     /* use <Hn> for summary */
  1091.     if wow<>0 then do 
  1092.        yaman=1
  1093.        return wow
  1094.     end  /* Do */
  1095.     return gmess.3
  1096.   end
  1097.  
  1098.   otherwise do
  1099.      say " ERROR: should not be here in make summary "
  1100.      return gmess.4
  1101.   end
  1102. end
  1103.  
  1104.  
  1105. /******************/
  1106. /* read a description file with possible continuation lines */
  1107. make_desc:procedure expose comment_Flag continuation_flag latestd.  fdescribe  
  1108. parse arg checkd
  1109.  
  1110. latestd.=''
  1111. foo2=checkd||fdescribe
  1112. if stream(foo2,'c','query exists')="" then do /*no such file */
  1113.   checkd.0=0
  1114.   return 0
  1115. end /* do */
  1116.  
  1117. aname='';build1=''
  1118. do forever
  1119.     if lines(foo2)=0 then leave
  1120.     if abbrev(strip(alin),comment_flag) then iterate  /* comments */
  1121.     alin=strip(linein(foo2))
  1122.     if abbrev(alin,continuation_flag)=1 then do  /* continuations */
  1123.          build1=build1||substr(alin,length(continuation_flag)+1)
  1124.          iterate
  1125.     end                         /* else, got a file name. So write prior entry */
  1126.     if aname<>'' then do
  1127.       fnm=strip(translate(filespec('n',aname)))   /* check the descriptions, and return match if found */
  1128.       latestd.fnm=build1
  1129.     end
  1130.     parse var alin aname build1
  1131. end /* do */
  1132. if aname<>'' then do
  1133.       fnm=strip(translate(filespec('n',aname)))   /* check the descriptions, and return match if found */
  1134.       latestd.fnm=build1
  1135. end
  1136.  
  1137. xx=stream(foo2,'c','close')
  1138. return igoo
  1139.  
  1140.  
  1141.  
  1142.  
  1143. /* ----------------------------------------------------------------------- */
  1144. /* Look for "desc" field in header     */
  1145. /* ----------------------------------------------------------------------- */
  1146.  
  1147. look_header: procedure expose stuff url_title  
  1148. parse arg afile
  1149. dowrite=0
  1150. do until stuff=""
  1151.  
  1152.     parse var stuff  p1 '<' tag '>' stuff
  1153.     if  translate(word(tag,1))="HEAD" then do   /* now in head !*/
  1154.             dowrite=1
  1155.             iterate
  1156.     end
  1157.     if dowrite=0 then iterate    /* wait till we get into head .. */
  1158.  
  1159.     if  translate(word(tag,1))="/HEAD" then  /* out of head, all done ! */
  1160.         leave
  1161.  
  1162. /* IT IS A TITLE TAG?  */
  1163.      if translate(word(tag,1))="TITLE" then do
  1164.         parse var stuff url_title '<' footag '>' stuff
  1165.      end
  1166.  
  1167. /* is it a  META HTTP-EQUIV or a META NAME ? */
  1168.     if translate(word(tag,1))="META" then do
  1169.         parse var tag ameta atype '=' rest
  1170.         tatype=translate(atype)
  1171.         if tatype="HTTP-EQUIV" | tatype="NAME" then do
  1172.            parse var rest aval1 rest
  1173.            REST=STRIP(REST)
  1174.  
  1175.            aval1=strip(aval1) ;
  1176.            aval1=strip(aval1,,'"')
  1177.            if abbrev(translate(aval1),'DESC')<>1 then iterate
  1178.  
  1179.            aval2=" "
  1180.            foo1=ABBREV(translate(rest),'CONTENT')
  1181.            if foo1>0 then do
  1182.                 PARSE VAR REST FOO '=' AVAL2
  1183.                 aval2=strip(aval2)
  1184.                 aval2=strip(aval2,'b','"')
  1185.                 WOW=LEFT(AVAL2,500)
  1186.                 return WOW
  1187.            end
  1188.         end             /* name or http-equiv */
  1189.     end         /* meta */
  1190. end             /* stuff */
  1191.  
  1192.  
  1193. return 0
  1194.  
  1195.  
  1196. /* ----------------------------------------------------------------------- */
  1197. /* Extract <hn> fields     */
  1198. /* ----------------------------------------------------------------------- */
  1199.  
  1200. look_htag: procedure expose stuff filename  
  1201.  
  1202. stuff0=left(stuff,1000)
  1203.  
  1204. amessage=""
  1205. dowrite=0
  1206. do until stuff=""
  1207.     parse var stuff  p1 '<' tag '>' stuff
  1208.     ttag=translate(word(tag,1))
  1209.     if wordpos(ttag,' H1 H2 H3 H4 TITLE')>0 THEN DO   /* grab stuff */
  1210.         parse var stuff  amess '<' tag2 '>' stuff
  1211.         amessage=amessage||amess||'<b> | </b>'
  1212.     end
  1213. end
  1214.  
  1215. if amessage="" then do  /* getting desperate -- grab any old words! */
  1216.    do until stuff0=""
  1217.       parse var stuff0 p1 '<' tag '>' stuff0
  1218.       amessage=amessage||' '||p1
  1219.    end
  1220. end
  1221.  
  1222. if amessage="" then
  1223.    return 0
  1224. amessage=left(amessage,300)  /* keep it short */
  1225. return amessage
  1226.  
  1227.  
  1228.  
  1229.  
  1230. /***************************************************/
  1231. /* build a "description-cache index"
  1232. Call as:
  1233.   status=build_desc_cache(outname,swifile)
  1234. where
  1235.   outname: .dct file to create
  1236.   swifile : index file built from
  1237. and
  1238.   status = 1 : success, 0=failure
  1239.  
  1240. And where the DESC. variable is used (via an expose)
  1241. DESC. should be structured as:
  1242.   desc.0  : # of records
  1243.   desc.i   : the identifier (as stored in the swish index file)
  1244.   desc.i.!sumtype :  0= none, 
  1245.                  1= generated
  1246.                  2= derived from directory-specific description file
  1247.   desc.i.!title  : the title (as stored in the swish index file)
  1248.   desc.i.!size   : the size (as stored in the swish index file)
  1249.   desc.i.!summary : the summary. Might be "No Summary Available "
  1250. */
  1251. build_desc_cache:procedure expose desc.
  1252. parse arg outname,amessage,verbose
  1253.  
  1254. /* 
  1255. The structure is:
  1256.   idstring : identifies the file type, starts with a #GOSWISH and ends with a crlf
  1257.                  Example: #GOSWISH 1.4  This is descriptive summaries for foo.swi 
  1258.              The idstring must be less then 500 characters.
  1259.  parameters: A space delimited list of parameters:
  1260.               NRECS:   # of records,
  1261.               IDBYTES:  # of bytes used to score record id digests,
  1262.               OFFBYTES:  # of bytes used to store offset in body-of-records, and
  1263.               BODYAT:  # offset to first byte of body-of-records
  1264.    indx: list of record-id digests and offsets.
  1265.  body-of-records:  the various records; with fields seperated by '05'x character
  1266.  Terminator: a string consisting of crlf"END."  (useful for checking integrity)
  1267. */
  1268.  
  1269. idstring="#GOSWISH 1.4 : "||strip(amessage)||'0d0a'x
  1270.  
  1271.  
  1272. /* create a list of  digests of each entry name */
  1273. do mm=1 to desc.0
  1274.   if (mm//1000)=1 then say "Generating digest for # "mm
  1275.    md5s.mm=rexx_md0(desc.mm)
  1276. end /* do */
  1277. /* check for 4 char, 8 char and 16 char uniqueness. If all
  1278. these fail, all 32 characters (16 bytes) */
  1279. iuse=2
  1280. do iss=2 to 16 by 2
  1281.   iuse=iss*2           /*4,6,8,..,16 */
  1282.   drop tlist.
  1283.   drop idlist.
  1284.   tlist.=0
  1285.   iok=1                 /* assume okay */
  1286.   do mm=1 to desc.0
  1287.     a1=left(md5s.mm,iuse)    /* left most iuse characters of digest*/
  1288.     if tlist.a1<>0 then do        /* is this "id" already used? */
  1289.        jj=tlist.a1
  1290.        if desc.jj<>desc.mm then do
  1291.           igg2=iuse/2
  1292.           say ' repeated 'igg2 ' character id = #'a1' 'mm' 'tlist.a1
  1293.           iok=0                    /* yep, leave and try larger set of character */
  1294.           leave
  1295.        end
  1296.     end /* do */
  1297.     tlist.a1=mm                   /* mark this id as used */
  1298.     idlist.mm=a1                /* save for later use */
  1299.   end /* do */
  1300.   if iok=1 then leave           /* this size works */
  1301. end /* do */
  1302. idbytes=iuse/2           /* # hex chars /2 = # of bytes */
  1303.  
  1304. say "Using key length of " idbytes
  1305. /* Build the string of contents. An entry at a time.
  1306.    Each entry has fields seperated by '05'x.
  1307.    Each entry starts with a 2 byte size code (hence max entry size is 60k), where
  1308.    the size includes seperators but NOT the two byte size code
  1309.    Iats.ii points to the start of the entry (to first byte of the 2 byte size code)
  1310. */
  1311. div5='05'x
  1312. body_of_records=''
  1313. do ii=1 to desc.0  
  1314.    if (ii//1000)=1 then say "...examining entry # " ii
  1315.    blk0=desc.ii.!sumtype||div5||desc.ii||div5||desc.ii.!title||div5||desc.ii.!size
  1316.    c2=translate(desc.ii.!summary,' ','0001020304050607'x)  /* convert some stuff to ' '*/
  1317.    blk0=blk0||div5||c2||div5
  1318.    il=length(blk0)
  1319.    if il>99999 then  do
  1320.       blk0=left(blk0,99999)  /* should never happen, but ... */
  1321.       il=99999
  1322.    end
  1323.    ilc=left(il,5,' ')
  1324.    blk0=ilc||div5||blk0
  1325.    iats.ii=length(body_of_records)+1
  1326.    body_of_records=body_of_records||blk0   
  1327. end
  1328.  
  1329.  
  1330. /* Create offset to the entries contained in body_of_records (use iats.)
  1331.   But first-- how many bytes needed for this offset value? */
  1332.  
  1333. select
  1334.    when length(body_of_records)<64000 then offbytes=2
  1335.    when length(body_of_records)<16000000 then offbytes=3
  1336.    otherwise offbytes=4
  1337. end
  1338.  
  1339. parameters=desc.0' 'idbytes' 'offbytes' '
  1340.  
  1341.  
  1342. /* build the index to bigblock: desc.0 items with each item consisting of
  1343.    an id (with a length of idbytes bytes) and an offset (with a length of offbytes bytes)
  1344. */
  1345.  
  1346. indx=''
  1347. jpt=offbytes*2
  1348. do mm=1 to desc.0
  1349.    ida=x2c(strip(idlist.mm))
  1350.    apt= right(d2x(iats.mm),jpt,0)  
  1351.    apt=x2c(apt)
  1352.    indx=indx||ida||apt    
  1353. end /* do */
  1354. indx=indx||'ENDINDEX'||'0d0a'x
  1355. /* we now have id string,  index, and body of entries.
  1356.    Compute total length of idstring + parameters + index + 10 -- add this value
  1357.    to parameters (in a 8 character integer + crlf) */
  1358.  
  1359. isize=length(idstring)+length(parameters)+10+length(indx)+1
  1360. parameters=parameters||right(isize,8,' ')||'0d0a'x
  1361.  
  1362. /*
  1363.    Put 'em together and write'em out */
  1364. bigblock=idstring||parameters||indx||body_of_records||'0d0a'x||'END.'
  1365.  
  1366. ff=sysfiledelete(outname)
  1367. sike=charout(outname,bigblock,1)
  1368. if sike<>0 then return 0
  1369. sike=stream(outname,'c','close')
  1370. return 1
  1371.  
  1372.  
  1373. /****************************************/
  1374. /* return a record, given a string (as pulled from swish index) 
  1375.   Requires dctindx. file (as reated by load_desc_cache) to be expose
  1376.  
  1377. Call as:
  1378.    arecord=read_desc_record(lookfor)
  1379. where
  1380.   lookfor : string to look for (should be one of the identifiers in the swish index file)
  1381. and
  1382.   arecord  :the record corresponding to lookfor, or a blank if no such record
  1383.  
  1384. Arecord can be parsed using
  1385. div='05'x
  1386. parse var arecord summary_type  (div) title (div) size (div) description
  1387. where summary_type: 0= none, 
  1388.                     1= generated,
  1389.                     2= derived from directory-specific description file
  1390.                     3= hand entered (i.e.; edit mode 
  1391. */
  1392.  
  1393. read_desc_record:procedure expose dctindx.
  1394.  
  1395. parse arg lookfor
  1396. div='05'x
  1397.  
  1398. md5=rexx_md0(strip(lookfor))
  1399. rr=left(x2c(md5),dctindx.!keylen)
  1400.  
  1401. thisoff=dctindx.rr
  1402. if thisoff=0 then return ""
  1403.  
  1404. off2=thisoff+dctindx.!offset
  1405. reclen=strip(charin(dctindx.!file,off2,5))
  1406.  
  1407. arec=charin(dctindx.!file,off2,reclen+6)
  1408.  
  1409. parse var arec dlen (div) summary_type (div) thename (div) thetitle (div) ,
  1410.                      thesize (div) thesummary (div) .
  1411.  
  1412. return  summary_type||div||thetitle||div||thesize||div||thesummary
  1413.  
  1414.  
  1415. /****************************************/
  1416. /* load the index, and other info, from a decription-cache file 
  1417.  
  1418. Call as:
  1419.    status=load_desc_cache(dctfile)
  1420. where
  1421.   dctfile : the name of the description cache file
  1422. and
  1423.   status is 1 for okay, or a negative valued error code
  1424.   error codes are:
  1425.      -1 = "Not a GoSWISH descriptive-summaries cache file"
  1426.      -2 = "File corrupted (problem with terminiator) "
  1427.      -3  = Corrupted GoSWISH description-cache file (improper termination of index): "
  1428. And where
  1429.   dctindx.  is set (it's exposed). Note that dctindx. will be intialized.
  1430. DCTINDX. is structured as:
  1431.   DCTINDX.0 = # records
  1432.   DCTINDX.!KEYLEN  : size (in bytes) of the "tails"
  1433.   DCTINDX.!OFFSET : start (in dctfile) of first record
  1434.   DCTINDX.!FILE   : name of file this is derived from
  1435.   DCTINDX.!MESSAGE : message stored with file
  1436.   DCTINDX.atail=offset   
  1437. where atail is the DCTINDX.!KEYLEN length (in bytes) x2c  hash of what you want to lookup
  1438.       offset is the offset (after DCTINDX.!OFFSET, of the start of this record.
  1439.  
  1440. ******/
  1441. load_desc_cache:procedure expose dctindx.
  1442. parse arg dctfile
  1443.  
  1444. drop dctindx.
  1445. dctindx.=0
  1446.  
  1447. fsize=stream(dctfile,'c','query size')
  1448. abegin=charin(dctfile,1,min(600,fsize))
  1449. parse var abegin agoswish iver ':' amess '0d0a'x abegin
  1450. if strip(translate(agoswish))<>'#GOSWISH' then   return -1
  1451.  
  1452. aend=charin(dctfile,fsize-3,4)
  1453. if aend<>'END.' then  return -2
  1454.  
  1455.  
  1456. parse var abegin nrecs idbytes offbytes bodyat '0d0a'x .
  1457.  
  1458. dctindx.!message=amess
  1459. dctindx.0=nrecs
  1460. dctindx.!keylen=idbytes
  1461. dctindx.!offset=bodyat-1
  1462. dctindx.!file=dctfile
  1463. /* get the index */
  1464. iget=((idbytes+offbytes)*nrecs)
  1465. goof=charin(dctfile,1,iget+600)
  1466. parse var goof . '0d0a'x . '0d0a'x goof
  1467. goof=left(goof,iget+8)
  1468. if right(goof,8)<>'ENDINDEX' then return -3
  1469.  
  1470. do ii=1 to nrecs
  1471.    igg=((ii-1)*(idbytes+offbytes))+1
  1472.    atail=substr(goof,igg,idbytes)
  1473.    dctindx.atail=c2d(substr(goof,igg+idbytes,offbytes) )
  1474. end /* do */
  1475.  
  1476. return 1
  1477.  
  1478.  
  1479.  
  1480. /* ------------- */
  1481. /* ----------------------------------------------------------------------- */
  1482. /* REPLACESTRG: In string astring, find first occurence substring target and
  1483. .   replace it with substring putme
  1484. .      if no target, return unchanged astring
  1485. .      if no putme, then remove target
  1486. .      if type=backward, then find/change LAST occurence
  1487. .      if type=all, find/change all occurences
  1488. .      if exactmatch=yes, then do not capitalize during search (exact match only */
  1489. /* ----------------------------------------------------------------------- */
  1490.  
  1491. replacestrg: procedure
  1492.  
  1493. exactmatch=0
  1494. backward=0 ; doall=0
  1495.  
  1496. parse arg astring ,  target   , putme , type , exactmatch
  1497.  
  1498. type = translate(type)
  1499. if type="BACKWARD" then backward="YES"
  1500. if type="ALL" then doall="YES"
  1501.  
  1502. iat=1
  1503. joelen=length(target)
  1504. joelen2=length(putme)
  1505.  
  1506. doagain:                /* here if doall=yes */
  1507.  if exactmatch="YES" then do
  1508.     if   backward="YES" then
  1509.         joe= lastpos(target,astring)
  1510.     else
  1511.         joe= pos(target,astring,iat)
  1512.  end
  1513.  else do
  1514.    if   backward="YES" then
  1515.         joe= lastpos(translate(target),translate(astring))
  1516.     else
  1517.         joe= pos(translate(target),translate(astring),iat)
  1518.  end
  1519.  if joe=0 then
  1520.          return astring
  1521.  
  1522.  astring=delstr(astring,joe,joelen)
  1523.  if putme<>' ' then
  1524.     astring=insert(putme,astring,joe-1)
  1525.  
  1526.  if doall="YES" then do
  1527.      iat=joe+joelen2
  1528.      signal doagain
  1529.  end
  1530. /* else, all done */
  1531.  return astring
  1532.  
  1533.  
  1534. /*******************************************/
  1535. /* some initializations */
  1536. initit:     
  1537. /*---- load the rexxutil library */
  1538. foo=rxfuncquery('sysloadfuncs')
  1539. if foo=1 then do
  1540.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  1541.   call SysLoadFuncs
  1542. end
  1543.  
  1544.  
  1545. ansion=checkansi()
  1546. if ansion=1 then do
  1547.   aesc='1B'x
  1548.   cy_ye=aesc||'[37;46;m'
  1549.   normal=aesc||'[0;m'
  1550.   bold=aesc||'[1;m'
  1551.   re_wh=aesc||'[31;47;m'
  1552.   reverse=aesc||'[7;m'
  1553. end
  1554. else do
  1555.   say " Warning: Could not detect ANSI....  everything will look ugly ! "
  1556.   cy_ye="" ; normal="" ; bold="" ;re_wh="" ;
  1557.   reverse=""
  1558. end  /* Do */
  1559.  
  1560. return 0
  1561.  
  1562.  
  1563.  /* ------------------------------------------------------------------ */
  1564.  /* function: Check if ANSI is activated                               */
  1565.  /*                                                                    */
  1566.  /* call:     CheckAnsi                                                */
  1567.  /*                                                                    */
  1568.  /* where:    -                                                        */
  1569.  /*                                                                    */
  1570.  /* returns:  1 - ANSI support detected                                */
  1571.  /*           0 - no ANSI support available                            */
  1572.  /*          -1 - error detecting ansi                                 */
  1573.  /*                                                                    */
  1574.  /* note:     Tested with the German and the US version of OS/2 3.0    */
  1575.  /*                                                                    */
  1576.  /*                                                                    */
  1577.  CheckAnsi: PROCEDURE
  1578.    thisRC = -1
  1579.  
  1580.    trace off
  1581.                          /* install a local error handler              */
  1582.    SIGNAL ON ERROR Name InitAnsiEnd
  1583.  
  1584.    "@ANSI 2>NUL | rxqueue 2>NUL"
  1585.  
  1586.    thisRC = 0
  1587.  
  1588.    do while queued() <> 0
  1589.      queueLine = lineIN( "QUEUE:" )
  1590.      if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
  1591.         pos( " (ON).", queueLine ) <> 0 then                    /* GER */
  1592.        thisRC = 1
  1593.    end /* do while queued() <> 0 */
  1594.  
  1595.  InitAnsiEnd:
  1596.  signal off error
  1597.  RETURN thisRC
  1598.  
  1599.  
  1600. /**********/
  1601. /* bogus strigin procedure */
  1602. stringin2:procedure expose bold normal desc.
  1603. parse arg         amess,iff
  1604. parse var amess . '//' . '/' showmess
  1605. if length(showmess)>35 then showmess='..'||right(showmess(32)
  1606. afoo: call charout,bold showmess': 'normal 
  1607. a=sysgetkey('noecho')
  1608. ia=c2d(a)
  1609. iu=''
  1610. if ia=0 then do
  1611.    a=sysgetkey('noecho')
  1612.    ia=c2d(a)
  1613.    if ia=80 then iu=iff+1
  1614.    if ia=72 then iu= iff-1
  1615.    if ia=73 then iu=iff-10
  1616.    if ia=81 then iu=iff+10
  1617.    if iu<>'' then do
  1618.       say
  1619.       return max(min(iu,desc.0),1)
  1620.    end
  1621.    call charout,'0d'x
  1622.    signal afoo
  1623. end /* do */
  1624. if a='?' | a='@' then return a
  1625. if ia=26 | ia=27 | ia=32 then do
  1626.   return a
  1627. end
  1628. if a=',' | a='<' then do
  1629.  say
  1630.  return '<'
  1631. end
  1632. if ia=10 | ia=13 then do
  1633.    say
  1634.    return ''
  1635. end /* do */
  1636. call charout,a
  1637. pull a2
  1638. return a||a2
  1639.  
  1640. /************/
  1641. /* read file into ffread stem var */
  1642. afileread:procedure expose clines.
  1643. parse arg hfile
  1644. crlf='0d0a'x
  1645. if stream(hfile,'c','query exists')="" then return 0
  1646. tmp=strip(charin(hfile,1,chars(hfile)),'t','1a'x)
  1647. tt=stream(hfile,'c','close')
  1648. itmp=0
  1649. do until tmp=""
  1650.    itmp=itmp+1
  1651.    parse var tmp clines.itmp (crlf) tmp
  1652. end /* do */
  1653. clines.0=itmp
  1654. return itmp 
  1655.  
  1656.  
  1657. /* See if directory exists , 0=no 1=yes*/
  1658. dir_exists:procedure
  1659. parse upper arg lookfor
  1660. lookfor=strip(lookfor,'t','\')
  1661.  
  1662. adrive=filespec('d',lookfor)       /* does drive exist? */
  1663. if adrive<>"" then do
  1664.   oo2=sysdrivemap(,'used')
  1665.   if pos(translate(adrive),translate(oo2))=0 then return 0   /* no such drive */
  1666. end
  1667. eek=lastpos('\',lookfor)
  1668. if eek>0 then do
  1669.   lookfor1=substr(lookfor,eek+1)
  1670.   foo=delstr(lookfor,eek)
  1671. end
  1672. else do
  1673.    return 1       /* it's a root dir */
  1674. end /* do */
  1675. foo=foo'\*.*'
  1676. aa=sysfiletree(foo,'eek','DO')
  1677. do mm=1 to eek.0
  1678.    if translate(filespec('n',eek.mm))=lookfor1 then do 
  1679.        return 1
  1680.    end /* do */
  1681. end /* do */
  1682. return 0
  1683.  
  1684.  
  1685. /******/
  1686. show_entries:procedure expose desc. bold normal reverse
  1687. parse arg iat
  1688. iat=max(min(iat,desc.0),1)
  1689. mm0=0
  1690. do forever
  1691.   if length(desc.iat)+length(desc.iat.!title)>65 then do
  1692.       mm0=mm0+2
  1693.       say bold iat normal reverse strip(translate(desc.iat)) normal bold ' :: '
  1694.       say copies(' ',15)  normal  left(desc.iat.!title,62)
  1695.    end
  1696.    else do
  1697.         say bold iat normal  reverse strip(translate(desc.iat)) normal bold ' :: ' normal  desc.iat.!title
  1698.        mm0=mm0+1
  1699.    end
  1700.    if mm0>20 then return iat
  1701.    iat=iat+1
  1702.    if iat>desc.0 then return iat
  1703. end  /* Do */
  1704.  
  1705.  
  1706.  
  1707. /***************************************************/
  1708. /* a hash, based on md5 */
  1709. rexx_md0:procedure        
  1710. parse arg stuff
  1711.  
  1712. numeric digits 11
  1713. lenstuff=length(stuff)
  1714.  
  1715. c0=d2c(0)
  1716. c1=d2c(128)
  1717. c1a=d2c(255)
  1718. c1111=c1a||c1a||c1a||c1a
  1719. slen=length(stuff)*8
  1720. slen512=slen//512
  1721.  
  1722. /* pad message to multiple of 512 bits.  Last 2 words are 64 bit # bits in message*/
  1723. if slen512=448 then  addme=512
  1724. if slen512<448 then addme=448-slen512
  1725. if slen512>448 then addme=960-slen512
  1726. addwords=addme/8
  1727.  
  1728. apad=c1||copies(c0,addwords-1)
  1729.  
  1730. xlen=reverse(right(d2c(lenstuff*8),4,c0))||c0||c0||c0||c0  /* 2**32 max bytes in message */
  1731.  
  1732. /* NEWSTUFF is the message to be md5'ed */
  1733. newstuff=stuff||apad||xlen
  1734.  
  1735. /* starting values of registers */
  1736.  a ='67452301'x;
  1737.  b ='efcdab89'x;
  1738.  c ='98badcfe'x;
  1739.  d ='10325476'x;
  1740.  
  1741. lennews=length(newstuff)/4
  1742.  
  1743. /* loop through entire message */
  1744. do i1 = 0 to ((lennews/16)-1)
  1745.   i16=i1*64
  1746.   do j=1 to 16
  1747.      j4=((j-1)*4)+1
  1748.      jj=i16+j4
  1749.      m.j=reverse(substr(newstuff,jj,4))
  1750.   end /* do */
  1751.  
  1752. /* transform this block of 16 chars to 4 values. Save prior values first */
  1753.  aa=a;bb=b;cc=c;dd=d
  1754.  
  1755. /* do 4 rounds, 16 operations per round (rounds differ in bit'ing functions */
  1756. S11=7
  1757. S12=12
  1758. S13=17
  1759. S14=22
  1760.   a=round1( a, b, c, d,   0 , S11, 3614090360); /* 1 */
  1761.   d=round1( d, a, b, c,   1 , S12, 3905402710); /* 2 */
  1762.   c=round1( c, d, a, b,   2 , S13,  606105819); /* 3 */
  1763.   b=round1( b, c, d, a,   3 , S14, 3250441966); /* 4 */
  1764.   a=round1( a, b, c, d,   4 , S11, 4118548399); /* 5 */
  1765.   d=round1( d, a, b, c,   5 , S12, 1200080426); /* 6 */
  1766.   c=round1( c, d, a, b,   6 , S13, 2821735955); /* 7 */
  1767.   b=round1( b, c, d, a,   7 , S14, 4249261313); /* 8 */
  1768.   a=round1( a, b, c, d,   8 , S11, 1770035416); /* 9 */
  1769.   d=round1( d, a, b, c,   9 , S12, 2336552879); /* 10 */
  1770.  
  1771. c=round1( c, d, a, b,  10 , S13, 4294925233); /* 11 */
  1772.   b=round1( b, c, d, a,  11 , S14, 2304563134); /* 12 */
  1773.   a=round1( a, b, c, d,  12 , S11, 1804603682); /* 13 */
  1774.   d=round1( d, a, b, c,  13 , S12, 4254626195); /* 14 */
  1775.   c=round1( c, d, a, b,  14 , S13, 2792965006); /* 15 */
  1776.   b=round1( b, c, d, a,  15 , S14, 1236535329); /* 16 */
  1777.   
  1778. a=m32add(aa,a) ; b=m32add(bb,b) ; c=m32add(cc,c) ; d=m32add(dd,d)
  1779.  
  1780. end
  1781.  
  1782. aa=c2x(reverse(a))||c2x(reverse(b))||c2x(reverse(C))||c2x(reverse(D))
  1783. return aa
  1784.  
  1785. c=round1( c, d, a, b,  10 , S13, 4294925233); /* 11 */
  1786.   b=round1( b, c, d, a,  11 , S14, 2304563134); /* 12 */
  1787.   a=round1( a, b, c, d,  12 , S11, 1804603682); /* 13 */
  1788.   d=round1( d, a, b, c,  13 , S12, 4254626195); /* 14 */
  1789.   c=round1( c, d, a, b,  14 , S13, 2792965006); /* 15 */
  1790.   b=round1( b, c, d, a,  15 , S14, 1236535329); /* 16 */
  1791.  
  1792.  
  1793.  
  1794. /* round 1 to 4 functins */
  1795.  
  1796. round1:procedure expose m. c1111 c0 c1
  1797. parse arg a1,b1,c1,d1,kth,shift,sini
  1798. kth=kth+1
  1799. t1=c2d(a1)+c2d(f(b1,c1,d1))+ c2d(m.kth) + sini
  1800. t1a=right(d2c(t1),4,c0)
  1801. t2=rotleft(t1a,shift)
  1802. t3=m32add(t2,b1)
  1803. return t3
  1804.  
  1805.  
  1806. /* add to "char" numbers, modulo 2**32, return as char */
  1807. m32add:procedure expose c0 c1 c1111
  1808. parse arg v1,v2
  1809. t1=c2d(v1)+c2d(v2)
  1810. t2=d2c(t1)
  1811. t3=right(t2,4,c0)
  1812. return t3
  1813.  
  1814.  
  1815.  
  1816. /*********** Basic functions */
  1817. /* F(x, y, z) == (((x) & (y)) | ((~x) & (z))) */
  1818. f:procedure expose c0 c1 c1111 
  1819. parse arg x,y,z
  1820. t1=bitand(x,y)
  1821. notx=bitxor(x,c1111)
  1822. t2=bitand(notx,z)
  1823. return bitor(t1,t2)
  1824.  
  1825.  
  1826. /* G(x, y, z) == (((x) & (z)) | ((y) & (~z)))*/
  1827. g:procedure expose c0 c1 c1111
  1828. parse arg x,y,z
  1829. t1=bitand(x,z)
  1830. notz=bitxor(z,c1111)
  1831. t2=bitand(y,notz)
  1832. return bitor(t1,t2)
  1833.  
  1834. /* H(x, y, z) == ((x) ^ (y) ^ (z)) */
  1835. h:procedure expose c0 c1 c1111
  1836. parse arg x,y,z
  1837. t1=bitxor(x,y)
  1838. return bitxor(t1,z)
  1839.  
  1840. /* I(x, y, z) == ((y) ^ ((x) | (~z))) */
  1841. i:procedure expose c0 c1 c1111
  1842. parse arg x,y,z
  1843. notz=bitxor(z,c1111)
  1844. t2=bitor(x,notz)
  1845. return bitxor(y,t2)
  1846.  
  1847. /* bit rotate to the left by s positions */
  1848. rotleft:procedure 
  1849. parse arg achar,s
  1850. if s=0 then return achar
  1851.  
  1852. bits=x2b(c2x(achar))
  1853. lb=length(bits)
  1854. t1=left(bits,s)
  1855. t2=bits||t1
  1856. yib=right(t2,lb)
  1857. return x2c(b2x(yib))
  1858.  
  1859.  
  1860.