- xhtbl: support for relative links added

[helm.git] / helm / www / lambdadelta / bin / xhtbl / xmlUnparser.ml

diff --git a/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml b/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml
index f413aa0ef071632dd034054ea3dcf320386b6b27..603c7f1bebd1baa2706ce4273b34e5a214ccc5b3 100644 (file)
--- a/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml
+++ b/helm/www/lambdadelta/bin/xhtbl/xmlUnparser.ml
@@ -22,12 +22,15 @@ let border cell =
    if cell.M.cb.T.w then str.[3] <- 's';
    str :: cell.M.cc
 
-let text = function
-   | T.Plain s       -> s
-   | T.Link (uri, s) -> P.sprintf "<a href=\"%s\">%s</a>" uri s
+let text baseuri ext = function
+   | T.Plain s              -> s
+   | T.Link (true, uri, s)  -> P.sprintf "<a href=\"%s\">%s</a>" uri s
+   | T.Link (false, uri, s) -> 
+      let uri = !O.baseuri ^ baseuri ^ uri ^ ext in
+      P.sprintf "<a href=\"%s\">%s</a>" uri s
 
 let key cell =
-   if cell.M.ck = [] then "<br/>" else S.concat " " (L.map text cell.M.ck)
+   if cell.M.ck = [] then "<br/>" else S.concat " " (L.map (text cell.M.cu cell.M.cx) cell.M.ck)
 
 let ind i = S.make (2 * i) ' '