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 toggle_visibility ~(win: GWindow.window) ~(check: GMenu.check_menu_item) =
34 ignore (check#connect#toggled (fun _ ->
35 if check#active then win#show () else win#misc#hide ()));
36 ignore (win#event#connect#delete (fun _ ->
38 check#set_active false;
41 let toggle_win ?(check: GMenu.check_menu_item option) (win: GWindow.window) () =
42 if win#is_active then win#misc#hide () else win#show ();
45 | Some check -> check#set_active (not check#active)
47 let add_key_binding key callback (evbox: GBin.event_box) =
48 ignore (evbox#event#connect#key_press (function
49 | key' when GdkEvent.Key.keyval key' = key ->
54 class stringListModel (tree_view: GTree.view) =
55 let column_list = new GTree.column_list in
56 let text_column = column_list#add Gobject.Data.string in
57 let list_store = GTree.list_store column_list in
61 let renderer = (GTree.cell_renderer_text [], ["text", text_column]) in
62 let view_column = GTree.view_column ~renderer () in
63 tree_view#set_model (Some (list_store :> GTree.model));
64 ignore (tree_view#append_column view_column)
66 method list_store = list_store
68 method easy_append s =
69 let tree_iter = list_store#append () in
70 list_store#set ~row:tree_iter ~column:text_column s
72 method easy_insert pos s =
73 let tree_iter = list_store#insert pos in
74 list_store#set ~row:tree_iter ~column:text_column s
76 method easy_selection () =
79 let iter = list_store#get_iter tree_path in
80 list_store#get ~row:iter ~column:text_column)
81 tree_view#selection#get_selected_rows
86 let cols = new GTree.column_list in
87 let id_col = cols#add Gobject.Data.string in
88 let dsc_col = cols#add Gobject.Data.string in
89 let interp_no_col = cols#add Gobject.Data.int in
90 let tree_store = GTree.tree_store cols in
91 let id_renderer = GTree.cell_renderer_text [], ["text", id_col] in
92 let dsc_renderer = GTree.cell_renderer_text [], ["text", dsc_col] in
93 let id_view_col = GTree.view_column ~renderer:id_renderer () in
94 let dsc_view_col = GTree.view_column ~renderer:dsc_renderer () in
95 fun tree_view choices ->
98 tree_view#set_model (Some (tree_store :> GTree.model));
99 ignore (tree_view#append_column id_view_col);
100 ignore (tree_view#append_column dsc_view_col);
102 (* try to find a reasonable name for an interpretation *)
106 List.assoc "0" interp
108 incr idx; string_of_int !idx
115 let interp_row = tree_store#append () in
116 tree_store#set ~row:interp_row ~column:id_col
117 (name_of_interp interp);
118 tree_store#set ~row:interp_row ~column:interp_no_col !idx;
121 let row = tree_store#append ~parent:interp_row () in
122 tree_store#set ~row ~column:id_col id;
123 tree_store#set ~row ~column:dsc_col dsc;
124 tree_store#set ~row ~column:interp_no_col !idx)
128 method get_interp_no tree_path =
129 let iter = tree_store#get_iter tree_path in
130 tree_store#get ~row:iter ~column:interp_no_col
135 String.sub s (String.length s - 4) 4 = ".var"
136 with Invalid_argument _ -> false
138 let non p x = not (p x)
142 method newUriDialog: unit -> MatitaGeneratedGui.uriChoiceDialog
143 method newInterpDialog: unit -> MatitaGeneratedGui.interpChoiceDialog
144 method newConfirmationDialog: unit -> MatitaGeneratedGui.confirmationDialog
145 method newEmptyDialog: unit -> MatitaGeneratedGui.emptyDialog
148 let interactive_user_uri_choice
149 ~(gui:#gui) ~(selection_mode:[`SINGLE|`MULTIPLE]) ?(title = "")
150 ?(msg = "") ?(nonvars_button=false) uris
152 let nonvars_uris = lazy (List.filter (non is_var_uri) uris) in
153 if (selection_mode <> `SINGLE) &&
154 (Helm_registry.get_bool "matita.auto_disambiguation")
156 Lazy.force nonvars_uris
158 let dialog = gui#newUriDialog () in
159 dialog#uriChoiceTreeView#selection#set_mode
160 (selection_mode :> Gtk.Tags.selection_mode);
161 let model = new stringListModel dialog#uriChoiceTreeView in
162 let choices = ref None in
163 let nonvars = ref false in
164 dialog#uriChoiceDialog#set_title title;
165 dialog#uriChoiceLabel#set_text msg;
166 List.iter model#easy_append uris;
167 dialog#uriChoiceConstantsButton#misc#set_sensitive nonvars_button;
170 dialog#uriChoiceDialog#destroy ();
173 ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
174 connect_button dialog#uriChoiceConstantsButton (fun _ ->
175 return (Some (Lazy.force nonvars_uris)));
176 connect_button dialog#uriChoiceAutoButton (fun _ ->
177 Helm_registry.set_bool "matita.auto_disambiguation" true;
178 return (Some (Lazy.force nonvars_uris)));
179 connect_button dialog#uriChoiceSelectedButton (fun _ ->
180 match model#easy_selection () with
182 | uris -> return (Some uris));
183 connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
184 dialog#uriChoiceDialog#show ();
187 | None -> raise Cancel
191 let interactive_interp_choice ~(gui:#gui) choices =
192 assert (choices <> []);
193 let dialog = gui#newInterpDialog () in
194 let model = new interpModel dialog#interpChoiceTreeView choices in
195 let interp_len = List.length (List.hd choices) in
196 dialog#interpChoiceDialog#set_title "Interpretation choice";
197 dialog#interpChoiceDialogLabel#set_label "Choose an interpretation:";
198 let interp_no = ref None in
200 dialog#interpChoiceDialog#destroy ();
203 let fail _ = interp_no := None; return () in
204 ignore (dialog#interpChoiceDialog#event#connect#delete (fun _ -> true));
205 connect_button dialog#interpChoiceOkButton (fun _ ->
206 match !interp_no with None -> () | Some _ -> return ());
207 connect_button dialog#interpChoiceCancelButton fail;
208 ignore (dialog#interpChoiceTreeView#connect#row_activated (fun path _ ->
209 interp_no := Some (model#get_interp_no path);
211 let selection = dialog#interpChoiceTreeView#selection in
212 ignore (selection#connect#changed (fun _ ->
213 match selection#get_selected_rows with
215 debug_print (sprintf "selection: %d" (model#get_interp_no path));
216 interp_no := Some (model#get_interp_no path)
217 | _ -> assert false));
218 dialog#interpChoiceDialog#show ();
220 (match !interp_no with Some row -> [row] | _ -> raise Cancel)
222 let ask_confirmation ~(gui:#gui) ?(title = "") ?(msg = "") () =
223 let dialog = gui#newConfirmationDialog () in
224 dialog#confirmationDialog#set_title title;
225 dialog#confirmationDialogLabel#set_label msg;
226 let result = ref None in
229 dialog#confirmationDialog#destroy ();
232 ignore (dialog#confirmationDialog#event#connect#delete (fun _ -> true));
233 connect_button dialog#confirmationDialogOkButton (return true);
234 connect_button dialog#confirmationDialogCancelButton (return false);
235 dialog#confirmationDialog#show ();
237 (match !result with None -> assert false | Some r -> r)
239 let ask_text ~(gui:#gui) ?(title = "") ?(msg = "") ?(multiline = false) () =
240 let dialog = gui#newEmptyDialog () in
241 dialog#emptyDialog#set_title title;
242 dialog#emptyDialogLabel#set_label msg;
243 let result = ref None in
246 dialog#emptyDialog#destroy ();
249 ignore (dialog#emptyDialog#event#connect#delete (fun _ -> true));
250 if multiline then begin (* multiline input required: use a TextView widget *)
252 GBin.scrolled_window ~width:400 ~height:150 ~hpolicy:`NEVER
253 ~vpolicy:`ALWAYS ~packing:dialog#emptyDialogVBox#add ()
255 let view = GText.view ~wrap_mode:`CHAR ~packing:win#add () in
256 view#misc#grab_focus ();
257 connect_button dialog#emptyDialogOkButton (fun _ ->
258 return (Some (view#buffer#get_text ())))
259 end else begin (* monoline input required: use a TextEntry widget *)
260 let entry = GEdit.entry ~packing:dialog#emptyDialogVBox#add () in
261 entry#misc#grab_focus ();
262 connect_button dialog#emptyDialogOkButton (fun _ ->
263 return (Some entry#text))
265 connect_button dialog#emptyDialogCancelButton (fun _ ->return None);
266 dialog#emptyDialog#show ();
268 (match !result with None -> raise Cancel | Some r -> r)