From a0227a655cb4a121c54e4c2762d6c2351fccc139 Mon Sep 17 00:00:00 2001 From: rich Date: Wed, 26 Jul 2006 13:41:31 +0000 Subject: [PATCH] Support for editing jsgo's. --- html/_css/editor.css | 10 +++++++- schema/contents_jsgo_check_tg.sql | 6 +++-- scripts/edit.ml | 47 ++++++++++++++++++++++++++++++------ scripts/edit_page_css.ml | 6 ++--- scripts/lib/cocanwiki_create_host.ml | 6 ++--- scripts/lib/cocanwiki_mail.ml | 4 +-- scripts/lib/cocanwiki_pages.ml | 23 +++++++++--------- scripts/lib/cocanwiki_pages.mli | 7 +++--- scripts/mail_import.ml | 6 ++--- scripts/restore.ml | 6 ++--- scripts/source.ml | 6 +++-- templates/edit.html | 2 +- tools/copy_page.ml | 7 +++--- 13 files changed, 89 insertions(+), 47 deletions(-) diff --git a/html/_css/editor.css b/html/_css/editor.css index 86c3d04..4775958 100644 --- a/html/_css/editor.css +++ b/html/_css/editor.css @@ -1,5 +1,5 @@ /* 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 { @@ -62,6 +62,14 @@ input.css_id { font-size: 70%; } +abbr.js_onclick { + font-size: 70%; +} + +input.js_onclick { + font-size: 70%; +} + div#errors { border: solid 2px #f00; color: #c00; diff --git a/schema/contents_jsgo_check_tg.sql b/schema/contents_jsgo_check_tg.sql index 97b0364..150e6f9 100644 --- a/schema/contents_jsgo_check_tg.sql +++ b/schema/contents_jsgo_check_tg.sql @@ -1,6 +1,6 @@ -- 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 ' @@ -18,7 +18,9 @@ begin 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; diff --git a/scripts/edit.ml b/scripts/edit.ml index c9aa1df..001f933 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -74,7 +74,9 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = 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 @@ -126,12 +128,37 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = * 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 @@ -240,13 +267,15 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = 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; @@ -337,7 +366,9 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = 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 @@ -381,7 +412,7 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = 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 diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml index d8add8d..aafbf63 100644 --- a/scripts/edit_page_css.ml +++ b/scripts/edit_page_css.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -78,9 +78,9 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = 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"; diff --git a/scripts/lib/cocanwiki_create_host.ml b/scripts/lib/cocanwiki_create_host.ml index 3d00e52..31c8a0d 100644 --- a/scripts/lib/cocanwiki_create_host.ml +++ b/scripts/lib/cocanwiki_create_host.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -81,9 +81,9 @@ let create_host dbh canonical_hostname hostnames template (* 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"; diff --git a/scripts/lib/cocanwiki_mail.ml b/scripts/lib/cocanwiki_mail.ml index 494e60c..eae28bb 100644 --- a/scripts/lib/cocanwiki_mail.ml +++ b/scripts/lib/cocanwiki_mail.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -402,7 +402,7 @@ let thread_mail dbh hostid ?user ?r year month = template#to_string in - (Some sectionname, None, content) + (Some sectionname, None, None, content) in let contents = diff --git a/scripts/lib/cocanwiki_pages.ml b/scripts/lib/cocanwiki_pages.ml index 948f8a5..fc4fce4 100644 --- a/scripts/lib/cocanwiki_pages.ml +++ b/scripts/lib/cocanwiki_pages.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -34,9 +34,8 @@ type model = { (* 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 @@ -57,7 +56,7 @@ let new_page pt = let new_page_with_title title = (* Initial page contents. *) - let contents = [ None, None, "" ^ title ^ " is " ] in + let contents = [ None, None, None, "" ^ title ^ " is " ] in let model = { id = 0l; pt = Title title; description = title; @@ -86,7 +85,7 @@ let load_page dbh hostid ~url ?version () = (* 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 @@ -143,13 +142,13 @@ let save_page dbh hostid ?user ?r model = (* 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 @@ -225,12 +224,12 @@ let save_page dbh hostid ?user ?r model = (* 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 diff --git a/scripts/lib/cocanwiki_pages.mli b/scripts/lib/cocanwiki_pages.mli index b7082c9..81a41db 100644 --- a/scripts/lib/cocanwiki_pages.mli +++ b/scripts/lib/cocanwiki_pages.mli @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -29,9 +29,8 @@ type model = { 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 diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml index ae04ef7..44d2b41 100644 --- a/scripts/mail_import.ml +++ b/scripts/mail_import.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -245,7 +245,7 @@ let run r (q : cgi) dbh hostid _ user = 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 @@ -330,7 +330,7 @@ let run r (q : cgi) dbh hostid _ user = 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. diff --git a/scripts/restore.ml b/scripts/restore.ml index f7ce475..431a937 100644 --- a/scripts/restore.ml +++ b/scripts/restore.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -72,8 +72,8 @@ let run r (q : cgi) dbh hostid {hostname = hostname} user = 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"; diff --git a/scripts/source.ml b/scripts/source.ml index 39f6227..9bf5476 100644 --- a/scripts/source.ml +++ b/scripts/source.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * 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 @@ -84,12 +84,14 @@ let run r (q : cgi) dbh hostid _ _ = (* 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_ diff --git a/templates/edit.html b/templates/edit.html index c620201..7121355 100644 --- a/templates/edit.html +++ b/templates/edit.html @@ -68,7 +68,7 @@ Redirect to (if given, page contents are ignored): synch_update ('content_::ordering::', 'preview_::ordering::'); init_edit_buttons ('edit_buttons_::ordering::', 'content_::ordering::', 'preview_::ordering::'); //--> -CSS id: +CSS id: Javascript onclick:

diff --git a/tools/copy_page.ml b/tools/copy_page.ml index 4533e93..178065f 100644 --- a/tools/copy_page.ml +++ b/tools/copy_page.ml @@ -1,6 +1,6 @@ (* 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 *) @@ -29,8 +29,9 @@ let () = 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]; -- 1.8.3.1