home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / htm2txt1.zip / HTM2TXT.CMD < prev    next >
OS/2 REXX Batch file  |  1997-03-13  |  35KB  |  867 lines
  1. /* ----------------------------------------------------------------- */
  2.    lastmod='1997-03-11'
  3. /* ----------------------------------------------------------------- */
  4. /* variables to be customized                                        */
  5. /*                                                                   */
  6. /* following variables may be set to permanent installation          */
  7. /* specific values. they may be temporary modified                   */
  8. /* by command line options                                           */
  9. /*                                                           option  */
  10. /*                                                           ------  */
  11.    linemax=72                /* maximum line length           l n    */
  12.    pixlbyt= 6                /* pixels per byte for tables    p n    */
  13.    editor ='E'               /* editor for output file        e [..] */
  14.    chain  ='Y'               /* follow url-chain              f n    */
  15.    showu  ='N'               /* show   url link adddress      u      */
  16.    ofile  ='.TXT'            /* derive outfilename from ifile o name */
  17. /* ----------------------------------------------------------------- */
  18. /* 97-03-11 or accept width= in <table> tag                          */
  19. /* 97-02-19 or define out-file name  due to
  20.                                  Ralph_Ulrich@p31.lemmi.ftg.donut.de */
  21. /* 97-02-19 or switch off chaining            due to jblumel@gs.net  */
  22. /* 97-02-06 or accept missing tags </td>, </tr>                      */
  23. /* 97-01-25 or substitute &#... tokens, <table> correction           */
  24. /* 96-12-31 or <PRE> correction                                      */
  25. /* 96-12-18 or /FONT correction                                      */
  26. /* 96-11-17 or list of &constants    due to tremro@digicom.qc.ca     */
  27. /* 96-11-07 or problem with nested tables                            */
  28. /* 96-10-22 or filenames drag-drop            due to sahag@ibm.net   */
  29. /* 96-10-21 or filenames with wildcard *      due to sahag@ibm.net   */
  30. /* 96-10-19 or filenames with embedded blanks due to sahag@ibm.net   */
  31. /* 96-10-17 or rework width=    due to lconyers@postmaster2.dot.gov  */
  32. /* 96-09-21 or rework follow href= error                             */
  33. /* 96-09-11 or <a ...> tag    due to etraas@te.xs4all.nl             */
  34. /* 96-08-21 or rework <table> tag error                              */
  35. /* 96-08-03 or rework <table> tag due to "Kirchner Soft"             */
  36. /* 96-08-02 or rework <table> tag due to pinkas@en.com               */
  37. /* 96-07-16 or follow href=                                          */
  38. /* 96-06-29 or rework                                                */
  39. /* 96-04-17 or try to support <table>                                */
  40. /* 96-01-15 or reworked                                              */
  41. /* 95-07-10 or decode HTML files                                     */
  42. /* ----------------------------------------------------------------- */
  43. /* call:    htm2txt infile  [l nn [p nn [e editor [u [f n [o xxx     */
  44. /* output:  infile-name.TXT                                          */
  45. /*                                                                   */
  46. /* recognised tags:                                                  */
  47. /*                                                                   */
  48. /*   all tags as supported by ibm webex 1.1b                         */
  49. /*                                                                   */
  50. /* special tags:                                                     */
  51. /*                                                                   */
  52. /*   <trace>                            trace '?i'                   */
  53. /*   <exit>                             exit immediately             */
  54. /*                                                                   */
  55. /* recognised substitute variables see variable 'consts'             */
  56. /*            tab-char ' ' will be ignored                           */
  57. /*                                                                   */
  58. /* notes:                                                            */
  59. /*                                                                   */
  60. /*   all tags are converted as 'best fit'.                           */
  61. /*   the image a browser produces will not be met.                   */
  62. /*                                                                   */
  63. /* ---------------------------------------------------------         */
  64. /* constants contributed by tremro@digicom.qc.ca                     */
  65. /*                                                                   */
  66.    consts=       "space  '20'x"
  67.    consts=consts "#32    '20'x"
  68.    consts=consts "quot   '22'x"
  69.    consts=consts "#34    '22'x"
  70.    consts=consts "amp    '00'x"
  71.    consts=consts "#38    '00'x"
  72.    consts=consts "#39    '27'x"
  73.    consts=consts "#58    '3a'x"
  74.    consts=consts "#60      <"
  75.    consts=consts "lt       <"
  76.    consts=consts "#62      >"
  77.    consts=consts "gt       >"
  78.    consts=consts "#91      ["
  79.    consts=consts "#93      ]"
  80.    consts=consts "nbsp   '20'x"
  81.    consts=consts "#160   '20'x"
  82.    consts=consts "iexcl  'a1'x"
  83.    consts=consts "cent   'a2'x"
  84.    consts=consts "pound  'a3'x"
  85.    consts=consts "curren 'a4'x"
  86.    consts=consts "yen    'a5'x"
  87.    consts=consts "brvbar 'a6'x"
  88.    consts=consts "sect   'a7'x"
  89.    consts=consts "uml    'a8'x"
  90.    consts=consts "copy   'a9'x"
  91.    consts=consts "ordf   'aa'x"
  92.    consts=consts "laqno  'ab'x"
  93.    consts=consts "not    'ac'x"
  94.    consts=consts "shy    'ad'x"
  95.    consts=consts "reg    'ae'x"
  96.    consts=consts "hibar  'af'x"
  97.    consts=consts "deg    'b0'x"
  98.    consts=consts "plusmn 'b1'x"
  99.    consts=consts "sup2   'b2'x"
  100.    consts=consts "sup3   'b3'x"
  101.    consts=consts "acute  'b4'x"
  102.    consts=consts "micro  'b4'x"
  103.    consts=consts "para   'b6'x"
  104.    consts=consts "middot 'b7'x"
  105.    consts=consts "cedil  'b8'x"
  106.    consts=consts "sup1   'b9'x"
  107.    consts=consts "ordm   'ba'x"
  108.    consts=consts "raquo  'bb'x"
  109.    consts=consts "frac14 'bc'x"
  110.    consts=consts "frac12 'bd'x"
  111.    consts=consts "frac34 'be'x"
  112.    consts=consts "iquest 'bf'x"
  113.    consts=consts "Agrave 'c0'x"
  114.    consts=consts "Aacute 'c1'x"
  115.    consts=consts "Acirc  'c2'x"
  116.    consts=consts "Atilde 'c3'x"
  117.    consts=consts "Auml   'c4'x"
  118.    consts=consts "Aring  'c5'x"
  119.    consts=consts "AElig  'c6'x"
  120.    consts=consts "Ccedil 'c7'x"
  121.    consts=consts "Egrave 'c8'x"
  122.    consts=consts "Eacute 'c9'x"
  123.    consts=consts "Ecirc  'ca'x"
  124.    consts=consts "Euml   'cb'x"
  125.    consts=consts "Igrave 'cc'x"
  126.    consts=consts "Iacute 'cd'x"
  127.    consts=consts "Icirc  'ce'x"
  128.    consts=consts "Iuml   'cf'x"
  129.    consts=consts "ETH    'd0'x"
  130.    consts=consts "Ntilde 'd1'x"
  131.    consts=consts "Ograve 'd2'x"
  132.    consts=consts "Oacute 'd3'x"
  133.    consts=consts "Ocirc  'd4'x"
  134.    consts=consts "Otilde 'd5'x"
  135.    consts=consts "Ouml   'd6'x"
  136.    consts=consts "times  'd7'x"
  137.    consts=consts "Oslash 'd8'x"
  138.    consts=consts "Ugrave 'd9'x"
  139.    consts=consts "Uacute 'da'x"
  140.    consts=consts "Ucirc  'db'x"
  141.    consts=consts "Uuml   'dc'x"
  142.    consts=consts "Yacute 'dd'x"
  143.    consts=consts "THORN  'de'x"
  144.    consts=consts "szlig  'df'x"
  145.    consts=consts "agrave 'e0'x"
  146.    consts=consts "aacute 'e1'x"
  147.    consts=consts "acirc  'e2'x"
  148.    consts=consts "atilde 'e3'x"
  149.    consts=consts "auml   'e4'x"
  150.    consts=consts "aring  'e5'x"
  151.    consts=consts "aelig  'e6'x"
  152.    consts=consts "ccedil 'e7'x"
  153.    consts=consts "egrave 'e8'x"
  154.    consts=consts "eacute 'e9'x"
  155.    consts=consts "ecirc  'ea'x"
  156.    consts=consts "euml   'eb'x"
  157.    consts=consts "igrave 'ec'x"
  158.    consts=consts "iacute 'ed'x"
  159.    consts=consts "icirc  'ee'x"
  160.    consts=consts "iuml   'ef'x"
  161.    consts=consts "eth    'f0'x"
  162.    consts=consts "ntilde 'f1'x"
  163.    consts=consts "ograve 'f2'x"
  164.    consts=consts "oacute 'f3'x"
  165.    consts=consts "ocirc  'f4'x"
  166.    consts=consts "otilde 'f5'x"
  167.    consts=consts "ouml   'f6'x"
  168.    consts=consts "divide 'f7'x"
  169.    consts=consts "oslash 'f8'x"
  170.    consts=consts "ugrave 'f9'x"
  171.    consts=consts "uacute 'fa'x"
  172.    consts=consts "ucirc  'fb'x"
  173.    consts=consts "uuml   'fc'x"
  174.    consts=consts "yacute 'fd'x"
  175.    consts=consts "thorn  'fe'x"
  176.    consts=consts "yuml   'ff'x"
  177. /* --------------------------------------------------------- */
  178. /* check input parameters                                    */
  179. /*                                                           */
  180.    if arg(1)='' then do
  181.      say
  182.      say 'correct call is:'
  183.      say
  184.      say ' htm2txt infilename [options '
  185.      say '         infilename = fully qualified path'
  186.      say '                      may contain wildcard *'
  187.      say '                     options (any order)'
  188.      say '                       l nn         max nn chars in a line'
  189.      say '                       p nn         max nn pixels per byte'
  190.      say '                       e editor name'
  191.      say '                       o outfile name'
  192.      say '                       f n          do not follow url-chain'
  193.      say '                       u            show anchor url''s'
  194.      say
  195.                                                  exit 4
  196.      end
  197.  
  198.    parse arg arg
  199.    arg=strip(translate(arg,' ','"'))
  200.    z=pos('.',arg)
  201.    if z=0 then do
  202.                  parse var arg ifiname options
  203.                  ifiname=ifiname'.HTM'
  204.                  end
  205.           else do
  206.                  parse var arg ifiname '.' ifext options
  207.                  ifiname=ifiname'.'ifext
  208.                  end
  209. /* --------------------------------------------------------- */
  210. /* check for wildcard char in ifiname                        */
  211. /*                                                           */
  212.    wcd.0=1; wcd.1=ifiname
  213.    swi_wcd = pos('*',ifiname)>0
  214.    if swi_wcd then do
  215.      if \RxFuncAdd('SysLoadFuncs','RexxUtil','SysLoadFuncs') then call 'SysLoadFuncs'
  216.      call SysFileTree ifiname,'WCD.','FO'
  217.      end
  218. /* --------------------------------------------------------- */
  219. /* check for options                                         */
  220. /*                                                           */
  221.    swi_url=0
  222.    swi_dbg=0
  223.    do while options \= ''
  224.      parse upper var options opt val options
  225.      select
  226.        when opt='L' then     linemax=val
  227.        when opt='P' then     pixlbyt=val
  228.        when opt='E' then     editor =val
  229.        when opt='F' then     chain  =val
  230.        when opt='O' then     ofile  =val
  231.        when opt='U' then do; showu  ='Y'; options=val options; end
  232.        when opt='D' then do; swi_dbg=1;   options=val options; end
  233.        otherwise nop
  234.        end
  235.      end
  236.    if translate(showu)='N' then swi_url=0; else swi_url=1
  237.    if translate(chain)='Y' then swi_chn=1; else swi_chn=0
  238. /* --------------------------------------------------------- */
  239. /* activate debug facilities                                 */
  240. /*                                                           */
  241.    if swi_dbg then do
  242.      say 'debug active'
  243.      signal on syntax
  244.      signal on error
  245.      signal on failure
  246.      signal on halt
  247.      end
  248. /* --------------------------------------------------------- */
  249. /* delete output file                                        */
  250. /*                                                           */
  251.    if ofile='.TXT' then do
  252.      parse var ifiname ofiname '.' .
  253.      ofiname=ofiname'.TXT'
  254.      end
  255.    else ofiname=ofile
  256.    if swi_dbg then signal off error
  257.    'erase' '"'ofiname'"' '2>NUL'
  258.    if swi_dbg then signal on  error
  259. /* --------------------------------------------------------- */
  260. /* loop on file-list                                         */
  261. /*                                                           */
  262.    call time 'r'
  263.    do wcd = 1 to wcd.0
  264.      ifiname=wcd.wcd
  265. /* --------------------------------------------------------- */
  266. /* some global controls                                      */
  267. /*                                                           */
  268.      hrf.0=1                   /* href-control               */
  269.      hrf.1=ifiname
  270.  
  271.      call lineout ofiname,'HTM2TXT v.' lastmod
  272.      call lineout ofiname,' '
  273.      call lineout ofiname,'Extracted from' ifiname',' date()',' left(time(),5)
  274.      call lineout ofiname,' '
  275.  
  276.      do nexthrf=1 while hrf.0>=nexthrf
  277.        call process_file hrf.nexthrf
  278.        end
  279. /* --------------------------------------------------------- */
  280.      end                         /* end wildcard loop        */
  281.    call lineout ofiname
  282. /* --------------------------------------------------------- */
  283. /*                               edit result                 */
  284.    swi_edt=(editor\='')
  285.    if swi_wcd then if wcd>1 then swi_edt=0
  286.    if swi_edt then 'start /F' editor '"'ofiname'"'
  287. /* --------------------------------------------------------- */
  288.    laps=time('e')%1
  289.    min=laps%60
  290.    sec=laps//60
  291.    say 'finished' min':'right(sec,2,0) 'min'
  292.                                                       exit 0
  293. /* --------------------------------------------------------- */
  294. /* process a file                                            */
  295. /*                                                           */
  296. process_file: parse arg ifiname
  297. /* --------------------------------------------------------- */
  298. /* read infile                                               */
  299. /*                                                           */
  300.    nl ='0d'x                 /* new line character           */
  301.    ifi=''
  302.    say
  303.    say 'reading' ifiname
  304. /* --------------------------------------------------------- */
  305. /* mod due to Ralph_Ulrich@p31.lemmi.ftg.donut.de            */
  306. /*                                                           */
  307.    call charin ifiname,1,0
  308.    ifiname_LEN  = chars(ifiname)
  309.    ifi = charin( ifiname,1,ifiname_LEN)
  310.    call stream ifiname,'c','close'
  311.    say ifiname_LEN 'Bytes read from' ifiname
  312.    ifi=translate(ifi,' ','090A'x)
  313. /* --------------------------------------------------------- */
  314. /* format outfile lines                                      */
  315. /*                                                           */
  316.    ofi.0=0                   /* out file controls            */
  317.    dlspaces  =''             /* <DL>-spaces                  */
  318.    lispaces  =''             /* <LI>-spaces                  */
  319.    indents   =0              /* number of indents            */
  320.    blanklines=0              /* number of blank lines        */
  321.    linelen   =linemax        /* max. linelength              */
  322.    outtext   =''             /* initial text                 */
  323.  
  324.                              /* switches:                    */
  325.    swi_pre   = 0             /* switch PRE                   */
  326.    swi_tbl   = 0             /* switch table                 */
  327.    swi_tr    = 0             /* switch table row active      */
  328.    swi_td    = 0             /* switch def/hdr   active      */
  329.    swi_wid   = 1             /* switch calc.col width        */
  330.    swi_lst   = 0             /* switch list  definition      */
  331.    swi_cnt   = 0             /* switch center text           */
  332.    swi_cat   = 0             /* switch concatenate           */
  333.    swi_trc   = 0             /* switch trace                 */
  334.    cnt_tbl   = 0             /* count nested tables          */
  335.    wid_tbl   = 0             /* width  table width           */
  336.  
  337. /* --------------------------------------------------------- */
  338. /* scan input stream                                         */
  339. /*                                                           */
  340.    call charout ,'processing token       '
  341.    text=''
  342.  
  343.    count=0
  344.    do while length(ifi)>0
  345.  
  346.      if swi_trc then do; interpret 'trace' tracetag; swi_dbg=1; end
  347.  
  348.                                /* check next line            */
  349.      parse var ifi parttext '<' tag '>' ifi
  350.      if pos('<',tag)>0 then do
  351.        parse var tag tag '<' rest
  352.        ifi='<'rest'>'ifi
  353.        end
  354.                                /* process text               */
  355.      select
  356.        when swi_pre            then call process_preformatted
  357.        when strip(parttext)=nl then nop
  358.        otherwise               do
  359.                                  do while pos(nl,parttext)>0
  360.                                    parse var parttext a (nl) b
  361.                                    parttext=strip(a) strip(b)
  362.                                    end
  363.                                  if swi_cat then text=text||parttext
  364.                                  else do
  365.                                    if text='' then text=     parttext
  366.                                               else text=text parttext
  367.                                    end
  368.                                  end
  369.        end
  370.                                /* process tag                */
  371.      tag=translate(tag,' ',nl)
  372.      if left(tag,1)='!' then tag='!' substr(tag,2)
  373.      parse var tag tag options
  374.      tag=translate(tag)
  375.      if tag='TRACE' then do
  376.                           swi_trc=1
  377.                           if pos('?',options)>0 then tracetag='?i'
  378.                                                 else tracetag=' i'
  379.                           end
  380.      swi_cat=0
  381.  
  382.      count=count+1
  383.      if \swi_dbg then call charout , copies('08'x,6)||format(count,5)' '
  384.  
  385.      select
  386.  
  387.        when swi_tbl then do
  388.          select
  389.            when tag='TR'       then do
  390.                                      if swi_td then call save_table_text
  391.                                      if swi_tr then call end_row
  392.                                      tabcol=0
  393.                                      drop tbtxt.
  394.                                      end
  395.            when tag='TD' ,
  396.            |    tag='TH'       then do
  397.                                      if swi_td then call save_table_text
  398.                                      swi_tr=1
  399.                                      swi_td=1
  400.  
  401.                                            /* determine next column    */
  402.  
  403.                                      z=parmval('COLSTART',options)
  404.                                      if z=0 then tabcol=tabcol+1
  405.                                             else tabcol=z
  406.                                      if colmax<tabcol then do
  407.                                                            colmax=tabcol
  408.                                                            swi_wid=1
  409.                                                            end
  410.  
  411.                                            /* check for width= tag     */
  412.  
  413.                                      p=parmval('WIDTH',options)
  414.                                      if p>0 & \datatype(p,'NUM') then do
  415.                                        z=verify(p,'1234567890'); n=0
  416.                                        if z>0 then do
  417.                                          n=substr(p,z,1)
  418.                                          q=left(p,z-1)
  419.                                          end
  420.                                        select
  421.                                          when n='P' then do
  422.                                            tbwid.tabcol.0=q%pixlbyt
  423.                                            end
  424.                                          when n='%' then do
  425.                                            tbwid.tabcol.0=(q*linelen)%100
  426.                                            end
  427.                                          otherwise
  428.                                          if wid_tbl>0 then q=trunc(q/wid_tbl*100)
  429.                                          if q>linemax then q=linemax
  430.                                          tbwid.tabcol.0=q
  431.                                          end
  432.                                        end
  433.                                      if p>0 &  datatype(p,'NUM') then do
  434.                                        if wid_tbl>0 then p=trunc(p/wid_tbl*100)
  435.                                        tbwid.tabcol.0=p
  436.                                        end
  437.                                      end
  438.  
  439.            when tag='/TD' ,
  440.            |    tag='/TH'      then  call save_table_text
  441.  
  442.            when tag='/TR'      then  call end_row
  443.  
  444.            when tag='TABLE'    then do
  445.                                      if swi_td then call save_table_text
  446.                                      if swi_tr then call end_row
  447.                                      cnt_tbl=cnt_tbl+1
  448.                                      end
  449.  
  450.            when tag='/TABLE'   then do
  451.                                      if swi_td then call save_table_text
  452.                                      if swi_tr then call end_row
  453.                                      blanklines=0
  454.                                      call out ' '
  455.                                      cnt_tbl=cnt_tbl-1
  456.                                      swi_tbl=(cnt_tbl>0)
  457.                                      if \swi_tbl then do
  458.                                                        wid_tbl=0
  459.                                                        end
  460.                                      end
  461.  
  462.            when tag='BR'       then do
  463.                                      if colmax>1 then call save_table_text
  464.                                                 else call out text
  465.                                      end
  466.            otherwise nop
  467.            end
  468.          end
  469.  
  470.        when tag='TABLE'    then do
  471.                                  call out text
  472.                                  blanklines=0
  473.                                  call out ' '
  474.                                  swi_tbl =1
  475.                                  swi_wid =1
  476.                                  cnt_tbl =cnt_tbl+1
  477.                                  swi_cnt =0
  478.                                  tbwid.  =0
  479.                                  tblin.  =0
  480.                                  tabcol  =0
  481.                                  colmax  =0
  482.                                  wid_tbl =parmval('WIDTH',options)
  483.                                  if \datatype(wid_tbl,'NUM') then wid_tbl=0
  484.                                  end
  485.  
  486.        when tag='EXIT'     then  signal finish
  487.  
  488.        when tag='!'        then call out '***' options '***'
  489.  
  490.        when tag='FONT',
  491.        |    tag='/FONT'    then  swi_cat=1
  492.  
  493.        when tag='UL',
  494.        |    tag='OL',
  495.        |    tag='DL',
  496.        |    tag='DIR',
  497.        |    tag='MENU',
  498.                            then do
  499.                                  call out text
  500.                                  call out ' '
  501.                                  if lispaces='' then lispaces=' * '
  502.                                                 else lispaces='   'lispaces
  503.                                  indents=indents+1
  504.                                  swi_lst=1
  505.                                  end
  506.        when tag='LI'       then  call out text
  507.        when tag='DT'       then do
  508.                                  call out text
  509.                                  dlspaces='  '
  510.                                  end
  511.        when tag='DD'       then do
  512.                                  call out text
  513.                                  dlspaces='    '
  514.                                  end
  515.        when tag='/UL',
  516.        |    tag='/OL',
  517.        |    tag='/DL',
  518.        |    tag='/DIR',
  519.        |    tag='/MENU',
  520.                            then do
  521.                                  call out text
  522.                                  dlspaces=''
  523.                                  lispaces=substr(lispaces,4)
  524.                                  if indents>0 then indents=indents-1
  525.                                  call out ' '
  526.                                  swi_lst=0
  527.                                  end
  528.        when tag='CENTER',
  529.        |    tag='CENTRE',
  530.                            then do
  531.                                  swi_cnt=1
  532.                                  end
  533.        when tag='/CENTER',
  534.        |    tag='/CENTRE',
  535.                            then do
  536.                                  swi_cnt=0
  537.                                  call out text
  538.                                  end
  539.        when tag='P',
  540.        |    tag='/TITLE',
  541.                            then  call out text
  542.        when tag='/HEAD',
  543.                            then do
  544.                                  call out text
  545.                                  call out ' '
  546.                                  end
  547.        when tag='PRE'      then do
  548.                                  swi_pre=1
  549.                                  linelen=parmval('WIDTH',options)
  550.                                  end
  551.        when tag='/PRE'     then do
  552.                                  swi_pre=0
  553.                                  linelen=linemax
  554.                                  end
  555.  
  556.        when tag='HR'       then do
  557.                                  call out text
  558.                                  call out copies('-',linelen)
  559.                                  end
  560.  
  561.        when tag='H1',
  562.        |    tag='H2',
  563.        |    tag='H3',
  564.        |    tag='H4',
  565.        |    tag='/H1',
  566.        |    tag='/H2',
  567.        |    tag='/H3',
  568.        |    tag='/H4',
  569.        |    tag='/CAPTION',
  570.                            then do
  571.                                  call out text
  572.                                  call out ' '
  573.                                  end
  574.        when tag='A'        then do
  575.                                  parse upper var options 'HREF' . '"' hrefid '"'
  576.                                  nogo= pos('#',hrefid)>0
  577.                                  srefid=''
  578.                                  if swi_url,
  579.                                  &  \nogo then do
  580.                                    srefid=hrefid
  581.                                    end
  582.                                  parse var hrefid z '.' fext
  583.                                  nogo=nogo|(left(fext,3)\='HTM')
  584.                                  parse var hrefid z 'FILE:' hrefid
  585.                                  if hrefid='' then hrefid=z
  586.                                  nogo=nogo|(strip(hrefid)='')
  587.                                  do i=1 to hrf.0
  588.                                    if hrf.i=hrefid then leave
  589.                                    end
  590.                                  if (i>hrf.0)&(\nogo)&(swi_chn) then do
  591.                                    hrf.0=hrf.0+1; z=hrf.0; hrf.z=hrefid
  592.                                    end
  593.                                  end
  594.        when tag='/A'       then do
  595.                                  if swi_url,
  596.                                  &  srefid\='' then do
  597.                                    text=text '('srefid')'
  598.                                    srefid=''
  599.                                    end
  600.                                  end
  601. /*
  602.        when tag='IMG'      then do
  603.                                  z=parmval('ALT',options)
  604.                                  if z\=0 then do
  605.                                    if swi_tbl then do
  606.                                                    text=z
  607.                                                    call save_table_text
  608.                                                    end
  609.                                    else text=text z
  610.                                    end
  611.                                  end
  612. */
  613.        when tag='BR'       then call out text
  614.        otherwise nop
  615.        end
  616.                                /* all finished               */
  617.      end
  618. /* --------------------------------------------------------- */
  619. /* write outfile                                             */
  620. /*                                                           */
  621. finish:
  622.  
  623.    do i=1 to ofi.0
  624.      call lineout ofiname,ofi.i
  625.      end
  626.                                                       return
  627. /* ========================================================= */
  628. /* --------------------------------------------------------- */
  629. /*                             close table row               */
  630.    end_row:
  631.  
  632.    swi_tr=0
  633.    swi_td=0
  634.          /* col-width already done ?     */
  635.  
  636.    if swi_wid then do
  637.  
  638.          /* check predefined col-width */
  639.  
  640.      colwi=0
  641.      do i=1 to colmax
  642.        if tbwid.i.0>0 then tbwid.i=tbwid.i.0
  643.                       else tbwid.i=0
  644.        colwi=colwi+tbwid.i
  645.        end
  646.      linelen=linemax-colwi
  647.      if linelen<=0 then linelen=linemax
  648.  
  649.          /* set col-width if not set   */
  650.  
  651.      do i=1 to colmax
  652.        if tbwid.i>0 then iterate
  653.        tbwid.i=linelen%colmax
  654.        end
  655.      linelen=linemax
  656.  
  657.          /* check sum colwid exceeds   */
  658.  
  659.      sum_col=0
  660.      do i=1 to colmax
  661.        sum_col=sum_col+tbwid.i
  662.        end
  663.      if sum_col>linemax then do
  664.        ratio=linemax/sum_col
  665.        do i=1 to colmax
  666.          tbwid.i=trunc(tbwid.i/ratio)
  667.          end
  668.        end
  669.      end
  670.    swi_wid=0
  671.  
  672.          /* get max nr. lines in row   */
  673.  
  674.    linmax=1
  675.    do i=1 to colmax
  676.      if linmax<tblin.i then linmax=tblin.i
  677.      end
  678.  
  679.        /* fill uninitlzd variables   */
  680.  
  681.    do y=1 to linmax
  682.      do k=1 to colmax
  683.        tbtxt.k.y=subs(tbtxt.k.y)
  684.        if left(tbtxt.k.y,6)\='TBTXT.' then iterate
  685.        if k=1 then tbtxt.k.y='_'
  686.               else tbtxt.k.y=''
  687.        end
  688.      end
  689.  
  690.        /* scan all lines all cols    */
  691.  
  692.    do y=1 to linmax
  693.      anytxt=0
  694.      do k=1 to colmax
  695.        if strip(tbtxt.k.y)='' then iterate
  696.        anytxt=1
  697.        leave
  698.        end
  699.  
  700.      do while anytxt
  701.          anytxt=0
  702.        do k=1 to colmax
  703.  
  704.          /* check length fits          */
  705.  
  706.          if length(tbtxt.k.y)>tbwid.k ,
  707.          &  tbwid.k>0 then do
  708.            z=lastpos(' ',tbtxt.k.y,tbwid.k)
  709.            if z=0 then z=tbwid.k
  710.            otext=left(tbtxt.k.y,z) /* split text */
  711.            tbtxt.k.y=strip(substr(tbtxt.k.y,z))
  712.            anytxt=1
  713.            end
  714.          else do
  715.            otext=tbtxt.k.y
  716.            tbtxt.k.y=''
  717.            end
  718.          if tbtxt.1.y='' then tbtxt.1.y='_'
  719.  
  720.          /*  build output line       */
  721.  
  722.          text=text left(otext,tbwid.k)
  723.          end
  724.  
  725.          /* all cols processed         */
  726.  
  727.        call out_table_text
  728.        end
  729.      end
  730.    tblin.=0
  731.                                                       return
  732. /* --------------------------------------------------------- */
  733. /* save table-text                                           */
  734. /*                                                           */
  735.    save_table_text:
  736.  
  737.      swi_td=0
  738.      if strip(text)\='' then do
  739.        tblin.tabcol=tblin.tabcol+1
  740.        z=tblin.tabcol
  741.        tbtxt.tabcol.z=text
  742.        end
  743.      text=''
  744.                                                       return
  745. /* --------------------------------------------------------- */
  746. /* out  table-text                                           */
  747. /*                                                           */
  748.    out_table_text:
  749.  
  750.      text = strip(text)
  751.      if text  =''   then                              return
  752.      if text \= '_' then call o text
  753.      text = ''
  754.                                                       return
  755. /* --------------------------------------------------------- */
  756. /* process preformatted                                      */
  757. /*                                                           */
  758. process_preformatted:
  759.  
  760.    do while length(parttext)>0
  761.      parse var parttext outtext (nl) parttext
  762.      oli=subs(outtext)
  763.      ofi.0=ofi.0+1; z=ofi.0; ofi.z=outtext
  764.      end
  765.                                                     return
  766. /* --------------------------------------------------------- */
  767. /* extract parameter values                                  */
  768. /*                                                           */
  769. parmval: procedure; parse upper arg key,string
  770.  
  771.    z=pos(key,string)
  772.    if z=0 then                                  return 0
  773.    string=substr(string,z)
  774.    parse var string '=' val  .
  775.    val=translate(val,' ','"')
  776.    val=translate(strip(val))
  777.                                                 return val
  778. /* --------------------------------------------------------- */
  779. /* do output lines                                           */
  780. /*                                                           */
  781. out:
  782.  
  783.    oli=subs(arg(1))
  784.    oll=length(oli)
  785.                      /* do not output more than 1 blank line */
  786.    if oll=0 then do
  787.      if blanklines>0 then                       return
  788.      blanklines=blanklines+1
  789.      end
  790.  
  791.    if linelen>0 then do
  792.      do while oll>linelen
  793.        z=lastpos(' ',oli,linelen)
  794.        if z=0 then z=oll
  795.        if (z>0) then do
  796.                      call o left(oli,z)
  797.                      oli=strip(substr(oli,z+1))
  798.                      oll=length(oli)
  799.                      end
  800.        end
  801.      end
  802.    call o oli
  803.    if oll>0 then blanklines=0
  804.    text=''
  805.                                                      return
  806. o: procedure expose swi_cnt linelen indents dlspaces lispaces ofi.
  807.                             parse arg ooo
  808.    if swi_cnt then do
  809.      z=(linelen-length(ooo))%2
  810.      if z>0 then prefix=copies(' ',z)
  811.             else prefix=''
  812.      end
  813.    else do
  814.      prefix=copies(' ',indents)||lispaces||dlspaces
  815.      end
  816.    ofi.0=ofi.0+1; z=ofi.0; ofi.z=prefix||ooo
  817.                                                      return
  818. /* --------------------------------------------------------- */
  819. /* substitute constants                                      */
  820. /*                                                           */
  821.    subs: procedure expose consts count
  822.  
  823.      l=arg(1)
  824.                                /* check for tab chars        */
  825.      l=translate(l,' ','09'x)
  826.                                /* check for variables        */
  827.      z=pos('&',l)
  828.      do while z > 0
  829.        parse var l head '&' token ';' tail
  830.        w=wordpos(token,consts)
  831.        if w=0 then do
  832.          if (left(token,1)='#')&(datatype(token,'NUM')) then do
  833.            token=substr(token,2)
  834.            token=d2c(token)
  835.            end
  836.          else do
  837.            token='?'token';'
  838.            end
  839.          end
  840.        else do
  841.          token=word(consts,w+1)
  842.          if right(token,2)="'x" then interpret "token="token
  843.          end
  844.        l=head||token||tail
  845.        z=pos('&',l)
  846.        end
  847.                         return strip(translate(l,'&','00'x))
  848. /* --------------------------------------------------------- */
  849.    syntax:
  850.      say 'signal on syntax in'  sigl':' strip(sourceline(sigl))
  851.      signal common_error
  852.    error:
  853.      say 'signal on error in'   sigl':' strip(sourceline(sigl))
  854.      signal common_error
  855.    failure:
  856.      say 'signal on failure in' sigl':' strip(sourceline(sigl))
  857.      signal common_error
  858.    halt:
  859.      say 'signal on halt in'    sigl':' strip(sourceline(sigl))
  860.      signal common_error
  861.    common_error:
  862.      trace '?i'
  863.            do forever
  864.        nop
  865.        end
  866. /* --------------------------------------------------------- */
  867.