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.94 -r1.95
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 4 Sep 2018 18:11:53 -0000 1.94
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 4 Sep 2018 18:26:55 -0000 1.95
@@ -171,20 +171,31 @@
}
ad_proc -public ad_html_qualify_links {
+ -location
-path
html
} {
Convert in the HTML text relative URLs into fully qualified URLs
including the host name. It performs the following operations:
- 1) prepend paths starting with a "/" by the protocol and host.
- 2) prepend paths not starting a "/" by the package_url, in case it was passed in.
+ 1. prepend paths starting with a "/" by the location (protocol and host).
+ 2. prepend paths not starting a "/" by the path, in case it was passed in.
Links, which are already fully qualified are not modified.
+ @param location protcol and host (defaults to [ad_url])
+ @param path optional path to be prepended to paths not starting with a "/"
+ @param html HTML text, in which substitutions should be performed.
+
} {
- set host "[string trimright [ad_url] /]/"
+ if {![info exists location]} {
+ set location [ad_url]
+ }
+ #
+ # make sure, location ends with a "/"
+ #
+ set location "[string trimright $location /]/"
#
# Protect all full qualified URLs with special characters (one
@@ -200,10 +211,10 @@
if {[info exists path]} {
set path "[string trim $path /]/"
regsub -all {(href|src)\s*=\s*['\"]([^/][^\u0001:'\"]+?)['\"]} $html \
- "\\1='${host}${path}\\2'" html
+ "\\1='${location}${path}\\2'" html
}
regsub -all {(href|src)\s*=\s*['\"]/([^\u0001:'\"]+?)['\"]} $html \
- "\\1='${host}\\2'" html
+ "\\1='${location}\\2'" html
#
# Remove all protection characters again.