scripts/edit.ml

   1 (* COCANWIKI - a wiki written in Objective CAML.
   2  * Written by Richard W.M. Jones <rich@merjis.com>.
   3  * Copyright (C) 2004 Merjis Ltd.
   4  * $Id: edit.ml,v 1.17 2004/10/09 09:52:10 rich Exp $
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; see the file COPYING.  If not, write to
  18  * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19  * Boston, MA 02111-1307, USA.
  20  *)
  21
  22 open Apache
  23 open Registry
  24 open Cgi
  25 open Printf
  26
  27 open ExtString
  28
  29 open Cocanwiki
  30 open Cocanwiki_template
  31 open Cocanwiki_ok
  32 open Cocanwiki_emailnotify
  33 open Cocanwiki_diff
  34 open Cocanwiki_strings
  35
  36 (* Page of title. *)
  37 type pt_t = Page of string | Title of string
  38
  39 (* We keep an "internal model" of the page - see build_internal_model ()
  40  * below.
  41  *)
  42 type model_t = {
  43   id : int;                             (* Original page ID (0 = none). *)
  44   pt : pt_t;                            (* Page of title (only used if id=0) *)
  45   description : string;                 (* Description. *)
  46   redirect : string;                    (* Redirect to ("" = none). *)
  47   contents : (string * string * string) list;
  48                                         (* (sectionname, divname, content)
  49                                          * for each section. *)
  50 }
  51
  52 let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
  53   let template = get_template dbh hostid "edit.html" in
  54   let template_conflict = get_template dbh hostid "edit_conflict.html" in
  55   let template_email = get_template dbh hostid "edit_page_email.txt" in
  56
  57   (* Workaround bugs in IE, specifically lack of support for <button>
  58    * elements.
  59    *)
  60   let msie =
  61     try
  62       let ua = Table.get (Request.headers_in r) "User-Agent" in
  63       ignore (String.find ua "MSIE"); (* Throws Invalid_string if not found. *)
  64       true
  65     with
  66         Not_found | String.Invalid_string -> false in
  67   template#conditional "msie" msie;
  68
  69   (* Build the internal model from the parameters passed to the script. *)
  70   let build_internal_model () =
  71     let id = int_of_string (q#param "id") in
  72     let description = q#param "description" in
  73     let redirect = q#param "redirect" in
  74     let pt = match q#param "pt_type" with
  75         "page" -> Page (q#param "pt_value")
  76       | "title" -> Title (q#param "pt_value")
  77       | _ -> failwith "unknown value for pt_type parameter" in
  78
  79     let contents = ref [] in
  80     let i = ref 1 in
  81     while q#param_exists ("content_" ^ string_of_int !i) do
  82       let sectionname = q#param ("sectionname_" ^ string_of_int !i) in
  83       let content = q#param ("content_" ^ string_of_int !i) in
  84       let divname = q#param ("divname_" ^ string_of_int !i) in
  85       contents := (sectionname, divname, content) :: !contents;
  86       incr i
  87     done;
  88     let contents = List.rev !contents in
  89
  90     { id = id;
  91       pt = pt;
  92       description = description;
  93       redirect = redirect;
  94       contents = contents; }
  95   in
  96
  97   (* Check for errors in the model. *)
  98   let check_for_errors model =
  99     let errors = ref [] in
 100     let add_error msg = errors := msg :: !errors in
 101     let get_errors () = List.rev !errors in
 102
 103     if model.redirect = "" then (
 104       (* Empty page? *)
 105       if model.contents = [] then
 106         add_error ("This page is empty.  Use 'Insert new section here' " ^
 107                    "to write something!");
 108
 109       (* Description field? *)
 110       if model.description = "" then
 111         add_error ("The description field is very important!  This field is " ^
 112                    "used by search engines and directories to describe " ^
 113                    "what's on this page.");
 114     )
 115     else (* it's a redirect *) (
 116       (* Redirect points to a real page? *)
 117       let sth = dbh#prepare_cached "select 1 from pages
 118                                      where hostid = ?
 119                                        and url is not null
 120                                        and url = ?
 121                                        and id <> ?
 122                                        and redirect is null" in
 123       sth#execute [`Int hostid; `String model.redirect; `Int model.id];
 124
 125       let ok = try sth#fetch1 () = [`Int 1] with Not_found -> false in
 126       if not ok then
 127         add_error ("Redirect must point to an ordinary page " ^
 128                    "(ie. not to a page which is itself a redirect).")
 129     );
 130
 131     (* All sections after the first one have sectionnames?  The first
 132      * section ONLY is allowed to have an empty title.
 133      *)
 134     if model.contents <> [] then
 135       List.iter (function (sectionnames, _, _)
 136                      when string_is_whitespace sectionnames ->
 137                        add_error
 138                        ("Every section except the first must have a title.");
 139                    | _ -> ())
 140         (List.tl model.contents);
 141
 142     get_errors ()
 143   in
 144
 145   (* Various "actions" that can be performed on the model. *)
 146   let action_insert model posn item =
 147     (* posn = 0 means insert before the first element of the current list. *)
 148     let rec loop =
 149       function
 150           0, xs -> item :: xs
 151         | _, [] -> [ item ]
 152         | n, x :: xs -> x :: (loop (n-1, xs))
 153     in
 154     let contents = loop (posn, model.contents) in
 155     { model with contents = contents }
 156   in
 157   let action_moveup model posn =
 158     (* posn = 1 means move up the first element, ie. do nothing
 159      * posn = 2 means move up the second element to the first position
 160      * etc.
 161      *)
 162     let rec loop =
 163       function
 164           0, xs
 165         | 1, xs -> xs
 166         | _, [] -> []
 167         | 2, x :: y :: xs -> y :: x :: xs
 168         | n, x :: xs -> x :: (loop (n-1, xs))
 169     in
 170     let contents = loop (posn, model.contents) in
 171     { model with contents = contents }
 172   in
 173   let action_movedn model posn =
 174     (* posn = 1 means move down the first element to the second position
 175      * etc.
 176      *)
 177     let rec loop =
 178       function
 179           0, xs -> xs
 180         | _, [] -> []
 181         | 1, x :: y :: xs -> y :: x :: xs
 182         | n, x :: xs -> x :: (loop (n-1, xs))
 183     in
 184     let contents = loop (posn, model.contents) in
 185     { model with contents = contents }
 186   in
 187   let action_delete model posn =
 188     (* posn = 1 means delete the first element *)
 189     let rec loop =
 190       function
 191           0, xs -> xs
 192         | _, [] -> []
 193         | 1, x :: xs -> xs
 194         | n, x :: xs -> x :: (loop (n-1, xs))
 195     in
 196     let contents = loop (posn, model.contents) in
 197     { model with contents = contents }
 198   in
 199
 200   (* Convert model to template. *)
 201   let model_to_template model template =
 202     template#set "id" (string_of_int model.id);
 203     template#set "description" model.description;
 204
 205     (match model.pt with
 206          Page page ->
 207            template#set "pt_type" "page";
 208            template#set "pt_value" page
 209        | Title title ->
 210            template#set "pt_type" "title";
 211            template#set "pt_value" title);
 212
 213     (* Redirects table. *)
 214     let sth = dbh#prepare_cached "select url, title from pages
 215                                    where url is not null
 216                                      and redirect is null
 217                                      and hostid = ? and id <> ?
 218                                    order by 2" in
 219     sth#execute [`Int hostid; `Int model.id];
 220     let table = sth#map (function [`String url; `String title] ->
 221                            let selected = model.redirect = url in
 222                            [ "url", Template.VarString url;
 223                              "title", Template.VarString title;
 224                              "selected", Template.VarConditional selected ]
 225                            | _ -> assert false) in
 226     template#table "redirects" table;
 227
 228     if model.id <> 0 then (
 229       (* Need to go to the database to get the title of the page ... *)
 230       let sth = dbh#prepare_cached "select title from pages
 231                                      where hostid = ? and id = ?" in
 232       sth#execute [`Int hostid; `Int model.id];
 233       let title = sth#fetch1string () in
 234       template#set "title" title;
 235     ) else (
 236       match model.pt with
 237           Page page -> template#set "title" page
 238         | Title title -> template#set "title" title
 239     );
 240
 241     let ordering = ref 0 in
 242     let table =
 243       List.map
 244         (fun (sectionname, divname, content) ->
 245            incr ordering; let ordering = !ordering in
 246            [ "ordering", Template.VarString (string_of_int ordering);
 247              "sectionname", Template.VarString sectionname;
 248              "divname", Template.VarString divname;
 249              "content", Template.VarString content ]) model.contents in
 250     template#table "contents" table;
 251
 252     (* Check for errors and put those into the template. *)
 253     let errors = check_for_errors model in
 254     let errors = List.map (fun msg ->
 255                              [ "error", Template.VarString msg ]) errors in
 256     template#table "errors" errors;
 257     template#conditional "has_errors" (errors <> [])
 258   in
 259
 260   (* Check if a URL exists in the database. *)
 261   let page_exists page =
 262     let sth =
 263       dbh#prepare_cached "select 1 from pages where hostid = ? and url = ?" in
 264     sth#execute [`Int hostid; `String page];
 265
 266     try sth#fetch1int () = 1 with Not_found -> false
 267   in
 268
 269   (* Begin editing a page, pulling the page out of the database and building
 270    * a model from it.
 271    *)
 272   let begin_editing page =
 273     (* Pull out the page itself from the database. *)
 274     let sth = dbh#prepare_cached "select id, title, description,
 275                                          coalesce (redirect, '')
 276                                     from pages
 277                                    where hostid = ? and url = ?" in
 278     sth#execute [`Int hostid; `String page];
 279
 280     let pageid, title, description, redirect =
 281       match sth#fetch1 () with
 282           [`Int pageid; `String title; `String description; `String redirect]->
 283             pageid, title, description, redirect
 284         | _ -> assert false in
 285
 286     (* Get the sections. *)
 287     let sth = dbh#prepare_cached "select coalesce (sectionname, ''),
 288                                          content,
 289                                          coalesce (divname, '')
 290                                     from contents
 291                                    where pageid = ?
 292                                    order by ordering" in
 293     sth#execute [`Int pageid];
 294
 295     let contents =
 296       sth#map (function
 297                  | [`String sectionname; `String content; `String divname] ->
 298                      sectionname, divname, content
 299                  | _ -> assert false) in
 300
 301     let model = { id = pageid;
 302                   pt = Page page;
 303                   description = description;
 304                   redirect = redirect;
 305                   contents = contents; } in
 306
 307     model_to_template model template
 308   in
 309
 310   (* Begin editing with a blank page, typically a template. *)
 311   let begin_editing_new pt =
 312     let url, title =
 313       match pt with
 314           Page url -> url, url
 315         | Title title ->
 316             match Wikilib.generate_url_of_title dbh hostid title with
 317                 Wikilib.GenURL_OK url -> url, title
 318               | Wikilib.GenURL_Duplicate url ->
 319                   q#redirect ("http://" ^ hostname ^ "/" ^ url);
 320                   return ()
 321               | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL ->
 322                   error ~back_button:true ~title:"Bad page name"
 323                     q "The page name supplied is too short or invalid.";
 324                   return () in
 325
 326     let model = { id = 0;
 327                   pt = pt;
 328                   description = title;
 329                   redirect = "";
 330                   contents = [] } in
 331
 332     model_to_template model template
 333   in
 334
 335   let continue_editing () =
 336     let model = ref (build_internal_model ()) in
 337
 338     (* An "action" parameter? *)
 339     let is_action, get_action =
 340       let actions = q#params in
 341       (* Don't actually care about the value fields ... *)
 342       let actions = List.map (fun (str, _) -> str) actions in
 343       (* Some of our actions are imagemaps, so parameters like name.x, name.y
 344        * need to be changed to name and have resulting duplicates removed.
 345        *)
 346       let actions =
 347         List.filter (fun str ->
 348                        String.length str > 7 &&
 349                        String.sub str 0 7 = "action_" &&
 350                        not (String.ends_with str ".y")) actions in
 351       let actions =
 352         List.map (fun str ->
 353                     if String.ends_with str ".x" then (
 354                       let str = String.sub str 0 (String.length str - 2) in
 355                       str
 356                     )
 357                     else str) actions in
 358       let actions =
 359         List.map (fun str ->
 360                     let action_type = String.sub str 7 6 in
 361                     let action_value =
 362                       String.sub str 14 (String.length str - 14) in
 363                     let action_value = int_of_string action_value in
 364                     action_type, action_value) actions in
 365
 366       let is_action typ = List.mem_assoc typ actions in
 367       let get_value typ = List.assoc typ actions in
 368
 369       is_action, get_value
 370     in
 371
 372     if is_action "insert" then (
 373       let posn = get_action "insert" in
 374       let item = "New section - change this", "", "Write some content here." in
 375       model := action_insert !model posn item
 376     ) else if is_action "moveup" then (
 377       let posn = get_action "moveup" in
 378       model := action_moveup !model posn
 379     ) else if is_action "movedn" then (
 380       let posn = get_action "movedn" in
 381       model := action_movedn !model posn
 382     ) else if is_action "delete" then (
 383       let posn = get_action "delete" in
 384       model := action_delete !model posn
 385     );
 386
 387     model_to_template !model template
 388   in
 389
 390   (* Try to save the page.  Returns a boolean indicating if the
 391    * page was saved successfully.
 392    *)
 393   let try_save () =
 394     let model = build_internal_model () in
 395     let no_errors = [] = check_for_errors model in
 396     if no_errors then (
 397       (* No errors, so we can save the page ... *)
 398
 399       (* Get the IP address of the user, if available. *)
 400       let logged_ip =
 401         try `String (Connection.remote_ip (Request.connection r))
 402         with Not_found -> `Null in
 403
 404       let logged_user =
 405         match user with
 406           | User (id, _, _) -> `Int id
 407           | _ -> `Null in
 408
 409       (* Get redirect. *)
 410       let redirect =
 411         if model.redirect = "" then `Null
 412         else `String model.redirect in
 413
 414       let url, pageid =
 415         (* Creating a new page (id = 0)?  If so, we're just going to insert
 416          * a new row, which is easy.
 417          *)
 418         if model.id = 0 then (
 419           (* Create the page title or URL. *)
 420           let url, title =
 421             match model.pt with
 422                 Page url -> url, url
 423               | Title title ->
 424                   match Wikilib.generate_url_of_title dbh hostid title with
 425                       Wikilib.GenURL_OK url -> url, title
 426                     | Wikilib.GenURL_Duplicate url ->
 427                         error ~back_button:true ~title:"Page exists"
 428                           q ("While you were editing that page, it looks " ^
 429                              "like another user created the same page.");
 430                         return ()
 431                     | _ ->
 432                         assert false (* This should have been detected in
 433                                       * begin_editing_new.
 434                                       *) in
 435
 436           let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
 437                                         description, logged_ip, logged_user,
 438                                         redirect)
 439                                         values (?, ?, ?, ?, ?, ?, ?)" in
 440           sth#execute [`Int hostid; `String url; `String title;
 441                        `String model.description; logged_ip; logged_user;
 442                        redirect];
 443
 444           let pageid = sth#serial "pages_id_seq" in
 445
 446           (* Create the page contents. *)
 447           let sth = dbh#prepare_cached "insert into contents (pageid,
 448                                         ordering, sectionname, divname,
 449                                         content)
 450                                         values (?, ?, ?, ?, ?)" in
 451           let ordering = ref 0 in       (* Creating new ordering. *)
 452           List.iter (fun (sectionname, divname, content) ->
 453                        let divname =
 454                          if string_is_whitespace divname then `Null
 455                          else `String divname in
 456                        let sectionname =
 457                          if string_is_whitespace sectionname then `Null
 458                          else `String sectionname in
 459                        incr ordering; let ordering = !ordering in
 460                        sth#execute [`Int pageid; `Int ordering;
 461                                     sectionname; divname;
 462                                     `String content])
 463             model.contents;
 464
 465           url, pageid
 466         )
 467         (* Otherwise it's an old page which we're updating. *)
 468         else (
 469           (* Pull out fields from the database. *)
 470           let sth = dbh#prepare_cached "select creation_date,
 471                                                coalesce (url, url_deleted),
 472                                                title, css
 473                                           from pages
 474                                          where hostid = ? and id = ?" in
 475           sth#execute [`Int hostid; `Int model.id];
 476
 477           let creation_date, url, title, css =
 478             match sth#fetch1 () with
 479                 [ creation_date; `String url; `String title; css ] ->
 480                   creation_date, url, title, css
 481               | _ -> assert false in
 482
 483           (* Has someone else edited this page in the meantime? *)
 484           let sth = dbh#prepare_cached "select max(id) from pages
 485                                          where hostid = ? and url = ?" in
 486           sth#execute [`Int hostid; `String url];
 487
 488           let max_id = sth#fetch1int () in
 489           let edited = max_id <> model.id in
 490
 491           if edited then (
 492             (* Edited by someone else ...  Get the other's changes. *)
 493             let other_diff, _ =
 494               get_diff dbh hostid url
 495                 ~old_version:model.id ~version:max_id () in
 496
 497             (* Synthesize our own changes. *)
 498             let old_page = get_version_for_diff dbh model.id in
 499             let new_page =
 500               let css = match css with
 501                   `Null -> "" | `String css -> css
 502                 | _ -> assert false in
 503               page_for_diff css (List.map (fun (sectionname, _, content) ->
 504                                 sectionname, content) model.contents) in
 505             let our_diff = diff_cmd old_page new_page in
 506
 507             (* Fill out the conflict template. *)
 508             template_conflict#set "other_diff" other_diff;
 509             template_conflict#set "our_diff" our_diff;
 510             template_conflict#set "old_version" (string_of_int model.id);
 511             template_conflict#set "new_version" (string_of_int max_id);
 512             template_conflict#set "url" url;
 513
 514             q#template template_conflict;
 515             return ()
 516           );
 517
 518           (* Defer the pages_redirect_cn constraint because that would
 519            * temporarily fail on the next UPDATE.
 520            *)
 521           let sth =
 522             dbh#prepare_cached
 523               "set constraints pages_redirect_cn, sitemenu_url_cn,
 524                    page_emails_url_cn, links_from_cn deferred" in
 525           sth#execute [];
 526
 527           (* Mark the old page as deleted.  NB. There is a small race
 528            * condition here because PostgreSQL doesn't do isolation
 529            * properly.  If a user tries to visit this page between the
 530            * delete and the creation of the new page, then they'll get
 531            * a page not found error. (XXX)
 532            *)
 533           let sth = dbh#prepare_cached "update pages set url_deleted = url,
 534                                                          url = null
 535                                          where hostid = ? and id = ?" in
 536           sth#execute [`Int hostid; `Int model.id];
 537
 538           (* Create the new page. *)
 539           let sth = dbh#prepare_cached "insert into pages (hostid, url, title,
 540                                         description, creation_date, logged_ip,
 541                                         logged_user, redirect, css)
 542                                         values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in
 543           sth#execute [`Int hostid; `String url; `String title;
 544                        `String model.description; creation_date; logged_ip;
 545                        logged_user; redirect; css];
 546
 547           (* New page ID <> old page ID model.id. *)
 548           let pageid = sth#serial "pages_id_seq" in
 549
 550           (* Create the page contents. *)
 551           let sth = dbh#prepare_cached "insert into contents (pageid,
 552                                         ordering, sectionname, divname,
 553                                         content)
 554                                         values (?, ?, ?, ?, ?)" in
 555           let ordering = ref 0 in       (* Creating new ordering. *)
 556           List.iter (fun (sectionname, divname, content) ->
 557                        let divname =
 558                          if string_is_whitespace divname then `Null
 559                          else `String divname in
 560                        let sectionname =
 561                          if string_is_whitespace sectionname then `Null
 562                          else `String sectionname in
 563                        incr ordering; let ordering = !ordering in
 564                        sth#execute [`Int pageid; `Int ordering;
 565                                     sectionname; divname;
 566                                     `String content])
 567             model.contents;
 568
 569           (* General email notification of page edits.  Send an email to
 570            * anyone in the page_emails table who has a confirmed address
 571            * and who hasn't received an email already today.
 572            *)
 573           let sth = dbh#prepare_cached "select email, opt_out from page_emails
 574                                          where hostid = ? and url = ?
 575                                            and pending is null
 576                                            and last_sent < current_date" in
 577           sth#execute [`Int hostid; `String url];
 578
 579           let addrs = sth#map (function [`String email; `String opt_out] ->
 580                                  email, opt_out
 581                                  | _ -> assert false) in
 582
 583           if addrs <> [] then (
 584             (* Construct the email. *)
 585             template_email#set "hostname" hostname;
 586             template_email#set "page" url;
 587
 588             let subject =
 589               "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in
 590
 591             (* Send each email individually (they all have different opt out
 592              * links).
 593              *)
 594             List.iter (fun (to_addr, opt_out) ->
 595                          template_email#set "opt_out" opt_out;
 596                          let body = template_email#to_string in
 597                          Sendmail.send_mail ~subject
 598                            ~to_addr:[to_addr] ~body ())
 599               addrs
 600           );
 601
 602           (* Update the database to record when these emails were sent. *)
 603           let sth = dbh#prepare_cached "update page_emails
 604                                            set last_sent = current_date
 605                                          where hostid = ? and url = ?
 606                                            and pending is null" in
 607           sth#execute [`Int hostid; `String url];
 608
 609           url, pageid
 610         ) in
 611
 612       (* Keep the links table in synch. *)
 613       Cocanwiki_links.update_links_for_page dbh hostid url;
 614
 615       (* Commit changes to the database. *)
 616       dbh#commit ();
 617
 618       (* Email notification, if anyone is listed for this host. *)
 619       let subject = "Page " ^ url ^ " has been edited" in
 620
 621       let body = fun () ->
 622         (* Prepare the diff between this version and the previous version. *)
 623         let diff, _ = get_diff dbh hostid url ~version:pageid () in
 624         "Page: http://" ^ hostname ^ "/" ^ url ^ "\n\n" ^
 625         diff in
 626
 627       email_notify ~body ~subject dbh hostid;
 628
 629       (* Redirect back to the URL. *)
 630       q#redirect ("http://" ^ hostname ^ "/" ^ url);
 631       return ()
 632     );
 633   in
 634
 635   let cancel id =
 636     let url =
 637       if id <> 0 then (
 638         let sth = dbh#prepare_cached "select url from pages
 639                                        where hostid = ? and id = ?" in
 640         sth#execute [`Int hostid; `Int id];
 641         sth#fetch1string ()
 642       ) else if q#param "pt_type" = "page" then
 643         q#param "pt_value"
 644       else
 645         (* Create a new page, but the user hits the cancel button.  Because
 646          * we didn't save where they came from, we now have nowhere to
 647          * go.  So we redirect to the home page. XXX
 648          *)
 649         "" in
 650
 651     q#redirect ("http://" ^ hostname ^ "/" ^ url);
 652     return ()
 653   in
 654
 655   (* This codes decides where we are in the current editing cycle.
 656    *
 657    * Inputs:
 658    *   id - if set, then we are in the midst of editing a page.
 659    *   save - if set, then we want to save the page.
 660    *   cancel - if set, abandon changes and go back to viewing the page.
 661    *   action_* - one of the action buttons was set, eg. move up/down.
 662    *   page - the page URL opened newly for editing, or a template which
 663    *          doesn't yet exist.
 664    *   title - page doesn't yet exist; create it.
 665    *)
 666   let id =
 667     try Some (int_of_string (q#param "id")) with Not_found -> None in
 668   (match id with
 669      | None ->                          (* Begin editing the page. *)
 670          if q#param_exists "page" then (
 671            let page = q#param "page" in
 672            let page = if page = "" then "index" else page in
 673            if page_exists page then
 674              begin_editing page
 675            else
 676              begin_editing_new (Page page)
 677          ) else (
 678            let title = q#param "title" in
 679            begin_editing_new (Title title)
 680          )
 681
 682      | Some id ->
 683          if q#param_true "cancel" then
 684            cancel id;
 685          if q#param_true "save" then
 686            try_save ();                 (* might fail and fall through ... *)
 687          continue_editing ()
 688   );
 689
 690   q#template template
 691
 692 let () =
 693   register_script ~restrict:[CanEdit] run