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_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;
64 KP.printf "<div class=\"roles\">\n";
71 KP.printf "<div class=\"buttons\">\n";
72 List.iter each_button button_specs;
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;
81 let before_atoms a p count =
83 if a then "object-color", "objects"
84 else "name-color", "names"
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;
91 KP.printf "<div class=\"atoms\"><table class=\"atoms-table\"><tr>\n"
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
100 KP.printf "</tr></table></div>\n"
102 KP.printf "<div class=\"head\">Role Manager</div>\n";
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;
108 KP.printf "<div class=\"error error-color\">Error: %s</div>\n" !error
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))
121 | ET.Error e -> error := EU.string_of_error e
122 | e -> error := Printexc.to_string e
130 WS.loop_in ignore handler ignore ()