Tidied up redirect box.
redirect text,
css text,
logged_user integer,
- title_description_fti tsvector NOT NULL
+ title_description_fti tsvector NOT NULL,
+ keywords text
);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.34 2006/08/04 12:20:06 rich Exp $
+ * $Id: edit.ml,v 1.35 2006/08/04 12:45:31 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
let build_internal_model () =
let id = Int32.of_string (q#param "id") in
let description = q#param "description" in
+ let keywords = q#param "keywords" in
+ let keywords =
+ if string_is_whitespace keywords then None else Some keywords in
let redirect = q#param "redirect" in
let redirect =
- if string_is_whitespace redirect then
- None else Some redirect in
+ if string_is_whitespace redirect then None else Some redirect in
let pt = match q#param "pt_type" with
| "page" -> Page (q#param "pt_value")
| "title" -> Title (q#param "pt_value")
{ id = id;
pt = pt;
description = description;
+ keywords = keywords;
redirect = redirect;
contents_ = contents; }
in
let model_to_template model template =
template#set "id" (Int32.to_string model.id);
template#set "description" model.description;
+ template#set "keywords"
+ (match model.keywords with None -> "" | Some keywords -> keywords);
(match model.pt with
Page page ->
let table = List.map (
fun (url, title) ->
let url = Option.get url in
+ let is_index = url = "index" in
let selected = model.redirect = Some url in
[ "url", Template.VarString url;
"title", Template.VarString title;
- "selected", Template.VarConditional selected ]
+ "selected", Template.VarConditional selected;
+ "is_index", Template.VarConditional is_index ]
) rows in
template#table "redirects" table;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css.ml,v 1.21 2006/07/26 13:41:37 rich Exp $
+ * $Id: edit_page_css.ml,v 1.22 2006/08/04 12:45:31 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
* us to revert changes to the CSS easily.
*)
let rows = PGSQL(dbh)
- "select id, title, description, creation_date, redirect
+ "select id, title, description, keywords, creation_date, redirect
from pages
where hostid = $hostid and url = $page" in
- let oldpageid, title, description, creation_date, redirect =
+ let oldpageid, title, description, keywords, creation_date, redirect =
match rows with
- | [id, title, description, creation_date, redirect ] ->
- id, title, description, creation_date, redirect
+ | [row] -> row
| _ -> assert false in
PGSQL(dbh)
where hostid = $hostid and id = $oldpageid";
PGSQL(dbh) "insert into pages (hostid, url, title,
- description, creation_date, logged_ip,
+ description, keywords,
+ creation_date, logged_ip,
logged_user, redirect, css)
- values ($hostid, $page, $title, $description,
+ values ($hostid, $page, $title, $description, $?keywords,
$creation_date, $?logged_ip, $?logged_user,
$?redirect, $?css)";
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_create_host.ml,v 1.4 2006/07/26 13:41:40 rich Exp $
+ * $Id: cocanwiki_create_host.ml,v 1.5 2006/08/04 12:45:33 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
(* Copy pages. *)
PGSQL(dbh)
- "insert into pages (hostid, url, title, description, redirect, css)
- select $hostid, url, title, description, redirect, css
+ "insert into pages (hostid, url, title, description, keywords,
+ redirect, css)
+ select $hostid, url, title, description, keywords, redirect, css
from pages
where hostid = $template and url is not null";
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_diff.ml,v 1.6 2006/08/04 12:20:07 rich Exp $
+ * $Id: cocanwiki_diff.ml,v 1.7 2006/08/04 12:45:33 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
let title_or_url = match model.pt with Page t -> t | Title t -> t in
"Title or URL: " ^ title_or_url ^ "\n" ^
"Description: " ^ model.description ^ "\n\n" ^
+ (match model.keywords with
+ | None -> ""
+ | Some keywords -> "Keywords: " ^ keywords ^ "\n\n") ^
(match model.redirect with
| None -> ""
| Some redirect -> "Redirect: " ^ redirect ^ "\n\n") ^
let get_version_for_diff dbh version =
if version = 0l then ""
else (
- let title, description, redirect, css = List.hd (
+ let title, description, keywords, redirect, css = List.hd (
PGSQL(dbh)
- "select title, description, redirect, css from pages
+ "select title, description, keywords, redirect, css from pages
where id = $version"
) in
let model = { id = version;
pt = Title title;
description = description;
+ keywords = keywords;
redirect = redirect;
contents_ = contents_ } in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_pages.ml,v 1.8 2006/08/04 12:20:07 rich Exp $
+ * $Id: cocanwiki_pages.ml,v 1.9 2006/08/04 12:45:33 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
id : int32; (* Original page ID (0 = none). *)
pt : pt; (* Page of title (only used if id=0) *)
description : string; (* Description. *)
+ keywords : string option; (* Keywords. *)
redirect : string option; (* Redirect to. *)
(* NB. Don't call this 'contents' because that clashes with the
* Pervasives.contents fields of the ref type.
let new_page pt =
let description =
match pt with
- Page page -> page
- | Title title -> title in
+ | Page page -> page
+ | Title title -> title in
let model = { id = 0l;
pt = pt;
description = description;
+ keywords = None;
redirect = None;
contents_ = [] } in
model
let model = { id = 0l;
pt = Title title;
description = title;
+ keywords = None;
redirect = None;
contents_ = contents } in
model
let rows =
match version with
| None ->
- PGSQL(dbh) "select id, title, description, redirect
+ PGSQL(dbh) "select id, title, description, keywords, redirect
from pages
where hostid = $hostid and url = $url"
| Some version ->
- PGSQL(dbh) "select id, title, description, redirect
+ PGSQL(dbh) "select id, title, description, keywords, redirect
from pages
where hostid = $hostid and id = $version and
(url = $url or url_deleted = $url)" in
- let pageid, title, description, redirect =
+ let pageid, title, description, keywords, redirect =
match rows with
| [row] -> row
| _ -> raise Not_found in
let model = { id = pageid;
pt = Page url;
description = description;
+ keywords = keywords;
redirect = redirect;
contents_ = contents } in
model
raise SaveURLError in
let description = model.description in
+ let keywords = model.keywords in
let redirect = model.redirect in
PGSQL(dbh) "insert into pages (hostid, url, title,
- description, logged_ip, logged_user,
+ description, keywords,
+ logged_ip, logged_user,
redirect)
- values ($hostid, $url, $title, $description,
+ values ($hostid, $url, $title, $description, $?keywords,
$?logged_ip, $?logged_user, $?redirect)";
let pageid = PGOCaml.serial4 dbh "pages_id_seq" in
where hostid = $hostid and id = $model_id";
let description = model.description in
+ let keywords = model.keywords in
let redirect = model.redirect in
PGSQL(dbh)
"insert into pages (hostid, url, title,
- description, creation_date, logged_ip,
+ description, keywords,
+ creation_date, logged_ip,
logged_user, redirect, css)
- values ($hostid, $url, $title, $description, $creation_date,
+ values ($hostid, $url, $title, $description, $?keywords,
+ $creation_date,
$?logged_ip, $?logged_user, $?redirect, $?css)";
(* New page ID <> old page ID model.id. *)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_pages.mli,v 1.5 2006/08/04 12:20:07 rich Exp $
+ * $Id: cocanwiki_pages.mli,v 1.6 2006/08/04 12:45:33 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
id : int32; (* Original page ID (0 = none). *)
pt : pt; (* Page of title (only used if id=0) *)
description : string; (* Description. *)
+ keywords : string option; (* Keywords. *)
redirect : string option; (* Redirect to. *)
contents_ : section list; (* List of sections. *)
}
(* 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.51 2006/08/03 13:52:58 rich Exp $
+ * $Id: page.ml,v 1.52 2006/08/04 12:45:31 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
open Cocanwiki_extensions
open Cocanwiki_strings
-type fp_status = FPOK of int32 * string * string * Calendar.t * bool
- | FPInternalRedirect of string
- | FPExternalRedirect of string
- | FPNotFound
+type fp_status =
+ | FPOK of int32 * string * string * string option * Calendar.t * bool
+ | FPInternalRedirect of string
+ | FPExternalRedirect of string
+ | FPNotFound
(* Referer strings which help us decide if the user came from
* a search engine and highlight terms in the page appropriately.
in
(* This code generates ordinary pages. *)
- let make_page title description pageid last_modified_date has_page_css
+ let make_page title description keywords
+ pageid last_modified_date has_page_css
version page page' extension =
let t = template_page in
let th = template_page_header in
th#conditional "has_description" true;
th#set "description" description);
+ (match keywords with
+ None -> th#conditional "has_keywords" false
+ | Some keywords ->
+ th#conditional "has_keywords" true;
+ th#set "keywords" keywords);
+
if page <> page' then (* redirection *) (
t#set "page" page';
th#set "page" page';
| None ->
if allow_redirect then (
let rows = PGSQL(dbh)
- "select url, redirect, id, title, description,
+ "select url, redirect, id, title, description, keywords,
last_modified_date, css is not null
from pages
where hostid = $hostid and lower (url) = lower ($page)" in
match rows with
- | [Some page', _, _, _, _, _, _]
+ | [Some page', _, _, _, _, _, _, _]
when page <> page' -> (* different case *)
FPExternalRedirect page'
- | [ _, None, id, title, description,
+ | [ _, None, id, title, description, keywords,
last_modified_date, has_page_css ] ->
let has_page_css = Option.get has_page_css in
- FPOK (id, title, description, last_modified_date,
+ FPOK (id, title, description, keywords, last_modified_date,
has_page_css)
- | [_, Some redirect, _, _, _, _, _] ->
+ | [_, Some redirect, _, _, _, _, _, _] ->
FPInternalRedirect redirect
| [] -> FPNotFound
| _ -> assert false
) else (* redirects not allowed ... *) (
let rows = PGSQL(dbh)
- "select id, title, description, last_modified_date,
+ "select id, title, description, keywords, last_modified_date,
css is not null
from pages where hostid = $hostid and url = $page" in
match rows with
- | [ id, title, description,
+ | [ id, title, description, keywords,
last_modified_date, has_page_css ] ->
let has_page_css = Option.get has_page_css in
- FPOK (id, title, description, last_modified_date,
+ FPOK (id, title, description, keywords, last_modified_date,
has_page_css)
| [] -> FPNotFound
| _ -> assert false
)
| Some version ->
let rows = PGSQL(dbh)
- "select id, title, description, last_modified_date,
+ "select id, title, description, keywords, last_modified_date,
css is not null
from pages
where hostid = $hostid and id = $version and
(url = $page or url_deleted = $page)" in
match rows with
- | [ id, title, description,
+ | [ id, title, description, keywords,
last_modified_date, has_page_css ] ->
let has_page_css = Option.get has_page_css in
- FPOK (id, title, description, last_modified_date,
+ FPOK (id, title, description, keywords, last_modified_date,
has_page_css)
| [] -> FPNotFound
| _ -> assert false
return ()
) else
match fetch_page page' version allow_redirect with
- | FPOK (pageid, title, description, last_modified_date, has_page_css)->
+ | FPOK (pageid, title, description, keywords,
+ last_modified_date, has_page_css)->
(* Check if the page is also a template. *)
let extension = get_extension page' in
- make_page title (Some description) (Some pageid)
+ make_page title (Some description) keywords (Some pageid)
(printable_date last_modified_date) has_page_css
version page page' extension
| FPInternalRedirect page' ->
(match extension with
| (Some _) as extension ->
let title = page' in
- make_page title None None
+ make_page title None None None
"Now" false None page page'
extension
| None ->
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: rename_page.ml,v 1.7 2006/07/27 16:46:55 rich Exp $
+ * $Id: rename_page.ml,v 1.8 2006/08/04 12:45:31 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
*)
let old_model = load_page dbh hostid ~url:page () in
let new_model = new_page_with_title new_title in
- let new_model = { new_model with description = old_model.description;
+ let new_model = { new_model with
+ description = old_model.description;
+ keywords = old_model.keywords;
contents_ = old_model.contents_ } in
let old_model = { old_model with redirect = Some new_page } in
ignore (save_page r dbh hostid ~user old_model);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: restore.ml,v 1.23 2006/07/27 16:46:55 rich Exp $
+ * $Id: restore.ml,v 1.24 2006/08/04 12:45:31 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
(* Copy the old version of the page to be live. *)
let rows = PGSQL(dbh)
- "select title, description, creation_date,
+ "select title, description, keywords, creation_date,
redirect, css
from pages
where hostid = $hostid
and url_deleted = $page and id = $version" in
- let title, description, creation_date, redirect, css =
+ let title, description, keywords, creation_date, redirect, css =
match rows with
| [row] -> row
| _ -> assert false in
PGSQL(dbh) "update pages set url_deleted = url, url = null
where hostid = $hostid and url = $page";
PGSQL(dbh) "insert into pages (hostid, url, title,
- description, creation_date, logged_ip,
+ description, keywords,
+ creation_date, logged_ip,
logged_user, redirect, css)
- values ($hostid, $page, $title, $description, $creation_date,
+ values ($hostid, $page, $title, $description, $?keywords,
+ $creation_date,
$?logged_ip, $?logged_user, $?redirect, $?css)";
let pageid = PGOCaml.serial4 dbh "pages_id_seq" in
<input type="hidden" name="pt_type" value="::pt_type::"/>
<input type="hidden" name="pt_value" value="::pt_value_html_tag::"/>
-<p>
-Description:
+<table class="left_table">
+<tr>
+<th>Description:</th>
+<td>
<input name="description" value="::description_html_tag::" size="60"/>
-</p>
+</td>
+</tr>
+
+<tr>
+<th>Keywords:</th>
+<td>
+<input name="keywords" value="::keywords_html_tag::" size="60"/>
+</td>
+</tr>
-<p>
-Redirect to (if given, page contents are ignored):
+<tr>
+<th>
+Redirect to:<br/>
+<small>(if given, page contents are ignored)</small>
+</th>
+<td>
<select name="redirect">
<option value="">None (ordinary page)</option>
-::table(redirects)::<option value="::url_html_tag::" ::if(selected)::selected="selected"::end::>::title_html:: (<code>/::url_html::</code>)</option>::end::
+<option value="index">Home page</option>
+::table(redirects)::<option value="::url_html_tag::"::if(selected):: selected="selected"::end::>::title_html::::if(is_index):: (<code>/::url_html::</code>)::end::</option>::end::
</select>
-</p>
+</td>
+</tr>
+</table>
::if(has_errors)::
<div id="errors">
<title>::title_html::</title>
::if(is_old_version)::<meta name="robots" content="noindex,nofollow" />::end::
::if(has_description)::<meta name="description" content="::description_html_tag::" />::end::
+::if(has_keywords)::<meta name="keywords" content="::keywords_html_tag::" />::end::
<meta name="author" content="http://www.merjis.com/" />
<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
(* Copy a page from one host to another. Note that this only copies
* the text, not any images which may be present.
- * $Id: copy_page.ml,v 1.2 2006/07/26 13:41:46 rich Exp $
+ * $Id: copy_page.ml,v 1.3 2006/08/04 12:45:35 rich Exp $
*
* Usage: copy_page hostid url new_hostid new_url
*)
let old_pageid = sth#fetch1int () in
let sth = dbh#prepare_cached
- "insert into pages (url, title, description, hostid, redirect, css)
- select ? as url, title, description, ? as hostid, redirect, css
+ "insert into pages (url, title, description, keywords,
+ hostid, redirect, css)
+ select ? as url, title, description, keywords, ? as hostid, redirect, css
from pages
where id = ?" in
sth#execute [`String new_url; `Int new_hostid; `Int old_pageid];