home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / html_txt.zip / HTML_TXT.CM2 < prev    next >
Text File  |  1999-03-11  |  146KB  |  4,520 lines
  1. /* 25 Feb 1999. HTML_TXT ver 1.07
  2.  
  3.              HTML_TXT.CMD : An HTML to text converter
  4.    Created by Daniel Hellerstein (danielH@econ.ag.gov)
  5.  
  6.    This program is freeware. It's written in REXX, and has been
  7.    tested under OS/2 4.0, and under the VCPI version of Regina REXX
  8.    for DOS.  Note that several io features are not available when
  9.    run under REGINA REXX (see HTML_TXT.HTM for details).
  10.  
  11.    It can also be run as an "addon" for the SRE-http web server
  12.    (http://rpbcam.econ.ag.gov/srehttp)
  13.  
  14.    See HTML_TXT.HTM for installation & usage details -- there are a number of
  15.    options you may want to modify (though the defaults will work
  16.    fine in most cases).
  17.  
  18. Usage:
  19.  
  20.    Assuming HTML_TXT.CMD is on your "x" drive; from an
  21.    os/2 command prompt enter:
  22.       x:>HTML_TXT file.htm file.txt
  23.    will convert the HTML document "file.htm" into an equivalent
  24.    text (ascii), and save the results as file.txt.
  25.  
  26.    Or, enter HTML_TXT at a command prompt, and answer the queries.
  27.  
  28. Disclaimer:
  29.  
  30.    This is freeware that is to be used at your own risk -- the author
  31.    and any potentially affiliated institutions disclaim all responsibilties
  32.    for any consequence arising from the use, misuse, or abuse of
  33.    this software.
  34.  
  35.    You may use this, or subsets of this program, as you see fit,
  36.    including for commercial  purposes; so long as  proper attribution
  37.    is made, and so long as such use does not preclude others from making
  38.    similar use of this code.
  39. */
  40.  
  41.  
  42. /**************        USER CONFIGURABLE PARAMETERS       **************/
  43. /* Note: there are 3 classes of parameters:
  44.        General controls
  45.        Table controls
  46.        Display characters
  47.  
  48. The following parameters are of particular importance (that is, they
  49. may cure serious problems).
  50.  
  51.    NOANSI -- suppress use of ansi screen controls
  52.   LINEART -- suppress use of high ascii characters
  53.  TABLEMAXNEST and TABLEMODE2 -- use lists instead of nested tables
  54.  TOOLONGWORD -- trim overly long strings (that have no spaces)
  55. */
  56.  
  57. /*  ----- General controls */
  58.  
  59.  
  60.  
  61.  
  62. /*CHARWIDTH: width of a character in pixels.
  63.    Used to convert various WIDTH and HEIGHT attributes.  */
  64. charwidth=8
  65.  
  66. /* DOCAPS: Captialization is used for these "logical and physical" elements */
  67. docaps='TT CODE B STRONG '
  68.  
  69. /* DOULINE: Spaces are replaced with _ (uncerlines) for these "logical and
  70.             physical elements" */
  71. douline='U BLINK'
  72.  
  73. /* DOQUOTE: "quotes" are used for "logical and physical" elements.
  74.   Note : QUOTESTRING1 and QUOTESTRING2 are used as the "quote" characters */
  75. doquote='I EM VAR '
  76.  
  77. /*ERRORFLAG: String to place in output file when an error is found in the HTML code */
  78. errorflag='_ERROR_'
  79.  
  80. /* FORM_BR: if 1, start a new line after end of a form. 
  81.              That is, interpret </FORM>  as a <BR> */
  82. form_br=1
  83.  
  84. /* HN_OUTLINE: use numbered outline
  85.    You can replace Hn elements  with a hierarchical outline.
  86.    HN_OUTLINE says at what level of Hn to start.
  87.       1 : start at H1
  88.       2 : start at H2
  89.       3...7 : etc.
  90.       8   : never do outlining
  91.    Note: see the HN_NUMBERS.n parameters for fine control of hierarchical outlininig*/
  92. hn_outline=2
  93.  
  94. /* IGNORE_WIDTH: Ignore WIDTH in TABLE and TD elements
  95.       2 : Ignore width, no autosizing (equi-sized cells
  96.       1 : Ignore WIDTH attributes in table (auto-sizing used for column width
  97.       0 : Use WIDTH attribute if available, otherwise use autosizing of table columns  */
  98. ignore_width=0
  99.  
  100.  
  101. /* IMGSTRING_MAX: maximum # of IMG ALT attribute characters to display
  102.     0 : Display all characters
  103.     1 : Display, at most, current linelength characters
  104.    nnn : display, at most, nnn characters
  105.   Note: the filename is used if no ALT attribute is available*/
  106. imgstring_max=1
  107.  
  108. /* LINEART: Suppress use of high ascii (non keyboard) characters.
  109.             This is useful if you have a non-standard display.
  110.     -1 : No high ascii characters allows
  111.      0 : No lineart characters, but other high ascii characters are allowed
  112.      1 : Use high ascii characters   */
  113. lineart=1
  114.  
  115. /* How to display URLS.
  116.    0 = as the targets (stuff between >  </a>)
  117.    1 = as [nnn] target, where [nnn) points to a reference list at end of document
  118.    2 = as the urls (the http://... ) */
  119. link_display=2
  120.  
  121.  
  122. /* LINEART_ADDON: LIneart if called as sre-http addon 
  123.    Same values as above.
  124.    This is used ONLY when HTML_TXT is called as an sre-http addon */
  125. lineart_addon=-1 
  126.  
  127. /* LINELEN: maximum length of line (in characters).
  128.             Larger values mean wider text files */
  129. linelen=80
  130.  
  131. /* NOANSI: Suppress use of ANSI screen controls.
  132.   This only effects screen io, not program functioning. If you see lots of
  133.   $, [ and other garbage on your screen, set NOSANSI=1
  134.      0 : do NOT suppress ANSI screen controls
  135.      1 : suppress ANSI screen controls */
  136. noansi=1
  137.  
  138. /* NO_WORDWRAP: Each non-table paragraph is one long line
  139.    This will suppress linelen (effectively setting linelen to infinity);
  140.    but only for non-table output.  If you intend to import the text ouptut
  141.    to a wordprocessor, use of NO_WORDWRAP is recommended.
  142.      0 : do NOT suppress linelen
  143.      1 : infinite lines (suppress linelen), but only for non-table output */
  144. no_wordwrap=0
  145.  
  146. /* NOSPAN: Suppress COLSPAN and ROWSPAN
  147.    0 : Do not suppress
  148.    1 : Suppress COLSPAN and ROWSPAN
  149.   If NOSPAN=1, then COLSPAN and ROWSPAN attributes of <TD> elements are ignored */
  150. nospan=0
  151.  
  152. /* SHOWALLOPTS: display all OPTIONS in a SELECT list.
  153.    0 : Use the SIZE attrbute of a SELECT list
  154.    1 : Ignore SIZE attribute (always display all OPTIONS) */
  155. showallopts=0
  156.  
  157. /* SUPPRESS_BLANKLINES: minimize number of blank lines
  158.    1  : If multiple empty lines, just print one empty line (except if PRE)
  159.    0  : allow multiple empty lines  (i.e.; <BR><BR><BR> becomes 3 empty lines)*/
  160. suppress_blanklines=1
  161.  
  162. /* TOOLONG WORD: trimming long strings.
  163.   What to do with strings that don't fit (say, into a table cell)
  164.     -1 : trim (discard excess)
  165.      0 : wrap
  166.      1 : push margins (does not apply to tables; for tables, 1 means trim) */
  167. toolongword=1
  168.  
  169.  
  170. /* DISPLAY_ERRORS: note errors in text file
  171.     0 : Do not note errors
  172.     1 : Note serious errors
  173.     2 : Note all errors and warnings
  174.     3 : Long Note all errors, with
  175.    The "ERROR_FLAG" is used to "note errors" (it is written to the text file
  176.    near where the error was found). For 3, a short error description is also written*/
  177. display_errors=0
  178.  
  179. /*  ----- Table controls */
  180.  
  181. /* SUPPRESS_EMPTY_TABLE: display empty rows and empty tables
  182.      0  : do display (as blank lines)
  183.      1  : do not display */
  184. suppress_empty_table=1
  185.  
  186. /* TABLEMODE: Suppress "tabular" display of tables:
  187.       1 :  use tabular display (possibly lineart)
  188.       2 :  use a UL list instead of tabluar display
  189.       3 :  use a HR like bar, P and BR instead of tabluar display*/
  190. tablemode=1
  191.  
  192. /* TABLEMODE2: Suppress nested tables
  193.     Values (1, 2, 3) are same as for TABLEMODE.
  194.     Notes:
  195.        * only applies when TABLEMAXNEST is sufficiently small.
  196.        * never used if TABLEMODE>1   */
  197. tablemode2=1
  198.  
  199. /* TABLEMAXNEST: When to apply TABLEMODE2
  200.    At what "level of nesting" should TABLEMODE2 be used.
  201.       0 : Use for all "nested tables" (tables within tables)
  202.       1 : Use for "tables within tables within tables"
  203.       2, 3, etc. : Larger numbers mean more nested tables are displayed.
  204.   Note: you may need to set this to 0 if you are using Regina REXX */
  205. tablemaxnest=3
  206.  
  207. /* TABLEBORDER: type of default table borders 
  208.     -1  : never display borders (ignore BORDER attribute)
  209.       0 : default is no border -- can be overridden by a BORDER=n attribute in <TABLE>
  210.       1 : default is narrow border -- can be overridden by a BORDER=n attribute in <TABLE>
  211.     1.1 : always use narrow border
  212.   2 and above: Use broad border. */
  213. tableborder=0
  214.  
  215.  
  216. /* TD_ADD: Augment cell widths 
  217.    Augment cell widths by this factor.  This will increase narrow
  218.    cell widths, and decrease wide cells. Large values (say, 50)
  219.    will tend to make all cells the same size. 0 means "no adjustment".*/
  220. td_add=0
  221.  
  222. /*  ----- Display Characters */
  223.  
  224. /* You can specify either the actual character (in single quotes)
  225.    or an ascii value (i.e.; 48 would mean '0').
  226.    For example:
  227.          RADIOBOX='X' and RADIOBOX=88 are equivalent.
  228.  
  229.    Notes:
  230.       * for high ascii (values > 127), the character displayed may depend
  231.          on the code page your computer uses.
  232.       * if lineart=-1, high ascii values will not be used (if you
  233.         specify a high ascii value, a default character will be used
  234.         instead).
  235.       * if lineart=0, high ascii values can be specified, but not for lineart.
  236.       * in many cases, these characters are used to "quote" strings that
  237.         would be displayed using fonts (say, italics, large bold headers,
  238.         or colored links).
  239. */
  240.  
  241. /* CHECKBOX: Character used as to signify an <INPUT TYPE=CHECKBOX .. > element
  242.    CHECKBOXCHECK: Character used as to signify an
  243.                     <INPUT TYPE=CHECKBOX .. CHECKED> element */
  244. checkbox=176
  245. checkboxcheck=178
  246.  
  247. /* FLAGMENU: bullets used in MENU list.
  248.     You can specify characters and/or ascii numbers. If the "level" of menus exceeds
  249.     the words in flagmenu, the first character is used for these "excess" levels. */
  250. flagmenu='# '
  251.  
  252. /* FLAGUL : bullets used in UL list.
  253.      As with flagmenu, first character is used in "excess" levels */
  254. flagul='@ ~ $ '
  255.  
  256. /* FLAGTL : bullets used with UL lists, when UL lists is used instead of a TABLE
  257.      As with flagmenu, first character is used in "excess" levels */
  258. flagtl='176 177 178 220 224'
  259.  
  260. /* FLAGSELECT: character used before an OPTION (in a SELECT list)
  261.    FLAGSELECT2: character used for a "selected OPTION" (in a SELECT list) */
  262. flagselect='?'
  263. flagselect2='x'
  264.  
  265. /* HN_NUMBERS.n: characters to use in outlining
  266.    These are used with the "nth level" of an Hn outline.
  267.    Notes:
  268.     *   hn_numbers.1 refers to the "first outline" -- if HN_OUTLINE=2, then these
  269.         are used with H2 (that is, H1 is NOT subject to outline numbering).
  270.     *   if the number of outline numbers exceeds the words in a hn_numbers.n list,
  271.         standard numbers (i.e.; 27, 28, ...) are used  */
  272. hn_numberS.1='I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII IXX XX XX XXI XXII XXIII XXIV XXV XXVI'
  273. hn_numberS.2='a b c d e f g h i j k l m n o p q r s t u v w x y z '
  274. hn_numbers.3='1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 '
  275. hn_numberS.4='i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii ixx xx xx xxi xxii xxiii xxiv xxv xxvi'
  276. hn_numbers.5='1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 '
  277. hn_numbers.6='1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 '
  278. hn_numbers.7='1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 '
  279.  
  280. /* HRBIG: character to use if SIZE>1 in an <HR ..> element */
  281. hrbig=220
  282.  
  283. /* OL_NUMBERS: Characters (i.e.; roman numerals, standard digits, letters) in OL lists.
  284.    If number of elements in a list exceeds the number of words in ol_numbers, standard
  285.    numbers are used (i.e.; 11, 12, ...)
  286.    These can be superseded by a TYPE= attribute (i.e. <OL type=a>  */
  287. ol_numbers='1 2 3 4 5 6 7 8 9 10 '
  288.  
  289.  
  290. /* PRETITLE: short string to place before the "document title"
  291.    POSTTITLE: short string to place after the "document title" */
  292. PRETITLE='   ***   '
  293. POSTTITLE='   ***   '
  294.  
  295. /* PREA: character used before <A> anchors
  296.    POSTA: character used after <A> anchors */
  297. PREA=174
  298. POSTA=175
  299.  
  300. /* PREH1 : character used before <H1>
  301.    POSTH1 : character used after <H1> */
  302. preh1='* '
  303. posth1=' *'
  304.  
  305. /* PREHN : character used before H2 ... H7
  306.    POSTHN : character used after H2 ... H7 */
  307. prehn=' '
  308. posthn=' '
  309.  
  310. /* PREIMG: character to place before an  "image placeholder" (the ALT attribute of <IMG ..>
  311.    POSTIMG: character to place after and "image placeholder" */
  312. preimg=' ['
  313. postimg='] '
  314.  
  315.  
  316. /* QUOTESTRING1: character used as a "left quote" (with doquote elements)
  317.    QUOTESTRING2: character used as a "right quote" (with doquote elements) */
  318. quotestring1=244 /* 180 */
  319. quotestring2=245 /* 195 */
  320.  
  321.  
  322. /* RADIOBOX: Character used as to signify an <INPUT TYPE=RADIO .. > element
  323.    RADIOBOXCHECK: Character used as to signify an
  324.                     <INPUT TYPE=RADIO .. CHECKED> element */
  325. radiobox=176
  326. radioboxcheck=178
  327.  
  328. /* SUBMITMARK1: Character to use before a <INPUT TYPE=SUBMIT or TYPE=RESET ..> element
  329.    SUBMITMARK2: Character to use after a <INPUT TYPE=SUBMIT or TYPE=RESET ..> element */
  330. submitmark1=204
  331. submitmark2=185
  332.  
  333.  
  334. /* TEXTMARK1 : character to use on left end of an <INPUT TYPE=TEXT ..> element
  335.    TEXTMARK2 : character to use on right end of an <INPUT TYPE=TEXT ..> element
  336.    TEXTMARK : character to use inside of  an <INPUT TYPE=TEXT ..> element  */
  337. textmark1=222
  338. textmark2=221
  339. textmark=250
  340.  
  341. /* TABLEVERT: character to use as vertical lines in a table
  342.    TABLEHORIZ: character to use as horizontal lines in a table
  343.    Neither of these are used if LINEART=1  */
  344. tablevert='!'
  345. tablehoriz='-'
  346.  
  347. /* TABLEFILLER: character to used to fill empty spaces in tables and textbox's */
  348. tablefiller=' '
  349.  
  350. /**********            END OF USER CONFIGURABLE PARAMETERS        *********/
  351. /**************************************************************************/
  352.  
  353.  
  354. /* Do NOT edit stuff below this line ! */
  355.  
  356. parse arg  ddir, tempfile, reqstrg,list,verb ,uri,user, ,
  357.           basedir ,workdir,privset,enmadd,transaction,verbose, ,
  358.          servername,host_nickname,homedir,aparam,semqueue,prog_file
  359.  
  360.  
  361. crlf='0d0a'x
  362.  
  363. if verb='' then do              /* called as standalone ? */
  364.    parse arg infile outfile params   /* reread command line options */
  365.    call init_standalone
  366.    addonmode=0
  367. end
  368. else do         /* called as addon */
  369.    call init_sreaddon  
  370.    if result=0 then return ' '
  371.    addonmode=1
  372. end /* do */
  373.  
  374. /* get HEAD and BODY */
  375. atitle=head_body(stuff)
  376.  
  377. /* write <TITLE> */
  378. atitle=pretitle||atitle||posttitle
  379. atitle=space(atitle)
  380. if length(atitle)<linelen then atitle=center(atitle,linelen)
  381. call lineout2 outfile,atitle
  382. call lineout outfile,' '
  383.  
  384.  
  385. /* find all <IMG links and convert to ALT tag, or to filename */
  386. call img_convert 'IMG','SRC'
  387.  
  388. call img_convert 'AREA','HREF'   /* ,'<A>','</A>' */
  389.  
  390.  
  391.  
  392. /* remove APPLET  etc junk */
  393. foo=remove_applet('APPLET')
  394. foo=remove_applet('OBJECT')
  395. foo=remove_applet('EMBED')
  396.  
  397. call set_vars           /* check and set display characters */
  398.  
  399. /* start parsing BODY */
  400.  
  401. /* ol numbers used with TYPE= option in <OL
  402.   .0  == default (oL_NUMBERS)
  403.   .1  == TYPE=1
  404.   .2  == TYPE=a
  405.   .3  == type=A
  406.   .4  == TYPE=i
  407.   .5  == TYPE=I
  408. */
  409. ol_numbers.0=ol_numbers
  410. ol_numbers.1='1 2 3 4 5 6 7 8 9 10 11 12 14 15 16 17 18 19 20 '
  411. ol_numbers.2='a b c d e f g h i j k l m n o p q r s t u v w x y z '
  412. ol_numbers.3='A B C D E F G H I J K L M N O P Q R S T U V W X Y Z '
  413. OL_NUMBERS.4='i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii ixx xx xx xxi xxii xxiii xxiv xxv xxvi'
  414. ol_numberS.5='I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII IXX XX XX XXI XXII XXIII XXIV XXV XXVI'
  415.  
  416.  
  417. leftside.0=0 ; leftside.!width=0 ; leftside.!done=0
  418. linelen_orig=linelen
  419. ISCLEAR=0
  420. wasblank=0
  421. indent=0                /* current indent */
  422. rightindent=0
  423. ispre=0                 /* <PRE> is on? */
  424. olcnts=''                 /* OL count */
  425. lastelem=''
  426. capon=0
  427. ulineon=0
  428. listtypes=''
  429. links_list.=0
  430. anchoron=0 ; anchoron1=0 ; ANCHORON2=0
  431. quoteon=0 ; quoteon1=0 ; QUOTEON2=0
  432. ddon=0
  433. thispara=''             /* current paragraph */
  434. iscenter=0
  435. sendout_internal=0
  436.  
  437. if datatype(td_add)<>'NUM' then td_add=0
  438.  
  439. if hn_outline>0 then do
  440.   do jj=hn_outline to 7
  441.      hn_outlines.jj=0
  442.   end /* do */
  443. end
  444.  
  445. iat=htmllen-length(body)
  446. if addonmode<>1 then say bold " Converting HTML to Text " normal " ...... "
  447. prenote=reverse||'   : '||normal
  448. if htmllen>15000 then call charout, prenote
  449.  
  450. eeks=time('r')
  451.  
  452.  
  453. doingtable=0    /* used to signal sendout that "we are writing a table */
  454. do forever
  455.  
  456.     if body='' then leave
  457.     if htmllen>15000 then iat=noteit(htmllen-length(body),iat,10000,prenote)
  458.     
  459.     parse var body t1 '<' t2a '>' body
  460.  
  461.     T1=CONVERT_CODES(T1,CAPON,ISPRE,ULINEON)
  462.  
  463.     t1=fix_quote_anchor(t1)  /* may change globals */
  464.  
  465.  
  466. /* Ready to add more content ..... */
  467.      thispara=thispara||t1      /* ADD T1 TO THISPARA FOR EVENTUAL OUTPUT */
  468.  
  469. /* now prepare to process this <element> (T2 is first word, T2A is all words */
  470.     t2=strip(translate(word(t2a,1)))             /* get rid of element modifiers */
  471.     if left(t2,1)='/'  then
  472.         t2end=substr(t2,2)
  473.     else
  474.         t2end=''
  475.  
  476. /* a check: convert table to something else (works on globals? */
  477.     t2=cvt_table_elements(t2,1)
  478.  
  479.  
  480. /* Now, process this ELEMENT */
  481.    if T2='TABLE' then DO            /* table -- LOTS OF WORK! */
  482.          foo=sendout(thispara,ispre,indent,aflag,linelen)
  483.          doingtable=1
  484.          thispara='';aflag=0
  485.          call sendout ' '
  486.          AA=DO_TABLE(t2a)
  487.          dacaption=''
  488.          if tables.1.!caption<>' ' then do
  489.             dacaption=prehn||tables.1.!caption||posthn
  490.             if tables.1.!captiona<>'BOTTOM' then do
  491.                foo=sendout(dacaption,0,indent,' ',linelen,'CENTER')  
  492.             end
  493.          end /* do */
  494.          sendout_internal=1
  495.          tmptoolong=toolongword
  496.          if toolongword=1 then toolongword=-1
  497.          abb=gen_table(1,linelen-(indent+rightindent+leftside.!width))
  498.  
  499.          sendout_internal=0
  500.          if tables.1.!errors<>'' then
  501.               call do_display_error 0,'Table Warning(s): '||tables.1.!errors,tables.1.!errors
  502.  
  503. /* write it, or flow around it? */
  504.          talign=get_elem_val(t2a,'ALIGN')
  505.          if talign='LEFT' then do
  506.             ifoo=0 ; lwidth=0; abb2=abb
  507.             do forever
  508.                if abb2='' then leave
  509.                ifoo=ifoo+1
  510.                parse var abb2 leftside.ifoo (crlf) abb2
  511.                lwidth=max(lwidth,length(strip(leftside.ifoo,'t',' ')))
  512.             end /* do */
  513.             leftside.0=ifoo
  514.             leftside.!done=0
  515.             leftside.!width=lwidth+1
  516.             IF LWIDTH+9 > LINELEN  then DO /* TOO WIDE -- CAN'T WRAP */
  517.                  DROP LEFTSIDE.
  518.                  LEFTSIDE.!WIDTH=0; LEFTSIDE.0=0; LEFTSIDE.!DONE=0
  519.                  FOO=SENDOUT(ABB,1)
  520.             end /* do */
  521.          end /* do */
  522.          else do
  523.            foo=sendout(abb,2,indent,' ',linelen)           /* not align left */
  524.            if tables.1.!captiona='BOTTOM'  & dacaption<>'' then do
  525.                foo=sendout(dacaption,0,indent,' ',linelen,'CENTER')  
  526.            end /* do */
  527.          end
  528.          toolongword=tmptoolong
  529.          doingtable=0
  530.     end /* do */
  531.    else do              /* NOT a table -- interpret this element (sets globals */
  532.          if leftside.!done>=leftside.0 then leftside.!width=0
  533.          call interpret_elems linelen   /* changes globals */
  534.    end
  535.    IF ISCLEAR<>0 then DO
  536.       do mm=leftside.!done+1 to leftside.0
  537.         call lineout outfile,leftside.mm
  538.       end
  539.       DROP LEFTSIDE.
  540.       LEFTSIDE.!WIDTH=0; LEFTSIDE.0=0; LEFTSIDE.!DONE=0
  541.       ISCLEAR=0
  542.    END
  543. end             /* do foerver -- until no more stuff in BODY  */
  544.  
  545.  
  546. /* dump current paragraph */
  547. foo=sendout(thispara,ispre,indent,aflag)
  548.  
  549. do mm=leftside.!done+1 to leftside.0
  550.    call lineout outfile,leftside.mm
  551. end
  552.  
  553. /* and we are done!  welll, maybe we need to write a refernce list of urls?*/
  554. if link_display=1 then do
  555.    call lineout outfile,' '
  556.    call lineout outfile,'      =============================== '
  557.    call lineout outfile,'          Reference List of URLs     '
  558.    call lineout outfile,'      =============================== '
  559.    call lineout outfile,' '
  560.    do mmm=1 to links_list.0
  561.         call lineout outfile,'['right(mmm,4)'] '||links_list.mmm
  562.    end /* do */
  563.    call lineout outfile
  564. end /* do */
  565.  
  566.  
  567. call lineout outfile
  568. etime=time('r')
  569.  
  570. if addonmode=1 then do
  571.    return 'FILE ERASE TYPE text/plain name 'outfile
  572. end
  573. else do
  574.   say ' '
  575.   say "Elapsed time=" etime
  576. end
  577. exit
  578.  
  579.  
  580. /*************** END OF MAIN **************/
  581.  
  582.  
  583. /****************************************/
  584. /* initialize when run as sre-http addon */
  585. init_sreaddon:
  586.  
  587.  newp=''
  588.  outfile=tempfile
  589.  newp='LINEART='lineart_addon';'
  590.  do forever
  591.     if list='' then leave
  592.       parse var list a1 '&' list
  593.       if pos('=',a1)=0 then a1='THEURL='a1
  594.       parse var a1 avar '=' aval
  595.       avar=strip(translate(avar))
  596.       aval=packur(translate(aval,' ','+'))
  597.       
  598.       if length(aval)='' then iterate           /*empty junk, ignore */
  599.       if avar="THEURL" then do           /* the file or url to lookup */
  600.         ico=pos(':',aval)
  601.         if ico>0 & ico<4   then do      /* a file, on this server, must be superuser to request this*/
  602.            if wordpos('SUPERUSER',privset)+wordpos('HTML_TXT',privset)=0 then do
  603.                 call ask_auth0
  604.                 return 0
  605.            end                  /* otherwise, get the file */
  606.  
  607.            infile=strip(aval)
  608.            htmlfile=stream(infile,'c','query exists')              /* does it, or .html or .htm version of it, exist*/
  609.            if htmlfile='' then htmlfile=stream(infile||'.HTM','c','query exists')
  610.            if htmlfile='' then htmlfile=stream(infile||'.HTML','c','query exists')
  611.  
  612.            if htmlfile='' then do
  613.               call no_file infile,' File could not be found '
  614.               return 0
  615.            end
  616.            htmllen=stream(htmlfile,'c','query size')
  617.            if htmllen=0 then do
  618.               call no_file infile,' File is empty '
  619.               return 0
  620.             end
  621.             stuff=charin(htmlfile,1,htmllen)
  622.             if verbose>2 then Say "HTML_TXT: Reading " HTMLlen " characters from " htmlfile
  623.             iterate 
  624.  
  625.        end /* do */
  626.        else do                  /* it is a url */
  627.             'extract serverport '
  628.            foo1=sref_fix_url(aval,servername,serverport)
  629.            hdr='Referer: HTML_TXT@'||servername||crlf||'Connection: close'||crlf
  630.            hdr=hdr||'User-agent: Mozilla/2.0 (compatible)'||crlf
  631.   
  632.            stuff=sref_get_url(foo1,5000000,0,hdr)   /* 5meg max */
  633.            if stuff=0 then do
  634.                call no_url aval,'Could not retrieve URL '
  635.                return 0
  636.            end /* do */
  637.            htmllen=length(stuff)
  638.            if verbose>2 then Say "HTML_TXT: Reading " HTMLlen " characters from " aval
  639.            htmlfile=aval
  640.            iterate
  641.        end /* do */
  642.         
  643.      end /* do */                       /* URL option */
  644.      newp=newp||avar'='aval';'||' '     /* otherwise, retain other options */
  645.  
  646.  end /* do */
  647.  if newp<>'' then    call change_params '/VAR '||newp,1     /* change parameters (globals) */
  648.  
  649.  
  650. return 1
  651.  
  652.  
  653. /************************************/
  654. /* no such file */
  655. no_file:
  656. parse arg afile,amess
  657.         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  658.         call lineout tempfile, "<html><head><title>HTML_TXT error </title>"
  659.         call lineout tempfile, '</head><body> <h2>File Problem/h2>'
  660.         call lineout tempfile,' Problem with: 'afile'<p><em>'amess'</em>'
  661.         call lineout tempfile,' </body> </html> '
  662.         call lineout tempfile
  663.         'FILE ERASE TYPE text/html NAME' tempfile
  664.         return 1
  665.  
  666.  
  667. /************************************/
  668. /* no such file */
  669. no_url:
  670. parse arg afile,amess
  671.         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  672.         call lineout tempfile, "<html><head><title>HTML_TXT error </title>"
  673.         call lineout tempfile, '</head><body> <h2>URL Problem</h2>'
  674.         call lineout tempfile,' Problem with: 'afile'<p><em>'amess'</em>'
  675.         call lineout tempfile,' </body> </html> '
  676.         call lineout tempfile
  677.         'FILE ERASE TYPE text/html NAME' tempfile
  678.         return 1
  679.  
  680.  
  681. /************************************/
  682. /* not allowed -- ask for username pwd */
  683. ask_auth0:
  684.  
  685.  
  686.     is13=value('SREF_PREFIX',,'os2environment') /* which version of sre */
  687.     if is13='' then do
  688.         'RESPONSE HTTP/1.0 401 Unauthorized '     /* Set HTTP response line */
  689.         'header add WWW-Authenticate: Basic Realm=<HTML_TXT>'  /* challenge */
  690.         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  691.         call lineout tempfile, "<html><head><title>Not authorized </title>"
  692.         call lineout tempfile, '</head><body> '
  693.         call lineout tempfile,' </body> </html> '
  694.         call lineout tempfile
  695.         'FILE ERASE TYPE text/html NAME' tempfile
  696.         return 1
  697.      end
  698.      else do
  699.         foo=sref_response('unauth HTML_TXT','You are not allowed to select local files under HTML_TXT',servername,1)
  700.         return foo
  701.      end
  702.  
  703.  
  704. /****************************************/
  705. /* initializations; when run as a standalone program */
  706. init_standalone:
  707.  
  708. call loadlibs           /* load up some libraries and ANSI support*/
  709.  
  710.  
  711. if abbrev(translate(infile),'/VAR')=1 then do
  712.     params='/VAR 'outfile' 'params
  713.     outfile='' ; infile=' '
  714. end /* do */
  715.  
  716. if abbrev(translate(outfile),'/VAR')=1 then do
  717.     outfile=''
  718.     params='/VAR  'params
  719. end /* do */
  720.  
  721.  
  722. forceout=0
  723. if outfile<>'' then forceout=1
  724.  
  725. if params<>'' then do
  726.    call change_params params     /* change parameters (globals) */
  727. end /* do */
  728.  
  729. if noansi=0 then call loadlibs
  730.  
  731.  
  732. getin:
  733. if infile="" then do
  734.     call lineout,bold " Enter name of HTML file (? for help, EXIT to quit) "normal
  735.     call charout,"  "reverse " :" normal
  736.     pull infile ; infile=strip(translate(infile))
  737. end
  738.  
  739. if strip(translate(infile))='EXIT' then do
  740.    if addonmode<>1 then say "bye "
  741.    exit
  742. end /* do */
  743.  
  744. if infile=' ' | strip(infile)='?' then do
  745.    call sayhelp
  746.    infile=''
  747.    signal getin
  748. end /* do */
  749.  
  750. if abbrev(translate(strip(infile)),'/DIR')=1 then do
  751.     infile=substr(strip(infile),2)
  752.     address cmd infile
  753.     infile=''
  754.     signal getin
  755. end /* do */
  756.  
  757.  
  758. if abbrev(translate(strip(infile)),'/VAR')=1 then do
  759.   call change_params infile
  760.   infile=''
  761.   signal getin
  762. end
  763.  
  764. /* maybe it's actually a file name */
  765.  
  766. htmlfile=stream(infile,'c','query exists')              /* does it, or .html or .htm version of it, exist*/
  767. if htmlfile='' then htmlfile=stream(infile||'.HTM','c','query exists')
  768. if htmlfile='' then htmlfile=stream(infile||'.HTML','c','query exists')
  769.  
  770. if htmlfile='' then do
  771.     Say "Sorry. could not find: " infile
  772.     exit
  773. end /* do */
  774.  
  775. htmllen=stream(htmlfile,'c','query size')
  776. if htmllen=0 then do
  777.    say " Sorry -- " htmlfile " is empty "
  778.    infile=''
  779.    signal getin
  780. end /* do */
  781. stuff=charin(htmlfile,1,htmllen)
  782. Say "Reading " HTMLlen " characters from " htmlfile
  783.  
  784. outget: nop
  785. if outfile='' then do
  786.    parse var htmlfile tout '.' .
  787.    tout=tout||'.TXT'
  788.    say " "
  789.    say bold " Enter name of output file (ENTER="tout")"normal
  790.    call charout,"  "reverse " :" normal
  791.    parse pull outfile
  792.    if outfile='' then outfile=tout
  793. end /* do */
  794.  
  795. foo=stream(outfile,'c','query size')
  796. if foo='' then foo=0
  797.  
  798. signal off syntax ; signal off error
  799. signal on syntax name hoy1 ; signal on error name hoy1
  800. if foo<>0 then do
  801.      if forceout=0 then do
  802.         if yesno("Overwrite? ")=0 then do
  803.             outfile='' ; signal outget
  804.        end /* do */
  805.      end                /* else, command line mode implies overrwrite */
  806.      else do
  807.           say "Overwriting "foo
  808.      end /* do */
  809.      foo=sysfiledelete(outfile)
  810.      if foo<>0 then do
  811.             say "Could not delete (error " foo
  812.             outfile=''
  813.             signal outget
  814.      end /* do */
  815. end /* do */
  816. signal off syntax ; signal off error
  817. return 1
  818.  
  819. hoy1:
  820. outfile=' '
  821. say " % " sigl " : " rc
  822. say "File exists. Try another name"
  823. signal off syntax ; signal off error
  824. signal outget
  825.  
  826.  
  827.  
  828.  
  829. /******************************/
  830. /* change parameters */
  831. change_params:
  832. parse arg plist,nosay
  833.  
  834. plist_ok='TOOLONGWORD TABLEMODE TABLEMODE2 TABLEBORDER PRETITLE POSTTITLE ' ,
  835.          ' LINELEN PREA POSTA PREH1 POSTH1 PREHN POSTHN  IMGSTRING_MAX PREIMG POSTIMG ',
  836.          ' DOCAPS DOULINE DOQUOTE QUOTESTRING1 QUOTESTRING2 HN_OUTLINE ' ,
  837.          ' HN_NUMBERS.1 HN_NUMBERS.2 HN_NUMBERS.3 HN_NUMBERS.4 HN_NUMBERS.5 HN_NUMBERS.6 ',
  838.          ' HN_NUMBERS.7 OL_NUMBERS FLAGMENU FLAGUL FLAGTL FLAGSELECT FLAGSELECT2 ',
  839.          ' RADIOBOX RADIOBOXCHECK CHECKBOXK CHECKBOXCHECK TEXTMARK1 TEXTMARK2 TEXTMARK ',
  840.          ' HRBIG SUBMITMARK1 SUBMITMARK2 LINEART TABLEHORIZ TABLEFILLER SHOWALLOPTS ' ,
  841.          ' ERRORFLAG  NOANSI TABLEMAXNEST CHARWIDTH SUPPRESS_BLANKLINES DISPLAY_ERRORS ' ,
  842.          ' IGNORE_WIDTH NOSPAN TD_ADD NO_WORDWRAP FORM_BR'
  843.  
  844. PLIST=STRIP(PLIST) ; PLIST=SUBSTR(PLIST,5)
  845.  
  846. do forever
  847.    if plist='' then leave
  848.    plist=strip(plist,'l',';')
  849.    PARSE VAR PLIST AVAR '=' AVAL ';' PLIST
  850.    avar=translate(avar)
  851.    if avar='' then iterate
  852. /* file specifieers ... */
  853.    if avar='INFILE' then do
  854.        infile=strip(aval) ; iterate
  855.    end /* do */
  856.    if avar='OUTFILE' then do
  857.        outfile=strip(aval) ;iterate
  858.    end /* do */
  859.    if avar='PFILE' then do                      /* read parameter file */
  860.        psize=stream(strip(aval),'c','query size')
  861.        if psize>0  then do
  862.              gge=charin(strip(aval),1,psize)
  863.              t0=''
  864.              do forever
  865.                 if gge='' then leave
  866.                 parse var gge b1 '0d0a'x gge
  867.                 t0=t0||b1';'
  868.              end /* do */
  869.              plist=t0||plist
  870.              iterate
  871.        end /* do */
  872.    end /* do */
  873.  
  874.    AVAR=STRIP(TRANSLATE(AVAR))
  875.    if avar='' | avar=';' then iterate
  876.  
  877.    IF WORDPOS(AVAR,PLIST_OK)=0  & nosay<>1 then DO
  878.        SAY "Parameter Error: no such parameter= "avar
  879.        iterate
  880.    end /* do */
  881.    if datatype(strip(aval))='NUM' then aval=strip(aval)
  882.    oldval=value(avar)
  883.    foo=value(avar,aval)
  884.    if nosay<>1 then  say " Changing "avar" from "reverse||oldval||normal' to 'bold||aval||normal
  885. end /* do */
  886. return 1
  887.  
  888.  
  889.  
  890.  
  891. /*************/
  892. /* write a box around a string. Use lineart, or ascii characters */
  893. /* box if no ncols, then use width of longest line */
  894. /* if ncols, cut longest line at ncols */
  895. box_around:procedure expose  lineart tablefiller crlf
  896. parse arg ah,ncols
  897. if ncols="" then do     /* no length -- use length of longest line */
  898.    smot=ah ; ncols=0
  899.    do forever
  900.       if smot='' then leave
  901.       parse var smot al1 (crlf) smot
  902.       ncols=max(max,length(al1))
  903.    end /* do */
  904. end /* do */
  905.  ahz='_' ; avt='|'
  906.  ah2='   'copies(ahz,ncols+1)||crlf
  907.  if lineart=1 then do
  908.        ahz=d2c(196) ; avt=d2c(179)
  909.        ah2=' 'd2c(218)||copies(ahz,ncols)||d2c(191)||crlf
  910.  end
  911.  do until ah=''
  912.         parse var ah  aline (crlf) ah
  913.         aline=left(aline,ncols,tablefiller)
  914.         if lineart=1 then
  915.               ah2=ah2' 'avt||aline||avt
  916.         else
  917.               ah2=ah2' 'avt' 'aline' 'avt
  918.         if ah<>'' then ah2=ah2||crlf
  919.   end /* do */
  920.   if lineart=1 then
  921.           ah2=ah2||crlf||' 'd2c(192)||copies(ahz,ncols)||d2c(217)||crlf
  922.   else
  923.          ah2=ah2||crlf'   'copies(ahz,ncols+1)||crlf
  924.  
  925.   return ah2
  926.  
  927.  
  928. /*******************/
  929. /* a "list flag" needed? */
  930. figflag:procedure expose olcnts flagul flagmenu listtypes flagtl oltypes.
  931. parse arg thisval
  932.  
  933.  if listtypes='' then return ''
  934.  IW=WORDS(LISTTYPES)
  935.   LASTT=WORD(LISTTYPES,IW)
  936.  
  937. select
  938.   when lastt='UL' then aflag=nth_word(flagul,iw)
  939.   when lastt='TL' then aflag=nth_word(flagtl,iw)
  940.   when lastt='MENU' | lastt='DIR' then aflag=nth_word(flagmenu,iw)
  941.   when lastt='OL' then do
  942.      iw2=words(olcnts)
  943.      io2=strip(word(olcnts,iw2))
  944.      io2=io2+1
  945.      if datatype(thisval)='NUM' then io2=thisval  /* VALUE attribute in LI ? */
  946.      olhere=oltypes.iw2
  947.      if io2>words(olhere) then
  948.         aflag=io2+1
  949.      else
  950.         aflag=strip(word(olhere,io2))
  951.      aflag=aflag'.'
  952.      if iw2<1 then
  953.          call do_display_error 1, "Warning: Problem with OL UL or SELECT ","UNEXPECTED_DELWORD" 
  954.      else
  955.          olcnts=delword(olcnts,iw2)' 'io2
  956.   end /* do */
  957.   otherwise nop
  958. end  /* select */
  959.  
  960. return aflag
  961.  
  962.  
  963.  
  964. /***********************************/
  965. img_convert:
  966. parse upper arg aimg,hrefsrc,p1,p2
  967. if addonmode<>1 then say bold ' Converting <'aIMG'> elements ... ' normal
  968. stuff2=''
  969. iat=1
  970. tbody=translate(body)
  971. do forever
  972.   iat2=pos('<'||aIMG,tbody,iat)
  973.   if iat2=0 then leave          /* all done */
  974.  
  975. /* found an IMG element. Extract it, modify body */
  976.    iat3=pos('>',body,iat2)
  977.     imgis=substr(body,iat2+4,iat3-(iat2+4))
  978.     imgname=get_elem_val(imgis,'ALT')
  979.     if imgname='' then do
  980.         imgname=get_elem_val(imgis,hrefsrc)
  981.         rimg=reverse(imgname)
  982.         if pos('.',rimg)>0 then parse var rimg . '.' rimg
  983.         rimg=strip(rimg,'l','/')
  984.         parse var rimg imgname '/' .
  985.         imgname=reverse(imgname)
  986.         if imgname='' then imgname='IMG'
  987.     end /* do */
  988.  
  989.    IF IMGSTRING_MAX<LENGTH(IMGNAME) & IMGSTRING_MAX>1 then
  990.         IMGNAME=LEFT(IMGNAME,IMGSTRINg_MAX)
  991.  
  992.     abody=left(body,iat2-1)||p1||'<IMG 'imgname'>'||p2
  993.     iat=length(abody)
  994.     body=abody||substr(body,iat3+1)
  995.     tbody=abody||substr(tbody,iat3+1)
  996. end
  997.  
  998. return 1
  999.  
  1000.  
  1001.  
  1002.  
  1003. /****************/
  1004. /* set global vars */
  1005. set_vars:
  1006.  
  1007. aflag=0
  1008.  
  1009. if datatype('IMGSTRING_MAX')<>'NUM' then imngstring_max=0
  1010.  
  1011. tablefiller=do_d2c(tablefiller,' ')
  1012. tablevert=do_d2c(tablevert,'|')
  1013. tablehoriz=do_d2c(tablehoriz,'_')
  1014.  
  1015. hrbig=do_d2c(hrbig,'=')
  1016.  
  1017. quotestring1=do_d2c(quotestring1,'`')
  1018. quotestring2=do_d2c(quotestring2,"`")
  1019.  
  1020. radiobox=do_d2c(radiobox,'o')
  1021. checkbox=do_d2c(checkbox,'O')
  1022. radioboxcheck=do_d2c(radioboxcheck,'x')
  1023. checkboxcheck=do_d2c(checkboxcheck,'x')
  1024.  
  1025. flagselect=do_d2c(flagselect,'?')
  1026. flagselect2=do_d2c(flagselect2,'x')
  1027.  
  1028. submitmark1=do_d2c(submitmark1,'{')
  1029. submitmark2=do_d2c(submitmark2,'}')
  1030.  
  1031. textmark1=do_d2c(textmark1,'[')
  1032. textmark2=do_d2c(textmark2,']')
  1033. textmark=do_d2c(textmark,'.')
  1034.  
  1035.  
  1036. prea=do_d2c(prea,'<')
  1037. posta=do_d2c(posta,'>')
  1038. preh1=do_d2c(preh1,':')
  1039. posth1=do_d2c(posth1,':')
  1040. prehn=do_d2c(prehn,':')
  1041. posthn=do_d2c(posthn,':')
  1042.  
  1043. preimg=do_d2c(preimg,'[')
  1044. postimg=do_d2c(postimg,'[')
  1045.  
  1046. flagul=do_d2c(flagul,'*',1)
  1047. flagmenu=do_d2c(flagmenu,'@',1)
  1048. flagtl=do_d2c(flagtl,'=',1)
  1049.  
  1050. return 1
  1051.  
  1052.  
  1053.  
  1054. /***********************************/
  1055. /* get string ending with /TOFIND */
  1056. getelem:
  1057. parse upper arg tofind
  1058. tofind=strip(tofind)
  1059. foo=pos('<'||tofind,translate(body))
  1060. p1=left(body,foo-1)
  1061. body=substr(body,foo+1)
  1062. parse var body . '>' body
  1063. return p1
  1064.  
  1065.  
  1066. /********/
  1067. /* remove < > from a string */
  1068. remove_htmls:procedure expose preimg postimg
  1069. parse arg ast
  1070. ast0=''
  1071. do forever
  1072.   if ast='' then leave
  1073.   parse var ast v1 '<' v2 '>' ast
  1074.   v1a=''
  1075.   if abbrev(v2,'IMG')=1 then do
  1076.       parse var v2  . v1a '>'
  1077.       v1a=preimg||strip(v1a)||postimg
  1078.   end
  1079.   ast0=ast0||v1||v1a
  1080. end /* do */
  1081. return ast0
  1082.  
  1083.  
  1084.  
  1085. /***********************************/
  1086. /* dump something to output file */
  1087. sendout:procedure expose linelen outfile rightindent iscenter toolongword , 
  1088.                  prea posta crlf no_wordwrap doingtable, 
  1089.                  sendout_internal sendout_var suppress_blanklines wasblank , 
  1090.                  leftside. preimg postimg tablehoriz
  1091.  
  1092. parse arg toput,ispre,indent,aflag,XLINELEN,altype
  1093.  
  1094. if wordpos(strip(altype),'RIGHT CENTER')=0 then altype='LEFT' /* only supplied within tables */
  1095.  
  1096. if datatype(indent)<>'NUM' then indent=0
  1097.  
  1098.  
  1099. IF XLINELEN="" THEN XLINELEN=LINELEN
  1100. xlinelen_wrap=xlinelen
  1101. if  doingtable=0 & no_wordwrap=1 then xlinelen=10000000
  1102. dolft=1-sendout_internal
  1103.  
  1104. if (ispre='' | ispre=0)& toput=''  then do
  1105.   if suppress_blanklines=1 & wasblank=1 then do
  1106.       return 1           /* ignore this "extra crlf */
  1107.   end
  1108.   if  dolft=1 then toput=add_leftside(toput)
  1109.   if sendout_internal<>1 then do
  1110.       call lineout2 outfile,toput
  1111.   end
  1112.   else do
  1113.       sendout_var=sendout_var||toput||crlf
  1114.   end
  1115.   wasblank=1            /* signal "we just did a crlf (ignored if suppress_blanklines<>1 */
  1116.   return 1
  1117. end
  1118.  
  1119. wasblank=0              /* not a crlf, or a <PRE> crlf */
  1120.  
  1121.  
  1122. /* PRE-- send as is (with possible margin clipping */
  1123. if  ispre=1 then do
  1124.   if toolongword<1 then do
  1125.     toput0=''
  1126.     do forever
  1127.       if toput='' then leave
  1128.       parse var toput aline (crlf) toput
  1129.       if altype='CENTER' | iscenter=1 then do      /* center it*/
  1130.          isleft=min(xlinelen_wrap,Xlinelen)
  1131.          aline=center(aline,isleft)
  1132.       end
  1133.       if altype='RIGHT' | iscenter=2 then do      /* right it*/
  1134.          isleft=min(xlinelen_wrap,Xlinelen)
  1135.          aline=right(aline,isleft,' ')
  1136.       end
  1137.  
  1138.       aline=fix_linelen(aline,Xlinelen,toolongword,dolft,altype)
  1139.       toput0=toput0||aline
  1140.       if toput<>'' then do
  1141.          toput0=toput0||crlf
  1142.        end
  1143.     end
  1144.     toput=toput0
  1145.   end
  1146.   else do
  1147.      if dolft=1 then toput=add_leftside(toput)             /* uses leftside. global */
  1148.   end
  1149.  
  1150.   if sendout_internal<>1 then do
  1151.       call lineout2 outfile,toput
  1152.   end
  1153.   else do
  1154.       sendout_var=sendout_var||toput||crlf
  1155.   end
  1156.   return 1
  1157. end
  1158.  
  1159. /* pre, with indent */
  1160. if ispre=2 then do
  1161.   toput0=''
  1162.   do forever
  1163.       if toput='' then leave
  1164.       parse var toput aline (crlf) toput
  1165.  
  1166.       aline=fix_linelen(copies(' ',indent)||aline,Xlinelen,toolongword,dolft)  /* might use leftside. */
  1167.  
  1168.       toput0=toput0||aline
  1169.       if toput<>'' then toput0=toput0||crlf
  1170.   end
  1171.  
  1172.   toput=toput0
  1173.   if sendout_internal<>1 then do
  1174.       call lineout2 outfile,toput
  1175.   end
  1176.   else do
  1177.       sendout_var=sendout_var||toput||crlf
  1178.   end
  1179.   return 1
  1180. end
  1181.  
  1182. if aflag=0 & toput='' then return 1
  1183.  
  1184.  
  1185. if indent='' then indent=0
  1186. if indent<0 | indent>(Xlinelen-1) then indent=0
  1187. anindent=''
  1188. if indent>0 then anindent=copies(' ',indent)
  1189. anindent1=anindent
  1190.  
  1191. if aflag<>0 then do
  1192.   if indent>=(length(aflag)) then do
  1193.        indent=indent-length(aflag)
  1194.        anindent1=copies(' ',indent)||aflag||' '
  1195.        anindent=anindent' '
  1196.    end
  1197. end /* do */
  1198.  
  1199.  
  1200. linelenl=Xlinelen-(rightindent)    /* shorten linelen if blockquote is on */
  1201.  
  1202. /* remove extra spaces and crlfs */
  1203. toput=translate(toput,' ','0d0a0009'x)
  1204. toput=space(toput,1)
  1205. toput=translate(toput,' ','01'x)  /* hack used for &Nbsp */
  1206.  
  1207.  
  1208. if (length(toput)+indent + (dolft*leftside.!width) ) <linelenl then do  /* short string -- write it */
  1209.      if altype='CENTER' | iscenter=1 then do      /* center it*/
  1210.          isleft=min(xlinelen_wrap,Xlinelen)-length(anindent1)
  1211.          toput=center(toput,isleft)
  1212.      end
  1213.      if altype='RIGHT' | iscenter=2 then do      /* right it*/
  1214.          isleft=min(xlinelen_wrap,Xlinelen)-length(anindent1)
  1215.          toput=right(toput,isleft,' ')
  1216.      end
  1217.  
  1218.      if dolft=1 then toput=add_leftside(toput)             /* uses leftside. global */
  1219.  
  1220.      if sendout_internal<>1 then
  1221.        call lineout2 outfile,anindent1||toput
  1222.      else
  1223.         sendout_var=sendout_var||anindent1||toput||crlf
  1224.  
  1225.      return 1
  1226. end /* do */
  1227.  
  1228.  
  1229.  
  1230.  
  1231. /* else, parse into linelen chunks and write out */
  1232. aline=anindent1
  1233. do forever
  1234.    SUP1=0
  1235.    if toput='' then leave
  1236.    parse var toput aword toput
  1237.    IUU=POS('_',AWORD)
  1238.    IF IUU>0 & IUU<>LENGTH(AWORD) then DO  /* ALLOW _ TO BE WORD BREAKERS */
  1239.       AW1=LEFT(AWORD,IUU)
  1240.       AW2=SUBSTR(AWORD,IUU+1)
  1241.       AWORD=AW1
  1242.       TOPUT=AW2' 'TOPUT
  1243.       SUP1=1
  1244.    end /* do */
  1245.  
  1246.    lenword=length(aword)
  1247.  
  1248.    if lenword>(linelenl-(dolft*leftside.!width)) then do /* BIG word */
  1249.        if aline<>'' then do
  1250.          if altype='CENTER' | iscenter=1 then
  1251.             aline=center(aline,min(xlinelen_wrap,Xlinelen)-(dolft*leftside.!width))
  1252.          if altype='RIGHT'| iscenter=2 then
  1253.                  aline=right(aline,min(xlinelen_wrap,Xlinelen)-(dolft*leftside.!width))
  1254.  
  1255.          if dolft=1 then aline=add_leftside(aline)             /* uses leftside. global */
  1256.  
  1257.          if sendout_internal<>1 then
  1258.              call lineout2 outfile,aline
  1259.          else
  1260.              sendout_var=sendout_var||aline||crlf
  1261.        end
  1262.  
  1263.        aword=fix_linelen(aword,Xlinelen,toolongword,dolft)
  1264.        if sendout_internal<>1 then
  1265.               call lineout2 outfile,aword
  1266.         else
  1267.              sendout_var=sendout_var||aword||crlf
  1268.        aline=anindent
  1269.  
  1270.        iterate
  1271.    end /* do */
  1272.  
  1273.    if (length(aline)+lenword)>linelenl then do /* line + word too long */
  1274.        if altype='CENTER' | iscenter=1 then  aline=center(aline,min(xlinelen_wrap,Xlinelen)-(dolft*leftside.!width))
  1275.        if altype='RIGHT' | iscenter=2 then aline=right(aline,min(xlinelen_wrap,Xlinelen)-(dolft*leftside.!width))
  1276.  
  1277.        if dolft=1 then aline=add_leftside(aline)             /* uses leftside. global */
  1278.        if sendout_internal<>1 then
  1279.           call lineout2 outfile,aline
  1280.        else
  1281.            sendout_var=sendout_var||aline||crlf
  1282.        aline=anindent
  1283.    end /* do */
  1284.  
  1285.    IF SUP1=1 then
  1286.       aline=aline||aword      /* append this word to current line */
  1287.    ELSE
  1288.       aline=aline||aword||' '      /* append this word to current line */
  1289.  
  1290. end /* do */
  1291.  
  1292. if aline<>''  then  do
  1293.   if altype='CENTER' | iscenter=1 then  aline=center(aline,min(xlinelen_wrap,Xlinelen)-(dolft*leftside.!width))
  1294.   if altype='RIGHT' | iscenter=2 then aline=right(aline,min(xlinelen_wrap,Xlinelen)-(dolft*leftside.!width))
  1295.  
  1296.   aline=fix_linelen(aline,Xlinelen,toolongword,dolft)
  1297.   if sendout_internal<>1 then
  1298.      call lineout2 outfile,aline
  1299.   else
  1300.      sendout_var=sendout_var||aline||crlf
  1301. end
  1302. return 1
  1303.  
  1304.  
  1305. /*************************************/
  1306. /* remove <APPLET> ... </APPLET>  */
  1307. remove_applet:procedure expose body
  1308. parse upper arg badelem
  1309.  
  1310. do forever  /* exit with RETURN */
  1311.    tbody=translate(body)                /* not real efficient, but easy */
  1312.    app1=pos('<'badelem,tbody,1)
  1313.    if app1=0 then return 0
  1314.    app2=pos('</'||badelem,tbody,app1+5)
  1315.    if app2=0 then do
  1316.         say ' '
  1317.         say " Warning: no /"badelem ' element '
  1318.         return 0
  1319.    end /* do */
  1320.    body2=substr(body,app2+5)
  1321.    body=left(body,app1-1)
  1322.    parse var body2 . '>' body2
  1323.    body=body||body2
  1324. end
  1325.  
  1326.  
  1327. /*************************************/
  1328. /* REMOVE HTML COMMENTS, fix up <  x  elements, parse into HEAD and BODY sections (globals ) */
  1329. head_body:PROCEDURE expose head body normal reverse bold prenote addonmode
  1330. PARSE ARG STUFF
  1331.  
  1332. /* remove html comments */
  1333. if addonmode<>1 then say bold " Removing comments ... " normal
  1334. body="" ;iat=0
  1335. prenote=reverse||'   : '||normal
  1336. do forever              /*no comments within comments are allowed */
  1337.    if stuff="" then leave
  1338.    parse var stuff t1 '<!--' t2 '-->' stuff
  1339.    body=body||t1
  1340. end /* do */
  1341.  
  1342. /* convert < x to <x, where space can be space, tab, crlf */
  1343. if addonmode<>1 then say bold " Cleaning up elements " normal
  1344. stuff=body
  1345. body='' ;iat=0
  1346. hhlen=lengtH(stuff)
  1347. iat=0
  1348. do forever
  1349.   if stuff="" then leave
  1350.   parse var stuff t1 '<' t2 '>' stuff
  1351.   body=body||t1
  1352.   if abbrev(strip(t2),'<')=1 then do  /* get rid of < < */
  1353.      t2=substr(strip(t2,'l'),2)
  1354.      say " Warning: removing repeated < "
  1355.   end /* do */
  1356.   if t2<>''  then do
  1357.     t2=translate(t2,' ','0d0a0900'x) 
  1358.     t2=strip(t2)
  1359.     if t2<>'' then body=body||'<'||t2||'>'
  1360.   end
  1361.   if hhlen>15000 then iat=noteit(length(body),iat,10000,prenote)
  1362. end /* do */
  1363.  
  1364. if addonmode<>1 then say bold " Extracting <HEAD> and <BODY> " normal
  1365. /* pull out <HEAD> and <BODY> sections */
  1366. stuff=body ;iat=0
  1367. body='' ; head='' ; iat=0
  1368. headon=0; bodyon=0 ; headon2=0; bodyon2=0
  1369.  
  1370. tstuff=translate(stuff)
  1371. hd1=pos('<HEAD',tstuff,1)
  1372. hd2=pos('</HEAD',tstuff,max(hd1,1))
  1373.  
  1374. if hd1=0 & addonmode<>1 then say "Warning: no <HEAD> element "
  1375. if hd2=0 & addonmode<>1 then say "Warning: no </HEAD> element "
  1376.  
  1377. if hd2>0 then do
  1378.    hdlen=hd2-(hd1+5)  /*  <HEAD starts at 10, then read from 10+5 */
  1379.    head=substr(stuff,hd1,hdlen)
  1380.    parse var head . '>' head   /* get rid of remnand  > */
  1381. end /* do */
  1382.  
  1383. hd2=hd2+6  /* get by /HEAD */
  1384.  
  1385. bd1=pos('<BODY',tstuff,hd2)
  1386. bd2=pos('</BODY',tstuff,max(bd1+5,hd2))
  1387.  
  1388. if bd1=0 & addonmode<>1 then say "Warning: No <BODY> element "
  1389. if bd2=0 & addonmode<>1 then say "Warning: No <HEAD> element "
  1390.  
  1391. if bd1=0 then bd1=max(bd1+5,hd2)
  1392. if bd2=0 then bd2=length(tstuff)+1
  1393. bdlen=bd2-bd1
  1394. body=substr(stuff,bd1,bdlen)
  1395.  
  1396.  
  1397. /* extract TITLE  from HEAD */
  1398. do forever
  1399.    if head="" then leave
  1400.    parse var head t1 '<' t2 '>' head
  1401.    t2a=strip(translate(word(t2,1)))
  1402.    if t2a="TITLE" then do
  1403.       parse var head title '<' .
  1404.       return title
  1405.    end /* do */
  1406. end /* do */
  1407.  
  1408. return ' '
  1409.  
  1410.  
  1411.  
  1412.  
  1413. /***************/
  1414. /* return 0 for no, 1 for yes, default otherwise */
  1415. is_yes_no:procedure
  1416. parse arg aval,def
  1417. tdef=strip(translate(aval))
  1418. if wordpos(tdef,'Y YES 1')>0 then return 1
  1419. if wordpos(tdef,'N NO 0')>0 then return 0
  1420. return def
  1421.  
  1422.  
  1423.  /* ------------------------------------------------------------------ */
  1424.  /* function: Check if ANSI is activated                               */
  1425.  /*                                                                    */
  1426.  /* call:     CheckAnsi                                                */
  1427.  /*                                                                    */
  1428.  /* where:    -                                                        */
  1429.  /*                                                                    */
  1430.  /* returns:  1 - ANSI support detected                                */
  1431.  /*           0 - no ANSI support available                            */
  1432.  /*          -1 - error detecting ansi                                 */
  1433.  /*                                                                    */
  1434.  /* note:     Tested with the German and the US version of OS/2 3.0    */
  1435.  /*                                                                    */
  1436.  /*                                                                    */
  1437.  CheckAnsi: PROCEDURE
  1438.    thisRC = -1
  1439.  
  1440.    trace off
  1441.                          /* install a local error handler              */
  1442.    SIGNAL ON ERROR Name InitAnsiEnd
  1443.  
  1444.    "@ANSI 2>NUL | rxqueue 2>NUL"
  1445.  
  1446.    thisRC = 0
  1447.  
  1448.    do while queued() <> 0
  1449.      queueLine = lineIN( "QUEUE:" )
  1450.      if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
  1451.         pos( " (ON).", queueLine ) <> 0 then                    /* GER */
  1452.        thisRC = 1
  1453.    end /* do while queued() <> 0 */
  1454.  
  1455.  InitAnsiEnd:
  1456.  signal off error
  1457.  RETURN thisRC
  1458.  
  1459.  
  1460.  
  1461.  
  1462. /*********************************/
  1463. /* PROCESS A TABLE */
  1464. DO_TABLE:PROCEDURE EXPOSE BODY TABLES. ignore_width tablemode2 tablemaxnest  charwidth linelen_orig nospan ,
  1465.                         addonmode
  1466. parse arg table1
  1467. drop tables.
  1468.  
  1469. tableinner=0
  1470. tables.0=1
  1471. tables.1.!rows=0
  1472. tables.1.1.!cols=0
  1473. tables.1.1.!totcols=0
  1474. tables.1.!errors=''
  1475. tables.1.!caption=' '
  1476. tables.1.!captiona=' '
  1477. parse var table1 .  aspec
  1478. tables.1.!spec=aspec
  1479. tables.1.!align=get_elem_val(aspec,'ALIGN')
  1480. tables.1.!border=get_elem_val(aspec,'BORDER')
  1481.  
  1482.  
  1483. curtables=1
  1484.  
  1485. DO FOREVER
  1486.    if body='' then leave
  1487.    parse var body v1 '<' v2a '>' body
  1488.    v2=strip(translate(word(v2a,1)))
  1489.  
  1490.   tfoo=wordpos(v2,'TABLE TR TD TH /TABLE')
  1491.  
  1492.   if v2='TABLE' then do
  1493.       tableinner=tableinner+1
  1494.   end /* do */
  1495.  
  1496.   if tablemaxnest<tableinner  & tfoo>0 then do     /* inner tables not allowed, then..*/
  1497.       select
  1498.           when tablemode2=2 then do
  1499.              v2=strip(word('TL LI LI LI /TL',tfoo)) ;v2a=v2
  1500.           end
  1501.           when tablemode2=3 then do
  1502.              v2=strip(word('HR1 P BR BR HR2 ',tfoo)); v2a=v2
  1503.           end
  1504.           otherwise nop           /* make a table using ascii and/or lineart */
  1505.       end               /* select */
  1506.    end
  1507.    if tfoo=5 then tableinner=max(0,tableinner-1)
  1508.  
  1509.  
  1510.    if tfoo>0 then do    /*dump prior stuff, or perhaps convert */
  1511.            curtable=strip(word(curtables,1))
  1512.            currow=tables.curtable.!rows
  1513.            curcol=tables.curtable.currow.!cols
  1514.            if curcol>0 then do          /* add stuff */
  1515.               tables.curtable.currow.curcol.!stuff=tables.curtable.currow.curcol.!stuff||v1
  1516.            end
  1517.            else do
  1518.              if translate(v1,' ','0d0a0009'x)<>' '  & addonmode<>1 then 
  1519.                     say v1 ":ERROR:: Material outside of column at table " curtable " row " currow
  1520.            end /* do */
  1521.    end
  1522.  
  1523. /* TR: new row,  TD or TH: new colum, TABLE: new table definition */
  1524.    select
  1525.       when v2='TR' then do
  1526.         curtable=strip(word(curtables,1))
  1527.         currow=tables.curtable.!rows+1
  1528.         tables.curtable.!rows=currow
  1529.         parse var v2a . tables.curtable.currow.!spec
  1530.         tables.curtable.currow.!cols=0
  1531.         tables.curtable.currow.!totcols=0
  1532.  
  1533.       end /* do */
  1534.  
  1535.       when v2='TD' | v2='TH' then do
  1536.         curtable=strip(word(curtables,1))
  1537.         currow=tables.curtable.!rows
  1538.         curcol=tables.curtable.currow.!cols
  1539.  
  1540.         if currow=0 then do
  1541.                 tables.curtable.!rows=1
  1542.                 tables.curtable.1.!spec=''
  1543.                 tables.curtable.!errors=tables.curtable.!errors';MISSING_LEADING_TR '
  1544.                 currow=1
  1545.                 curcol=0
  1546.         end /* do */
  1547.  
  1548.         tdcols=get_elem_val(v2a,'COLSPAN')
  1549.         if datatype(tdcols)<>'NUM' | nospan=1 then tdcols=1
  1550.         if tdcols<=0  then tdcols=1
  1551.  
  1552.         tdrows=get_elem_val(v2a,'ROWSPAN')
  1553.         if datatype(tdrows)<>'NUM' | nospan=1 then tdrows=1
  1554.         if tdrows<=0 then tdrows=1
  1555.  
  1556.         curcol=curcol+1
  1557.  
  1558. /* A ROWSPAN KICKED IN? */
  1559.         DO FOREVER
  1560.           oaa=SYMBOL('TABLES.'CURTABLE'.'CURROW'.'CURCOL'.!ROWSPAN')
  1561.           if oaa='VAR' then do
  1562.              tables.curtable.currow.!totcols=tables.curtable.currow.!totcols+ ,
  1563.                                              tables.curtable.currow.curcol.!colspan
  1564.              CURCOL=CURCOL+1       /* if here, prior row's rowspan created this var */
  1565.           end
  1566.           else do
  1567.              leave
  1568.           end
  1569.         END
  1570.  
  1571.         tables.curtable.currow.!cols=curcol   /* !cols is actualys "TDs" */
  1572.  
  1573. /* wastot = actual # of columns (includes colspans */
  1574.         wastot=tables.curtable.currow.!totcols
  1575.         tables.curtable.currow.!totcols=wastot+tdcols
  1576.  
  1577. /* specs etc for this cell */
  1578.         parse var v2a . tables.curtable.currow.curcol.!spec
  1579.         tables.curtable.currow.curcol.!TH=v2
  1580.         tables.curtable.currow.curcol.!stuff=''
  1581.         tables.curtable.currow.curcol.!colspan=tdcols
  1582.         tables.curtable.currow.curcol.!rowspan=tdrows
  1583.         tables.curtable.currow.curcol.!nobot=0
  1584.         if tdrows>1 then tables.curtable.currow.curcol.!nobot=1
  1585.  
  1586. /* if rowspan>1, then create cells in next trs */
  1587.         DO CUR2=CURROW+1 TO (CURROW+TDROWS-1)
  1588.  
  1589.            tables.curtable.cur2.curcol.!th=v2
  1590.            tables.curtable.cur2.curcol.!colspan=tdcols
  1591.            tables.curtable.cur2.curcol.!spec=''
  1592.            if cur2<>(currow+tdrows-1) then do
  1593.               tables.curtable.cur2.curcol.!nobot=1
  1594.               TABLES.CURTABLE.CUR2.curcol.!ROWSPAN=-1
  1595.            end
  1596.            else do
  1597.                 tables.curtable.cur2.curcol.!nobot=0
  1598.                 TABLES.CURTABLE.CUR2.curcol.!ROWSPAN=1
  1599.            end
  1600.            TABLES.CURTABLE.CUR2.curcol.!STUFF='  '
  1601.         end /* do */
  1602.       end /* do */
  1603.  
  1604.  
  1605.       when v2='CAPTION' then do         /* table caption */
  1606.          curtable=strip(word(curtables,1))
  1607.          foo1=pos('</TABLE',translate(body))
  1608.          foo2=pos('</CAPTION',translate(body))
  1609.          if foo2=0 | foo1<foo2 then do
  1610.               say v1 ":ERROR:: Unclosed CAPTION at table " curtable 
  1611.               tables.curtable.!errors=tables.curtable.!errors';UNCLOSED_CAPTION '
  1612.          end    
  1613.          acaption=left(body,foo2-2)
  1614.          body=substr(body,foo2)
  1615.          parse var body . '>' body
  1616.          tables.curtable.!captiona=get_elem_val(v2a,'ALIGN')
  1617.          tables.curtable.!caption=acaption
  1618.       end /* do */
  1619.  
  1620.       when v2='TABLE' then do           /* a sub table */
  1621.  
  1622.         kurtable=strip(word(curtables,1))
  1623.         kurrow=tables.kurtable.!rows
  1624.         kurcol=tables.kurtable.kurrow.!cols
  1625.         curtable=tables.0+1
  1626.  
  1627.         if kurcol>0 then do          /* add stuff */
  1628.             moose= tables.kurtable.kurrow.kurcol.!stuff
  1629.             tables.kurtable.kurrow.kurcol.!stuff=moose||' <_TABLE_ 'curtable '>'
  1630.         end
  1631.         else do
  1632.            if translate(v1,' ','0d0a0009'x)<>' ' then do
  1633.                 if addonmode<>1 then
  1634.                    say v1 ":ERROR:: NEW table of column at table " kurtable " row " kurrow
  1635.                 tables.kurtable.!errors=tables.kurtable.!errors';PREMATURE_NEW_COLUMN '
  1636.            end
  1637.         end /* do */
  1638.  
  1639.         TABLES.0=CURTABLE
  1640.         curtables=curtable' 'curtables
  1641.         tables.curtable.!rows=0
  1642.         tables.curtable.1.!cols=0
  1643.         tables.curtable.1.!totcols=0
  1644.         tables.curtable.!errors=''
  1645.         tables.curtable.!caption=' '
  1646.         tables.curtable.!captiona=' '
  1647.         PARSE VAR V2A . aspec
  1648.  
  1649.         TABLES.CURTABLE.!SPEC=aspec
  1650.         tables.curtable.!border=get_elem_val(aspec,'BORDER')
  1651.         tables.curtable.!align=get_elem_val(aspec,'ALIGN')
  1652.  
  1653.  
  1654.       end /* do */
  1655.  
  1656.       when v2='/TABLE' then do                  /* end of table, pop an index from curtables */
  1657.            if words(curtables)=1 then leave
  1658.            parse var curtables . curtables
  1659.       end
  1660.  
  1661.       otherwise do              /* add to !stuff of current cell */
  1662.         curtable=strip(word(curtables,1))
  1663.  
  1664.          v2a2='<'v2a'>'
  1665.  
  1666.          currow=tables.curtable.!rows ; curcol=tables.curtable.currow.!cols
  1667.          if currow=0 | curcol=0 then do
  1668.                 if addonmode<>1 then
  1669.                    say " ERROR: row or column not specified ("currow curcol")"
  1670.                 iterate
  1671.          end
  1672.          tables.curtable.currow.curcol.!stuff=tables.curtable.currow.curcol.!stuff||v1||v2a2
  1673.      end
  1674.   end                   /*select */
  1675. end
  1676.  
  1677.  
  1678. return 1
  1679.  
  1680.  
  1681.  
  1682. /************/
  1683. /* determine tablewidth in character s*/
  1684. get_tablewidth:procedure expose charwidth linelen_orig ignore_width 
  1685. parse arg specs,linelen
  1686.  
  1687. tablewidth=strip(get_elem_val(specs,'WIDTH'))
  1688.  
  1689. if tablewidth='' | ignore_width<>0 then  do
  1690.   tablewidth=linelen
  1691. end
  1692. else do
  1693.    if right(tablewidth,1)='%' then do           /* pct of line lenght */
  1694.          tablewidth=strip(tablewidth,,'%')
  1695.          if datatype(tablewidth)<>'NUM' then do
  1696.             tablewidth=linelen
  1697.          end
  1698.          else do
  1699.             tablewidth=(tablewidth/100)*linelen_orig
  1700.             tablewidth=trunc(min(tablewidth,linelen))
  1701.          end
  1702.    end /* do */
  1703.    else do              /* convert pixels to charactes */
  1704.          if datatype(tablewidth)='NUM' then do
  1705.             tablewidth=trunc(min(tablewidth/charwidth,linelen))
  1706.          end /* do */
  1707.          else do
  1708.             tablewidth=linelen
  1709.          end
  1710.    end /* do */
  1711.    tablewidth=max(2,tablewidth)   /* can't bee too small */
  1712. end /* do */
  1713. return tablewidth
  1714.  
  1715. /****************/
  1716. /* determine max width of cell (check for WIDTH element */
  1717. get_tdwidth:procedure expose charwidth
  1718. parse arg aspec,linelen,ign,stuff2,colspan
  1719.  
  1720. tdwidth=''
  1721. if ign=0 then tdwidth=strip(get_elem_val(aspec,'WIDTH'))
  1722.  
  1723. if tdwidth='' | ign>0 | colspan>1 then  do
  1724.   if ign=2 | colspan>1  then return '0 0 0'
  1725.   eff=qcell_width(stuff2,linelen)                /* rough guess as to max and min linelength */
  1726.   return 0' 'eff      /* 0 means "no default length found */
  1727. end
  1728.  
  1729. /* convert % to characters */
  1730. if right(tdwidth,1)='%' then do
  1731.          tdwidth=strip(tdwidth,,'%')
  1732.          if datatype(tdwidth)<>'NUM' then  return 0  /* error- ignore width */
  1733.          tdwidth=trunc(min(linelen*tdwidth/100,linelen))
  1734. end /* do */
  1735. else do              /* convert pixels to charactes */
  1736.       if datatype(tdwidth)<>'NUM' then  return 0  /* error- ignore width */
  1737.       tdwidth=min(trunc(tdwidth/charwidth,linelen))
  1738. end /* do */
  1739. return trunc(max(tdwidth,1))
  1740.  
  1741.  
  1742.  
  1743. /*************************/
  1744. /* quick guess at length of line in a cell (after html mappings */
  1745. qcell_width:procedure
  1746. parse arg stuff,deflen
  1747. ithl=0
  1748. aline=''
  1749. do forever
  1750.  
  1751.   if stuff='' then do
  1752.         ithl=ithl+1 ; tlines.ithl=aline
  1753.         leave
  1754.   end /* do */
  1755.  
  1756.   parse upper var stuff t1 '<' t2 '>' stuff
  1757.  
  1758.   if pos('&',t1)>0 then do
  1759.     t1a=''
  1760.     do forever
  1761.        if t1='' then leave
  1762.        parse var t1  p1 '&' p2 ';' t1
  1763.        if p2<>"" then
  1764.           t1a=t1a||p1'x'
  1765.        else
  1766.           t1a=t1a||p1
  1767.     end
  1768.     t1=t1a
  1769.   end /* do */
  1770.  
  1771.   t1=space(translate(t1,' ','000d0a0d'x))
  1772.   aline=aline||t1
  1773.  
  1774.   parse var t2 t2a t2b ; t2a=strip(t2a); t2a=strip(t2a,,'/')
  1775.  
  1776.  
  1777.   if wordpos(t2a,'HR HR2 HR1 P BR H1 H2 H3 H4 H5 H6 H7 PRE ')>0 then do
  1778.         ithl=ithl+1 ; tlines.ithl=alineadd||aline
  1779.         aline='' ; iterate ; alineadd=''
  1780.   end
  1781.  
  1782.   if t2a='_TABLE_' then do
  1783.         ithl=ithl+1 ; tlines.ithl=copies('x',deflen); aline='' ;alineadd=''
  1784.         iterate
  1785.   end /* do */
  1786.  
  1787.   if wordpos(t2a,'BLOCKQUOTE TL SELECT UL DL OL MENU DIR ')>0 then do
  1788.         ithl=ithl+1 ; tlines.ithl=alineadd||aline
  1789.         alineadd='         ' ; iterate                /* no nested indenting, might fix later */
  1790.    end
  1791.  
  1792.  
  1793.   IF T2A='IMG' then DO
  1794.        PARSE VAR T2  . FOO
  1795.        foo=space(translate(foo,' ','000d0a0d'x))
  1796.        ALINE=ALINE||'x'FOO ; ITERATE
  1797.   END
  1798.  
  1799.    if t2a='INPUT' then do
  1800.           atype=TRANSLATE(get_elem_val(t2,'TYPE'))
  1801.           IF ATYPE='' then ATYPE='TEXT'
  1802.           avalue=get_elem_val(t2,'VALUE',1)
  1803.           if atype='RADIO' | atype='CHECKBOX' then do
  1804.             aline=aline' '
  1805.           end
  1806.           if atype='TEXT' then do
  1807.                av2=get_elem_val(t2,'SIZE')
  1808.                if av2='' then av2=get_elem_val(t2a,'SIZE')
  1809.                if av2='' then av2=4
  1810.                aline=aline'xx'||copies('_',av2)
  1811.           end
  1812.           if atype='FILE' then do
  1813.                av2=get_elem_val(t2,'SIZE')
  1814.                if av2='' then av2=get_elem_val(t2a,'SIZE')
  1815.                if av2='' then av2=12
  1816.                aline=aline'xx'||copies('_',av2)
  1817.           end
  1818.  
  1819.           if atype='SUBMIT' | atype='RESET' then do
  1820.                 if avalue='' then avalue='     '
  1821.                 aline=aline'  '||avalue
  1822.           end /* do */
  1823.          iterate
  1824.    end
  1825.  
  1826. /* paragraph modifiers */
  1827.    if wordpos(t2a,'A OPTION '||doquote)>1 then do
  1828.         aline=aline' '                  /* add space for quote characters */
  1829.    end /* do */
  1830.  
  1831. end
  1832.  
  1833. mxlen=2
  1834. mnlen=2
  1835. do iii=1 to ithl
  1836.     mxlen=max(mxlen,length(tlines.iii))
  1837.     do ithlw=1 to words(tlines.iii)
  1838.         sww=strip(word(tlines.iii,ithlw))
  1839.         if left(sww,1)='&' then sww='x'
  1840.         mnlen=max(mnlen,length(sww))
  1841.     end
  1842. end
  1843.  
  1844. drop tlines.
  1845.  
  1846. return mxlen' 'mnlen
  1847.  
  1848.  
  1849.  
  1850.  
  1851.  
  1852. /******************************/
  1853. /* various utility procedures */
  1854.  
  1855. /***********************************/
  1856. /* load libraries, set ansi, set defaults */
  1857. loadlibs:
  1858. foo=rxfuncquery('sysloadfuncs')
  1859. if foo=1 then do
  1860.   foo2=RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs')
  1861.   if foo2=0 then call SysLoadFuncs
  1862. end
  1863.  
  1864. cy_ye=' '; normal=''; bold='';re_wh='';reverse='';aesc=''
  1865. if noansi<>1 then do
  1866.   aesc='1B'x
  1867.   cy_ye=aesc||'[37;46;m'
  1868.   normal=aesc||'[0;m'
  1869.   bold=aesc||'[1;m'
  1870.   re_wh=aesc||'[31;47;m'
  1871.   reverse=aesc||'[7;m'
  1872. end
  1873.  
  1874. return 1
  1875.  
  1876.  
  1877. /********************/
  1878. /* get, possibly quoted, value of a field in an html type <element > */
  1879. get_elem_val:procedure
  1880. parse arg haystack,needle,lc
  1881. haystack=translate(haystack,' ','000d0a09'x)
  1882.  
  1883. thay=' 'translate(haystack)
  1884. needle=' '||translate(needle)||'='
  1885. foo=pos(needle,thay)
  1886. if foo=0 then return ''
  1887. haystack=strip(substr(haystack,foo+length(needle)-1))
  1888.  
  1889. if abbrev(haystack,'"')=1 then
  1890.   parse var haystack '"' aval '"' .
  1891. else
  1892.   parse var haystack aval .
  1893.  
  1894. if lc<>1 then aval=translate(aval)
  1895. return aval
  1896.  
  1897.  
  1898. /***************/
  1899. /* convert to ascii, but only if >1 character that is
  1900.  a numeric value. */
  1901. do_d2c:procedure expose lineart
  1902. parse arg a1,defval,islist
  1903.  
  1904.  
  1905. if islist=1 then do
  1906.   alist2=''
  1907.   do forever
  1908.      if a1='' then leave
  1909.      parse var a1 a1a a1 ; a1a=strip(a1a)
  1910.      if length(a1a)>1 & datatype(a1a)='NUM' then do
  1911.        if lineart>-1 then
  1912.          a1a=d2c(a1a)
  1913.        else
  1914.          a1a=defval
  1915.      end
  1916.      alist2=alist2||a1a' '
  1917.   end /* do */
  1918.   return alist2
  1919. end /* do */
  1920. else do
  1921.   if length(a1)>1 & datatype(a1)='NUM' then  do
  1922.     if lineart>-1 then
  1923.        a1=d2c(a1)
  1924.     else
  1925.        a1=defval
  1926.   end
  1927.   return a1
  1928. end
  1929.  
  1930.  
  1931.  
  1932. /* -------------------- */
  1933. /* get a yes or no , return 1 if yes */
  1934. yesno:procedure expose normal reverse bold
  1935. parse arg fooa , allopt,altans
  1936. if altans<>" " & words(altans)>1 then do
  1937.    w1=strip(word(altans,1))
  1938.    w2=strip(word(altans,2))
  1939.    a1=left(w1,1) ; a2=left(w2,1)
  1940.    a1a=substr(w1,2) ; a2a=substr(w2,2)
  1941. end
  1942. else do
  1943.     a1='Y' ; a1a='es'
  1944.     a2='N' ; a2a='o'
  1945. end  /* Do */
  1946. ayn='  '||bold||a1||normal||a1a||'\'||bold||a2||normal||a2a
  1947. if allopt=1 then  ayn=ayn||'\'||bold||'A'||normal||'ll'
  1948.  
  1949. do forever
  1950.  foo1=normal||reverse||fooa||normal||ayn
  1951.  call charout,  foo1 normal ':'
  1952.  pull anans
  1953.  if abbrev(anans,a1)=1 then return 1
  1954.  if abbrev(anans,a2)=1 then return 0
  1955.  if allopt=1 & abbrev(anans,'A')=1 then return 2
  1956. end
  1957.  
  1958.  
  1959.  
  1960. /*********************/
  1961. /* select nth from a sequence of words -- use first if nth ># words */
  1962. nth_word:procedure
  1963. parse arg alist,nth
  1964. if words(alist)=1 then return alist
  1965. if nth>words(alist) then nth=1
  1966. return strip(word(alist,nth))
  1967.  
  1968. /************/
  1969. /* running status report to screen  */
  1970. noteit:procedure
  1971. parse arg nowlen,waslen,blocksize,prenote
  1972. if nowlen-waslen> blocksize then do
  1973.    call charout,'0d'x || '0d'x||prenote' 'nowlen
  1974.    return nowlen
  1975. end /* do */
  1976. return waslen
  1977.  
  1978.  
  1979. /***********************/
  1980. /* wrap or strip a string */
  1981. fix_linelen:procedure expose leftside. preimg postimg prea posta crlf
  1982.  
  1983. parse arg aline,llen,itype,dolft,altype
  1984. adash=' '
  1985. select
  1986.    when length(aline)<=(llen-(dolft*leftside.!width)) then do  /* as is */
  1987.        bud=aline
  1988.        if dolft=1 then bud=add_leftside(aline)
  1989.    end /* do */
  1990.  
  1991.    when itype=-1 then do                /* trim */
  1992.       aline=shrink_in(preimg,aline,postimg,llen)                /* remove stuff between quotes */
  1993.       aline=shrink_in(prea||preimg,aline,postimg||posta,llen)
  1994.       arf=substr(aline,2,1)             /* detect line of all same stuff */
  1995.       repeats=1
  1996.       do iarf=3 to length(aline)-1       
  1997.          if arf=substr(aline,iarf,1) then iterate
  1998.          repeats=0 ; leave
  1999.       end /* do */
  2000.       if repeats=0 then do              /* not all same stuff */
  2001.         bud=left(aline,llen-(dolft*leftside.!width))  /* trim */
  2002.       end
  2003.       else do           /* all same stuff, remove junk from middle */
  2004.            tt1=left(aline,1); tt2=right(aline,1)
  2005.            bud=copies(arf,max(1,llen-((dolft*leftside.!width)+2)))
  2006.            bud=tt1||bud||tt2
  2007.       end /* do */
  2008.       if dolft=1 then bud=add_leftside(aline)
  2009.    end
  2010.  
  2011.    otherwise do
  2012.       bud=''
  2013.       alime=strip(aline,'t')
  2014.       if length(alime)<=(llen-(dolft*leftside.!width)) then do  /* as is */
  2015.          bud=alime
  2016.          if dolft=1 then bud=add_leftside(alime)
  2017.       end /* do */
  2018.       else do
  2019.         do mm=1 to length(alime) by (llen-((dolft*leftside.!width)+1))
  2020.            s2=substr(alime,mm,llen-1)
  2021.            if dolft=1 then s2=add_leftside(s2)
  2022.            bud=bud||s2||adash||crlf
  2023.         end /* do */
  2024.         if length(bud)>3 then
  2025.         bud=left(bud,length(bud)-3)   /* clip last adash||crlf */
  2026.       end                        /* too long ,even after stripping */
  2027.    end   /*otherwise */
  2028. end             /* select */
  2029.  
  2030. return bud
  2031.  
  2032.  
  2033. /**********************/
  2034. /* remove middle, unimportatnt portions of quoted string */
  2035. shrink_in:procedure
  2036. parse arg q1,aline,q2,llen
  2037. q1=space(q1,0)
  2038. q2=space(q2,0)
  2039. iq1=length(q1)
  2040. iq2=length(q2)
  2041. if (left(aline,iq1)=q1) & (right(aline,iq2)=q2)  &  (llen>(iq1+iq2+1))  then do
  2042.            aline=q1||substr(aline,iq1+1,llen-(iq1+iq2))||q2
  2043. end
  2044. return aline
  2045.  
  2046. /***************/
  2047. /* add leftside. stuff */
  2048.  
  2049. add_leftside:procedure expose leftside.
  2050. parse arg bud
  2051. if leftside.!width>0  then do
  2052.    if leftside.!done<leftside.0 then do
  2053.       iss=leftside.!done+1
  2054.       bud=leftside.iss' 'bud
  2055.       leftside.!done=iss
  2056.       if iss=leftside.0 then do
  2057.           leftside.0=0 ;leftside.!done=0
  2058.       end
  2059.       drop leftside.iss
  2060.    end
  2061.    else do
  2062.         bud=copies(' ',leftside.!width)||bud
  2063.    end /* do */
  2064. end
  2065. return bud
  2066.  
  2067.  
  2068. /***************/
  2069. /* ADD SPECIAL "LOGICAL ELEMENT" CHARACTERS? */
  2070. fix_quote_anchor:procedure expose link_display links_list. anchoron1 anchoron2 quoteon1 quoteon2 ,
  2071.                 quotestring1 quotestring2 prea posta thispara
  2072. parse arg t1
  2073.  
  2074.      firstspace=verify(t1,' ')
  2075.      if firstspace=0 then signal stp2
  2076.  
  2077.      if anchoron1=1 then do
  2078.           select
  2079.              when link_display=1 then do 
  2080.                 t1='['||links_list.0||']'||strip(t1)
  2081.              end
  2082.              when link_display=2 then do
  2083.                 mm3=links_list.0
  2084.                 parse var links_list.mm3 atp '?' .
  2085.                 t1='<"'atp'">'||t1
  2086.              end /* do */
  2087.              otherwise nop
  2088.           end  /* select */
  2089.          firstspace=verify(t1,' ')
  2090.           t1=insert(prea,t1,firstspace-1)     /* preface this with prea */
  2091.           anchoron1=0
  2092.      end
  2093.  
  2094.  
  2095.  
  2096.      if quoteon1=1 & t1<>'' then do
  2097.            t1=insert(quotestring1,t1,firstspace-1)
  2098.            quoteon1=0
  2099.      end
  2100.  
  2101. stp2:
  2102.      lenth=length(thispara)
  2103.      if thispara='' then
  2104.          lastchar=0
  2105.      else
  2106.          lastchar= 1+lenth-verify(reverse(thispara),' ')
  2107.  
  2108.      if anchoron2=1 then do
  2109.             thispara=insert(posta,thispara,lastchar)
  2110.             anchoron2=0
  2111.      end
  2112.      if quoteon2=1 & thispara<>'' then do
  2113.            thispara=insert(quotestring2,thispara,lastchar)
  2114.            quoteon2=0
  2115.      end
  2116.      return t1
  2117.  
  2118.  
  2119. /**********************/
  2120. /* convert table elements? (uses globals */
  2121. cvt_table_elements:procedure expose t2a tablemode addonmode
  2122. parse arg t2,inmain
  2123.  
  2124.     tfoo=wordpos(t2,'TABLE TR TD TH /TABLE ')
  2125.     if tfoo>0 then do           /* a table element ... */
  2126.  
  2127. /*   note: if tablemode=1, one should NEVER see TR TD or TH */
  2128.       if tablemode=1 & tfoo>1 & inmain=1 & addonmode<>1 then do
  2129.           say ' '
  2130.           say "Warning: syntax error; TD TR or TH detected in main "
  2131.       end /* do */
  2132.  
  2133.       select
  2134.           when tablemode=2 then do
  2135.              t2=strip(word('TL LI LI LI /TL',tfoo)) ;t2a=t2
  2136.           end
  2137.           when tablemode=3 then do
  2138.              t2=strip(word('HR1 P BR BR HR2 ',tfoo)); t2a=t2
  2139.           end
  2140.           otherwise nop           /* make a table using ascii and/or lineart */
  2141.       end               /* select */
  2142.    end          /* tfoo */
  2143.    return t2
  2144.  
  2145.  
  2146. /*************/
  2147. /* CONVERT &ENCODING */
  2148. CONVERT_CODES:PROCEDURE
  2149. PARSE ARG T1,CAPON,ISPRE,ULINEON,ISTH
  2150.  
  2151. IF T1='' then RETURN T1
  2152.  
  2153.       if capon>0 | ISTH='TH' then t1=translate(t1)
  2154.       if ispre=0 then t1=translate(T1,' ','0d0a0009'x)
  2155.       if ulineon=1 then do
  2156.            if ispre=0 then
  2157.               t1= translate(space(t1,1),'_',' ')
  2158.            else
  2159.               t1=translate(t1,'_',' ')
  2160.       end /* do */
  2161.  
  2162.       tt1=t1 ;t1=''
  2163.       do forever
  2164.         if tt1='' then leave
  2165.         parse var tt1 v1 '&' v2a tt1
  2166.  
  2167.         t1=t1||v1
  2168.         goo=pos(';',v2a)
  2169.  
  2170.         if goo>0 then do
  2171.             v2=left(v2a,goo-1)
  2172.             v3a=substr(v2a,goo+1)
  2173.             tt1=v3a' 'tt1
  2174.         end /* do */
  2175.         else do
  2176.            v2=v2a
  2177.         end /* do */
  2178.  
  2179.         v2=strip(v2)
  2180.  
  2181.         if v2<>"" then do
  2182.             v2=strip(translate(v2))
  2183.             v2=strip(v2,,'#')
  2184.             select
  2185.                when v2='AMP' then t1=t1||'&'
  2186.                when v2='LT' then t1=t1||'<'
  2187.                when v2='GT' then t1=t1||'>'
  2188.                when v2='QUOT' then t1=t1||'"'
  2189.                when v2='NBSP' then t1=t1||'01'x
  2190.                when datatype(v2)='NUM' then t1=t1||d2c(v2)
  2191.                otherwise t1=t1||' 'translate(v2)' '
  2192.             end  /* select */
  2193.         end /* v2<>"" */
  2194.       end /* FOREVER  */
  2195. RETURN T1
  2196.  
  2197.  
  2198.  
  2199.  
  2200. /***********************/
  2201. /* a lineout with a fix for regina rexx */
  2202. lineout2:
  2203. parse arg oofile,dothis1
  2204. dothis2=dothis1  ; leaveit=0
  2205. do until leaveit=1
  2206.    ffo=pos('0d0a'x,dothis2)
  2207.    if ffo=0 then do
  2208.      ooline=dothis2 ; leaveit=1    /* end */
  2209.    end
  2210.    else do
  2211.       if ffo=1 then do  /* empty line */
  2212.           ooline='  '
  2213.           dothis2=substr(dothis2,3)
  2214.       end
  2215.       else do
  2216.           ooline=left(dothis2,ffo-1)
  2217.           dothis2=substr(dothis2,ffo+2)
  2218.       end
  2219.     end
  2220.  
  2221. /* replace leading spaces with tabs if no_wordwrap? */
  2222.    if no_wordwrap=1 & doingtable=0 then do
  2223.        ll1=length(ooline); ll2=length(strip(ooline,'l'))
  2224.        if pos('___',ooline)=0 & ll1>ll2 then do  /* don't center hrs */
  2225.             ntabs=(ll1-ll2)%4 
  2226.             a3=copies('09'x,ntabs+1)
  2227.             ooline=a3||strip(ooline,'l')
  2228.        end /* do */
  2229.    end /* do */
  2230.    call lineout oofile,ooline
  2231.  
  2232. end /* do */
  2233. return 1
  2234.  
  2235.  
  2236. /* END OF UTILITY PROCS */
  2237. /******************/
  2238.  
  2239.  
  2240.  
  2241. /*******************************************/
  2242. /* GENERATE A TABLE INTO A TEMP VARIABLE */
  2243. GEN_TABLE:PROCEDURE EXPOSE TABLES. outfile ,
  2244.        pretitle posttitle prea posta preh1 posth1 prehn posthn imgstring_max preimg postimg ,
  2245.        docaps douline doquote quotestring1 quotestring2 hn_outline hn_Numbers.  oltypes. ol_numbers. olnumber ,
  2246.        flagmenu flagul flagselect flagselect2 radiobox checkbox  errorflag display_errors ,
  2247.        tablevert tablehoriz tablefiller lineart submitmark1 submitmark2 ,
  2248.        textmark1 textmark2 textmark radioboxcheck checkboxcheck toolongword hrbig ,
  2249.        tablemode2 flagtl  tableborder showallopts suppress_empty_table charwidth ,
  2250.        linelen_orig wasblank suppress_blanklines ignore_width leftside. addonmode ,
  2251.        td_add crlf form_br links_list. link_display
  2252.  
  2253.  
  2254.  
  2255. arow.0=0
  2256.  
  2257. PARSE ARG nth,linelen
  2258.  
  2259.  /* say linelen " table " nth tables.nth.!spec  */
  2260. l0=linelen
  2261.  
  2262.  
  2263. /* set width of  this table */
  2264. linelen=get_tablewidth(tables.nth.!spec,linelen)  /* might be less then linelen */
  2265.  
  2266. call get_border_info    /* get border character info (uses only globals, and sets BVAL  */
  2267. if bval>1.0 then do
  2268.   noouter=' '; norules=' '
  2269. end
  2270.  
  2271. /* determine max columns in table, and WIDTH info of cells */
  2272. ccols=1; CSCOLS=1
  2273. do iir=1 to tables.nth.!rows
  2274.   tribble=tables.nth.iir.!totcols
  2275.   if tribble=0 then do                  /* warning: 0 tds in this tr */
  2276.     tables.nth.!errors=tables.nth.!errors||"TR_NO_TD "
  2277.     if addonmode<>1 then
  2278.        say " Warning: TR with no TD "
  2279.   end
  2280.   cscols=max(cscols,tribble)
  2281.   ccols=max(ccols,tables.nth.iir.!cols)
  2282.   do jcc=1 to tables.nth.iir.!cols
  2283.        gogo=get_tdwidth(tables.nth.iir.jcc.!spec,linelen,ignore_width,tables.nth.iir.jcc.!stuff, ,
  2284.                         tables.nth.iir.jcc.!colspan)
  2285.        parse var gogo gogo1 gogo2 gogo3         /* explicit maxauto minauto */
  2286.        if gogo1='' then gogo1=0
  2287.        if gogo3='' then gogo3=0
  2288.        if gogo2='' then gogo2=0
  2289.        tables.nth.iir.jcc.!tdwidth=gogo1
  2290.  
  2291. /*       tables.nth.iir.jcc.!mxll=max(gogo2+td_add,tables.nth.iir.jcc.!tdwidth)
  2292.        tables.nth.iir.jcc.!mnll=max(gogo3,td_add+2) */
  2293.  
  2294.        tables.nth.iir.jcc.!mxll=min(gogo2,trunc(l0*1.5))
  2295.        tables.nth.iir.jcc.!mnll=max(gogo3,td_add+2)
  2296.  
  2297. end   /* jcc tds */
  2298.  
  2299. end /* iir trs */
  2300.  
  2301. /* determine width of each column, given WIDTH info exists from above */
  2302. do kk=1 to cscols
  2303.    colwidths.kk=0               /* 0 signfies "unspecified */
  2304.    colwidths2.kk=0              /* unwrapped line lengths (concatended */
  2305.    colwidths2.kk.!min=2
  2306.    EXTRAS.KK.0=0
  2307.    extras.kk.!rws=1
  2308. end /* do */
  2309. do kr =1 to tables.nth.!rows
  2310.      kc2=1
  2311.      do kc=1 to tables.nth.kr.!cols
  2312.           cspan=tables.nth.kr.kc.!colspan
  2313.           cwidth=tables.nth.kr.kc.!tdwidth
  2314.           colwidths.kc2=max(colwidths.kc2,cwidth)
  2315.           if cwidth=0 then do
  2316.              tmx=tables.nth.kr.kc.!mxll
  2317.              colwidths2.kc2=max(colwidths2.kc2,tmx)
  2318.              tmn=tables.nth.kr.kc.!mnll
  2319.              colwidths2.kc2.!min=max(colwidths2.kc2.!min,tmn)
  2320.           end /* do */
  2321.           tables.nth.kr.kc.!tblcol=kc2  /* actual table column this td starts at */
  2322.           kc2=kc2+cspan
  2323.      end /* do */
  2324. end /* do */
  2325.  
  2326. /* colwidths2.0 ... */
  2327. colwidths2.0=0
  2328. do kk=1 to cscols
  2329.   colwidths2.0=colwidths2.0+colwidths2.kk
  2330. end /* do */
  2331.  
  2332. /* determine missing widths */
  2333.  
  2334. /* first, assign widths to columns with no width specified  -- use  td specific ".!maxlinelen" info*/
  2335. nsum=0 ; nnone=0
  2336. do kk=1 to cscols
  2337.    nsum=nsum+colwidths.kk
  2338.    if colwidths.kk=0 then do
  2339.       nnone=nnone+1
  2340.     end
  2341. end /* do */
  2342.  
  2343. /* 2) add missings? */
  2344. if nnone>0 then do
  2345.    misslen=linelen-nsum    /* default width to use for non width specfied columns */
  2346.    deflen=trunc(misslen/nnone)
  2347.    nsum=0
  2348.    do kk=1 to cscols
  2349.        if colwidths.kk=0 then do
  2350.            if colwidths2.kk=0 then do
  2351.                colwidths.kk=deflen
  2352.            end
  2353.            else do
  2354.               t1=colwidths2.kk/colwidths2.0
  2355.               colwidths.kk=max(colwidths2.kk.!Min+2,trunc(t1*misslen))
  2356.            end
  2357.        end
  2358.        nsum=nsum+colwidths.kk
  2359.    end
  2360. end
  2361.  
  2362. /* normalize (insure sum equals linelen) */
  2363. if (nnone>0 & nsum<>linelen) | (nsum>linelen) then do
  2364.    afact=linelen/nsum
  2365.    nsum=0
  2366.    do kk=1 to cscols
  2367.         colwidths.kk=max(1,trunc(colwidths.kk*afact))
  2368.  
  2369.         nsum=nsum+colwidths.kk
  2370.    end /* do */
  2371.    fixit=linelen-nsum
  2372.    if fixit>0 then do
  2373.       colwidths.1=colwidths.1+linelen-nsum           /* truncations get added to first column */
  2374.    end
  2375.    else do                      /* cols must be 1 space wide -- subtract from other columns*/
  2376.       do pp=1 to cscols         /* column that will support it */
  2377.          if colwidths.pp>5 then do
  2378.               colwidths.pp=colwidths.pp-1
  2379.               fixit=fixit+1 ; if fixit=0 then leave 
  2380.               if colwidths.pp>25 then do         /* extra penalty */
  2381.                 colwidths.pp=colwidths.pp-1
  2382.                 fixit=fixit+1
  2383.                 if fixit=0 then leave 
  2384.               end                       /* small chance it won't get evened out . */
  2385.           end           /* >5 */
  2386.       end               /* 1 to cscols */
  2387.    end                  /* fixit */
  2388. end /* do */
  2389.  
  2390. if bval<>0 then colwidths.1=colwidths.1-1                       /* leave room for left side border */
  2391.  
  2392. mincellwidth=linelen            /* used for a warning message */
  2393. funk=''
  2394. do kk=1 to cscols
  2395.    mincellwidth=min(mincellwidth,colwidths.kk)
  2396.    funk=funk' 'colwidths.kk
  2397. end /* do */
  2398.  
  2399. /* compute actual size of cells in each row, taking colspan into account */
  2400. /* also, add filler cell if need be */
  2401. do kr=1 to tables.nth.!rows
  2402.     jc1=1 ; mycols=tables.nth.kr.!cols
  2403.     do kc=1 to mycols
  2404.        actsize=-1
  2405.        jc2=jc1+tables.nth.kr.kc.!colspan
  2406.        do jj=jc1 to (jc2-1)
  2407.           actsize=actsize+colwidths.jj
  2408.        end /* do */
  2409.        tables.nth.kr.kc.!linecc=actsize
  2410.        jc1=jc2
  2411.     end /* do */
  2412. end /* do */
  2413.  
  2414. call go_make_bars       /* make default horizontal diviers (use/set globals */
  2415.  
  2416. IF mincellwidth<14  then  do
  2417.     tables.nth.!errors=tables.nth.!errors||"NARROW_CELLS "
  2418.     TABLEMODE=3         /* use HR BR instead for internal tables */
  2419. end
  2420. else do
  2421.   tablemode=tablemode2            /* tablemode for nested tables */
  2422. end
  2423. wasblank=0
  2424. indent=0; rightindent=0
  2425. ispre=0                 /* <PRE> is on? */
  2426. olcnts=''                 /* OL count */
  2427. lastelem=''
  2428. capon=0
  2429. ulineon=0
  2430. listtypes=''
  2431. anchoron=0 ; anchoron1=0; anchoron2=0
  2432. quoteon=0 ; quoteon1=0 ; quoteon2=0
  2433. ddon=1
  2434. thispara=''             /* current paragraph */
  2435. iscenter=0
  2436. aflag=' '
  2437.  
  2438. if hn_outline>0 then do
  2439.   do jj=hn_outline to 7
  2440.      hn_outlines.jj=0
  2441.   end /* do */
  2442. end
  2443.  
  2444. sendout_internal=1
  2445. sendout_var=''
  2446.  
  2447. /********* Widths are now determined -- start writing lines of the table */
  2448.  
  2449. datable=''
  2450. tablealive=0                    /* used to suppress empty table */
  2451.  
  2452. do Jir=1 to tables.nth.!rows    /********* FOR EACH ROW OF THE TABLE */
  2453. ic0=1
  2454. do ic=1 to tables.nth.Jir.!cols /**** FOR EACH COLUMN-CELL IN THE ROW */
  2455.  
  2456.  body=tables.nth.Jir.ic.!stuff          /* cell contents */
  2457.  
  2458.  linecc=tables.nth.jir.ic.!linecc       /* cell width in characters */
  2459.  if ic=tables.nth.jir.!cols & bval=0 then do
  2460.     linecc=linecc+1
  2461.     tables.nth.jir.ic.!linecc=linecc
  2462.  end
  2463.  
  2464. /* parse and format this cell's content */
  2465.  
  2466.  indent=0+cellpadding ; rightindent=0+cellpadding
  2467.  do forever                     /**** FOR EACH LINE IN A COLUMN-CELL */
  2468.     if body='' then leave
  2469.  
  2470.     parse var body t1 '<' t2a '>' body
  2471.  
  2472. /* Add t1 to thispara */
  2473. /* but first convert &codes */
  2474.      T1=CONVERT_CODES(T1,CAPON,ISPRE,ULINEON,TABLES.NTH.JIR.IC.!TH)
  2475.  
  2476. /* and fix up quote/anchor stuff */
  2477.      t1=fix_quote_anchor(t1)     /* may change globals */
  2478. /* now add it..... */
  2479.      thispara=thispara||t1      /* ADD T1 TO THISPARA FOR EVENTUAL OUTPUT */
  2480.  
  2481. /* now, process the <element> */
  2482.     t2=strip(translate(word(t2a,1)))
  2483.     if left(t2,1)='/'  then
  2484.         t2end=substr(t2,2)
  2485.     else
  2486.         t2end=''
  2487.  
  2488. /* convert table element to simpler form?? */
  2489.     t2=cvt_table_elements(t2)
  2490.  
  2491. /* THIS DOES THE PARSING */
  2492.      if t2='_TABLE_' then do            /* this is an internal table -- recurse! */
  2493.            parse var t2a . newtable ; newtable=strip(newtable)
  2494.            foo=sendout(thispara,ispre,indent,aflag,lineCC)
  2495.            aflag='' ;THISPARA=''
  2496.            if  datatype(newtable)='NUM' then do
  2497.               newtable=strip(newtable)
  2498.               if tables.newtable.!caption<>' ' then do
  2499.                  dacaption=prehn||tables.newtable.!caption||posthn
  2500.                  if tables.newtable.!captiona<>'BOTTOM' then
  2501.                    foo=sendout(dacaption,0,indent,' ',linecc,'CENTER')     
  2502.               end /* do */
  2503.               thispara=gen_table2(newtable,linecc)
  2504.  
  2505.               altype=tables.newtable.!ALIGN
  2506.  
  2507.               foo=sendout(thispara,1,indent,'',lineCC,altype)
  2508.               if tables.newtable.!captiona='BOTTOM' then
  2509.                    foo=sendout(dacaption,0,indent,' ',linecc,'CENTER')     
  2510.  
  2511.               if tables.newtable.!errors<>' ' then
  2512.                  tables.1.!errors=tables.1.!errors||';'NEWTABLE':'tables.newtable.!errors' '
  2513.               thispara='' ;aflag=''
  2514.            end
  2515.      end /* do */
  2516.      else do
  2517.         call interpret_elems linecc /* generic interprets */
  2518.      end
  2519.   end           /* body forever */
  2520.  
  2521. /* all done with this cell -- write it out a "line at a time */
  2522.  
  2523.   t1=fix_quote_anchor('')  /* may change globals */
  2524.  
  2525.   foo=sendout(thispara,ispre,indent,aflag,lineCC)
  2526.   thispara=''
  2527.  
  2528. /* add some prior lines (from rowspan>1 cell in this column) ? */
  2529.   nlines=0
  2530.   ictbl=tables.nth.jir.ic.!tblcol  /* starting table column of this td */
  2531.   if extras.ictbl.0>0 then do
  2532.       do nl=1 to extras.ictbl.0         /* add "extras for this table column */
  2533.          arow.ic.nl=extras.ictbl.nl
  2534.       end /* do */
  2535.       nlines=extras.ictbl.0
  2536.       extras.ictbl.0=0
  2537.   end
  2538.  
  2539.   do forever            /* Parse lines out and store in arow.ic. array */
  2540.      if sendout_var='' then leave
  2541.      nlines=nlines+1
  2542.      parse var sendout_var arow.ic.nlines (crlf) sendout_var
  2543.   end /* do */
  2544.   arow.ic.0=nlines
  2545.   sendout_var=''
  2546.  
  2547. /* note: excess lines in rowspan>1 are shuffled down; these may have
  2548.          been from a several rows back large rowspan  */
  2549.  
  2550.   if tables.nth.jir.ic.!rowspan=1 then arow.0=max(arow.0,nlines)
  2551.  
  2552. end    /* ic */
  2553.  
  2554. /* and extras  beyond this tr's last td? */
  2555. ikoo=tables.nth.jir.!cols
  2556. islandtds=''
  2557. if ikoo=0 then 
  2558.    ikoo2=cscols+1   /* a hack to cause skip of next section */
  2559. else
  2560.    ikoo2=tables.nth.jir.ikoo.!tblcol
  2561. do joob=ikoo2+1 to cscols
  2562.    if extras.joob.0=0 then iterate
  2563.    arow.0=max(arow.0,extras.joob.0)  /* island cells  approximation */
  2564.    islandtds=islandtds' 'joob
  2565. end /* do */
  2566.  
  2567. /* shuffle down extra lines (for rowspan<>1 cells) -- they may have come
  2568.    from prior rows */
  2569.  
  2570. do ic=1 to tables.nth.jir.!cols
  2571.    ictbl=tables.nth.jir.ic.!tblcol     /* save to appropriate table column storage */
  2572.    extras.ictbl.!bar=' '
  2573.    if arow.ic.0>arow.0 then do
  2574.  
  2575.       ictbl=tables.nth.jir.ic.!tblcol     /* save to appropriate table column storage */
  2576.       iq1=arow.0+1
  2577.       extras.ictbl.!bar=arow.ic.iq1          /* use this instead of usebar */
  2578.       iq3=0
  2579.       do iq2=arow.0+2 to arow.ic.0
  2580.          iq3=iq2-(1+arow.0)
  2581.          extras.ictbl.iq3=arow.ic.iq2
  2582.       end
  2583.       extras.ictbl.0=IQ3
  2584.    end /* do  >arow.0 */
  2585. end /* do ic */
  2586.  
  2587. /* done with all cells in this row of the table.
  2588.   horiz append each line of each cell to create linelen lines,
  2589.   vert appen these lines to make a row of cells */
  2590.  
  2591. /* type of alighment */
  2592. rspec=tables.nth.Jir.!spec
  2593. dalign=get_elem_val(rspec,'ALIGN')
  2594. dalignv=get_elem_val(rspec,'ALIGNV')
  2595.  
  2596. thisrows="" ; tralive=0      /* assume empty row */
  2597. iii0=1
  2598. didpad=cellpadding ; didpad2=didpad 
  2599.  
  2600. do until iii0>arow.0
  2601.   thisline=''
  2602.  
  2603.   if jir=tables.nth.!rows then do
  2604.     if noouter<>"VOID" then do
  2605.                usebar=horizbar2
  2606.      end
  2607.      else do
  2608.                usebar=copies(' ',length(horizbar2))
  2609.      end
  2610.   end
  2611.   else do
  2612.     if norules<>"NONE" then do
  2613.        if noouter="VOID" then
  2614.           usebar=' 'substr(horizbarm,2,length(horizbarm)-2)' '
  2615.        else
  2616.           usebar=horizbarm
  2617.     end
  2618.     else  do
  2619.        usebar='|'||copies(' ',max(1,length(horizbarm)-2))||'|'
  2620.     end
  2621.   end
  2622.  
  2623.   do ic=1 to tables.nth.Jir.!cols
  2624.       linecc=tables.nth.jir.ic.!linecc
  2625.       if iii0=1 then do          /* cell specs , check on first line */
  2626.           call set_caligns
  2627.       end
  2628.       iii=iii0-lineoffset.ic            /* used for centering */
  2629.  
  2630.       if iii<1 | iii>arow.ic.0 then do       /* fller line (valign stuff ?*/
  2631.          addme=copies(tablefiller,linecc)
  2632.          if didpad>0 & iii0=1 then do     /* add initial padding */
  2633.             if ic=tables.nth.jir.!cols then didpad=didpad-1
  2634.             dopad=1
  2635.           end 
  2636.           if didpad2>0 & iii0=arow.0 then do     /* add ending padding */
  2637.              if ic=tables.nth.jir.!cols then didpad2=didpad2-1
  2638.              dopad=1
  2639.           end
  2640.       end
  2641.       else do                   /* got a line to add */
  2642. /* initial padding? */
  2643.        select
  2644.          when didpad>0 & iii0=1 then do     /* add initial padding */
  2645.             if ic=tables.nth.jir.!cols then didpad=didpad-1
  2646.             addme0='  '; dopad=1
  2647.           end 
  2648.           when didpad2>0 & iii0=arow.0 then do     /* add ending padding */
  2649.              if ic=tables.nth.jir.!cols then didpad2=didpad2-1
  2650.               addme0=arow.ic.iii ; arow.ic.iii=' '; dopad=1
  2651.           end 
  2652.           otherwise   do
  2653.                 addme0=arow.ic.iii ;dopad=0
  2654.           end
  2655.         end
  2656.         if addme0<>' ' then do
  2657.             tralive=1  ;tablealive=1
  2658.         end /* do */
  2659.         select
  2660.            when calign.ic='MIDDLE' | calign.ic='CENTER' then
  2661.               addme=center(addme0,linecc)
  2662.            when calign.ic='RIGHT' then
  2663.               addme=right(addme0,linecc)
  2664.            otherwise
  2665.               addme=left(addme0,linecc,' ')
  2666.         END
  2667.       end               /* non filler line */
  2668.  
  2669.       if bval=0 & ic=1 then do          /* put border around thisline */
  2670.          tl1=length(thisline)
  2671.          thisline=addme
  2672.          tl2=length(thisline)
  2673.       end
  2674.       else do
  2675.          tl1=length(thisline)+length(tvert)
  2676.          tvv=tvert
  2677.          if ic=1 & noouter='VOID' then tvv=' '
  2678.          if ic<>1 & norules='NONE' then tvv=' '
  2679.          thisline=thisline||tvv||addme
  2680.          tl2=length(thisline)
  2681.       end
  2682.  
  2683.      if iii0==arow.0 then do                       /* modify usebar? */
  2684.         if tables.nth.jir.ic.!nobot=1 then do      /* suppress bottom border */
  2685.           ictbl=tables.nth.jir.ic.!tblcol
  2686.           usebar=overlay(extras.ictbl.!bar,usebar,tl1+1,tl2-tl1)
  2687.        end
  2688.      end
  2689.  
  2690.   end /* do ic */
  2691.  
  2692. /* in case of insufficient cells .. */
  2693.   if cScols>tables.nth.Jir.!TOTcols then do
  2694.      if islandtds<>'' then do            /* island cells to do? */
  2695.        is2=islandtds
  2696.        oz0=tables.nth.jir.!totcols+1
  2697.        do forever
  2698.          if is2='' then do              /* no more islands -- fill to end */
  2699.              do ozo=isle1+1 to cscols
  2700.                 thisline=thisline||copies(tablefiller,max(1,colwidths.ozo-1))
  2701.              end /* do */
  2702.              leave
  2703.          end /* do */
  2704.          parse var is2 isle1 is2 ; isle1=striP(isle1)
  2705.          tvv=tvert; if norules='NONE' then tvv=' '
  2706.          do ozo=oz0 to (isle1-1)                /* fill some columns */
  2707.             thisline=thisline||tvv||copies(tablefiller,max(colwidths.ozo-1,1))
  2708.          end /* do */
  2709.          addmox=extras.isle1.iii0
  2710.          select
  2711.            when calign.ic='MIDDLE' | calign.ic='CENTER' then
  2712.               addmox=center(addmox,colwidts.isle1-1)
  2713.            when calign.ic='RIGHT' then
  2714.               addmox=right(addmox,colwidths.isle1-1)
  2715.            otherwise
  2716.               addmox=left(addmox,colwidths.isle1-1,' ')
  2717.           END
  2718.          tvv=tvert ; if norules="NONE" then tvv=' '
  2719.          thisline=thisline||tvv||addmox||tvv
  2720.        end
  2721.      end
  2722.      else do            /* no istlands -- fill rest of line */
  2723.           goon2=LINELEN-length(thisline)
  2724.           thisline=thisline||copies(tablefiller,max(1,goon2-1))
  2725.      end /* do */
  2726.   end /* do */
  2727.  
  2728.   if bval<>0 & noouter<>'VOID' then 
  2729.       thisline=thisline||TVERT          /* END OF A LINE */
  2730.   else
  2731.       thisline=thisline||' '          /* END OF A LINE */
  2732.  
  2733.   thisrows=thisrows||thisline||CRLF     /* APPEND TO "LINES IN THIS ROW OF CELLS */
  2734.  
  2735.   if dopad=0 then iii0=iii0+1   /* not padding */
  2736.  
  2737. end             /* iii (lines in this row ) */
  2738.  
  2739. DO FOREVER
  2740.    IF ISLANDTDS='' then LEAVE
  2741.    PARSE VAR ISLANDTDS IS1 ISLANDTDS ; IS1=STRIP(IS1)
  2742.    EXTRAS.IS1.0=0
  2743. end /* do */
  2744.  
  2745. if tralive=0 & suppress_empty_table=1 then do  /* suppress empty row? */
  2746.      nop
  2747. end /* do */
  2748. else do
  2749.      datable=DATABLE||thisrows||usebar||CRLF
  2750. end
  2751.  
  2752. arow.0=0
  2753.  
  2754. end             /* Jir'th row */
  2755.  
  2756. sendout_internal=0
  2757.  
  2758. if tablealive=0 & suppress_empty_table=1 then return ' '
  2759.  
  2760.  
  2761. if noouter<>'VOID' then
  2762.    datable=horizbar1||crlf||datable               /* top line of da table */
  2763. else 
  2764.   datable=copies(' ',length(horizbar1))||crlf||datable
  2765.  
  2766.  
  2767.  
  2768. return datable
  2769.  
  2770.  
  2771.  
  2772. /***********/
  2773. /* set alignment info */
  2774. set_caligns:
  2775.          calign=''; calignv=''
  2776.          cspec=tables.nth.Jir.ic.!spec
  2777.          calignv=get_elem_val(cspec,'VALIGN')
  2778.            if calignv="" then calignv=dalignv
  2779.          calign=get_elem_val(cspec,'ALIGN')
  2780.            if calign="" then calign=dalign
  2781.          calign.ic=calign
  2782.          lineoffset.ic=0
  2783.          if calignv='MIDDLE' | calignv='CENTER' | calignv='' then do
  2784.             lineoffset.ic=max(0,trunc((arow.0-arow.ic.0)/2))
  2785.          end /* do */
  2786. return 1
  2787.  
  2788.  
  2789. /***********************/
  2790. go_make_bars:
  2791.  
  2792. horizbar2=' '||copies(THORIZ,max(1,linelen-2))  /* TABLE WIDE DIVIDER LINE */
  2793. horizbar1=horizbar2 ; horizbarm=horizbar2
  2794.  
  2795.  
  2796. I218=' ';I192=' ';I195=' ';I197=' ';I194=' '; I193=' '
  2797. I180=' '; I191=' '; I217=' '
  2798.  
  2799. SELECT
  2800.   WHEN bvaL=0 THEN DO           /* no lines */
  2801.      USET=' '
  2802.   end /* do */
  2803.   WHEN LINEART=1 then DO                /* use lineart for nice boxes */
  2804.     if bval<2 then do
  2805.        i218=d2c(218) ;   i192=d2c(192) ;  i195=d2c(195)
  2806.        i197=d2c(197) ; i194=d2c(194) ; i193=d2c(193)
  2807.        i180=d2c(180) ; i191=d2c(191) ; i217=d2c(217)
  2808.     end
  2809.     else do
  2810.          i218=d2c(201) ; i192=d2c(200); i195=d2c(204)
  2811.          i193=d2c(202) ; i194=d2c(203)
  2812.          i197=d2c(206) ; i180=d2c(185) ; i191=d2c(187) ;i217=d2c(188)
  2813.     end /* do */
  2814.     uset=thoriz
  2815.   END
  2816.   OTHERWISE DO          /* NO LINEART --  use _ only */
  2817.       USET=THORIZ
  2818.   END
  2819. END
  2820.  
  2821.  
  2822.   horizbar1=i218
  2823.   horizbar2=i192
  2824.   horizbarm=i195
  2825.   do kk=1 to cScols
  2826.      horizbarm=horizbarm||copies(uset,max(1,colwidths.kk-1))
  2827.      horizbar1=horizbar1||copies(uset,max(1,colwidths.kk-1))
  2828.      horizbar2=horizbar2||copies(uset,max(1,colwidths.kk-1))
  2829.      if kk<>cScols then do
  2830.        horizbarm=horizbarm||i197
  2831.        horizbar1=horizbar1||i194
  2832.        horizbar2=horizbar2||i193
  2833.      end
  2834.   end
  2835.   horizbarm=horizbarm||i180
  2836.   horizbar1=horizbar1||i191
  2837.   horizbar2=horizbar2||i217
  2838.   return 1
  2839.  
  2840.  
  2841. /**************************/
  2842. /* get border info */
  2843. get_border_info:
  2844.  
  2845. /* Border for this table */
  2846. SPECS=TABLES.NTH.!SPEC
  2847. bval=tables.nth.!border
  2848.  
  2849.  
  2850. if datatype(bval)<>'NUM' then bval=tableborder
  2851.  
  2852. if tableborder>1 then bval=trunc(tableborder)  /* force borders? */
  2853. if tableborder=-1 then bval=0           /* suppress borders */
  2854.  
  2855. noouter=get_elem_val(specs,'FRAME')
  2856.  
  2857. norules=get_elem_val(specs,'RULES')
  2858.  
  2859. cellpadding=get_elem_val(specs,'CELLPADDING')
  2860. if datatype(cellpadding)<>'NUM' then
  2861.   cellpadding=0
  2862. else
  2863.   cellpadding=max(0,trunc(cellpadding/charwidth))
  2864.  
  2865.  
  2866.  
  2867. IF  bval=0 then DO               /* border type */
  2868.    TVERT=' '; THORIZ=' '
  2869. end /* do */
  2870. else DO                 /* line art, or explicit character */
  2871.   if lineart<>1 then do
  2872.       tvert=tablevert
  2873.   end
  2874.   else do
  2875.      if bval=1  then
  2876.        tvert=d2c(179)
  2877.      else
  2878.         tvert=d2c(186)
  2879.   end
  2880.   if lineart<>1 then do
  2881.       thoriz=tablehoriz
  2882.   end
  2883.   else do
  2884.     if bval=1  then
  2885.       thoriz=d2c(196)
  2886.     else
  2887.       thoriz=d2c(205)
  2888.   end
  2889. END
  2890.  
  2891. return 1
  2892.  
  2893.  
  2894. /*********************/
  2895. /* routine to interpret html elements -- uses lots of globals */
  2896. interpret_elems:
  2897.  
  2898. parse arg Xlinelen
  2899. indent3=4
  2900. if xlinelen<22 then indent3=1
  2901.  
  2902. mindent3=4
  2903. if xlinelen<22 then mindent3=1
  2904.  
  2905. /* break off piece of body  */
  2906.  
  2907. /* look for line breakers */
  2908.     select
  2909.       when t2='HR' then do
  2910.  
  2911.          hrsize=get_elem_val(t2a,'SIZE')                /* line height */
  2912.          if datatype(hrsize)<>'NUM' then hrsize=1
  2913.          if hrsize<3 then
  2914.             hrchar='_'
  2915.          else
  2916.             hrchar=hrbig
  2917.  
  2918.          hrwidth=strip(get_elem_val(t2a,'WIDTH'))   /* line width */
  2919.          select
  2920.              when hrwidth='' then hrwidth=1.0
  2921.              when right(hrwidth,1)='%' then do
  2922.                  parse var hrwidth hrwidth '%' .
  2923.                  if datatype(hrwidth)='NUM' then
  2924.                     hrwidth=min(100,hrwidth)/100
  2925.                  else
  2926.                     hrwidth=1
  2927.              end /* do */
  2928.              otherwise do
  2929.                 if datatype(hrwidth)='NUM' then
  2930.                       hrwidth=min(1,hrwidth/640)
  2931.                 else
  2932.                        hrwidth=1
  2933.              end
  2934.          end
  2935.          hrchars=max(2,trunc((xlinelen-4)*hrwidth))
  2936.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  2937.          call sendout ' '
  2938.          thispara='';aflag=0
  2939.          foo=sendout(center(copies(hrchar,hrchars),xlinelen),1,,,xlinelen)
  2940.          if hrsize>10 then
  2941.             foo=sendout(center(copies(hrchar,hrchars),xlinelen),1,,,xlinelen)
  2942.          call sendout ' '
  2943.  
  2944.       end
  2945.  
  2946.       when t2='HR1' then do
  2947.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  2948.          thispara='';aflag=0
  2949.          if lineart>=0 then do
  2950.              foo=sendout(center(d2c(201)||copies(d2c(205),max(1,Xlinelen-6))||d2c(187),Xlinelen),1,,,xlinelen)
  2951.          end
  2952.          else do
  2953.              foo=sendout(center('/'copies('=',max(1,Xlinelen-6))'\',Xlinelen),1,,,xlinelen)
  2954.          end
  2955.          indent=indent+indent3
  2956.       end
  2957.  
  2958.       when t2='HR2' then do
  2959.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  2960.          thispara='';aflag=0
  2961.          att='='
  2962.          if lineart>=0 then do
  2963.              foo=sendout(center(d2c(200)||copies(d2c(205),max(1,Xlinelen-6))||d2c(188),Xlinelen),1,,,xlinelen)
  2964.          end
  2965.          else do
  2966.              foo=sendout(center('\'copies('=',max(1,Xlinelen-6))'/',Xlinelen),1,,,xlinelen)
  2967.          end
  2968.          indent=max(indent-mindent3,0)
  2969.       end
  2970.  
  2971. /* H1 H2 H3 ... HEADERS */
  2972.       when wordpos(t2,'H1 H2 H3 H4 H5 H6 H7')>0 then do
  2973.          HN_LEVEL=WORDPOS(T2,'H1 H2 H3 H4 H5 H6 H7')
  2974.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  2975.          thispara=''
  2976.          ah=getelem('/H')
  2977.  
  2978.          ah=remove_htmls(ah)
  2979.  
  2980.          docenter=0     /* don't add pre Hn stuff if centered */
  2981.  
  2982. /* Add an "outline" number */
  2983.         if hn_outline<=hn_level & hn_outline<>0 then do
  2984.            hn_outlines.hn_level=hn_outlines.hn_level+1
  2985.  
  2986.            do mmh=hn_outline to (hn_level-1)        /* fix up lower levels */
  2987.               if hn_outlines.mmh=0 then hn_outlines.mmh=1
  2988.            end /* do */
  2989.            do mmh=hn_level+1 to 7  /* fix up higher levels */
  2990.               hn_outlines.mmh=0
  2991.            end /* do */
  2992.  
  2993.            immh=0 ;aah=''       /* build outline number */
  2994.            do mmh=hn_outline to hn_level
  2995.               immh=immh+1
  2996.               jint=hn_outlines.mmh
  2997.               anums=hn_numbers.immh
  2998.               if words(anums)<jint then
  2999.                 aah=aah||jint
  3000.               else
  3001.                 aah=aah||strip(word(anums,jint))
  3002.               if mmh<hn_level then aah=aah'.'
  3003.            end /* do */
  3004.            ah=aah') 'ah         /* add the outline number */
  3005.         end
  3006.  
  3007.         if  (pos('CENTER',translate(t2a))+pos('MIDDLE',translate(t2a)))>0 & ,
  3008.              length(ah)<Xlinelen then do
  3009.                 docenter=1
  3010.          end
  3011.          else do
  3012.              if HN_LEVEL=1 then do
  3013.                  p1=preh1;p2=posth1
  3014.               end
  3015.               else do
  3016.                    p1=prehn ; p2=posthn
  3017.               end /* do */
  3018.               ah=p1||ah||p2
  3019.          end /* do */
  3020.  
  3021.          ah=translate(ah,' ','0d0a0009'x)
  3022.          if docenter=1 then  ah=center(ah,Xlinelen)
  3023.  
  3024.          call sendout ' '
  3025.          foo=sendout(ah,2,indent,,xlinelen)
  3026.          if HN_LEVEL<4 then call sendout ' '
  3027.          aflag=0 ; thispara=''
  3028.       end
  3029.  
  3030.       when t2='P' then do
  3031.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3032.          thispara='';aflag=0
  3033.          if lastelem<>'P' then
  3034.              foo=sendout(' ',ispre,indent,aflag,xlinelen)
  3035.          palign=get_elem_val(t2a,'ALIGN')
  3036.          if palign='CENTER' | palign='MIDDLE' then docenter=1
  3037.          if palign='LEFT' | palign='RIGHT' then docenter=0
  3038.       end /* do */
  3039.  
  3040.  
  3041.        when t2='PRE'  then DO
  3042.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3043.           CALL SENDOUT ' '
  3044.           thispara='' ; aflag=0
  3045.           ispre=1
  3046.        END
  3047.        when t2='/PRE' then DO
  3048.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3049.           CALL SENDOUT ' '
  3050.           thispara='' ; aflag=0
  3051.           ispre=0
  3052.        END
  3053.  
  3054.        when t2='DIV'  then do
  3055.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3056.           isc=get_elem_val(t2a,'ALIGN')
  3057.           if isc="MIDDLE" | isc="CENTER" then
  3058.               iscenter=1
  3059.           if isc="RIGHT" then iscenter=2
  3060.           thispara='' ; aflag=0
  3061.        end /* do */
  3062.  
  3063.        when t2='/DIV' then do
  3064.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3065.           thispara='' ; aflag=0
  3066.           iscenter=0
  3067.        end
  3068.  
  3069.        when t2='CENTER' then do
  3070.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3071.           thispara='' ; aflag=0
  3072.           iscenter=1
  3073.         end
  3074.  
  3075.        when t2='/CENTER' then do
  3076.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3077.           thispara='' ; aflag=0
  3078.           iscenter=0
  3079.         end
  3080.  
  3081.       when t2='TEXTAREA' then do
  3082.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3083.          thispara='';aflag=0
  3084.          ah=getelem('/TEXTAREA')
  3085.          ah=remove_htmls(ah)
  3086.          ncols=get_elem_val(t2a,'COLS')
  3087.          if datatype(ncols)<>'NUM' then ncols=50
  3088.          ah2=box_around(ah,min(ncols,Xlinelen-3))
  3089.          foo=sendout(ah2,1)
  3090.          aflag=0
  3091.       end
  3092.  
  3093.       when t2='IMG' then do
  3094.          parse var t2a . imgname
  3095.          select
  3096.           when imgstring_max=1 then imgname=left(imgname,min(length(imgname),max(5,xlinelen-5)))
  3097.           when imgstring_max=0 then nop
  3098.           otherwise imgname=left(imgname,min(length(imgname),imgstring_max))
  3099.          end
  3100.          if imgname<>'' then
  3101.             imgname=preimg||strip(imgname)||postimg
  3102.          else
  3103.             imgname='[IMG]'
  3104.          imgname=space(translate(imgname,' ','0d0a0009'x))
  3105.          imgname=fix_quote_anchor(imgname)
  3106.          thispara=thispara||imgname' '
  3107.       end /* do */
  3108.  
  3109.       when t2='BLOCKQUOTE' then do
  3110.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3111.          call sendout ' '
  3112.          thispara='';aflag=0
  3113.          indent=indent+indent3 ; rightindent=rightindent+indent3
  3114.       end
  3115.  
  3116.       when t2='/BLOCKQUOTE' then do
  3117.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3118.          thispara='';aflag=0
  3119.          call sendout ' '
  3120.          indent=max(0,indent-mindent3); rightindent=max(0,rightindent-mindent3)
  3121.       end
  3122.  
  3123.       when wordpos(t2,'UL TL DL OL MENU DIR')>0 then do
  3124.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3125.          listtypes=listtypes' 't2
  3126.          if t2='OL' then DO
  3127.              olstart=get_elem_val(t2a,'START')
  3128.              if datatype(olstart)<>'NUM' then olstart=1
  3129.              olstart=olstart-1
  3130.              OLCNTs=OLCNTs' 'olstart
  3131.              aOLTYPE=GET_ELEM_VAL(T2A,'TYPE',1)
  3132.              oltype=WORDPOS(aOLTYPE,'1 a A i I')
  3133.              foof=words(olcnts)
  3134.              oltypes.foof=ol_numbers.oltype
  3135.  
  3136.          end
  3137.          thispara='';aflag=0
  3138.          i3=3; if xlinelen<25 then i3=1
  3139.          indent=indent+indent3
  3140.      end
  3141.  
  3142.       when wordpos(t2,'/UL /DL /OL /MENU /DIR /TL ')>0 then do
  3143.          IW=WORDS(LISTTYPES)
  3144.          LASTT=WORD(LISTTYPES,IW)
  3145.  
  3146.          IF lastt<>SUBSTR(T2,2) then do
  3147.               indent=0 ; olcnts='' ; listtypes=''
  3148.               call do_display_error 1 ,  "Warning: expected "||t2||"; found /"||lastt , ,
  3149.                                          T2"_NOT_"lastt
  3150.          end /* do */
  3151.  
  3152. /* legit list .. */
  3153.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3154.          thispara=' '         ; aflag=0
  3155.  
  3156. /* shrink list infos */
  3157.          if lastt='OL' then do
  3158.              iw2=words(olcnts)
  3159.              if iw2=1 then do
  3160.                 olcnts=''
  3161.              end
  3162.              else do
  3163.                if iw2<1 then
  3164.                  call do_display_error 1, "Warning: Problem with OL UL or SELECT ","UNEXPECTED_DELWORD" 
  3165.                ELSE
  3166.                   olcnts=delword(olcnts,iw2)
  3167.              END
  3168.          end
  3169.          if iw=1 | listtypes='' then                 /* fix list of UL OL */
  3170.                 listtypes=''
  3171.          else
  3172.                listtypes=delword(listtypes,iw)
  3173.          indent=max(0,indent-mindent3)
  3174.          if t2='/DL' & ddon=1 then indent=max(0,indent-mindent3)
  3175.  
  3176.          call sendout ' '
  3177.  
  3178.       end               /* /ul etc */
  3179.  
  3180.       when t2='LI'  then do
  3181.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3182.          thisval=get_elem_val(t2a,'VALUE')
  3183.          aflag=figflag(thisval)       /* the flag for this type */
  3184.          thispara=''
  3185.          call sendout ' '
  3186.       end /* do */
  3187.  
  3188.       when t2='DD' | t2='DT' then do
  3189.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3190.          goon=words(listtypes)
  3191.          if word(listtypes,goon)<>'DL' then do
  3192.               if addonmode<>1 then SAY ' '
  3193.               indent=0 ; olcnts='' ; listtypes=''
  3194.               call do_display_error 1, "Warning: DD or DT not expected in  list " , "UNEXPECTED_DD|DT"
  3195.          end
  3196.          aflag=' '
  3197.          if t2='DT' then do
  3198.              if ddon=1 then indent=max(0,indent-mindent3)
  3199.              ddon=0
  3200.          end
  3201.          if t2='DD' then do
  3202.               indent=indent+indent3
  3203.               ddon=1
  3204.          end
  3205.          thispara=''
  3206.          call sendout ' '
  3207.       end /* do */
  3208.  
  3209.       when t2='SELECT' then do
  3210.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3211.          selsize=get_elem_val(t2a,'SIZE')
  3212.          if datatype(selsize)<>"NUM" | showallopts=1 then do
  3213.              listtypes=listtypes' 't2
  3214.          end
  3215.          else do
  3216.              a1=2
  3217.              if selsize=1 then a1=1
  3218.              listtypes=listtypes' 't2||(selsize+a1)
  3219.          end
  3220.          thispara='';aflag=0
  3221.          ijm=max(1,xlinelen-(indent+rightindent+4))
  3222.  
  3223.          ijm=min(ijm,14)
  3224.          if  lineart>=0 then
  3225.             foo3=d2c(218)||copies(d2c(196),ijm)  /* ||d2c(191) */
  3226.          else
  3227.             foo3='/'||copies('-',ijm)   /* ||'\' */
  3228.          foo=sendout(foo3,0,indent,,xlinelen)
  3229.          indent=indent+1
  3230.  
  3231.       end
  3232.  
  3233.       when t2='OPTION' then do
  3234.          goon=words(listtypes)
  3235.          ggw=word(listtypes,goon)
  3236.          if abbrev(ggw,'SELECT')=0 then do      /* SELECT not active */
  3237.               indent=0 ; olcnts='' ; listtypes=''
  3238.               call display_error 1,"Warning: Option not expected in list" , "UNEXPECTED_OPTION"
  3239.               iterate
  3240.          end
  3241.  
  3242. /* check selsize counter */
  3243.          parse var ggw 'SELECT' ggw2
  3244.          showok=0
  3245.          if ggw='SELECT' then do
  3246.             showok=1
  3247.          end
  3248.          else do
  3249.             if datatype(ggw2)='NUM' then do
  3250.                if ggw2>0  then do
  3251.                    showok=1
  3252.                    if ggw2=1 then showok=2
  3253.                    jt3=ggw2-1 /* count down */
  3254.                    ggw3='SELECT'||jt3
  3255.                    listtypes=delword(listtypes,goon)' 'ggw3
  3256.                end /* do */
  3257.             end
  3258.          end
  3259.          if showok=1 then do    /* SIZE not violated */
  3260.  
  3261.               if thispara<>"" then foo=sendout(thispara,ispre,indent+1,aflag,xlinelen)
  3262.               aflag=flagselect
  3263.               if pos('SELECTED',translate(t2a))>0 then aflag=flagselect2
  3264.               thispara=''
  3265.           end         /* else, SIZE shown already */
  3266.           else do
  3267.              if showok=2 then DO
  3268.                thispara=prea||'...more'||posta /* this is the ..more.. flag */
  3269.                foo=sendout(thispara,ispre,indent+1,aflag,xlinelen)
  3270.              END
  3271.              thispara='' ; AFLAG=''  /* zap this option text */
  3272.           end /* do */
  3273.       end /* do */
  3274.  
  3275.  
  3276.      WHEN T2='/SELECT' then DO
  3277.          IW=WORDS(LISTTYPES)
  3278.          LASTT=WORD(LISTTYPES,IW)
  3279.          IF abbrev(lastt,'SELECT')=0 then do
  3280.               call do_display_error 1, "Warning: expected "||t2||"; found /"||lastt , "UNEXPECTED_/SELECT"
  3281.               indent=0 ; olcnts='' ; listtypes=''
  3282.               iterate
  3283.          end /* do */
  3284.  
  3285. /* legit list .. WITHIN SIZE?*/
  3286.          if right(lastt,1)<>'0' then
  3287.             foo=sendout(thispara,ispre,indent+1,aflag,xlinelen)
  3288.  
  3289.          thispara=' '         ; aflag=0
  3290.          if iw=1 then                 /* fix list of UL OL */
  3291.                 listtypes=''
  3292.          else
  3293.                listtypes=delword(listtypes,iw)
  3294.  
  3295.          indent=max(0,indent-1)
  3296.  
  3297.          ijm=max(1,xlinelen-(indent+rightindent+4))
  3298.  
  3299.          ijm=min(ijm,14)
  3300.          if  lineart>=0 then
  3301.                 foo3=d2c(192)||copies(d2c(196),ijm) /*||d2c(217) */
  3302.          else
  3303.                 foo3='\'||copies('-',ijm)   /* ||'/' */
  3304.          foo=sendout(foo3,0,indent,,xlinelen)
  3305.       end
  3306.  
  3307.       when t2='BR' | (t2='/FORM' & form_br=1) then do
  3308.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  3309.          if t2='BR' then isclear=get_elem_val(t2a,'CLEAR')      /* clear past floatings (end word wrap) ? */
  3310.          thispara='';aflag=0
  3311.       end /* do */
  3312.  
  3313. /* paragraph modifiers */
  3314.        when t2='A' then  do
  3315.              if pos(' NAME=',translate(t2a))=0 then do
  3316.                 anchoron2=0
  3317.                 if anchoron=1 then do           /* warning */
  3318.                     call do_display_error 0,"Warning: unclosed <A> ", "UNCLOSED_<A>"
  3319.                     anchoron2=1                /* assume we are preceded by a </a> */
  3320.                 end /* do */
  3321.                 anchoron=1 ;anchoron1=1
  3322.                 yowo=pos('HREF=',translate(t2a))
  3323.                 yowo2=substr(t2a,yowo)
  3324.                 parse var yowo2 hh '"' a_url '"' .
  3325.                 if link_display<>0 then do
  3326.                   igg=links_list.0+1
  3327.                   links_list.igg=a_url
  3328.                   links_list.0=igg
  3329.                 end
  3330.              end
  3331.        end
  3332.        when t2='/A' then  do
  3333.           if anchoron=1 then anchoron2=1
  3334.           anchoron=0 ;anchoron1=0
  3335.        end
  3336.  
  3337. /* LOGICAL ELEMENTS */
  3338.        when pos(t2,docaps' 'douline' 'doquote)>0 then do        /* a font modifer */
  3339.            if wordpos(t2,docaps)>0 then capon=capon+1
  3340.            if wordpos(t2,douline)>0 then ulineon=ulineon+1
  3341.            if wordpos(t2,doquote)>0 then do
  3342.                 quoteon=quoteon+1 ;quoteon1=1 ; QUOTEON2=0
  3343.             end
  3344.        end /* do */
  3345.  
  3346. /* END LOGICAL ELEMENTS */
  3347.        when pos(t2end,docaps' 'douline' 'doquote)>0 then do        /* end of font modifer */
  3348.           if wordpos(t2end,docaps)>0 then capon=max(0,capon-1)
  3349.  
  3350.           if wordpos(t2end,douline)>0 then ulineon=max(0,ulineon-1)
  3351.           if wordpos(t2end,doquote)>0 then do
  3352.              IF QUOTEON=1 then QUOTEON2=1   /* this is the end of nested emphasis */
  3353.              quoteon=max(quoteon-1,0) ;quoteon1=0
  3354.           end
  3355.           if t1<>'' then thispara=' 'thispara
  3356.  
  3357.        end
  3358.  
  3359.       when t2='INPUT' then do
  3360.  
  3361.           atype=TRANSLATE(get_elem_val(t2a,'TYPE'))
  3362.  
  3363.           IF ATYPE='' then ATYPE='TEXT'
  3364.           avalue=get_elem_val(t2a,'VALUE',1)
  3365.           if atype='RADIO' then do
  3366.              if wordpos('CHECKED',translate(t2a))>0 then
  3367.                  thispara=thispara' 'radioboxcheck
  3368.              else
  3369.                  thispara=thispara' 'radiobox
  3370.           end
  3371.           if atype='CHECKBOX' then do
  3372.              if wordpos('CHECKED',translate(t2a))>0 then
  3373.                  thispara=thispara' 'checkboxcheck' '
  3374.              else
  3375.                  thispara=thispara' 'checkbox' '
  3376.           end
  3377.           if atype='TEXT' then do
  3378.                av2=get_elem_val(t2a,'SIZE')
  3379.                if av2='' then av2=get_elem_val(t2a,'MAXLENGTH')
  3380.                if av2='' then av2=4
  3381.                atextmark=textmark1||textmark||textmark||left(avalue,max(1,av2-2),textmark)||textmark2
  3382.                thispara=thispara' 'atextmark
  3383.           end
  3384.           if atype='FILE' then do
  3385.                av2=get_elem_val(t2a,'SIZE')
  3386.                if av2='' then av2=get_elem_val(t2a,'MAXLENGTH')
  3387.                if av2='' then av2=7
  3388.                atextmark=textmark1||textmark||textmark||left(avalue,max(1,av2-2),textmark)||'(submit)'||textmark2
  3389.                thispara=thispara' 'atextmark
  3390.           end
  3391.  
  3392.           if atype='SUBMIT' then do
  3393.              if avalue='' then avalue='SUBMIT'
  3394.              thispara=thispara' '||submitmark1||strip(avalue)||submitmark2
  3395.           end /* do */
  3396.           if atype='RESET' then do
  3397.              if avalue='' then avalue='RESET'
  3398.              thispara=thispara' 'submitmark1||strip(avalue)||submitmark2
  3399.           end /* do */
  3400.  
  3401.        end /* do */
  3402.  
  3403.        otherwise nop
  3404.     end  /* select */
  3405.  
  3406. return 1                /* results saved in thispara */
  3407.  
  3408.  
  3409. /*************/
  3410. /* display error? */
  3411. do_display_error:
  3412. parse arg serious,amess,err2
  3413. if display_errors=0 then return 1       /* write nothing */
  3414.  
  3415. if addonmode<>1 then say amess               /* write to screen */
  3416.  
  3417. if display_errors=1 & serious<>1 then return 1  /* do not record to file */
  3418. if display_errors=3 then errflag=errorflag||err2
  3419. ioo=sendout(eRRflag' 'thispara,ispre,indent,aflag,xlinelen)
  3420. if addonmode<>1 then say " "
  3421. thispara=' ' ; aflag=0
  3422. return 1
  3423.  
  3424.  
  3425. /***************************/
  3426. /* say help */
  3427. sayhelp:
  3428. say ''
  3429. say "          "cy_ye||copies('/',25)||copies('\',25)|| normal
  3430. say "                    "bold"HTML_TXT: An HTML to text converter"normal
  3431. say " "
  3432. say bold"HTML_TXT "normal" is used to convert an "bold"HTML"normal" file to a "bold"text"normal" file. "
  3433. say " "
  3434. say bold"HTML_TXT"normal" will attempt to maintain the format of the HTML document "
  3435. say "by using appropriate spacing and ASCII characters. "
  3436. say " "
  3437. say bold"HTML_TXT"normal" can use ASCII art (lines and boxes), as well as other high-ascii "
  3438. say "characters, to improve the appearance of the output (text) file."
  3439. say " "
  3440. say bold"HTML_TXT"normal" can be customized in a number of ways. For example, you can:"
  3441. say " * suppress the use of line art and other high ASCII characters (your output"
  3442. say "   will be rougher, but will suffer from fewer compatability problems)."
  3443. say " * display tables (including nested tables) in a tabular format, or as "
  3444. say "   ordered lists"
  3445. say " * change the bullet characters used in ordered lists "
  3446. say ' * display Hn "headers" as an hierarchical outline '
  3447. say " * change characters used to signify logical elements (emphasis, anchors, etc.)"
  3448. say " "
  3449. say " "
  3450. say cy_YE " ... hit ENTER key for more " NORMAL
  3451. parse pull xx
  3452. say " ";say " " ; say " " ; say " "; say " "; say " "
  3453. say bold" Usage Hints: "normal
  3454. say " "
  3455. SAY " * "reverse"Quick file list:"normal" enter "bold"/DIR file.ext"normal" (for example: "bold"/DIR *.HTM /p"normal
  3456. say " "
  3457. SAY " * "reverse"To change a parameter:"normal" enter "bold"/VAR var1=val1"normal" (for example: "bold"/VAR lineart=0 "normal
  3458. say " "
  3459. SAY " * "reverse"Command line mode:"normal" Specify input (html) and output (text) file"
  3460. say "         "bold"Example: "normal"D:\>HTML_TXT foo.htm foo.txt "
  3461. say " "
  3462. say "    ... or, to modify the default parameters, add "bold" /VAR var1=val1 ; var2=val2  "normal
  3463. say "         "bold"Example: "normal"D:\>HTML_TXT foo.htm foo.txt /VAR lineart=0 ; flagul=* $ ! "
  3464. say " "
  3465. say " * "bold"Reading parameters from a file:"normal" include a "bold"PLIST=file.ext"normal" in a /VAR list"
  3466. say " "
  3467. say " * "bold"You can change the default parameters by editing HTML_TXT.CMD "
  3468. say " "
  3469. say "            "cy_ye||copies('\',25)||copies('/',25)|| normal
  3470. say " " ; say " "
  3471. return 1
  3472.  
  3473.  
  3474. /*******************************************/
  3475. /* iterated procedures */
  3476. /*******************************************/
  3477.  
  3478.  
  3479.  
  3480.  
  3481. /*******************************************/
  3482. /* GENERATE A TABLE INTO A TEMP VARIABLE */
  3483. GEN_TABLE2:PROCEDURE EXPOSE TABLES. outfile ,
  3484.        pretitle posttitle prea posta preh1 posth1 prehn posthn imgstring_max preimg postimg ,
  3485.        docaps douline doquote quotestring1 quotestring2 hn_outline hn_Numbers.  oltypes. ol_numbers. olnumber ,
  3486.        flagmenu flagul flagselect flagselect2 radiobox checkbox  errorflag display_errors ,
  3487.        tablevert tablehoriz tablefiller lineart submitmark1 submitmark2 ,
  3488.        textmark1 textmark2 textmark radioboxcheck checkboxcheck toolongword hrbig ,
  3489.        tablemode2 flagtl  tableborder showallopts suppress_empty_table charwidth ,
  3490.        linelen_orig wasblank suppress_blanklines ignore_width leftside. addonmode ,
  3491.        td_add crlf form_br links_list. link_display
  3492.  
  3493.  
  3494.  
  3495. arow.0=0
  3496.  
  3497. PARSE ARG nth,linelen
  3498.  
  3499.  /* say linelen " table " nth tables.nth.!spec  */
  3500. l0=linelen
  3501.  
  3502.  
  3503. /* set width of  this table */
  3504. linelen=get_tablewidth(tables.nth.!spec,linelen)  /* might be less then linelen */
  3505.  
  3506. call get_border_info    /* get border character info (uses only globals, and sets BVAL  */
  3507. if bval>1.0 then do
  3508.   noouter=' '; norules=' '
  3509. end
  3510.  
  3511. /* determine max columns in table, and WIDTH info of cells */
  3512. ccols=1; CSCOLS=1
  3513. do iir=1 to tables.nth.!rows
  3514.   tribble=tables.nth.iir.!totcols
  3515.   if tribble=0 then do                  /* warning: 0 tds in this tr */
  3516.     tables.nth.!errors=tables.nth.!errors||"TR_NO_TD "
  3517.     if addonmode<>1 then
  3518.        say " Warning: TR with no TD "
  3519.   end
  3520.   cscols=max(cscols,tribble)
  3521.   ccols=max(ccols,tables.nth.iir.!cols)
  3522.   do jcc=1 to tables.nth.iir.!cols
  3523.        gogo=get_tdwidth(tables.nth.iir.jcc.!spec,linelen,ignore_width,tables.nth.iir.jcc.!stuff, ,
  3524.                         tables.nth.iir.jcc.!colspan)
  3525.        parse var gogo gogo1 gogo2 gogo3         /* explicit maxauto minauto */
  3526.        if gogo1='' then gogo1=0
  3527.        if gogo3='' then gogo3=0
  3528.        if gogo2='' then gogo2=0
  3529.        tables.nth.iir.jcc.!tdwidth=gogo1
  3530.  
  3531. /*       tables.nth.iir.jcc.!mxll=max(gogo2+td_add,tables.nth.iir.jcc.!tdwidth)
  3532.        tables.nth.iir.jcc.!mnll=max(gogo3,td_add+2) */
  3533.  
  3534.        tables.nth.iir.jcc.!mxll=min(gogo2,trunc(l0*1.5))
  3535.        tables.nth.iir.jcc.!mnll=max(gogo3,td_add+2)
  3536.  
  3537. end   /* jcc tds */
  3538.  
  3539. end /* iir trs */
  3540.  
  3541. /* determine width of each column, given WIDTH info exists from above */
  3542. do kk=1 to cscols
  3543.    colwidths.kk=0               /* 0 signfies "unspecified */
  3544.    colwidths2.kk=0              /* unwrapped line lengths (concatended */
  3545.    colwidths2.kk.!min=2
  3546.    EXTRAS.KK.0=0
  3547.    extras.kk.!rws=1
  3548. end /* do */
  3549. do kr =1 to tables.nth.!rows
  3550.      kc2=1
  3551.      do kc=1 to tables.nth.kr.!cols
  3552.           cspan=tables.nth.kr.kc.!colspan
  3553.           cwidth=tables.nth.kr.kc.!tdwidth
  3554.           colwidths.kc2=max(colwidths.kc2,cwidth)
  3555.           if cwidth=0 then do
  3556.              tmx=tables.nth.kr.kc.!mxll
  3557.              colwidths2.kc2=max(colwidths2.kc2,tmx)
  3558.              tmn=tables.nth.kr.kc.!mnll
  3559.              colwidths2.kc2.!min=max(colwidths2.kc2.!min,tmn)
  3560.           end /* do */
  3561.           tables.nth.kr.kc.!tblcol=kc2  /* actual table column this td starts at */
  3562.           kc2=kc2+cspan
  3563.      end /* do */
  3564. end /* do */
  3565.  
  3566. /* colwidths2.0 ... */
  3567. colwidths2.0=0
  3568. do kk=1 to cscols
  3569.   colwidths2.0=colwidths2.0+colwidths2.kk
  3570. end /* do */
  3571.  
  3572. /* determine missing widths */
  3573.  
  3574. /* first, assign widths to columns with no width specified  -- use  td specific ".!maxlinelen" info*/
  3575. nsum=0 ; nnone=0
  3576. do kk=1 to cscols
  3577.    nsum=nsum+colwidths.kk
  3578.    if colwidths.kk=0 then do
  3579.       nnone=nnone+1
  3580.     end
  3581. end /* do */
  3582.  
  3583. /* 2) add missings? */
  3584. if nnone>0 then do
  3585.    misslen=linelen-nsum    /* default width to use for non width specfied columns */
  3586.    deflen=trunc(misslen/nnone)
  3587.    nsum=0
  3588.    do kk=1 to cscols
  3589.        if colwidths.kk=0 then do
  3590.            if colwidths2.kk=0 then do
  3591.                colwidths.kk=deflen
  3592.            end
  3593.            else do
  3594.               t1=colwidths2.kk/colwidths2.0
  3595.               colwidths.kk=max(colwidths2.kk.!Min+2,trunc(t1*misslen))
  3596.            end
  3597.        end
  3598.        nsum=nsum+colwidths.kk
  3599.    end
  3600. end
  3601.  
  3602. /* normalize (insure sum equals linelen) */
  3603. if (nnone>0 & nsum<>linelen) | (nsum>linelen) then do
  3604.    afact=linelen/nsum
  3605.    nsum=0
  3606.    do kk=1 to cscols
  3607.         colwidths.kk=max(1,trunc(colwidths.kk*afact))
  3608.  
  3609.         nsum=nsum+colwidths.kk
  3610.    end /* do */
  3611.    fixit=linelen-nsum
  3612.    if fixit>0 then do
  3613.       colwidths.1=colwidths.1+linelen-nsum           /* truncations get added to first column */
  3614.    end
  3615.    else do                      /* cols must be 1 space wide -- subtract from other columns*/
  3616.       do pp=1 to cscols         /* column that will support it */
  3617.          if colwidths.pp>5 then do
  3618.               colwidths.pp=colwidths.pp-1
  3619.               fixit=fixit+1 ; if fixit=0 then leave 
  3620.               if colwidths.pp>25 then do         /* extra penalty */
  3621.                 colwidths.pp=colwidths.pp-1
  3622.                 fixit=fixit+1
  3623.                 if fixit=0 then leave 
  3624.               end                       /* small chance it won't get evened out . */
  3625.           end           /* >5 */
  3626.       end               /* 1 to cscols */
  3627.    end                  /* fixit */
  3628. end /* do */
  3629.  
  3630. if bval<>0 then colwidths.1=colwidths.1-1                       /* leave room for left side border */
  3631.  
  3632. mincellwidth=linelen            /* used for a warning message */
  3633. funk=''
  3634. do kk=1 to cscols
  3635.    mincellwidth=min(mincellwidth,colwidths.kk)
  3636.    funk=funk' 'colwidths.kk
  3637. end /* do */
  3638.  
  3639. /* compute actual size of cells in each row, taking colspan into account */
  3640. /* also, add filler cell if need be */
  3641. do kr=1 to tables.nth.!rows
  3642.     jc1=1 ; mycols=tables.nth.kr.!cols
  3643.     do kc=1 to mycols
  3644.        actsize=-1
  3645.        jc2=jc1+tables.nth.kr.kc.!colspan
  3646.        do jj=jc1 to (jc2-1)
  3647.           actsize=actsize+colwidths.jj
  3648.        end /* do */
  3649.        tables.nth.kr.kc.!linecc=actsize
  3650.        jc1=jc2
  3651.     end /* do */
  3652. end /* do */
  3653.  
  3654. call go_make_bars       /* make default horizontal diviers (use/set globals */
  3655.  
  3656. IF mincellwidth<14  then  do
  3657.     tables.nth.!errors=tables.nth.!errors||"NARROW_CELLS "
  3658.     TABLEMODE=3         /* use HR BR instead for internal tables */
  3659. end
  3660. else do
  3661.   tablemode=tablemode2            /* tablemode for nested tables */
  3662. end
  3663. wasblank=0
  3664. indent=0; rightindent=0
  3665. ispre=0                 /* <PRE> is on? */
  3666. olcnts=''                 /* OL count */
  3667. lastelem=''
  3668. capon=0
  3669. ulineon=0
  3670. listtypes=''
  3671. anchoron=0 ; anchoron1=0; anchoron2=0
  3672. quoteon=0 ; quoteon1=0 ; quoteon2=0
  3673. ddon=1
  3674. thispara=''             /* current paragraph */
  3675. iscenter=0
  3676. aflag=' '
  3677.  
  3678. if hn_outline>0 then do
  3679.   do jj=hn_outline to 7
  3680.      hn_outlines.jj=0
  3681.   end /* do */
  3682. end
  3683.  
  3684. sendout_internal=1
  3685. sendout_var=''
  3686.  
  3687. /********* Widths are now determined -- start writing lines of the table */
  3688.  
  3689. datable=''
  3690. tablealive=0                    /* used to suppress empty table */
  3691.  
  3692. do Jir=1 to tables.nth.!rows    /********* FOR EACH ROW OF THE TABLE */
  3693. ic0=1
  3694. do ic=1 to tables.nth.Jir.!cols /**** FOR EACH COLUMN-CELL IN THE ROW */
  3695.  
  3696.  body=tables.nth.Jir.ic.!stuff          /* cell contents */
  3697.  
  3698.  linecc=tables.nth.jir.ic.!linecc       /* cell width in characters */
  3699.  if ic=tables.nth.jir.!cols & bval=0 then do
  3700.     linecc=linecc+1
  3701.     tables.nth.jir.ic.!linecc=linecc
  3702.  end
  3703.  
  3704. /* parse and format this cell's content */
  3705.  
  3706.  indent=0+cellpadding ; rightindent=0+cellpadding
  3707.  do forever                     /**** FOR EACH LINE IN A COLUMN-CELL */
  3708.     if body='' then leave
  3709.  
  3710.     parse var body t1 '<' t2a '>' body
  3711.  
  3712. /* Add t1 to thispara */
  3713. /* but first convert &codes */
  3714.      T1=CONVERT_CODES(T1,CAPON,ISPRE,ULINEON,TABLES.NTH.JIR.IC.!TH)
  3715.  
  3716. /* and fix up quote/anchor stuff */
  3717.      t1=fix_quote_anchor(t1)     /* may change globals */
  3718. /* now add it..... */
  3719.      thispara=thispara||t1      /* ADD T1 TO THISPARA FOR EVENTUAL OUTPUT */
  3720.  
  3721. /* now, process the <element> */
  3722.     t2=strip(translate(word(t2a,1)))
  3723.     if left(t2,1)='/'  then
  3724.         t2end=substr(t2,2)
  3725.     else
  3726.         t2end=''
  3727.  
  3728. /* convert table element to simpler form?? */
  3729.     t2=cvt_table_elements(t2)
  3730.  
  3731. /* THIS DOES THE PARSING */
  3732.      if t2='_TABLE_' then do            /* this is an internal table -- recurse! */
  3733.            parse var t2a . newtable ; newtable=strip(newtable)
  3734.            foo=sendout(thispara,ispre,indent,aflag,lineCC)
  3735.            aflag='' ;THISPARA=''
  3736.            if  datatype(newtable)='NUM' then do
  3737.               newtable=strip(newtable)
  3738.               if tables.newtable.!caption<>' ' then do
  3739.                  dacaption=prehn||tables.newtable.!caption||posthn
  3740.                  if tables.newtable.!captiona<>'BOTTOM' then
  3741.                    foo=sendout(dacaption,0,indent,' ',linecc,'CENTER')     
  3742.               end /* do */
  3743.               thispara=gen_table2(newtable,linecc)
  3744.  
  3745.               altype=tables.newtable.!ALIGN
  3746.  
  3747.               foo=sendout(thispara,1,indent,'',lineCC,altype)
  3748.               if tables.newtable.!captiona='BOTTOM' then
  3749.                    foo=sendout(dacaption,0,indent,' ',linecc,'CENTER')     
  3750.  
  3751.               if tables.newtable.!errors<>' ' then
  3752.                  tables.1.!errors=tables.1.!errors||';'NEWTABLE':'tables.newtable.!errors' '
  3753.               thispara='' ;aflag=''
  3754.            end
  3755.      end /* do */
  3756.      else do
  3757.         call interpret_elems2 linecc /* generic interprets */
  3758.      end
  3759.   end           /* body forever */
  3760.  
  3761. /* all done with this cell -- write it out a "line at a time */
  3762.  
  3763.   t1=fix_quote_anchor('')  /* may change globals */
  3764.  
  3765.   foo=sendout(thispara,ispre,indent,aflag,lineCC)
  3766.   thispara=''
  3767.  
  3768. /* add some prior lines (from rowspan>1 cell in this column) ? */
  3769.   nlines=0
  3770.   ictbl=tables.nth.jir.ic.!tblcol  /* starting table column of this td */
  3771.   if extras.ictbl.0>0 then do
  3772.       do nl=1 to extras.ictbl.0         /* add "extras for this table column */
  3773.          arow.ic.nl=extras.ictbl.nl
  3774.       end /* do */
  3775.       nlines=extras.ictbl.0
  3776.       extras.ictbl.0=0
  3777.   end
  3778.  
  3779.   do forever            /* Parse lines out and store in arow.ic. array */
  3780.      if sendout_var='' then leave
  3781.      nlines=nlines+1
  3782.      parse var sendout_var arow.ic.nlines (crlf) sendout_var
  3783.   end /* do */
  3784.   arow.ic.0=nlines
  3785.   sendout_var=''
  3786.  
  3787. /* note: excess lines in rowspan>1 are shuffled down; these may have
  3788.          been from a several rows back large rowspan  */
  3789.  
  3790.   if tables.nth.jir.ic.!rowspan=1 then arow.0=max(arow.0,nlines)
  3791.  
  3792. end    /* ic */
  3793.  
  3794. /* and extras  beyond this tr's last td? */
  3795. ikoo=tables.nth.jir.!cols
  3796. islandtds=''
  3797. if ikoo=0 then 
  3798.    ikoo2=cscols+1   /* a hack to cause skip of next section */
  3799. else
  3800.    ikoo2=tables.nth.jir.ikoo.!tblcol
  3801. do joob=ikoo2+1 to cscols
  3802.    if extras.joob.0=0 then iterate
  3803.    arow.0=max(arow.0,extras.joob.0)  /* island cells  approximation */
  3804.    islandtds=islandtds' 'joob
  3805. end /* do */
  3806.  
  3807. /* shuffle down extra lines (for rowspan<>1 cells) -- they may have come
  3808.    from prior rows */
  3809.  
  3810. do ic=1 to tables.nth.jir.!cols
  3811.    ictbl=tables.nth.jir.ic.!tblcol     /* save to appropriate table column storage */
  3812.    extras.ictbl.!bar=' '
  3813.    if arow.ic.0>arow.0 then do
  3814.  
  3815.       ictbl=tables.nth.jir.ic.!tblcol     /* save to appropriate table column storage */
  3816.       iq1=arow.0+1
  3817.       extras.ictbl.!bar=arow.ic.iq1          /* use this instead of usebar */
  3818.       iq3=0
  3819.       do iq2=arow.0+2 to arow.ic.0
  3820.          iq3=iq2-(1+arow.0)
  3821.          extras.ictbl.iq3=arow.ic.iq2
  3822.       end
  3823.       extras.ictbl.0=IQ3
  3824.    end /* do  >arow.0 */
  3825. end /* do ic */
  3826.  
  3827. /* done with all cells in this row of the table.
  3828.   horiz append each line of each cell to create linelen lines,
  3829.   vert appen these lines to make a row of cells */
  3830.  
  3831. /* type of alighment */
  3832. rspec=tables.nth.Jir.!spec
  3833. dalign=get_elem_val(rspec,'ALIGN')
  3834. dalignv=get_elem_val(rspec,'ALIGNV')
  3835.  
  3836. thisrows="" ; tralive=0      /* assume empty row */
  3837. iii0=1
  3838. didpad=cellpadding ; didpad2=didpad 
  3839.  
  3840. do until iii0>arow.0
  3841.   thisline=''
  3842.  
  3843.   if jir=tables.nth.!rows then do
  3844.     if noouter<>"VOID" then do
  3845.                usebar=horizbar2
  3846.      end
  3847.      else do
  3848.                usebar=copies(' ',length(horizbar2))
  3849.      end
  3850.   end
  3851.   else do
  3852.     if norules<>"NONE" then do
  3853.        if noouter="VOID" then
  3854.           usebar=' 'substr(horizbarm,2,length(horizbarm)-2)' '
  3855.        else
  3856.           usebar=horizbarm
  3857.     end
  3858.     else  do
  3859.        usebar='|'||copies(' ',max(1,length(horizbarm)-2))||'|'
  3860.     end
  3861.   end
  3862.  
  3863.   do ic=1 to tables.nth.Jir.!cols
  3864.       linecc=tables.nth.jir.ic.!linecc
  3865.       if iii0=1 then do          /* cell specs , check on first line */
  3866.           call set_caligns
  3867.       end
  3868.       iii=iii0-lineoffset.ic            /* used for centering */
  3869.  
  3870.       if iii<1 | iii>arow.ic.0 then do       /* fller line (valign stuff ?*/
  3871.          addme=copies(tablefiller,linecc)
  3872.          if didpad>0 & iii0=1 then do     /* add initial padding */
  3873.             if ic=tables.nth.jir.!cols then didpad=didpad-1
  3874.             dopad=1
  3875.           end 
  3876.           if didpad2>0 & iii0=arow.0 then do     /* add ending padding */
  3877.              if ic=tables.nth.jir.!cols then didpad2=didpad2-1
  3878.              dopad=1
  3879.           end
  3880.       end
  3881.       else do                   /* got a line to add */
  3882. /* initial padding? */
  3883.        select
  3884.          when didpad>0 & iii0=1 then do     /* add initial padding */
  3885.             if ic=tables.nth.jir.!cols then didpad=didpad-1
  3886.             addme0='  '; dopad=1
  3887.           end 
  3888.           when didpad2>0 & iii0=arow.0 then do     /* add ending padding */
  3889.              if ic=tables.nth.jir.!cols then didpad2=didpad2-1
  3890.               addme0=arow.ic.iii ; arow.ic.iii=' '; dopad=1
  3891.           end 
  3892.           otherwise   do
  3893.                 addme0=arow.ic.iii ;dopad=0
  3894.           end
  3895.         end
  3896.         if addme0<>' ' then do
  3897.             tralive=1  ;tablealive=1
  3898.         end /* do */
  3899.         select
  3900.            when calign.ic='MIDDLE' | calign.ic='CENTER' then
  3901.               addme=center(addme0,linecc)
  3902.            when calign.ic='RIGHT' then
  3903.               addme=right(addme0,linecc)
  3904.            otherwise
  3905.               addme=left(addme0,linecc,' ')
  3906.         END
  3907.       end               /* non filler line */
  3908.  
  3909.       if bval=0 & ic=1 then do          /* put border around thisline */
  3910.          tl1=length(thisline)
  3911.          thisline=addme
  3912.          tl2=length(thisline)
  3913.       end
  3914.       else do
  3915.          tl1=length(thisline)+length(tvert)
  3916.          tvv=tvert
  3917.          if ic=1 & noouter='VOID' then tvv=' '
  3918.          if ic<>1 & norules='NONE' then tvv=' '
  3919.          thisline=thisline||tvv||addme
  3920.          tl2=length(thisline)
  3921.       end
  3922.  
  3923.      if iii0==arow.0 then do                       /* modify usebar? */
  3924.         if tables.nth.jir.ic.!nobot=1 then do      /* suppress bottom border */
  3925.           ictbl=tables.nth.jir.ic.!tblcol
  3926.           usebar=overlay(extras.ictbl.!bar,usebar,tl1+1,tl2-tl1)
  3927.        end
  3928.      end
  3929.  
  3930.   end /* do ic */
  3931.  
  3932. /* in case of insufficient cells .. */
  3933.   if cScols>tables.nth.Jir.!TOTcols then do
  3934.      if islandtds<>'' then do            /* island cells to do? */
  3935.        is2=islandtds
  3936.        oz0=tables.nth.jir.!totcols+1
  3937.        do forever
  3938.          if is2='' then do              /* no more islands -- fill to end */
  3939.              do ozo=isle1+1 to cscols
  3940.                 thisline=thisline||copies(tablefiller,max(1,colwidths.ozo-1))
  3941.              end /* do */
  3942.              leave
  3943.          end /* do */
  3944.          parse var is2 isle1 is2 ; isle1=striP(isle1)
  3945.          tvv=tvert; if norules='NONE' then tvv=' '
  3946.          do ozo=oz0 to (isle1-1)                /* fill some columns */
  3947.             thisline=thisline||tvv||copies(tablefiller,max(colwidths.ozo-1,1))
  3948.          end /* do */
  3949.          addmox=extras.isle1.iii0
  3950.          select
  3951.            when calign.ic='MIDDLE' | calign.ic='CENTER' then
  3952.               addmox=center(addmox,colwidts.isle1-1)
  3953.            when calign.ic='RIGHT' then
  3954.               addmox=right(addmox,colwidths.isle1-1)
  3955.            otherwise
  3956.               addmox=left(addmox,colwidths.isle1-1,' ')
  3957.           END
  3958.          tvv=tvert ; if norules="NONE" then tvv=' '
  3959.          thisline=thisline||tvv||addmox||tvv
  3960.        end
  3961.      end
  3962.      else do            /* no istlands -- fill rest of line */
  3963.           goon2=LINELEN-length(thisline)
  3964.           thisline=thisline||copies(tablefiller,max(1,goon2-1))
  3965.      end /* do */
  3966.   end /* do */
  3967.  
  3968.   if bval<>0 & noouter<>'VOID' then 
  3969.       thisline=thisline||TVERT          /* END OF A LINE */
  3970.   else
  3971.       thisline=thisline||' '          /* END OF A LINE */
  3972.  
  3973.   thisrows=thisrows||thisline||CRLF     /* APPEND TO "LINES IN THIS ROW OF CELLS */
  3974.  
  3975.   if dopad=0 then iii0=iii0+1   /* not padding */
  3976.  
  3977. end             /* iii (lines in this row ) */
  3978.  
  3979. DO FOREVER
  3980.    IF ISLANDTDS='' then LEAVE
  3981.    PARSE VAR ISLANDTDS IS1 ISLANDTDS ; IS1=STRIP(IS1)
  3982.    EXTRAS.IS1.0=0
  3983. end /* do */
  3984.  
  3985. if tralive=0 & suppress_empty_table=1 then do  /* suppress empty row? */
  3986.      nop
  3987. end /* do */
  3988. else do
  3989.      datable=DATABLE||thisrows||usebar||CRLF
  3990. end
  3991.  
  3992. arow.0=0
  3993.  
  3994. end             /* Jir'th row */
  3995.  
  3996. sendout_internal=0
  3997.  
  3998. if tablealive=0 & suppress_empty_table=1 then return ' '
  3999.  
  4000.  
  4001. if noouter<>'VOID' then
  4002.    datable=horizbar1||crlf||datable               /* top line of da table */
  4003. else 
  4004.   datable=copies(' ',length(horizbar1))||crlf||datable
  4005.  
  4006.  
  4007.  
  4008. return datable
  4009.  
  4010.  
  4011. /*********************/
  4012. /* routine to interpret html elements -- uses lots of globals */
  4013. interpret_elems2:
  4014.  
  4015. parse arg Xlinelen
  4016. indent3=4
  4017. if xlinelen<22 then indent3=1
  4018.  
  4019. mindent3=4
  4020. if xlinelen<22 then mindent3=1
  4021.  
  4022. /* break off piece of body  */
  4023.  
  4024. /* look for line breakers */
  4025.     select
  4026.       when t2='HR' then do
  4027.  
  4028.          hrsize=get_elem_val(t2a,'SIZE')                /* line height */
  4029.          if datatype(hrsize)<>'NUM' then hrsize=1
  4030.          if hrsize<3 then
  4031.             hrchar='_'
  4032.          else
  4033.             hrchar=hrbig
  4034.  
  4035.          hrwidth=strip(get_elem_val(t2a,'WIDTH'))   /* line width */
  4036.          select
  4037.              when hrwidth='' then hrwidth=1.0
  4038.              when right(hrwidth,1)='%' then do
  4039.                  parse var hrwidth hrwidth '%' .
  4040.                  if datatype(hrwidth)='NUM' then
  4041.                     hrwidth=min(100,hrwidth)/100
  4042.                  else
  4043.                     hrwidth=1
  4044.              end /* do */
  4045.              otherwise do
  4046.                 if datatype(hrwidth)='NUM' then
  4047.                       hrwidth=min(1,hrwidth/640)
  4048.                 else
  4049.                        hrwidth=1
  4050.              end
  4051.          end
  4052.          hrchars=max(2,trunc((xlinelen-4)*hrwidth))
  4053.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4054.          call sendout ' '
  4055.          thispara='';aflag=0
  4056.          foo=sendout(center(copies(hrchar,hrchars),xlinelen),1,,,xlinelen)
  4057.          if hrsize>10 then
  4058.             foo=sendout(center(copies(hrchar,hrchars),xlinelen),1,,,xlinelen)
  4059.          call sendout ' '
  4060.  
  4061.       end
  4062.  
  4063.       when t2='HR1' then do
  4064.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4065.          thispara='';aflag=0
  4066.          if lineart>=0 then do
  4067.              foo=sendout(center(d2c(201)||copies(d2c(205),max(1,Xlinelen-6))||d2c(187),Xlinelen),1,,,xlinelen)
  4068.          end
  4069.          else do
  4070.              foo=sendout(center('/'copies('=',max(1,Xlinelen-6))'\',Xlinelen),1,,,xlinelen)
  4071.          end
  4072.          indent=indent+indent3
  4073.       end
  4074.  
  4075.       when t2='HR2' then do
  4076.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4077.          thispara='';aflag=0
  4078.          att='='
  4079.          if lineart>=0 then do
  4080.              foo=sendout(center(d2c(200)||copies(d2c(205),max(1,Xlinelen-6))||d2c(188),Xlinelen),1,,,xlinelen)
  4081.          end
  4082.          else do
  4083.              foo=sendout(center('\'copies('=',max(1,Xlinelen-6))'/',Xlinelen),1,,,xlinelen)
  4084.          end
  4085.          indent=max(indent-mindent3,0)
  4086.       end
  4087.  
  4088. /* H1 H2 H3 ... HEADERS */
  4089.       when wordpos(t2,'H1 H2 H3 H4 H5 H6 H7')>0 then do
  4090.          HN_LEVEL=WORDPOS(T2,'H1 H2 H3 H4 H5 H6 H7')
  4091.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4092.          thispara=''
  4093.          ah=getelem('/H')
  4094.  
  4095.          ah=remove_htmls(ah)
  4096.  
  4097.          docenter=0     /* don't add pre Hn stuff if centered */
  4098.  
  4099. /* Add an "outline" number */
  4100.         if hn_outline<=hn_level & hn_outline<>0 then do
  4101.            hn_outlines.hn_level=hn_outlines.hn_level+1
  4102.  
  4103.            do mmh=hn_outline to (hn_level-1)        /* fix up lower levels */
  4104.               if hn_outlines.mmh=0 then hn_outlines.mmh=1
  4105.            end /* do */
  4106.            do mmh=hn_level+1 to 7  /* fix up higher levels */
  4107.               hn_outlines.mmh=0
  4108.            end /* do */
  4109.  
  4110.            immh=0 ;aah=''       /* build outline number */
  4111.            do mmh=hn_outline to hn_level
  4112.               immh=immh+1
  4113.               jint=hn_outlines.mmh
  4114.               anums=hn_numbers.immh
  4115.               if words(anums)<jint then
  4116.                 aah=aah||jint
  4117.               else
  4118.                 aah=aah||strip(word(anums,jint))
  4119.               if mmh<hn_level then aah=aah'.'
  4120.            end /* do */
  4121.            ah=aah') 'ah         /* add the outline number */
  4122.         end
  4123.  
  4124.         if  (pos('CENTER',translate(t2a))+pos('MIDDLE',translate(t2a)))>0 & ,
  4125.              length(ah)<Xlinelen then do
  4126.                 docenter=1
  4127.          end
  4128.          else do
  4129.              if HN_LEVEL=1 then do
  4130.                  p1=preh1;p2=posth1
  4131.               end
  4132.               else do
  4133.                    p1=prehn ; p2=posthn
  4134.               end /* do */
  4135.               ah=p1||ah||p2
  4136.          end /* do */
  4137.  
  4138.          ah=translate(ah,' ','0d0a0009'x)
  4139.          if docenter=1 then  ah=center(ah,Xlinelen)
  4140.  
  4141.          call sendout ' '
  4142.          foo=sendout(ah,2,indent,,xlinelen)
  4143.          if HN_LEVEL<4 then call sendout ' '
  4144.          aflag=0 ; thispara=''
  4145.       end
  4146.  
  4147.       when t2='P' then do
  4148.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4149.          thispara='';aflag=0
  4150.          if lastelem<>'P' then
  4151.              foo=sendout(' ',ispre,indent,aflag,xlinelen)
  4152.          palign=get_elem_val(t2a,'ALIGN')
  4153.          if palign='CENTER' | palign='MIDDLE' then docenter=1
  4154.          if palign='LEFT' | palign='RIGHT' then docenter=0
  4155.       end /* do */
  4156.  
  4157.  
  4158.        when t2='PRE'  then DO
  4159.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4160.           CALL SENDOUT ' '
  4161.           thispara='' ; aflag=0
  4162.           ispre=1
  4163.        END
  4164.        when t2='/PRE' then DO
  4165.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4166.           CALL SENDOUT ' '
  4167.           thispara='' ; aflag=0
  4168.           ispre=0
  4169.        END
  4170.  
  4171.        when t2='DIV'  then do
  4172.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4173.           isc=get_elem_val(t2a,'ALIGN')
  4174.           if isc="MIDDLE" | isc="CENTER" then
  4175.               iscenter=1
  4176.           if isc="RIGHT" then iscenter=2
  4177.           thispara='' ; aflag=0
  4178.        end /* do */
  4179.  
  4180.        when t2='/DIV' then do
  4181.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4182.           thispara='' ; aflag=0
  4183.           iscenter=0
  4184.        end
  4185.  
  4186.        when t2='CENTER' then do
  4187.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4188.           thispara='' ; aflag=0
  4189.           iscenter=1
  4190.         end
  4191.  
  4192.        when t2='/CENTER' then do
  4193.           foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4194.           thispara='' ; aflag=0
  4195.           iscenter=0
  4196.         end
  4197.  
  4198.       when t2='TEXTAREA' then do
  4199.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4200.          thispara='';aflag=0
  4201.          ah=getelem('/TEXTAREA')
  4202.          ah=remove_htmls(ah)
  4203.          ncols=get_elem_val(t2a,'COLS')
  4204.          if datatype(ncols)<>'NUM' then ncols=50
  4205.          ah2=box_around(ah,min(ncols,Xlinelen-3))
  4206.          foo=sendout(ah2,1)
  4207.          aflag=0
  4208.       end
  4209.  
  4210.       when t2='IMG' then do
  4211.          parse var t2a . imgname
  4212.          select
  4213.           when imgstring_max=1 then imgname=left(imgname,min(length(imgname),max(5,xlinelen-5)))
  4214.           when imgstring_max=0 then nop
  4215.           otherwise imgname=left(imgname,min(length(imgname),imgstring_max))
  4216.          end
  4217.          if imgname<>'' then
  4218.             imgname=preimg||strip(imgname)||postimg
  4219.          else
  4220.             imgname='[IMG]'
  4221.          imgname=space(translate(imgname,' ','0d0a0009'x))
  4222.          imgname=fix_quote_anchor(imgname)
  4223.          thispara=thispara||imgname' '
  4224.       end /* do */
  4225.  
  4226.       when t2='BLOCKQUOTE' then do
  4227.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4228.          call sendout ' '
  4229.          thispara='';aflag=0
  4230.          indent=indent+indent3 ; rightindent=rightindent+indent3
  4231.       end
  4232.  
  4233.       when t2='/BLOCKQUOTE' then do
  4234.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4235.          thispara='';aflag=0
  4236.          call sendout ' '
  4237.          indent=max(0,indent-mindent3); rightindent=max(0,rightindent-mindent3)
  4238.       end
  4239.  
  4240.       when wordpos(t2,'UL TL DL OL MENU DIR')>0 then do
  4241.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4242.          listtypes=listtypes' 't2
  4243.          if t2='OL' then DO
  4244.              olstart=get_elem_val(t2a,'START')
  4245.              if datatype(olstart)<>'NUM' then olstart=1
  4246.              olstart=olstart-1
  4247.              OLCNTs=OLCNTs' 'olstart
  4248.              aOLTYPE=GET_ELEM_VAL(T2A,'TYPE',1)
  4249.              oltype=WORDPOS(aOLTYPE,'1 a A i I')
  4250.              foof=words(olcnts)
  4251.              oltypes.foof=ol_numbers.oltype
  4252.  
  4253.          end
  4254.          thispara='';aflag=0
  4255.          i3=3; if xlinelen<25 then i3=1
  4256.          indent=indent+indent3
  4257.      end
  4258.  
  4259.       when wordpos(t2,'/UL /DL /OL /MENU /DIR /TL ')>0 then do
  4260.          IW=WORDS(LISTTYPES)
  4261.          LASTT=WORD(LISTTYPES,IW)
  4262.  
  4263.          IF lastt<>SUBSTR(T2,2) then do
  4264.               indent=0 ; olcnts='' ; listtypes=''
  4265.               call do_display_error 1 ,  "Warning: expected "||t2||"; found /"||lastt , ,
  4266.                                          T2"_NOT_"lastt
  4267.          end /* do */
  4268.  
  4269. /* legit list .. */
  4270.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4271.          thispara=' '         ; aflag=0
  4272.  
  4273. /* shrink list infos */
  4274.          if lastt='OL' then do
  4275.              iw2=words(olcnts)
  4276.              if iw2=1 then do
  4277.                 olcnts=''
  4278.              end
  4279.              else do
  4280.                if iw2<1 then
  4281.                  call do_display_error 1, "Warning: Problem with OL UL or SELECT ","UNEXPECTED_DELWORD" 
  4282.                ELSE
  4283.                   olcnts=delword(olcnts,iw2)
  4284.              END
  4285.          end
  4286.          if iw=1 | listtypes='' then                 /* fix list of UL OL */
  4287.                 listtypes=''
  4288.          else
  4289.                listtypes=delword(listtypes,iw)
  4290.          indent=max(0,indent-mindent3)
  4291.          if t2='/DL' & ddon=1 then indent=max(0,indent-mindent3)
  4292.  
  4293.          call sendout ' '
  4294.  
  4295.       end               /* /ul etc */
  4296.  
  4297.       when t2='LI'  then do
  4298.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4299.          thisval=get_elem_val(t2a,'VALUE')
  4300.          aflag=figflag(thisval)       /* the flag for this type */
  4301.          thispara=''
  4302.          call sendout ' '
  4303.       end /* do */
  4304.  
  4305.       when t2='DD' | t2='DT' then do
  4306.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4307.          goon=words(listtypes)
  4308.          if word(listtypes,goon)<>'DL' then do
  4309.               if addonmode<>1 then SAY ' '
  4310.               indent=0 ; olcnts='' ; listtypes=''
  4311.               call do_display_error 1, "Warning: DD or DT not expected in  list " , "UNEXPECTED_DD|DT"
  4312.          end
  4313.          aflag=' '
  4314.          if t2='DT' then do
  4315.              if ddon=1 then indent=max(0,indent-mindent3)
  4316.              ddon=0
  4317.          end
  4318.          if t2='DD' then do
  4319.               indent=indent+indent3
  4320.               ddon=1
  4321.          end
  4322.          thispara=''
  4323.          call sendout ' '
  4324.       end /* do */
  4325.  
  4326.       when t2='SELECT' then do
  4327.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4328.          selsize=get_elem_val(t2a,'SIZE')
  4329.          if datatype(selsize)<>"NUM" | showallopts=1 then do
  4330.              listtypes=listtypes' 't2
  4331.          end
  4332.          else do
  4333.              a1=2
  4334.              if selsize=1 then a1=1
  4335.              listtypes=listtypes' 't2||(selsize+a1)
  4336.          end
  4337.          thispara='';aflag=0
  4338.          ijm=max(1,xlinelen-(indent+rightindent+4))
  4339.  
  4340.          ijm=min(ijm,14)
  4341.          if  lineart>=0 then
  4342.             foo3=d2c(218)||copies(d2c(196),ijm)  /* ||d2c(191) */
  4343.          else
  4344.             foo3='/'||copies('-',ijm)   /* ||'\' */
  4345.          foo=sendout(foo3,0,indent,,xlinelen)
  4346.          indent=indent+1
  4347.  
  4348.       end
  4349.  
  4350.       when t2='OPTION' then do
  4351.          goon=words(listtypes)
  4352.          ggw=word(listtypes,goon)
  4353.          if abbrev(ggw,'SELECT')=0 then do      /* SELECT not active */
  4354.               indent=0 ; olcnts='' ; listtypes=''
  4355.               call display_error 1,"Warning: Option not expected in list" , "UNEXPECTED_OPTION"
  4356.               iterate
  4357.          end
  4358.  
  4359. /* check selsize counter */
  4360.          parse var ggw 'SELECT' ggw2
  4361.          showok=0
  4362.          if ggw='SELECT' then do
  4363.             showok=1
  4364.          end
  4365.          else do
  4366.             if datatype(ggw2)='NUM' then do
  4367.                if ggw2>0  then do
  4368.                    showok=1
  4369.                    if ggw2=1 then showok=2
  4370.                    jt3=ggw2-1 /* count down */
  4371.                    ggw3='SELECT'||jt3
  4372.                    listtypes=delword(listtypes,goon)' 'ggw3
  4373.                end /* do */
  4374.             end
  4375.          end
  4376.          if showok=1 then do    /* SIZE not violated */
  4377.  
  4378.               if thispara<>"" then foo=sendout(thispara,ispre,indent+1,aflag,xlinelen)
  4379.               aflag=flagselect
  4380.               if pos('SELECTED',translate(t2a))>0 then aflag=flagselect2
  4381.               thispara=''
  4382.           end         /* else, SIZE shown already */
  4383.           else do
  4384.              if showok=2 then DO
  4385.                thispara=prea||'...more'||posta /* this is the ..more.. flag */
  4386.                foo=sendout(thispara,ispre,indent+1,aflag,xlinelen)
  4387.              END
  4388.              thispara='' ; AFLAG=''  /* zap this option text */
  4389.           end /* do */
  4390.       end /* do */
  4391.  
  4392.  
  4393.      WHEN T2='/SELECT' then DO
  4394.          IW=WORDS(LISTTYPES)
  4395.          LASTT=WORD(LISTTYPES,IW)
  4396.          IF abbrev(lastt,'SELECT')=0 then do
  4397.               call do_display_error 1, "Warning: expected "||t2||"; found /"||lastt , "UNEXPECTED_/SELECT"
  4398.               indent=0 ; olcnts='' ; listtypes=''
  4399.               iterate
  4400.          end /* do */
  4401.  
  4402. /* legit list .. WITHIN SIZE?*/
  4403.          if right(lastt,1)<>'0' then
  4404.             foo=sendout(thispara,ispre,indent+1,aflag,xlinelen)
  4405.  
  4406.          thispara=' '         ; aflag=0
  4407.          if iw=1 then                 /* fix list of UL OL */
  4408.                 listtypes=''
  4409.          else
  4410.                listtypes=delword(listtypes,iw)
  4411.  
  4412.          indent=max(0,indent-1)
  4413.  
  4414.          ijm=max(1,xlinelen-(indent+rightindent+4))
  4415.  
  4416.          ijm=min(ijm,14)
  4417.          if  lineart>=0 then
  4418.                 foo3=d2c(192)||copies(d2c(196),ijm) /*||d2c(217) */
  4419.          else
  4420.                 foo3='\'||copies('-',ijm)   /* ||'/' */
  4421.          foo=sendout(foo3,0,indent,,xlinelen)
  4422.       end
  4423.  
  4424.       when t2='BR' | (t2='/FORM' & form_br=1) then do
  4425.          foo=sendout(thispara,ispre,indent,aflag,xlinelen)
  4426.          if t2='BR' then isclear=get_elem_val(t2a,'CLEAR')      /* clear past floatings (end word wrap) ? */
  4427.          thispara='';aflag=0
  4428.       end /* do */
  4429.  
  4430. /* paragraph modifiers */
  4431.        when t2='A' then  do
  4432.              if pos(' NAME=',translate(t2a))=0 then do
  4433.                 anchoron2=0
  4434.                 if anchoron=1 then do           /* warning */
  4435.                     call do_display_error 0,"Warning: unclosed <A> ", "UNCLOSED_<A>"
  4436.                     anchoron2=1                /* assume we are preceded by a </a> */
  4437.                 end /* do */
  4438.                 anchoron=1 ;anchoron1=1
  4439.                 yowo=pos('HREF=',translate(t2a))
  4440.                 yowo2=substr(t2a,yowo)
  4441.                 parse var yowo2 hh '"' a_url '"' .
  4442.                 if link_display<>0 then do
  4443.                   igg=links_list.0+1
  4444.                   links_list.igg=a_url
  4445.                   links_list.0=igg
  4446.                 end
  4447.                 anchoron=1 ;anchoron1=1
  4448.              end
  4449.        end
  4450.        when t2='/A' then  do
  4451.           if anchoron=1 then anchoron2=1
  4452.           anchoron=0 ;anchoron1=0
  4453.        end
  4454.  
  4455. /* LOGICAL ELEMENTS */
  4456.        when pos(t2,docaps' 'douline' 'doquote)>0 then do        /* a font modifer */
  4457.            if wordpos(t2,docaps)>0 then capon=capon+1
  4458.            if wordpos(t2,douline)>0 then ulineon=ulineon+1
  4459.            if wordpos(t2,doquote)>0 then do
  4460.                 quoteon=quoteon+1 ;quoteon1=1 ; QUOTEON2=0
  4461.             end
  4462.        end /* do */
  4463.  
  4464. /* END LOGICAL ELEMENTS */
  4465.        when pos(t2end,docaps' 'douline' 'doquote)>0 then do        /* end of font modifer */
  4466.           if wordpos(t2end,docaps)>0 then capon=max(0,capon-1)
  4467.  
  4468.           if wordpos(t2end,douline)>0 then ulineon=max(0,ulineon-1)
  4469.           if wordpos(t2end,doquote)>0 then do
  4470.              IF QUOTEON=1 then QUOTEON2=1   /* this is the end of nested emphasis */
  4471.              quoteon=max(quoteon-1,0) ;quoteon1=0
  4472.           end
  4473.           if t1<>'' then thispara=' 'thispara
  4474.  
  4475.        end
  4476.  
  4477.       when t2='INPUT' then do
  4478.  
  4479.           atype=TRANSLATE(get_elem_val(t2a,'TYPE'))
  4480.  
  4481.           IF ATYPE='' then ATYPE='TEXT'
  4482.           avalue=get_elem_val(t2a,'VALUE',1)
  4483.           if atype='RADIO' then do
  4484.              if wordpos('CHECKED',translate(t2a))>0 then
  4485.                  thispara=thispara' 'radioboxcheck
  4486.              else
  4487.                  thispara=thispara' 'radiobox
  4488.           end
  4489.           if atype='CHECKBOX' then do
  4490.              if wordpos('CHECKED',translate(t2a))>0 then
  4491.                  thispara=thispara' 'checkboxcheck' '
  4492.              else
  4493.                  thispara=thispara' 'checkbox' '
  4494.           end
  4495.           if atype='TEXT' then do
  4496.                av2=get_elem_val(t2a,'SIZE')
  4497.                if av2='' then av2=get_elem_val(t2a,'MAXLENGTH')
  4498.                if av2='' then av2=4
  4499.                atextmark=textmark1||textmark||textmark||left(avalue,max(1,av2-2),textmark)||textmark2
  4500.                thispara=thispara' 'atextmark
  4501.           end
  4502.           if atype='SUBMIT' then do
  4503.              if avalue='' then avalue='SUBMIT'
  4504.              thispara=thispara' '||submitmark1||strip(avalue)||submitmark2
  4505.           end /* do */
  4506.           if atype='RESET' then do
  4507.              if avalue='' then avalue='RESET'
  4508.              thispara=thispara' 'submitmark1||strip(avalue)||submitmark2
  4509.           end /* do */
  4510.  
  4511.        end /* do */
  4512.  
  4513.        otherwise nop
  4514.     end  /* select */
  4515.  
  4516. return 1                /* results saved in thispara */
  4517.  
  4518.  
  4519.  
  4520.