1 (* Copyright (C) 2004, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://helm.cs.unibo.it/
30 let connect_button (button: GButton.button) callback =
31 ignore (button#connect#clicked callback)
33 let connect_key (ev:GObj.event_ops) ?(modifiers = []) ?(stop = false) key
36 ignore (ev#connect#key_press (fun key' ->
37 let modifiers' = GdkEvent.Key.state key' in
39 | key' when GdkEvent.Key.keyval key' = key
40 && List.for_all (fun m -> List.mem m modifiers') modifiers ->
45 let toggle_visibility ~(win: GWindow.window) ~(check: GMenu.check_menu_item) =
46 ignore (check#connect#toggled (fun _ ->
47 if check#active then win#show () else win#misc#hide ()));
48 ignore (win#event#connect#delete (fun _ ->
50 check#set_active false;
53 let toggle_win ?(check: GMenu.check_menu_item option) (win: GWindow.window) () =
54 if win#is_active then win#misc#hide () else win#show ();
57 | Some check -> check#set_active (not check#active)
59 let add_key_binding key callback (evbox: GBin.event_box) =
60 ignore (evbox#event#connect#key_press (function
61 | key' when GdkEvent.Key.keyval key' = key ->
66 class stringListModel (tree_view: GTree.view) =
67 let column_list = new GTree.column_list in
68 let text_column = column_list#add Gobject.Data.string in
69 let list_store = GTree.list_store column_list in
73 let renderer = (GTree.cell_renderer_text [], ["text", text_column]) in
74 let view_column = GTree.view_column ~renderer () in
75 tree_view#set_model (Some (list_store :> GTree.model));
76 ignore (tree_view#append_column view_column)
78 method list_store = list_store
80 method easy_append s =
81 let tree_iter = list_store#append () in
82 list_store#set ~row:tree_iter ~column:text_column s
84 method easy_insert pos s =
85 let tree_iter = list_store#insert pos in
86 list_store#set ~row:tree_iter ~column:text_column s
88 method easy_selection () =
91 let iter = list_store#get_iter tree_path in
92 list_store#get ~row:iter ~column:text_column)
93 tree_view#selection#get_selected_rows
98 let cols = new GTree.column_list in
99 let id_col = cols#add Gobject.Data.string in
100 let dsc_col = cols#add Gobject.Data.string in
101 let interp_no_col = cols#add Gobject.Data.int in
102 let tree_store = GTree.tree_store cols in
103 let id_renderer = GTree.cell_renderer_text [], ["text", id_col] in
104 let dsc_renderer = GTree.cell_renderer_text [], ["text", dsc_col] in
105 let id_view_col = GTree.view_column ~renderer:id_renderer () in
106 let dsc_view_col = GTree.view_column ~renderer:dsc_renderer () in
107 fun tree_view choices ->
110 tree_view#set_model (Some (tree_store :> GTree.model));
111 ignore (tree_view#append_column id_view_col);
112 ignore (tree_view#append_column dsc_view_col);
114 (* try to find a reasonable name for an interpretation *)
118 List.assoc "0" interp
120 incr idx; string_of_int !idx
127 let interp_row = tree_store#append () in
128 tree_store#set ~row:interp_row ~column:id_col
129 (name_of_interp interp);
130 tree_store#set ~row:interp_row ~column:interp_no_col !idx;
133 let row = tree_store#append ~parent:interp_row () in
134 tree_store#set ~row ~column:id_col id;
135 tree_store#set ~row ~column:dsc_col dsc;
136 tree_store#set ~row ~column:interp_no_col !idx)
140 method get_interp_no tree_path =
141 let iter = tree_store#get_iter tree_path in
142 tree_store#get ~row:iter ~column:interp_no_col
147 String.sub s (String.length s - 4) 4 = ".var"
148 with Invalid_argument _ -> false
150 let non p x = not (p x)
154 method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
155 method newInterpDialog: unit -> MatitaGeneratedGui.interpChoiceDialog
156 method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
157 method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
160 let interactive_user_uri_choice
161 ~(gui:#gui) ~(selection_mode:[`SINGLE|`MULTIPLE]) ?(title = "")
162 ?(msg = "") ?(nonvars_button=false) uris
164 let nonvars_uris = lazy (List.filter (non is_var_uri) uris) in
165 if (selection_mode <> `SINGLE) &&
166 (Helm_registry.get_bool "matita.auto_disambiguation")
168 Lazy.force nonvars_uris
170 let dialog = gui#newUriDialog () in
171 dialog#uriChoiceTreeView#selection#set_mode
172 (selection_mode :> Gtk.Tags.selection_mode);
173 let model = new stringListModel dialog#uriChoiceTreeView in
174 let choices = ref None in
175 let nonvars = ref false in
176 dialog#uriChoiceDialog#set_title title;
177 dialog#uriChoiceLabel#set_text msg;
178 List.iter model#easy_append uris;
179 dialog#uriChoiceConstantsButton#misc#set_sensitive nonvars_button;
182 dialog#uriChoiceDialog#destroy ();
185 ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
186 connect_button dialog#uriChoiceConstantsButton (fun _ ->
187 return (Some (Lazy.force nonvars_uris)));
188 connect_button dialog#uriChoiceAutoButton (fun _ ->
189 Helm_registry.set_bool "matita.auto_disambiguation" true;
190 return (Some (Lazy.force nonvars_uris)));
191 connect_button dialog#uriChoiceSelectedButton (fun _ ->
192 match model#easy_selection () with
194 | uris -> return (Some uris));
195 connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
196 dialog#uriChoiceDialog#show ();
199 | None -> raise Cancel
203 let interactive_interp_choice ~(gui:#gui) choices =
204 assert (choices <> []);
205 let dialog = gui#newInterpDialog () in
206 let model = new interpModel dialog#interpChoiceTreeView choices in
207 let interp_len = List.length (List.hd choices) in
208 dialog#interpChoiceDialog#set_title "Interpretation choice";
209 dialog#interpChoiceDialogLabel#set_label "Choose an interpretation:";
210 let interp_no = ref None in
212 dialog#interpChoiceDialog#destroy ();
215 let fail _ = interp_no := None; return () in
216 ignore (dialog#interpChoiceDialog#event#connect#delete (fun _ -> true));
217 connect_button dialog#interpChoiceOkButton (fun _ ->
218 match !interp_no with None -> () | Some _ -> return ());
219 connect_button dialog#interpChoiceCancelButton fail;
220 ignore (dialog#interpChoiceTreeView#connect#row_activated (fun path _ ->
221 interp_no := Some (model#get_interp_no path);
223 let selection = dialog#interpChoiceTreeView#selection in
224 ignore (selection#connect#changed (fun _ ->
225 match selection#get_selected_rows with
227 debug_print (sprintf "selection: %d" (model#get_interp_no path));
228 interp_no := Some (model#get_interp_no path)
229 | _ -> assert false));
230 dialog#interpChoiceDialog#show ();
232 (match !interp_no with Some row -> [row] | _ -> raise Cancel)
234 let ask_confirmation ~(gui:#gui) ?(cancel = true) ?(title = "") ?(msg = "") () =
235 let dialog = gui#newConfirmationDialog () in
236 dialog#confirmationDialog#set_title title;
237 dialog#confirmationDialogLabel#set_label msg;
238 let result = ref None in
241 dialog#confirmationDialog#destroy ();
244 ignore (dialog#confirmationDialog#event#connect#delete (fun _ -> true));
245 connect_button dialog#confirmationDialogOkButton (return true);
246 connect_button dialog#confirmationDialogCancelButton (return false);
247 if not cancel then dialog#confirmationDialogCancelButton#misc#hide ();
248 dialog#confirmationDialog#show ();
250 (match !result with None -> assert false | Some r -> r)
252 let ask_text ~(gui:#gui) ?(title = "") ?(msg = "") ?(multiline = false) () =
253 let dialog = gui#newEmptyDialog () in
254 dialog#emptyDialog#set_title title;
255 dialog#emptyDialogLabel#set_label msg;
256 let result = ref None in
259 dialog#emptyDialog#destroy ();
262 ignore (dialog#emptyDialog#event#connect#delete (fun _ -> true));
263 if multiline then begin (* multiline input required: use a TextView widget *)
265 GBin.scrolled_window ~width:400 ~height:150 ~hpolicy:`NEVER
266 ~vpolicy:`ALWAYS ~packing:dialog#emptyDialogVBox#add ()
268 let view = GText.view ~wrap_mode:`CHAR ~packing:win#add () in
269 view#misc#grab_focus ();
270 connect_button dialog#emptyDialogOkButton (fun _ ->
271 return (Some (view#buffer#get_text ())))
272 end else begin (* monoline input required: use a TextEntry widget *)
273 let entry = GEdit.entry ~packing:dialog#emptyDialogVBox#add () in
274 entry#misc#grab_focus ();
275 connect_button dialog#emptyDialogOkButton (fun _ ->
276 return (Some entry#text))
278 connect_button dialog#emptyDialogCancelButton (fun _ ->return None);
279 dialog#emptyDialog#show ();
281 (match !result with None -> raise Cancel | Some r -> r)