Conservative & probably buggy implementation of breadcrumbs.

[cocanwiki.git] / scripts / page.ml

diff --git a/scripts/page.ml b/scripts/page.ml
index 3592f8f..82fa0e7 100644 (file)
--- a/scripts/page.ml
+++ b/scripts/page.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.54 2006/08/14 15:53:52 rich Exp $
+ * $Id: page.ml,v 1.55 2006/08/14 17:56:59 rich Exp $
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -189,8 +189,64 @@ let run r (q : cgi) dbh hostid
       version page page' extension =
     let t = template_page in
     let th = template_page_header in
-    t#set "title" title;
+    (*t#set "title" title; - nothing uses ::title:: on page.html - removed *)
+
+    (* Page title, h1 and superdirs (if any). *)
     th#set "title" title;
+
+    let superdirs, h1 =
+      match String.nsplit title "/" with
+      | [] -> [], ""
+      | [h1] -> [], h1
+      | xs ->
+         let xs = List.rev xs in
+         let h1 = List.hd xs in
+         let superdirs = List.rev (List.tl xs) in
+
+         (* Check the superdirs are reasonable, then convert them
+          * into paths or redlinks.
+          * If any of this fails, then there are no superdirs.
+          *)
+         try
+           let pathsofar = ref "" in
+           let superdirs =
+             List.mapi (
+               fun i name ->
+                 (* Path will be something like "Dir1/Dir2".  We want
+                  * a URL like "dir1/dir2".
+                  *)
+                 let path =
+                   if i = 0 then name else !pathsofar ^ "/" ^ name in
+                 (* Path so far reasonable? *)
+                 let url, redlink =
+                   match Wikilib.generate_url_of_title r dbh hostid path with
+                   | Wikilib.GenURL_Duplicate url -> url, None
+                   | Wikilib.GenURL_OK url -> url, Some path
+                   | Wikilib.GenURL_BadURL | Wikilib.GenURL_TooShort ->
+                       raise Exit in
+                 pathsofar := path;
+                 name, url, redlink
+             ) superdirs in
+           superdirs, h1
+         with
+           Exit -> [], title in
+
+    let superdirs = List.map (
+      fun (name, url, redlink) ->
+       let is_redlink, redlink_title =
+         match redlink with
+         | None -> false, ""
+         | Some title -> true, title in
+       [ "url", Template.VarString url;
+         "name", Template.VarString name;
+         "is_redlink", Template.VarConditional is_redlink;
+         "redlink_title", Template.VarString redlink_title ]
+    ) superdirs in
+
+    th#conditional "has_superdirs" (superdirs <> []);
+    th#table "superdirs" superdirs;
+    th#set "h1" h1;
+
     t#set "last_modified_date" last_modified_date;
 
     (match description with