/* Stylesheet for COCANWIKI editor, derived from EWM.
- * $Id: editor.css,v 1.6 2004/10/27 08:42:30 rich Exp $
+ * $Id: editor.css,v 1.7 2006/07/26 13:41:31 rich Exp $
*/
body {
font-size: 70%;
}
+abbr.js_onclick {
+ font-size: 70%;
+}
+
+input.js_onclick {
+ font-size: 70%;
+}
+
div#errors {
border: solid 2px #f00;
color: #c00;
-- Check the contents.jsgo field points to a valid URL.
-- This is triggered on rows inserted or updated in contents.
--- $Id: contents_jsgo_check_tg.sql,v 1.1 2006/07/26 11:07:06 rich Exp $
+-- $Id: contents_jsgo_check_tg.sql,v 1.2 2006/07/26 13:41:34 rich Exp $
create or replace function contents_jsgo_check_tg() returns trigger as '
select into my_count count(p.*)
from pages p
where p.hostid = my_hostid
- and p.url = new.jsgo;
+ and p.url is not null
+ and p.url = new.jsgo
+ and p.redirect is null;
if my_count < 1 then
raise exception ''contents.jsgo points to non-existent page (%, %)'',
my_hostid, new.jsgo;
(* 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.29 2006/07/26 13:12:10 rich Exp $
+ * $Id: edit.ml,v 1.30 2006/07/26 13:41:37 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 divname = q#param ("divname_" ^ string_of_int !i) in
let divname =
if string_is_whitespace divname then None else Some divname in
- contents := (sectionname, divname, content) :: !contents;
+ let jsgo = q#param ("jsgo_" ^ string_of_int !i) in
+ let jsgo = if string_is_whitespace jsgo then None else Some jsgo in
+ contents := (sectionname, divname, jsgo, content) :: !contents;
incr i
done;
let contents = List.rev !contents in
* section ONLY is allowed to have an empty title.
*)
if model.contents_ <> [] then
- List.iter (function (None, _, _) ->
- add_error
- ("Every section except the first must have a title.");
+ List.iter (function
+ | (None, _, _, _) ->
+ add_error
+ "Every section except the first must have a title.";
| _ -> ())
(List.tl model.contents_);
+ (* There are two constraints on any non-null jsgo's:
+ * (1) Must only be present if divname is non-null.
+ * (2) Must point to a valid URL on the current host.
+ *)
+ List.iter (
+ function
+ | (_, None, Some _, _) ->
+ add_error
+ "Javascript onclick can only be used with a CSS id."
+ | (_, _, Some jsgo, _) ->
+ let rows =
+ PGSQL(dbh) "select 1 from pages
+ where hostid = $hostid
+ and url is not null
+ and url = $jsgo
+ and redirect is null" in
+ let ok = rows = [Some 1l] in
+ if not ok then
+ add_error ("Javascript onclick must point to an ordinary page " ^
+ "on the current site (ie. not to a redirect). " ^
+ "Do not put '/' at the beginning of the URL.")
+ | _ -> ()
+ ) model.contents_;
+
get_errors ()
in
let ordering = ref 0 in
let table =
List.map
- (fun (sectionname, divname, content) ->
+ (fun (sectionname, divname, jsgo, content) ->
incr ordering; let ordering = Int32.of_int !ordering in
let sectionname = match sectionname with None -> "" | Some s -> s in
let divname = match divname with None -> "" | Some s -> s in
+ let jsgo = match jsgo with None -> "" | Some s -> s in
[ "ordering", Template.VarString (Int32.to_string ordering);
"sectionname", Template.VarString sectionname;
"divname", Template.VarString divname;
+ "jsgo", Template.VarString jsgo;
"content", Template.VarString content ]) model.contents_ in
template#table "contents" table;
if is_action "insert" then (
let posn = get_action "insert" in
let item =
- Some "The title of this section", None, "Write something here." in
+ Some "The title of this section",
+ None, None,
+ "Write something here." in
model := action_insert !model posn item
) else if is_action "moveup" then (
let posn = get_action "moveup" in
let old_page = get_version_for_diff dbh old_version in
let new_page =
page_for_diff css (List.map (
- fun (sectionname, _, content) ->
+ fun (sectionname, _, _, content) ->
let sectionname = match sectionname with
| None -> ""
| Some s -> s in
(* 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.20 2006/03/27 19:10:29 rich Exp $
+ * $Id: edit_page_css.ml,v 1.21 2006/07/26 13:41:37 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 pageid = PGOCaml.serial4 dbh "pages_id_seq" in
PGSQL(dbh) "insert into contents (pageid, ordering,
- sectionname, content, divname)
+ sectionname, content, divname, jsgo)
select $pageid as pageid, ordering, sectionname,
- content, divname
+ content, divname, jsgo
from contents
where pageid = $oldpageid";
(* 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.3 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_create_host.ml,v 1.4 2006/07/26 13:41:40 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 page contents. *)
PGSQL(dbh)
"insert into contents (pageid, ordering, sectionname, content,
- divname)
+ divname, jsgo)
select (select id from pages where hostid = $hostid and url = p.url),
- c.ordering, c.sectionname, c.content, c.divname
+ c.ordering, c.sectionname, c.content, c.divname, c.jsgo
from contents c, pages p
where c.pageid = p.id and p.hostid = $template and p.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_mail.ml,v 1.2 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_mail.ml,v 1.3 2006/07/26 13:41:40 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
template#to_string
in
- (Some sectionname, None, content)
+ (Some sectionname, None, None, content)
in
let contents =
(* 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.5 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_pages.ml,v 1.6 2006/07/26 13:41:40 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
(* NB. Don't call this 'contents' because that clashes with the
* Pervasives.contents fields of the ref type.
*)
- contents_ : (string option * string option * string) list;
- (* (sectionname, divname, content)
- * for each section. *)
+ contents_ : (string option * string option * string option * string) list;
+ (* (sectionname, divname, jsgo, content) for each section. *)
}
exception SaveURLError
let new_page_with_title title =
(* Initial page contents. *)
- let contents = [ None, None, "<b>" ^ title ^ "</b> is " ] in
+ let contents = [ None, None, None, "<b>" ^ title ^ "</b> is " ] in
let model = { id = 0l;
pt = Title title;
description = title;
(* Get the sections. *)
let contents = PGSQL(dbh)
- "select sectionname, divname, content
+ "select sectionname, divname, jsgo, content
from contents
where pageid = $pageid
order by ordering" in
(* Create the page contents. *)
let ordering = ref 0 in (* Creating new ordering. *)
List.iter (
- fun (sectionname, divname, content) ->
+ fun (sectionname, divname, jsgo, content) ->
incr ordering; let ordering = Int32.of_int !ordering in
PGSQL(dbh)
"insert into contents (pageid, ordering, sectionname, divname,
- content)
+ jsgo, content)
values ($pageid, $ordering,
- $?sectionname, $?divname, $content)"
+ $?sectionname, $?divname, $?jsgo, $content)"
) model.contents_;
url, pageid
(* Create the page contents. *)
let ordering = ref 0 in (* Creating new ordering. *)
List.iter (
- fun (sectionname, divname, content) ->
+ fun (sectionname, divname, jsgo, content) ->
incr ordering; let ordering = Int32.of_int !ordering in
PGSQL(dbh) "insert into contents (pageid,
- ordering, sectionname, divname, content)
+ ordering, sectionname, divname, jsgo, content)
values ($pageid, $ordering, $?sectionname,
- $?divname, $content)"
+ $?divname, $?jsgo, $content)"
) model.contents_;
url, pageid
(* 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.2 2006/03/27 16:43:44 rich Exp $
+ * $Id: cocanwiki_pages.mli,v 1.3 2006/07/26 13:41:40 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
pt : pt; (* Page of title (only used if id=0) *)
description : string; (* Description. *)
redirect : string option; (* Redirect to. *)
- contents_ : (string option * string option * string) list;
- (* (sectionname, divname, content)
- * for each section. *)
+ contents_ : (string option * string option * string option * string) list;
+ (* (sectionname, divname, jsgo, content) for each section. *)
}
exception SaveURLError
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: mail_import.ml,v 1.12 2006/03/28 16:24:07 rich Exp $
+ * $Id: mail_import.ml,v 1.13 2006/07/26 13:41:37 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
hdr_template#to_string
in
- None, Some "mail_header", content in
+ None, Some "mail_header", None, content in
(* Create the second section (mail body).
* XXX Very simple. Should be extended to understand attachments and
with
Not_found ->
"No plain text message body found" in
- Some "Message", Some "mail_body", content in
+ Some "Message", Some "mail_body", None, content in
(* Overwrite the first two sections of the current page, regardless of
* what they contain.
(* 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.21 2006/03/28 16:24:08 rich Exp $
+ * $Id: restore.ml,v 1.22 2006/07/26 13:41:37 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 pageid = PGOCaml.serial4 dbh "pages_id_seq" in
PGSQL(dbh) "insert into contents (pageid, ordering,
- sectionname, content, divname)
- select $pageid, ordering, sectionname, content, divname
+ sectionname, content, divname, jsgo)
+ select $pageid, ordering, sectionname, content, divname, jsgo
from contents
where pageid = $version";
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: source.ml,v 1.5 2006/03/28 16:24:08 rich Exp $
+ * $Id: source.ml,v 1.6 2006/07/26 13:41:37 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
(* Now write out the sections. *)
if model.redirect = None then
List.iteri
- (fun i (sectionname, divname, content) ->
+ (fun i (sectionname, divname, jsgo, content) ->
write "Section-Id" (string_of_int i);
(match sectionname with None -> () | Some sectionname ->
write "Section-Header" sectionname);
(match divname with None -> () | Some divname ->
write "Css-Id" divname);
+ (match jsgo with None -> () | Some jsgo ->
+ write "Javascript-Onclick" jsgo);
write "Content" content;
ignore (print_newline r)) model.contents_
synch_update ('content_::ordering::', 'preview_::ordering::');
init_edit_buttons ('edit_buttons_::ordering::', 'content_::ordering::', 'preview_::ordering::');
//--></script>
-<abbr class="css_id" title="Assign a stylesheet ID to this block of text to enable further styling">CSS id</abbr>: <input class="css_id" name="divname_::ordering::" value="::divname_html_tag::" size="8"/>
+<abbr class="css_id" title="Assign a stylesheet ID to this block of text to enable further styling">CSS id</abbr>: <input class="css_id" name="divname_::ordering::" value="::divname_html_tag::" size="8"/> <abbr class="js_onclick" title="Assign a destination URL on the site where clicks in this whole region go to. (Requires Javascript)">Javascript onclick</abbr>: <input class="js_onclick" name="jsgo_::ordering::" value="::jsgo_html_tag::" size="16"/>
<p class="insert">
<input class="insert" type="submit" name="action_insert_::ordering::" value="Insert new section here"/>
(* 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.1 2005/07/25 12:49:22 rich Exp $
+ * $Id: copy_page.ml,v 1.2 2006/07/26 13:41:46 rich Exp $
*
* Usage: copy_page hostid url new_hostid new_url
*)
let new_pageid = sth#serial "pages_id_seq" in
let sth = dbh#prepare_cached
- "insert into contents (pageid, ordering, sectionname, content, divname)
- select ? as pageid, ordering, sectionname, content, divname
+ "insert into contents (pageid, ordering, sectionname, content,
+ divname, jsgo)
+ select ? as pageid, ordering, sectionname, content, divname, jsgo
from contents
where pageid = ?" in
sth#execute [`Int new_pageid; `Int old_pageid];
git.annexia.org / cocanwiki.git / commitdiff