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.95 -r1.96
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl	4 Sep 2018 18:26:55 -0000	1.95
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl	7 Sep 2018 00:30:14 -0000	1.96
@@ -208,13 +208,22 @@
         {(href|src)\s*=\s*[\"]((http|https|ftp|mailto):[^'\"]+)[\"]} $html \
         "\\1=\"\u0001\\2\u0002\"" html
 
+    #
+    # If a path is specified, prefix all relative URLs (i.e. not
+    # starting with a slash) with the specified path.
+    #
     if {[info exists path]} {
         set path "[string trim $path /]/"
         regsub -all {(href|src)\s*=\s*['\"]([^/][^\u0001:'\"]+?)['\"]} $html \
             "\\1='${location}${path}\\2'" html
     }
+
+    #
+    # Prefix every URL starting with a slash by the location.
+    #
     regsub -all {(href|src)\s*=\s*['\"]/([^\u0001:'\"]+?)['\"]} $html \
         "\\1='${location}\\2'" html
+    ns_log notice "END\n$html"    
 
     #
     # Remove all protection characters again.
Index: openacs-4/packages/acs-tcl/tcl/test/text-html-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/text-html-procs.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-tcl/tcl/test/text-html-procs.tcl	5 Aug 2018 21:04:22 -0000	1.8
+++ openacs-4/packages/acs-tcl/tcl/test/text-html-procs.tcl	7 Sep 2018 00:30:14 -0000	1.9
@@ -219,7 +219,7 @@
 
 } {
     
-    aa_log " ------------ Testing left pad ------------ "
+    aa_section "Testing left pad"
 
     set string [ad_generate_random_string]
     set length [expr {int(rand()*1000)}]
@@ -234,7 +234,7 @@
     aa_true " - Result is exactly $length long " {[string length $result] == $length}
     aa_true " - String is at right end " [regexp "^.*${string}\$" $result]
 
-    aa_log " ------------ Testing right pad ------------ "
+    aa_section "Testing right pad"
 
     set string [ad_generate_random_string]
     set length [expr {int(rand()*1000)}]
@@ -251,7 +251,44 @@
     
 }
 
+aa_register_case \
+    -cats {api smoke} \
+    -procs {ad_html_qualify_links} \
+    ad_html_qualify_links {
 
+        Test if ad_html_qualify_links is working as expected.
+        
+        @author Gustaf Neumann
+} {
+    
+    aa_section "Testing without path"
+
+    set rURL "relative/r.txt"
+    set aURL "/dotlrn/clubs/club1/mytext.docx"
+    set fqURL "https://openacs.org/doc/"
+    
+    set html [subst {<div><div class="table">
+        A relative URL <a href="$rURL">relative/r.txt</a>
+        An absolute URL <a href="$aURL">mytext.docx</a>
+        A fully qualified URL <a href="$fqURL">Documentation</a>        
+    }]
+    set result [ad_html_qualify_links -location {http://myhost/} $html]
+
+    aa_true "result contains relative URL NOT expanded" {[string match *href=\"$rURL* $result]}
+    aa_true "result contains absolute URL location-prefixed" {[string match *http://myhost$aURL* $result]}
+    aa_true "result contains fully qualified URL" {[string match *$fqURL* $result]}
+
+    aa_section "Testing with path"
+
+    set pretty_link "/dotlrn/clubs/club2/uploads/mytext.docx"
+    set result [ad_html_qualify_links -location {http://myhost/} -path /somepath $html]
+
+    aa_true "result contains relative URL expanded" {[string match */somepath/$rURL* $result]}
+    aa_true "result contains absolute URL location-prefixed" {[string match *http://myhost$aURL* $result]}
+    aa_true "result contains fully qualified URL" {[string match *$fqURL* $result]}
+
+}
+
 # Local variables:
 #    mode: tcl
 #    tcl-indent-level: 4