matita/matita/contribs/lambdadelta/bin/roles/webEngine.ml

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department, University of Bologna, Italy.
   5     ||I||
   6     ||T||  HELM is free software; you can redistribute it and/or
   7     ||A||  modify it under the terms of the GNU General Public License
   8     \   /  version 2 or (at your option) any later version.
   9      \ /   This software is distributed as is, NO WARRANTY.
  10       V_______________________________________________________________ *)
  11
  12 module KP = Printf
  13
  14 module EE = RolesEngine
  15 module EG = RolesGlobal
  16 module ET = RolesTypes
  17 module EU = RolesUtils
  18 module WS = WebLWS
  19
  20 let error = ref ""
  21
  22 let open_out () =
  23   let author = "λδ development binary: roles manager" in
  24   let description = "λδ development binary: roles manager" in
  25   let title = "Roles Manager" in
  26   let css = Filename.concat !EG.base_url "css/roles.css" in
  27   let icon = Filename.concat !EG.base_url "images/crux_32.ico" in
  28   WS.open_out_html author description title css icon
  29
  30 let close_out () =
  31   WS.close_out_html ()
  32
  33 let string_of_request req arg =
  34   WS.string_of_request "roles" (["system-"^req, arg], "")
  35
  36 let status_out () =
  37   let button_specs = [
  38     "default", "Refresh";
  39     "save", "Save";
  40     "add", "Add";
  41     "match", "Match";
  42     "remove", "Remove";
  43   ] in
  44   let each_button (action, str) =
  45     let req = string_of_request action "" in
  46     KP.printf "<span class=\"button\"><a href=\"%s\">%s</a></span>\n" req str
  47   in
  48   let before_roles p count =
  49     let req = string_of_request "select" p in
  50     KP.printf "<div class=\"roles-head role-color\">\n";
  51     KP.printf "<a href=\"%s\">Roles:</a>\n" req;
  52     KP.printf "<span class=\"count\">%s</span>\n" count
  53   in
  54   let each_role p b str =
  55     let req_x = string_of_request "expand" p in
  56     let req_s = string_of_request "select" p in
  57     let s = if b then " selected" else "" in
  58     KP.printf "<div class=\"role role-color%s\">" s;
  59     KP.printf "<a href=\"%s\">⮞</a> " req_x;
  60     KP.printf "<a href=\"%s\">%s</a>" req_s str;
  61     KP.printf "</div>\n"
  62   in
  63   let before_role () =
  64     KP.printf "<div class=\"roles\">\n";
  65   in
  66   let after_role () =
  67     KP.printf "</div>\n"
  68   in
  69   let after_roles () =
  70     KP.printf "</div>\n";
  71     KP.printf "<div class=\"buttons\">\n";
  72     List.iter each_button button_specs;
  73     KP.printf "</div>\n"
  74   in
  75   let stage s m =
  76     let msg_m = if m then " (modified)" else "" in
  77     KP.printf "<div class=\"stage role-color\">";
  78     KP.printf "Stage: %s%s" s msg_m;
  79     KP.printf "</div>\n"
  80   in
  81   let before_atoms a p count =
  82     let c, str =
  83       if a then "object-color", "objects"
  84       else "name-color", "names"
  85     in
  86     let req = string_of_request "select" p in
  87     KP.printf "<div class=\"atoms-head %s\">\n" c;
  88     KP.printf "<a href=\"%s\">%s:</a>\n" req str;
  89     KP.printf "<span class=\"count\">%s</span>\n" count;
  90     KP.printf "</div>\n";
  91     KP.printf "<div class=\"atoms\"><table class=\"atoms-table\"><tr>\n"
  92   in
  93   let each_atom a p b str =
  94     let c = if a then "object-color" else "name-color" in
  95     let s = if b then " selected" else "" in
  96     let req = string_of_request "select" p in
  97     KP.printf "<td class=\"atom %s%s\"><a href=\"%s\">%s</a></td>\n" c s req str
  98   in
  99   let after_atoms () =
 100     KP.printf "</tr></table></div>\n"
 101   in
 102   KP.printf "<div class=\"head\">Role Manager</div>\n";
 103   EE.visit_status
 104     before_roles each_role before_role after_role after_roles stage
 105     (before_atoms true) (each_atom true) after_atoms
 106     (before_atoms false) (each_atom false) after_atoms;
 107   if !error <> "" then
 108     KP.printf "<div class=\"error error-color\">Error: %s</div>\n" !error
 109
 110 let handler opt arg () =
 111   begin try match opt with
 112   | "system-default" -> ()
 113   | "system-add"     -> EE.add_role ()
 114   | "system-remove"  -> EE.remove_roles ()
 115   | "system-match"   -> EE.add_matching ()
 116   | "system-select"  -> EE.select_entry (EU.pointer_of_string arg)
 117   | "system-save"    -> EE.write_status ()
 118   | "system-expand"  -> EE.expand_entry (EU.pointer_of_string arg)
 119   | _                -> EU.raise_error (ET.EWrongRequest (opt, arg))
 120   with
 121   | ET.Error e -> error := EU.string_of_error e
 122   | e          -> error := Printexc.to_string e
 123   end;
 124   open_out ();
 125   status_out ();
 126   close_out ();
 127   error := ""
 128
 129 let init () =
 130   WS.loop_in ignore handler ignore ()