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.
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_______________________________________________________________ *)
14 module EE = RolesEngine
15 module EG = RolesGlobal
16 module ET = RolesTypes
17 module EU = RolesUtils
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
33 let string_of_request req arg =
34 WS.string_of_request "roles" (["system-"^req, arg], "")
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
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
54 let each_role p b str =
55 let req = string_of_request "select" p in
56 let s = if b then " selected" else "" in
57 KP.printf "<div class=\"role role-color%s\">" s;
58 KP.printf "<a href=\"#%s\">⮞</a> " p;
59 KP.printf "<a href=\"%s\">%s</a>" req str;
63 KP.printf "<div class=\"roles\">\n";
70 KP.printf "<div class=\"buttons\">\n";
71 List.iter each_button button_specs;
75 let msg_m = if m then " (modified)" else "" in
76 KP.printf "<div class=\"stage role-color\">";
77 KP.printf "Stage: %s%s" s msg_m;
80 let before_atoms a p count =
82 if a then "object-color", "objects"
83 else "name-color", "names"
85 let req = string_of_request "select" p in
86 KP.printf "<div class=\"atoms-head %s\">\n" c;
87 KP.printf "<a href=\"%s\">%s:</a>\n" req str;
88 KP.printf "<span class=\"count\">%s</span>\n" count;
90 KP.printf "<div class=\"atoms\"><table class=\"atoms-table\"><tr>\n"
92 let each_atom a p b str =
93 let c = if a then "object-color" else "name-color" in
94 let s = if b then " selected" else "" in
95 let req = string_of_request "select" p in
96 KP.printf "<td class=\"atom %s%s\"><a href=\"%s\">%s</a></td>\n" c s req str
99 KP.printf "</tr></table></div>\n"
101 KP.printf "<div class=\"head\">Role Manager</div>\n";
103 before_roles each_role before_role after_role after_roles stage
104 (before_atoms true) (each_atom true) after_atoms
105 (before_atoms false) (each_atom false) after_atoms;
107 KP.printf "<div class=\"error error-color\">Error: %s</div>\n" !error
109 let handler opt arg () =
110 begin try match opt with
111 | "system-default" -> ()
112 | "system-add" -> EE.add_role ()
113 | "system-remove" -> ()
114 | "system-match" -> EE.add_matching ()
115 | "system-select" -> EE.select_entry (EU.pointer_of_string arg)
116 | "system-save" -> EE.write_status ()
117 | _ -> EU.raise_error (ET.EWrongRequest (opt, arg))
119 | ET.Error e -> error := EU.string_of_error e
120 | e -> error := Printexc.to_string e
128 WS.loop_in ignore handler ignore ()