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