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: role manager" in
24 let description = "λδ development binary: role manager" in
25 let title = "Role Manager" in
26 let icon = Filename.concat !EG.base_url "images/crux_32.ico" in
27 let css = Filename.concat !EG.base_url "css/roles.css" in
28 let js = Filename.concat !EG.base_url "js/roles.js" in
29 WS.open_out_html author description title icon css js
34 let string_of_request req arg =
35 WS.string_of_request "roles" (["system-"^req, arg], "")
39 KP.printf "<input class=\"filter\" type=\"text\" placeholder=\"Filter...\" \
40 onkeyup=\"filter('%s');\" id=\"f.%s\"\n/>" p p
49 let each_button (action, str) =
50 let req = string_of_request action "" in
51 KP.printf "<span class=\"button\"><a href=\"%s\">%s</a></span>\n" req str
53 let before_roles p count =
54 let req = string_of_request "select" p in
55 KP.printf "<div class=\"roles-head role-color\">\n";
56 KP.printf "<a href=\"%s\">Roles:</a>\n" req;
57 KP.printf "<span class=\"count\">%s</span>\n" count;
60 let each_role n p b k str =
61 let req_x = string_of_request "expand" p in
62 let req_s = string_of_request "select" p in
63 let s = if b then " selected" else "" in
64 KP.printf "<div class=\"role role-color%s\" name=%S key=%S>" s n k;
65 KP.printf "<a href=\"%s\">⮞</a> " req_x;
66 KP.printf "<a href=\"%s\">%s</a>" req_s str
68 let before_role x n o =
69 let msg_n = if n then " (added)" else "" in
70 let msg_o = if o then " (removed)" else "" in
71 KP.printf "%s%s</div>\n" msg_n msg_o;
72 if x then KP.printf "<div class=\"roles\">\n"
75 if x then KP.printf "</div>\n"
79 KP.printf "<div class=\"buttons\">\n";
80 List.iter each_button button_specs;
84 let msg_m = if m then " (modified)" else "" in
85 KP.printf "<div class=\"stage role-color\">";
86 KP.printf "Stage: %s%s" s msg_m;
89 let before_atoms a p count =
91 if a then "object-color", "objects"
92 else "name-color", "names"
94 let req = string_of_request "select" p in
95 KP.printf "<div class=\"atoms-head %s\">\n" c;
96 KP.printf "<a href=\"%s\">%s:</a>\n" req str;
97 KP.printf "<span class=\"count\">%s</span>\n" count;
100 KP.printf "<div class=\"atoms\"><table class=\"atoms-table\"><tr>\n"
102 let each_atom a n p b k str =
103 let c = if a then "object-color" else "name-color" in
104 let s = if b then " selected" else "" in
105 let req = string_of_request "select" p in
106 KP.printf "<td class=\"atom %s%s\" name=%S key=%S>\
107 <a href=\"%s\">%s</a></td>\n" c s n k req str
110 KP.printf "</tr></table></div>\n"
112 KP.printf "<div class=\"head\">Role Manager</div>\n";
114 before_roles each_role before_role after_role after_roles stage
115 (before_atoms true) (each_atom true) after_atoms
116 (before_atoms false) (each_atom false) after_atoms;
118 KP.printf "<div class=\"error error-color\">Error: %s</div>\n" !error
120 let handler opt arg () =
121 begin try match opt with
122 | "system-default" -> ()
123 | "system-add" -> EE.add_role ()
124 | "system-remove" -> EE.remove_roles ()
125 | "system-match" -> EE.add_matching ()
126 | "system-select" -> EE.select_entry (EU.pointer_of_string arg)
127 | "system-save" -> EE.write_status ()
128 | "system-expand" -> EE.expand_entry (EU.pointer_of_string arg)
129 | _ -> EU.raise_error (ET.EWrongRequest (opt, arg))
131 | ET.Error e -> error := EU.string_of_error e
132 | e -> error := Printexc.to_string e
140 WS.loop_in ignore handler ignore ()