home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 035A / TFANN11.ZIP / tfann.cmd < prev    next >
Encoding:
Text File  |  1997-06-25  |  11.2 KB  |  364 lines
  1. /*****************************************************************************/
  2. /*                    Announce utility for T-Fix                             */
  3. /*                    (c)1996 by Dmitry Dyakonov                             */
  4. /*****************************************************************************/
  5.  
  6. InFile=''; OutFile=''; SelFile=''; TplFile='tfann.tpl'
  7. area.0=0; bytes.0=0; selectarea.0=0; fdpos=20; fdlen=20
  8. Version='1.1/REXX'; SortOption='yes'
  9. palka.1='|'; palka.2='/'; palka.3='─'; palka.4='\'; pidx=1
  10. annheader.0=0; annareaheader.0=0
  11. anntext.0=0
  12. annareafooter.0=0; annfooter.0=0
  13. lowfname='NO'
  14.  
  15. say ; say 'Announce utility v'Version 'for T-Fix'
  16. parse arg InFile OutFile rest
  17. If InFile='' | OutFile='' Then  call Usage
  18. If stream(InFile,'c','open read') \= 'READY:' Then 
  19.   call EndProgram "Can't open file:" InFile
  20. do i=1 to words(rest)
  21.   p=word(rest,i)
  22.   select
  23.      when p='?' | p='/?' | p='-?' then call Usage
  24.      when translate(p)='/NS' then SortOption='no'
  25.      when substr(p,1,1)='@' then
  26.        do
  27.           SelFile=strip(p,'l','@')
  28.           If stream(SelFile,'c','open read') \= 'READY:' Then 
  29.             call EndProgram "Can't open file:" SelFile
  30.           call ReadSelect
  31.        end
  32.      when substr(p,1,1)='#' then  TplFile=strip(p,'l','#')
  33.      otherwise do
  34.                    selectarea.0=selectarea.0+1; i=selectarea.0;
  35.                    selectarea.i=translate(p)
  36.                end
  37.   end
  38. end
  39. If stream(TplFile,'c','open read') \= 'READY:' Then 
  40.   call EndProgram "Can't open file:" Tplfile
  41. call ReadTpl
  42. call ReadData
  43. if area.0 \= 0 then
  44.   do
  45.      do i=1 to area.0
  46.        bytes.0=bytes.0+1; bytes.i=0
  47.         do j=1 to files.i.0
  48.           bytes.i=bytes.i+word(files.i.j,2)
  49.         end
  50.      end
  51.      if SortOption = 'no' then  say ' ■ Sorting areas: disabled.'
  52.      else  call SortFiles
  53.      call Announce
  54.   end
  55. call EndProgram 'Thanks for using this program.'
  56.  
  57. /* ------------------------------------------------------------------------- */
  58. ReadTpl:
  59.  do while lines(TplFile)
  60.    str=linein(TplFile)
  61.    if str='' | substr(str,1,1)=';' then iterate
  62.    word=translate(word(str,1))
  63.    select
  64.      when word='LOWFNAME'        then  lowfname=translate(word(str,2))
  65.      when word='ANNHEADER'       then  call read_section 'annheader'
  66.      when word='ANNAREAHEADER'   then  call read_section 'annareaheader'
  67.      when word='ANNTEXT'         then  call read_section 'anntext'
  68.      when word='ANNAREAFOOTER'   then  call read_section 'annareafooter'
  69.      when word='ANNFOOTER'       then  call read_section 'annfooter'
  70.      otherwise iterate
  71.    end
  72.  end
  73.  call stream TplFile,'c','close'
  74. return
  75.  
  76. /* ------------------------------------------------------------------------- */
  77. read_section:
  78.  parse arg array
  79.  s=''; i=0
  80.  do while lines(TplFile)
  81.    s=linein(TplFile)
  82.    if translate(word(s,1))='END' then leave
  83.    interpret array'.0='array'.0+1'
  84.    interpret 'i='array'.0' 
  85.    interpret array'.'i'="'s'"'
  86.  end
  87. return
  88.  
  89. /* ------------------------------------------------------------------------- */
  90. ReadData:
  91.   do while lines(InFile)
  92.      str=strip(linein(InFile))
  93.      if str = "" then iterate
  94.      parse var str word rest
  95.      parse upper var word word
  96.      select 
  97.        when word = "AREA"  then
  98.           do
  99.              if selectarea.0 \= 0 then
  100.                do
  101.                   if AreaCmp(word(rest,1))\=0 then
  102.                   do
  103.                      str=linein(InFile)  /* skip file record */
  104.                      iterate
  105.                   end
  106.                end
  107.              i=QueryExist(word(rest,1))
  108.              if i=0 then
  109.                do
  110.                   area.0=area.0+1; i=area.0; area.i=rest; files.i.0=0
  111.                end
  112.           end    
  113.        when word = "FILE"  then
  114.           do
  115.              files.i.0=files.i.0+1; j=files.i.0;
  116.              files.i.j=translate(rest,'H','ì')
  117.           end
  118.        otherwise call lineout 'unknown.txt', str
  119.      end
  120.   end
  121.   call stream InFile,'c','close'
  122. return
  123.  
  124. /* ------------------------------------------------------------------------- */
  125. QueryExist: procedure expose area.
  126.  do i=1 to area.0
  127.    if compare(translate(Arg(1)),translate(word(area.i,1)))=0 then return i
  128.  end
  129. return 0
  130.  
  131. /* ------------------------------------------------------------------------- */
  132. ReadSelect: procedure expose SelFile selectarea.
  133.  do while lines(SelFile)
  134.    str=strip(linein(SelFile))
  135.    if str = '' | substr(str,1,1) = ';' then iterate
  136.    selectarea.0=selectarea.0+1; i=selectarea.0; selectarea.i=translate(str)
  137.  end
  138.  call stream SelFile,'c','close'
  139. return
  140.  
  141. /* ------------------------------------------------------------------------- */
  142. Announce:
  143.  If stream(OutFile,'c','open write') \= 'READY:' Then 
  144.    call EndProgram "Can't create/append file:" OutFile
  145.  
  146.  call handle_macros 'annheader'
  147.  call handle_macros 'annareaheader'
  148.  call handle_macros 'anntext'
  149.  call handle_macros 'annareafooter'
  150.  call handle_macros 'annfooter'
  151.  
  152.  call write_section 'annheader'
  153.  do i=1 to area.0
  154.    call write_section 'annareaheader'
  155.    call WriteArea
  156.    call write_section 'annareafooter'
  157.  end
  158.  call write_section 'annfooter'
  159.  call stream OutFile,'c','close'; say left(' ■ Writing areas: done.',79)
  160. return
  161.  
  162. /* ------------------------------------------------------------------------- */
  163. handle_macros:
  164.  parse arg section
  165.  interpret 'num =' section'.0'
  166.  do m=1 to num
  167.    interpret 'cmd =' section'.'m
  168.    if pos('%', cmd) \= 0 then
  169.      do
  170.         cmd = section'.'m "= process_macro("section'.'m")"
  171.         interpret cmd
  172.      end
  173.  end
  174. return
  175.  
  176. /* ------------------------------------------------------------------------- */
  177. write_section:
  178.  parse arg section
  179.  interpret 'num =' section'.0'
  180.  do m=1 to num
  181.    interpret 'cmd =' section'.'m
  182.    cmd = 'call lineout' OutFile', "'cmd'"'
  183.    interpret cmd
  184.  end
  185. return
  186.  
  187. /* ------------------------------------------------------------------------- */
  188. WriteArea:
  189.  do j=1 to files.i.0
  190.    parse var files.i.j fname fsize fdesc
  191.    ldesc.0=0
  192.    call process_ld fdesc
  193.    fdesc=ldesc.1
  194.    do m=1 to anntext.0
  195.      pidx=pidx+1; if pidx > 4 then pidx=1
  196.      call charout ,left(' ■ Writing area:' word(area.i,1)  palka.pidx,79)''d2c(13)
  197.      interpret 'call lineout' OutFile', "'anntext.m'"'
  198.      p = pos('fdesc', anntext.m)
  199.      if p \= 0 then
  200.        do
  201.           p=lastpos('"',anntext.m,p)-1
  202.           ld=substr(anntext.m, 1, p)
  203.           interpret 'ld = "'ld'"'
  204.           fdpos=length(ld)
  205.           do k=2 to ldesc.0
  206.            if substr(fdlen,1,1)='-' then
  207.              call lineout OutFile,left('',fdpos)''left(ldesc.k,substr(fdlen,2))
  208.            else
  209.              call lineout OutFile,left('',fdpos)''right(ldesc.k,fdlen)
  210.           end
  211.        end
  212.    end
  213.  end
  214. return
  215.  
  216. /* ------------------------------------------------------------------------- */
  217. process_ld: procedure expose ldesc. fdlen
  218.  parse arg fdesc
  219.  fdesclen = strip(fdlen,'l','-')
  220.  fdesc=strip(fdesc); str=fdesc; ldesc.0=0
  221.  if length(fdesc) < fdesclen then
  222.    do
  223.       ldesc.0=1; ldesc.1=fdesc; return
  224.    end
  225.  do while length(fdesc) > fdesclen
  226.    p='z'; k=fdesclen
  227.    do while p\=' '  &  k>0
  228.      fdesc=substr(str,k)
  229.      p=substr(fdesc,1,1)
  230.      k=k-1
  231.    end
  232.    if k=0 then 
  233.      fdesc=substr(str,1,fdesclen)
  234.    else
  235.      fdesc=substr(str,1,k)
  236.    ldesc.0=ldesc.0+1; i=ldesc.0; ldesc.i=fdesc
  237.    if k=0 then
  238.      fdesc=substr(str,fdesclen+1)
  239.    else
  240.      fdesc=substr(str,k+2)
  241.    str=fdesc
  242.  end  
  243.  ldesc.0=ldesc.0+1; i=ldesc.0; ldesc.i=fdesc
  244. return
  245.  
  246. /* ------------------------------------------------------------------------- */
  247. process_macro: procedure expose fdlen lowfname
  248.  parse arg s
  249.  out=''; p=pos('%',s)
  250.  do while (p > 0)
  251.    out=out''substr(s,1,p-1) /* ß«σpá¡∩Ѽ »pÑñδñπΘπε τáßΓ∞ »ÑpÑñ % */
  252.    s=substr(s,p+1)          /* ñѽáѼ % - »Ñpóδ¼ ß¿¼ó«½«¼ */
  253.    s=parse_macro(s)
  254.    out=out''substr(s,1,1)  /* ¡á ß½πτá⌐, Ñß½¿ íδ½ ¡Ñ¿ºóÑßΓ¡δ⌐ ¼á¬p«ß */
  255.    s=substr(s,2)
  256.    p=pos('%',s)
  257.  end
  258.  out=out''s
  259. return out
  260.  
  261. /* ------------------------------------------------------------------------- */
  262. parse_macro:
  263.  parse arg macro
  264.  align=''; tmp=''
  265.  do forever
  266.    ch=substr(macro,1,1)
  267.    if ch='-' | datatype(ch,'N')=1 then
  268.      do
  269.         align=align''ch         /* ß«σpá¡∩Ѽ - ¿½¿ µ¿Σpπ */
  270.         macro=substr(macro,2)   /* ñó¿úáѼß∩ ñá½∞ΦÑ */
  271.         iterate
  272.      end
  273.    if datatype(ch,'M')=1 then
  274.      do
  275.         ch=translate(substr(macro,1,2))
  276.         macro=substr(macro,3)
  277.         select
  278.             when ch='TH' then tmp="substr(time('n'),1,5)"
  279.             when ch='DT' then tmp="date('l')"
  280.             when ch='FN' then if lowfname='YES' then  tmp='tolower(fname)'
  281.                               else tmp='fname'
  282.             when ch='FS' then tmp='fsize'
  283.             when ch='FD' then do
  284.                                  tmp='fdesc'; fdlen=align
  285.                               end
  286.             when ch='AT' then tmp='word(area.i,1)'
  287.             when ch='AD' then tmp='subword(area.i,2)'
  288.             when ch='AS' then tmp='bytes.i'
  289.             when ch='A#' then tmp='files.i.0'
  290.             otherwise  
  291.                      return '%'align''ch''macro
  292.         end
  293.         if align='' then  return '"'tmp'"'macro
  294.         if substr(align,1,1)='-' then
  295.           return '"left('tmp','substr(align,2)')"'macro
  296.         else
  297.           return '"right('tmp','align')"'macro
  298.      end
  299.  end
  300. return
  301.  
  302. /* ------------------------------------------------------------------------- */
  303. AreaCmp: procedure expose selectarea.
  304.  do i=1 to selectarea.0
  305.    if MaskCmp(arg(1),selectarea.i) = 0 then return 0
  306.  end
  307. return 1
  308.  
  309. /* ------------------------------------------------------------------------- */
  310. MaskCmp: procedure
  311.  areaname=arg(1); mask=arg(2)
  312.  do while(mask\='' | areaname\='')
  313.    mchar=substr(mask,1,1)
  314.    if mchar='*' then
  315.      do
  316.         mask=substr(mask,2)
  317.         mchar=substr(mask,1,1); achar=substr(areaname,1,1)
  318.         do while(achar\=' ' & achar\=mchar)
  319.           areaname=substr(areaname,2)
  320.           achar=substr(areaname,1,1)
  321.         end
  322.      end
  323.    else
  324.      do
  325.         achar=substr(areaname,1,1)
  326.         if mchar\=achar then return 1
  327.         mask=substr(mask,2)
  328.         areaname=substr(areaname,2)
  329.      end
  330.  end
  331. return 0
  332.  
  333. /* ------------------------------------------------------------------------- */
  334. SortFiles:
  335.  do i=1 to area.0
  336.    do j=1 to files.i.0
  337.      do k=j+1 to files.i.0
  338.         call charout ,left(' ■ Sorting area:' word(area.i,1)  palka.pidx,79)''d2c(13)
  339.         pidx=pidx+1; if pidx > 4 then pidx=1
  340.        if word(files.i.j,1) > word(files.i.k,1) then
  341.          do; str=files.i.j; files.i.j=files.i.k; files.i.k=str; end
  342.      end
  343.    end
  344.  end; say left(' ■ Sorting areas: done.',79)
  345. return
  346.  
  347. /* ------------------------------------------------------------------------- */
  348. tolower: procedure
  349.  t1="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  350.  t2="abcdefghijklmnopqrstuvwxyz"
  351. return translate(arg(1),t2,t1)
  352.  
  353. /* ------------------------------------------------------------------------- */
  354. Usage:
  355. say 'Usage:'
  356. say 'TFANN <infile> <outfile> [#<tplfile>] [mask [mask]... @<selectfile>] [/ns]'
  357. call EndProgram ''
  358. return
  359.  
  360. /* ------------------------------------------------------------------------- */
  361. EndProgram:
  362.  say Arg(1); exit
  363. return
  364.