Updated MANIFEST.
[cocanwiki.git] / scripts / page.ml
index adba28f..db74684 100644 (file)
@@ -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.53 2006/08/14 11:36:50 rich Exp $
+ * $Id: page.ml,v 1.59 2006/12/06 09:46:57 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
@@ -73,18 +73,17 @@ let run r (q : cgi) dbh hostid
    *)
 
   let template_page_header =
-    get_template ~page dbh hostid "page_header.html" in
-  let template_page = get_template ~page dbh hostid "page.html" in
+    get_template ~page dbh hostid "page_header.html" in
+  let template_page = get_template ~page dbh hostid "page.html" in
 
   (* This is the simpler template for 404 pages. *)
-  let template_404_header  = get_template dbh hostid "page_404_header.html" in
-  let template_404  = get_template dbh hostid "page_404.html" in
+  let template_404_header = get_template r dbh hostid "page_404_header.html" in
+  let template_404  = get_template dbh hostid "page_404.html" in
 
   (* Host-specific fields. *)
   let rows =
     PGSQL(dbh)
-      "select feedback_email is not null,
-              mailing_list, navigation
+      "select feedback_email is not null, mailing_list, navigation
          from hosts where id = $hostid" in
   let has_feedback_email, mailing_list, navigation =
     match rows with
@@ -190,8 +189,68 @@ 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 ->
+                       (* Is it an extension page? *)
+                       (match get_extension url with
+                        | Some _ -> url, None (* extension page *)
+                        | None -> url, Some path (* redlink *))
+                   | 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
@@ -266,19 +325,33 @@ let run r (q : cgi) dbh hostid
          None -> []
        | Some pageid ->
            let rows = PGSQL(dbh)
-             "select ordering, sectionname, content, divname, jsgo
+             "select ordering, sectionname, content, divname, divclass, jsgo
                  from contents where pageid = $pageid order by ordering" in
 
            List.map
-             (fun (ordering, sectionname, content, divname, jsgo) ->
+             (fun (ordering, sectionname, content, divname, divclass, jsgo) ->
                 let divname, has_divname =
                   match divname with
                   | None -> "", false
                   | Some divname -> divname, true in
+                let divclass, has_divclass =
+                  match divclass with
+                  | None -> "", false
+                  | Some divclass -> divclass, true in
                 let jsgo, has_jsgo =
                   match jsgo with
                   | None -> "", false
                   | Some jsgo -> jsgo, true in
+
+                let has_divclass, divclass =
+                  if has_jsgo then
+                    (true,
+                     if divclass = "" then "jsgo_div"
+                     else divclass ^ " jsgo_div")
+                  else
+                    has_divclass, divclass in
+                let has_div = has_divname || has_divclass in
+
                 let sectionname, has_sectionname =
                   match sectionname with
                   | None -> "", false
@@ -294,6 +367,9 @@ let run r (q : cgi) dbh hostid
                       (Wikilib.xhtml_of_content r dbh hostid content);
                   "has_divname", Template.VarConditional has_divname;
                   "divname", Template.VarString divname;
+                  "has_divclass", Template.VarConditional has_divclass;
+                  "divclass", Template.VarString divclass;
+                  "has_div", Template.VarConditional has_div;
                   "has_jsgo", Template.VarConditional has_jsgo;
                   "jsgo", Template.VarString jsgo ]) rows in
 
@@ -310,6 +386,9 @@ let run r (q : cgi) dbh hostid
              "content", Template.VarString content;
              "has_divname", Template.VarConditional true;
              "divname", Template.VarString "form_div";
+             "has_divclass", Template.VarConditional false;
+             "divclass", Template.VarString "";
+             "has_div", Template.VarConditional true;
              "has_jsgo", Template.VarConditional false;
              "jsgo", Template.VarString "";
            ] in
@@ -451,7 +530,7 @@ let run r (q : cgi) dbh hostid
       let keywords = Pcre.split ~rex:split_words search_terms in
       let keywords =
        List.filter (fun s -> not (string_is_whitespace s)) keywords in
-      let keywords = List.map String.lowercase keywords in
+      let keywords = List.map lowercase keywords in
 
       (* Turn the keywords into a tsearch2 ts_query string. *)
       let tsquery = String.concat "&" keywords in
@@ -629,7 +708,7 @@ let run r (q : cgi) dbh hostid
   let rec loop page' i =
     if i > max_redirect then (
       error ~title:"Too many redirections" ~back_button:true
-        dbh hostid q
+        dbh hostid q
        ("Too many redirects between pages.  This may happen because " ^
         "of a cycle of redirections.");
       return ()