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.109.2.61 -r1.109.2.62
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl	28 Jul 2024 17:00:04 -0000	1.109.2.61
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl	20 Aug 2024 07:53:31 -0000	1.109.2.62
@@ -1392,54 +1392,58 @@
 
     set queue {}
     lappend queue [list $root [$tree children [$tree children root]]]
-    while {$queue ne {}} {
-        lassign [lindex $queue 0] domparent treechildren
-        set queue [lrange $queue 1 end]
+    try {
+        while {$queue ne {}} {
+            lassign [lindex $queue 0] domparent treechildren
+            set queue [lrange $queue 1 end]
 
-        foreach child $treechildren {
-            set type [$tree get $child type]
-            set data [$tree get $child data]
-            if {$type eq "PCDATA"} {
-                set el [$doc createTextNode $data]
-            } else {
-                set el [$doc createElement $type]
+            foreach child $treechildren {
+                set type [$tree get $child type]
+                set data [$tree get $child data]
+                if {$type eq "PCDATA"} {
+                    set el [$doc createTextNode $data]
+                } else {
+                    set el [$doc createElement $type]
 
-                # parse element attributes
-                while {$data ne ""} {
-                    set data [string trim $data]
-                    # attribute with a value, optionally surrounded by double or single quotes
-                    if {[regexp "^(\[^= \]+)=(\"\[^\"\]*\"|'\[^'\].*'|\[^ \]*)" $data m attname attvalue]} {
-                        if {[string match "\"*\"" $attvalue] ||
-                            [string match "'*'" $attvalue]} {
-                            set attvalue [string range $attvalue 1 end-1]
+                    # parse element attributes
+                    while {$data ne ""} {
+                        set data [string trim $data]
+                        # attribute with a value, optionally surrounded by double or single quotes
+                        if {[regexp "^(\[^= \]+)=(\"\[^\"\]*\"|'\[^'\].*'|\[^ \]*)" $data m attname attvalue]} {
+                            if {[string match "\"*\"" $attvalue] ||
+                                [string match "'*'" $attvalue]} {
+                                set attvalue [string range $attvalue 1 end-1]
+                            }
+                            # attribute with no value
+                        } elseif {[regexp {^([^\s]+)} $data m attname]} {
+                            set attvalue ""
+                        } else {
+                            error "Unrecoverable attribute spec in supplied markup"
                         }
-                        # attribute with no value
-                    } elseif {[regexp {^([^\s]+)} $data m attname]} {
-                        set attvalue ""
-                    } else {
-                        error "Unrecoverable attribute spec in supplied markup"
-                    }
 
-                    # skip bogus attribute names
-                    if {[string is alnum -strict $attname]} {
-                        $el setAttribute $attname $attvalue
+                        # skip bogus attribute names
+                        if {[string is alnum -strict $attname]} {
+                            $el setAttribute $attname $attvalue
+                        }
+
+                        set data [string range $data [string length $m] end]
                     }
+                }
+                $domparent appendChild $el
 
-                    set data [string range $data [string length $m] end]
+                set elchildren [$tree children $child]
+                if {$elchildren ne {}} {
+                    lappend queue [list $el $elchildren]
                 }
             }
-
-            $domparent appendChild $el
-
-            set elchildren [$tree children $child]
-            if {$elchildren ne {}} {
-                lappend queue [list $el $elchildren]
-            }
         }
+    } on error {errorMsg} {
+        $doc delete
+        throw $::errorInfo $errorMsg
+    } finally {
+        $tree destroy
     }
 
-    $tree destroy
-
     if {$dom_p} {
         return $doc
     } else {