/* 20 April 1999. Daniel Hellerstein (danielh@econ.ag.gov)
   Compress an html document, so as to save bandwidth
   This will remove extra spaces, and crlfs. But it will NOT
   attempt such compression withint PRE, APPLET, and SCRIPT blocks.

   In addition, it will remove <!-- --> comments that do NOT
   contain an ssi-keyphrase. The ssi_list variable identifies
   strings that might start an ssi keyphrase

Call using:
x:>htmlpack htmlfile.htm

The program will ask you for an output file name.


*/

/* You can modify this list of "ssi keyphrases" -- <!-- comments that
  start with one of these strings will NOT be removed */

ssi_list='REPLACE # % INCLUDE $ SELECT INTERPRET OPTIONS CACHE'
parse arg dafile 

if dafile='' then do
   say "Problem: no file specified "
   exit   
end /* do */

foo=rxfuncquery('sysloadfuncs') /* use rexxutil if it's available */
if foo=1 then do
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
end

dafile=strip(dafile)

ssi_list.0=0
if ssi_list<>'' then do
  do ioo=1 to words(ssi_list)
    ssi_list.ioo=translate(strip(word(ssi_list,ioo)))
  end
  ssi_list.0=words(ssi_list)
end

/* 1) read the file */
a=stream(dafile,'c','open read')
if abbrev(translate(a),'READY')<>1 then do
    say "Problem opening: "dafile '= 'a
    exit
end /* do */
ilen=stream(dafile,'c','query size')
if ilen=0 | ilen='' then do
    say "Problem querying: "dafile
    exit
end /* do */
stuff=charin(dafile,1,ilen)
foo=stream(dafile,'c','close')

tstuff=translate(stuff)

/* parse the file, removing crls and spaces where possible */
/* but -- pull out PRE SCRIPT and APPLET chunks */

i1=pos('PRE',tstuff); i2=pos('SCRIPT',tstuff) ; i3=pos('APPLET',tstuff)
if i1+i2+i3=0 then do
    newstuff=space(translate(stuff,' ','00090d0a'x),1)
    signal alldone    
end 

newstuff=''
do forever
    if stuff='' | stuff=' ' then leave
    parse var stuff a1 '<' a2 '>' stuff
    a1=space(translate(a1,' ','0d0a0009'x),1)
    newstuff=newstuff||a1
    if a2="" & stuff="" then  leave

/* what kind of element? */
   parse var a2 a2a a2b a2bb ; a2a=strip(translate(a2a))

/* get rid of comments? */
    a2b=translate(strip(a2b))
    if a2a='!--' then do                /* a comment -- remove it (if not an ssi)? */
        iscomment=1
        parse var a2b a2c . 
        do mm=1 to ssi_list.0
           if abbrev(ssi_list.mm,a2b)=1 then do
               iscomment=0 ; leave
           end /* do */
        end /* do */
       if iscomment=1 then iterate
    end /* do */

/* is a2a=PRE, SCRIPT or APPLET? If so, read as is (until /a2a) */
    if wordpos(a2a,'PRE SCRIPT APPLET')=0 then do
         a2=space(translate(a2,' ','0d0a0009'x),1)
         newstuff=newstuff||'<'||a2||'>'
         iterate
    end /* do */
/* add to newstuff until /a2a */
    newstuff=newstuff||'<'||a2||'>'
    endat='/'||a2a
    do forever                  /* use as is */
       if stuff='' | stuff=' ' then leave
       parse var stuff b1 '<' b2 '>' stuff
       newstuff=newstuff||b1||'<'||b2||'>'
       parse var b2 b2a . ; b2a=strip(translate(b2a))
       if b2a=endat then leave
    end /* do */
end                     /* stuff parsing */   

alldone:

foo=sysfiledelete
outdir=directory()
outdir=strip(outdir,'t','\')||'\'
ii=lastpos('.',dafile)
if ii=0 then ii=length(dafile)+1
dafileo=left(dafile,ii-1)||'.HT'
useout=getofile(outdir||dafileo)
if useout<>"" then do
           foo=stream(useout,'c','open write')
           foo=charout(useout,newstuff,1)
           if foo<>0 then do
                say "Problem writing "useout
           end /* do */
           else
                say "   .... "useout " written successfully "
          foo=stream(useout,'c','close')
           ill=lastpos('\',useout)
           if ill>0 then  outdir=left(useout,ill)
end /* do */

aa='temp.out'
foo=charout(aa,newstuff,1)

exit




/************** Ask for an output file *************/
getofile:procedure
parse arg defout
do forever
  aa="   Output to file (ENTER="defout"):"
  if length(aa)>40 then do
     say aa
     call charout, "    ? "
  end
  else do
    call charout,aa' ?'
  end

  pull gfile2 ; gfile2=strip(gfile2)
  if right(gfile2,1)='\' & defout<>'' then do
     iu=lastpos('\',defout)
     gfile2=gfile2||substr(defout,iu+1)
  end
  if gfile2='.'  then return ''
  if gfile2="" then gfile2=defout
  if gfile2="" then iterate
  gfile0=stream(gfile2,'c','query exists')
  if gfile0<>"" then do
      call charout,'   'Gfile0 ' exists.  Overwrite (Y/N)'
      pull anans
      if abbrev(strip(anans),'Y')<>1 then iterate
      foo=deleteme(gfile0)
      if foo=1 then do
         say "    Could not delete 'gfile0'. Try a different file name"
         iterate
      end
  end
  return gfile2
end /* do */


deleteme:procedure
parse arg afile
if rxfuncquery('SYSFILEDELETE')=0 then foo=sysfiledelete(afile)
if stream(afile,'c','query exists')<>''then return 0
return 1