Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v diff -u -r1.71 -r1.72 --- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 22 Dec 2017 14:14:20 -0000 1.71 +++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 17 Jan 2018 22:35:09 -0000 1.72 @@ -357,10 +357,12 @@ # set frag [string map [list &# "\0&#\0"] $html_fragment] - if {[catch {dom parse -html $frag doc} errorMsg]} { + ad_try { + dom parse -html $frag doc + } on error {errorMsg} { # we got an error, so do normal processing ns_log notice "tdom can't parse the provided HTML, error=$errorMsg,\nchecking fragment without tdom" - } else { + } on ok {r} { $doc documentElement root set html "" # discard forms @@ -1177,21 +1179,24 @@ } ## - - # root of the document must be unique, this will enforce it by # wrapping html in an auxiliary root element set lmarker "" set rmarker "" - if {[catch { + ad_try { dom parse -html "${lmarker}${html}${rmarker}" doc - } errmsg]} { - if {!$fix_p || - [catch { + + } on error {errorMsg} { + if {$fix_p} { + ad_try { set doc [ad_dom_fix_html -html $html -dom] - } errmsg]} { - ad_log error "Parsing of the document failed. Reported error: $errmsg" + } on error {errorMsg} { + ad_log error "Fixing of the document failed. Reported error: $errorMsg" + return [expr {$validate_p ? 0 : ""}] + } + } else { + ad_log error "Parsing of the document failed. Reported error: $errorMsg" return [expr {$validate_p ? 0 : ""}] } } @@ -1407,9 +1412,11 @@ set count 0 while 1 { if {[incr count] > 3000 } { - # JCD: the programming bug is that an unmatched < in the input runs off forever looking for - # it's closing > and in some long text like program listings you can have lots of quotes - # before you find that > + # JCD: the programming bug is that an unmatched < + # in the input runs off forever looking for it's + # closing > and in some long text like program + # listings you can have lots of quotes before you + # find that > error "There appears to be a programming bug in ad_html_to_text: We've entered an infinite loop." } # Find the positions of the first quote, apostrophe and greater-than sign. @@ -1439,7 +1446,8 @@ } set string_delimiter [string index $html $string_delimiter_idx] - # If the greater than sign appears before any of the string delimters, we've found the tag end. + # If the greater than sign appears before any of the + # string delimters, we've found the tag end. if { $gt_idx < $string_delimiter_idx || $string_delimiter_idx == -1 } { # we found the tag end set i $gt_idx