Index: openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl,v
diff -u -N -r1.61.2.16 -r1.61.2.17
--- openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl	2 Aug 2021 17:38:40 -0000	1.61.2.16
+++ openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl	20 Aug 2021 08:38:18 -0000	1.61.2.17
@@ -226,6 +226,7 @@
     {-form {}}
     {-level 1}
     {-context ""}
+    {-warn:boolean}    
     -properties
     docstring
     args
@@ -1200,12 +1201,18 @@
         #
         if {[incr ::__ad_complain_depth] < 10} {
 
+            set complaints [ad_complaints_get_list]
+            if {$warn_p} {
+                ad_log warning "contract in '$::ad_page_contract_context'"\
+                    "was violated:\n" [join $complaints "\n "]
+            }
+            
             if { [info exists return_errors] } {
                 upvar 1 $return_errors error_list
-                set error_list [ad_complaints_get_list]
+                set error_list $complaints
             } else {
                 template::multirow create complaints text
-                foreach elm [ad_complaints_get_list] {
+                foreach elm $complaints {
                     template::multirow append complaints $elm
                 }
                 ad_try {
@@ -1230,6 +1237,8 @@
                 ns_return 422 text/html $html
                 ad_script_abort
             }
+        } else {
+            ns_log Warning "ad_page_contract: depth of recursive complaints exceeded, complaint ignored"
         }
     }
 }
@@ -1302,7 +1311,7 @@
         set context ""
     }
 
-    ad_page_contract -level 2 -context $context -form [{*}$__cmd] $docstring {*}$args
+    ad_page_contract -warn -level 2 -context $context -form [{*}$__cmd] $docstring {*}$args
 }
 
 ####################