open MatitaGtkMisc
open MatitaMisc
-exception Found of int
-
let all_disambiguation_passes = ref false
-let gui_instance = ref None
-
(* this is a shit and should be changed :-{ *)
let interactive_uri_choice
?(selection_mode:[`SINGLE|`MULTIPLE] = `MULTIPLE) ?(title = "")
?(msg = "") ?(nonvars_button = false) ?(hide_uri_entry=false)
?(hide_try=false) ?(ok_label="_Auto") ?(ok_action:[`SELECT|`AUTO] = `AUTO)
?copy_cb ()
- ~id uris
+ ~id:_ uris
=
- let gui = MatitaMisc.get_gui () in
if (selection_mode <> `SINGLE) &&
(Helm_registry.get_opt_default Helm_registry.get_bool ~default:true "matita.auto_disambiguation")
then
uris
else begin
- let dialog = gui#newUriDialog () in
+ let dialog = new uriChoiceDialog () in
if hide_uri_entry then
dialog#uriEntryHBox#misc#hide ();
if hide_try then
| uris -> return (Some (List.map NReference.reference_of_string uris)));
connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
dialog#uriChoiceDialog#show ();
+ (* CSC: old Gtk2 code. Use #run instead. Look for similar code handling
+ other dialogs *)
GtkThread.main ();
(match !choices with
| None -> raise MatitaTypes.Cancel
end
-class type browserWin =
- (* this class exists only because GEdit.combo_box_entry is not supported by
- * lablgladecc :-(((( *)
-object
- inherit MatitaGeneratedGui.browserWin
- method browserUri: GEdit.entry
-end
-
class console ~(buffer: GText.buffer) () =
object (self)
val error_tag = buffer#create_tag [ `FOREGROUND "red" ]
| `Warning -> self#warning (s ^ "\n")
end
-let clean_current_baseuri grafite_status =
- LibraryClean.clean_baseuris [grafite_status#baseuri]
+let clean_current_baseuri status =
+ LibraryClean.clean_baseuris [status#baseuri]
-let save_moo grafite_status =
- let script = MatitaScript.current () in
- let baseuri = grafite_status#baseuri in
+let save_moo0 ~do_clean script status =
+ let baseuri = status#baseuri in
match script#bos, script#eos with
| true, _ -> ()
| _, true ->
GrafiteTypes.Serializer.serialize ~baseuri:(NUri.uri_of_string baseuri)
- grafite_status
- | _ -> clean_current_baseuri grafite_status
+ status
+ | _ -> if do_clean then clean_current_baseuri status
+;;
+
+let save_moo status =
+ let script = MatitaScript.current () in
+ save_moo0 ~do_clean:true script status
;;
let ask_unsaved parent filename =
tree_store#clear ();
let idx1 = ref ~-1 in
List.iter
- (fun _,lll ->
+ (fun (_,lll) ->
incr idx1;
let loc_row =
if List.length choices = 1 then
(let loc_row = tree_store#append () in
begin
match lll with
- [passes,envs_and_diffs,_,_] ->
+ [passes,_envs_and_diffs,_,_] ->
tree_store#set ~row:loc_row ~column:id_col
("Error location " ^ string_of_int (!idx1+1) ^
", error message " ^ string_of_int (!idx1+1) ^ ".1" ^
Some loc_row) in
let idx2 = ref ~-1 in
List.iter
- (fun passes,envs_and_diffs,_,_ ->
+ (fun (passes,envs_and_diffs,_,_) ->
incr idx2;
let msg_row =
if List.length lll = 1 then
exception UseLibrary;;
let interactive_error_interp ~all_passes
- (source_buffer:GSourceView2.source_buffer) notify_exn offset errorll filename
+ (source_buffer:GSourceView3.source_buffer) notify_exn offset errorll filename
=
(* hook to save a script for each disambiguation error *)
if false then
(MultiPassDisambiguator.DisambiguationError
(offset,[[env,diff,lazy (loffset,Lazy.force msg),significant]]));
| _::_ ->
+ GtkThread.sync (fun _ ->
let dialog = new disambiguationErrors () in
- dialog#check_widgets ();
- if all_passes then
- dialog#disambiguationErrorsMoreErrors#misc#set_sensitive false;
+ dialog#toplevel#add_button "Fix this interpretation" `OK;
+ dialog#toplevel#add_button "Close" `DELETE_EVENT;
+ if not all_passes then
+ dialog#toplevel#add_button "More errors" `HELP; (* HELP means MORE *)
let model = new interpErrorModel dialog#treeview choices in
dialog#disambiguationErrors#set_title "Disambiguation error";
dialog#disambiguationErrorsLabel#set_label
(MultiPassDisambiguator.DisambiguationError
(offset,[[env,diff,lazy(loffset,Lazy.force msg),significant]]))
));
- let return _ =
- dialog#disambiguationErrors#destroy ();
- GMain.Main.quit ()
+ (match GtkThread.sync dialog#toplevel#run () with
+ | `OK ->
+ let tree_path =
+ match fst (dialog#treeview#get_cursor ()) with
+ None -> assert false
+ | Some tp -> tp in
+ let idx1,idx2,idx3 = model#get_interp_no tree_path in
+ let diff =
+ match idx2,idx3 with
+ Some idx2, Some idx3 ->
+ let _,lll = List.nth choices idx1 in
+ let _,envs_and_diffs,_,_ = List.nth lll idx2 in
+ let _,_,diff = List.nth envs_and_diffs idx3 in
+ diff
+ | _,_ -> assert false
in
- let fail _ = return () in
- ignore(dialog#disambiguationErrors#event#connect#delete (fun _ -> true));
- connect_button dialog#disambiguationErrorsOkButton
- (fun _ ->
- let tree_path =
- match fst (dialog#treeview#get_cursor ()) with
- None -> assert false
- | Some tp -> tp in
- let idx1,idx2,idx3 = model#get_interp_no tree_path in
- let diff =
- match idx2,idx3 with
- Some idx2, Some idx3 ->
- let _,lll = List.nth choices idx1 in
- let _,envs_and_diffs,_,_ = List.nth lll idx2 in
- let _,_,diff = List.nth envs_and_diffs idx3 in
- diff
- | _,_ -> assert false
- in
- let newtxt =
- String.concat "\n"
- ("" ::
- List.map
- (fun k,desc ->
- let alias =
- match k with
- | DisambiguateTypes.Id id ->
- GrafiteAst.Ident_alias (id, desc)
- | DisambiguateTypes.Symbol (symb, i)->
- GrafiteAst.Symbol_alias (symb, i, desc)
- | DisambiguateTypes.Num i ->
- GrafiteAst.Number_alias (i, desc)
- in
- GrafiteAstPp.pp_alias alias)
- diff) ^ "\n"
- in
- source_buffer#insert
- ~iter:
- (source_buffer#get_iter_at_mark
- (`NAME "beginning_of_statement")) newtxt ;
- return ()
- );
- connect_button dialog#disambiguationErrorsMoreErrors
- (fun _ -> return () ; raise UseLibrary);
- connect_button dialog#disambiguationErrorsCancelButton fail;
- dialog#disambiguationErrors#show ();
- GtkThread.main ()
+ let newtxt =
+ String.concat "\n"
+ ("" ::
+ List.map
+ (fun (k,desc) ->
+ let alias =
+ match k with
+ | DisambiguateTypes.Id id ->
+ GrafiteAst.Ident_alias (id, desc)
+ | DisambiguateTypes.Symbol (symb, i)->
+ GrafiteAst.Symbol_alias (symb, i, desc)
+ | DisambiguateTypes.Num i ->
+ GrafiteAst.Number_alias (i, desc)
+ in
+ GrafiteAstPp.pp_alias alias)
+ diff) ^ "\n"
+ in
+ source_buffer#insert
+ ~iter:
+ (source_buffer#get_iter_at_mark
+ (`NAME "beginning_of_statement")) newtxt
+ | `HELP (* HELP MEANS MORE *) ->
+ dialog#toplevel#destroy () ;
+ raise UseLibrary
+ | `DELETE_EVENT -> ()
+ | _ -> assert false) ;
+ dialog#toplevel#destroy ()
+ ) ()
+let ref_kill_worker = ref (fun _ -> assert false)
class gui () =
(* creation order _is_ relevant for windows placement *)
let main = new mainWin () in
let sequents_viewer =
MatitaMathView.sequentsViewer_instance main#sequentsNotebook in
- let fileSel = new fileSelectionWin () in
let findRepl = new findReplWin () in
let keyBindingBoxes = (* event boxes which should receive global key events *)
[ main#mainWinEventBox ]
val mutable chosen_file = None
val mutable _ok_not_exists = false
val mutable _only_directory = false
+ val mutable current_page = -1
initializer
let s () = MatitaScript.current () in
- (* glade's check widgets *)
- List.iter (fun w -> w#check_widgets ())
- (let c w = (w :> <check_widgets: unit -> unit>) in
- [ c fileSel; c main; c findRepl]);
(* key bindings *)
List.iter (* global key bindings *)
- (fun (key, callback) -> self#addKeyBinding key callback)
+ (fun (key, modifiers, callback) ->
+ self#addKeyBinding key ~modifiers callback)
(*
[ GdkKeysyms._F3,
toggle_win ~check:main#showProofMenuItem proof#proofWin;
GdkKeysyms._F4,
toggle_win ~check:main#showCheckMenuItem check#checkWin;
*)
- [ ];
+ [
+ GdkKeysyms._Page_Down, [`CONTROL], main#scriptNotebook#next_page;
+ GdkKeysyms._Page_Up, [`CONTROL], main#scriptNotebook#previous_page
+ ];
(* about win *)
let parse_txt_file file =
let ch = open_in (BuildTimeConf.runtime_base_dir ^ "/" ^ file) in
~website:"http://matita.cs.unibo.it"
()
in
+ ignore(about_dialog#event#connect#delete (fun _ -> true));
ignore(about_dialog#connect#response (fun _ ->about_dialog#misc#hide ()));
connect_menu_item main#contentsMenuItem (fun () ->
if 0 = Sys.command "which gnome-help" then
~callback:(fun _ -> hide_find_Repl ();true));
connect_menu_item main#undoMenuItem
(fun () -> (MatitaScript.current ())#safe_undo);
-(*CSC: XXX
- ignore(source_view#source_buffer#connect#can_undo
- ~callback:main#undoMenuItem#misc#set_sensitive);
-*) main#undoMenuItem#misc#set_sensitive true;
+ main#undoMenuItem#misc#set_sensitive false;
connect_menu_item main#redoMenuItem
(fun () -> (MatitaScript.current ())#safe_redo);
-(*CSC: XXX
- ignore(source_view#source_buffer#connect#can_redo
- ~callback:main#redoMenuItem#misc#set_sensitive);
-*) main#redoMenuItem#misc#set_sensitive true;
+ main#redoMenuItem#misc#set_sensitive false;
connect_menu_item main#editMenu (fun () ->
main#copyMenuItem#misc#set_sensitive
(MatitaScript.current ())#canCopy;
let source_view = (s ())#source_view in
main#buttonsToolbar#misc#set_sensitive false;
main#scriptMenu#misc#set_sensitive false;
- source_view#set_editable false
+ source_view#set_editable false;
+ main#scriptAbortButton#set_sensitive true
in
let unlock_world _ =
let source_view = (s ())#source_view in
main#buttonsToolbar#misc#set_sensitive true;
main#scriptMenu#misc#set_sensitive true;
source_view#set_editable true;
- (*The next line seems sufficient to avoid some unknown race condition *)
- GtkThread.sync (fun () -> ()) ()
+ main#scriptAbortButton#set_sensitive false
in
let worker_thread = ref None in
- let notify_exn (source_view : GSourceView2.source_view) exn =
+ let notify_exn (source_view : GSourceView3.source_view) exn =
let floc, msg = MatitaExcPp.to_string exn in
begin
match floc with
match !id with
| None -> assert false (* a race condition occurred *)
| Some id ->
- (new GObj.gobject_ops source_view#source_buffer#as_buffer)#disconnect id));
+ source_view#source_buffer#misc#disconnect id));
source_view#source_buffer#place_cursor
(source_view#source_buffer#get_iter (`OFFSET x'));
end;
let source_view = script#source_view in
let thread_main =
fun () ->
+ ignore (Thread.sigmask Unix.SIG_UNBLOCK [Sys.sigvtalrm]);
lock_world ();
let saved_use_library= !MultiPassDisambiguator.use_library in
try
with Sys.Break as e -> notify_exn source_view e);
unlock_world ()
in
- (*thread_main ();*)
worker_thread := Some (Thread.create thread_main ())
in
let kill_worker =
- (* the following lines are from Xavier Leroy: http://alan.petitepomme.net/cwn/2005.11.08.html *)
let interrupt = ref None in
let old_callback = ref (function _ -> ()) in
let force_interrupt n =
- (* This function is called just before the thread's timeslice ends *)
+ (* This function is called every 1s (see Unix.setitimer call above) *)
!old_callback n;
+ (* it may be a masked interrupt for the previous thread that arrives
+ late *)
if Some(Thread.id(Thread.self())) = !interrupt then
- (interrupt := None; raise Sys.Break) in
+ (interrupt := None; raise Sys.Break)
+ in
+ ignore (Thread.sigmask Unix.SIG_BLOCK [Sys.sigvtalrm]);
+ ignore (Unix.setitimer Unix.ITIMER_VIRTUAL {Unix.it_interval = 1.; it_value = 1.});
let _ =
match Sys.signal Sys.sigvtalrm (Sys.Signal_handle force_interrupt) with
Sys.Signal_handle f -> old_callback := f
match !worker_thread with
None -> assert false
| Some t -> interrupt := Some (Thread.id t) in
+ ref_kill_worker := kill_worker ;
let keep_focus f (script: MatitaScript.script) =
try
f script; script#source_view#misc#grab_focus ()
with
exc -> script#source_view#misc#grab_focus (); raise exc in
- (* file selection win *)
- ignore (fileSel#fileSelectionWin#event#connect#delete (fun _ -> true));
- ignore (fileSel#fileSelectionWin#connect#response (fun event ->
- let return r =
- chosen_file <- r;
- fileSel#fileSelectionWin#misc#hide ();
- GMain.Main.quit ()
- in
- match event with
- | `OK ->
- let fname = fileSel#fileSelectionWin#filename in
- if Sys.file_exists fname then
- begin
- if HExtlib.is_regular fname && not (_only_directory) then
- return (Some fname)
- else if _only_directory && HExtlib.is_dir fname then
- return (Some fname)
- end
- else
- begin
- if _ok_not_exists then
- return (Some fname)
- end
- | `CANCEL -> return None
- | `HELP -> ()
- | `DELETE_EVENT -> return None));
(* menus *)
List.iter (fun w -> w#misc#set_sensitive false) [ main#saveMenuItem ];
(* console *)
ignore (adj#connect#changed
(fun _ -> adj#set_value (adj#upper -. adj#page_size)));
console#message (sprintf "\tMatita version %s\n" BuildTimeConf.version);
+ console#message (sprintf "\tStandard library location:\n\t %s\n" BuildTimeConf.new_stdlib_dir_devel);
(* natural deduction palette *)
main#tacticsButtonsHandlebox#misc#hide ();
MatitaGtkMisc.toggle_callback
"apply rule (∃#e (…) {…} […] (…));\n\t[\n\t|\n\t]\n");
- let module Hr = Helm_registry in
MatitaGtkMisc.toggle_callback ~check:main#fullscreenMenuItem
~callback:(function
| true -> main#toplevel#fullscreen ()
MatitaGtkMisc.toggle_callback ~check:main#ppNotationMenuItem
~callback:(function b ->
let s = s () in
- let status =
- Interpretations.toggle_active_interpretations s#grafite_status b
+ let _status = Interpretations.toggle_active_interpretations s#status b
in
assert false (* MATITA 1.0 ???
s#set_grafite_status status*)
main#unicodeAsTexMenuItem#set_active
(Helm_registry.get_bool "matita.paste_unicode_as_tex");
(* log *)
- HLog.set_log_callback self#console#log_callback;
+ HLog.set_log_callback (fun tag msg -> GtkThread.async (self#console#log_callback tag) msg);
GtkSignal.user_handler :=
(function
| MatitaScript.ActionCancelled s -> HLog.error s
connect_button main#scriptBottomButton bottom;
connect_button main#scriptJumpButton jump;
connect_button main#scriptAbortButton kill_worker;
+ main#scriptAbortButton#set_sensitive false;
connect_menu_item main#scriptAdvanceMenuItem advance;
connect_menu_item main#scriptRetractMenuItem retract;
connect_menu_item main#scriptTopMenuItem top;
connect_menu_item main#saveAsMenuItem
(fun () -> self#saveAsScript (MatitaScript.current ()));
connect_menu_item main#newMenuItem self#newScript;
- connect_menu_item main#closeMenuItem self#closeScript;
+ connect_menu_item main#closeMenuItem self#closeCurrentScript;
connect_menu_item main#showCoercionsGraphMenuItem
- (fun _ ->
- let c = MatitaMathView.cicBrowser () in
- c#load (`About `Coercions));
+ (fun _ -> MatitaMathView.cicBrowser (Some (`About `Coercions)));
connect_menu_item main#showHintsDbMenuItem
- (fun _ ->
- let c = MatitaMathView.cicBrowser () in
- c#load (`About `Hints));
+ (fun _ -> MatitaMathView.cicBrowser (Some (`About `Hints)));
connect_menu_item main#showTermGrammarMenuItem
- (fun _ ->
- let c = MatitaMathView.cicBrowser () in
- c#load (`About `Grammar));
+ (fun _ -> MatitaMathView.cicBrowser (Some (`About `Grammar)));
connect_menu_item main#showUnicodeTable
- (fun _ ->
- let c = MatitaMathView.cicBrowser () in
- c#load (`About `TeX));
+ (fun _ -> MatitaMathView.cicBrowser (Some (`About `TeX)));
(* debug menu *)
main#debugMenu#misc#hide ();
(* HBUGS *)
main#hpaneScriptSequent#set_position script_w;
(* math view handling *)
connect_menu_item main#newCicBrowserMenuItem (fun () ->
- ignore(MatitaMathView.cicBrowser ()));
+ ignore(MatitaMathView.cicBrowser None));
connect_menu_item main#increaseFontSizeMenuItem
MatitaMisc.increase_font_size;
connect_menu_item main#decreaseFontSizeMenuItem
MatitaMisc.decrease_font_size;
connect_menu_item main#normalFontSizeMenuItem
MatitaMisc.reset_font_size;
- ignore (main#scriptNotebook#connect#switch_page
- (fun page ->
- let script = MatitaScript.at_page page in
- script#activate;
- main#saveMenuItem#misc#set_sensitive script#has_name));
+ ignore (main#scriptNotebook#connect#switch_page (fun page ->
+ self#save_page ();
+ current_page <- page;
+ let script = MatitaScript.at_page page in
+ script#activate;
+ main#undoMenuItem#misc#set_sensitive
+ script#source_view#source_buffer#can_undo ;
+ main#redoMenuItem#misc#set_sensitive
+ script#source_view#source_buffer#can_redo ;
+ main#saveMenuItem#misc#set_sensitive script#has_name))
method private externalEditor () =
let script = MatitaScript.current () in
with
| `YES ->
self#saveScript script;
- save_moo script#grafite_status;
+ save_moo script#status;
true
| `NO -> true
- | `CANCEL -> false
+ | `DELETE_EVENT -> false
else
- (save_moo script#grafite_status; true)
+ (save_moo script#status; true)
- method private closeScript () =
- let page = main#scriptNotebook#current_page in
- let script = MatitaScript.at_page page in
+ method private closeScript page script =
if self#closeScript0 script then
begin
MatitaScript.destroy page;
ignore (main#scriptNotebook#remove_page page)
end
+ method private closeCurrentScript () =
+ let page = main#scriptNotebook#current_page in
+ let script = MatitaScript.at_page page in
+ self#closeScript page script
+
+ method private save_page () =
+ if current_page >= 0 then
+ let old_script = MatitaScript.at_page current_page in
+ save_moo0 ~do_clean:false old_script old_script#status
+
method newScript () =
+ self#save_page ();
let scrolledWindow = GBin.scrolled_window () in
- let tab_label = GMisc.label ~text:"foo" () in
- let script =
- MatitaScript.script
- ~urichooser:(fun source_view uris ->
- try
- interactive_uri_choice ~selection_mode:`SINGLE
- ~title:"Matita: URI chooser"
- ~msg:"Select the URI" ~hide_uri_entry:true
- ~hide_try:true ~ok_label:"_Apply" ~ok_action:`SELECT
- ~copy_cb:(fun s -> source_view#buffer#insert ("\n"^s^"\n"))
- () ~id:"boh?" uris
- with MatitaTypes.Cancel -> [])
- ~ask_confirmation:
- (fun ~title ~message ->
- MatitaGtkMisc.ask_confirmation ~title ~message
- ~parent:(MatitaMisc.get_gui ())#main#toplevel ())
- ~parent:scrolledWindow ~tab_label ()
- in
- ignore (main#scriptNotebook#prepend_page ~tab_label:tab_label#coerce scrolledWindow#coerce);
+ let hbox = GPack.hbox () in
+ let tab_label = GMisc.label ~text:"foo" ~packing:hbox#pack () in
+ let _ =
+ GMisc.label ~text:"" ~packing:(hbox#pack ~expand:true ~fill:true) () in
+ let closebutton =
+ GButton.button ~relief:`NONE ~packing:hbox#pack () in
+ let image = GMisc.image ~stock:`CLOSE ~icon_size:`MENU () in
+ closebutton#set_image image#coerce;
+ let script = MatitaScript.script ~parent:scrolledWindow ~tab_label () in
+ ignore (main#scriptNotebook#prepend_page ~tab_label:hbox#coerce
+ scrolledWindow#coerce);
+ ignore (closebutton#connect#clicked (fun () ->
+ self#closeScript
+ (main#scriptNotebook#page_num scrolledWindow#coerce) script));
main#scriptNotebook#goto_page 0;
sequents_viewer#reset;
sequents_viewer#load_logo;
let browser_observer _ = MatitaMathView.refresh_all_browsers () in
- let sequents_observer grafite_status =
+ let sequents_observer status =
sequents_viewer#reset;
- match grafite_status#ng_mode with
+ match status#ng_mode with
`ProofMode ->
- sequents_viewer#nload_sequents grafite_status;
+ sequents_viewer#nload_sequents status;
(try
let goal =
- Continuationals.Stack.find_goal grafite_status#stack
+ Continuationals.Stack.find_goal status#stack
in
- sequents_viewer#goto_sequent grafite_status goal
+ sequents_viewer#goto_sequent status goal
with Failure _ -> ());
| `CommandMode -> sequents_viewer#load_logo
in
script#addObserver sequents_observer;
script#addObserver browser_observer
+ method kill_worker () = !ref_kill_worker ()
+
method loadScript file =
- self#newScript ();
+ let page = main#scriptNotebook#current_page in
+ let script = MatitaScript.at_page page in
+ if script#source_view#buffer#modified || script#has_name then
+ self#newScript ();
let script = MatitaScript.current () in
let source_view = script#source_view in
script#reset ();
console#message ("'"^file^"' loaded.");
self#_enableSaveTo file
- method private _enableSaveTo file =
+ method private _enableSaveTo _file =
self#main#saveMenuItem#misc#set_sensitive true
method private console = console
- method private fileSel = fileSel
method private findRepl = findRepl
method main = main
- method newBrowserWin () =
- object (self)
- inherit browserWin ()
- val combo = GEdit.entry ()
- initializer
- self#check_widgets ();
- let combo_widget = combo#coerce in
- uriHBox#pack ~from:`END ~fill:true ~expand:true combo_widget;
- combo#misc#grab_focus ()
- method browserUri = combo
- end
-
- method newUriDialog () =
- let dialog = new uriChoiceDialog () in
- dialog#check_widgets ();
- dialog
-
- method private newConfirmationDialog () =
- let dialog = new confirmationDialog () in
- dialog#check_widgets ();
- dialog
-
- method newEmptyDialog () =
- let dialog = new emptyDialog () in
- dialog#check_widgets ();
- dialog
-
- method private addKeyBinding key callback =
- List.iter (fun evbox -> add_key_binding key callback evbox)
+ method private addKeyBinding key ?modifiers callback =
+(* List.iter (fun evbox -> add_key_binding key callback evbox) *)
+ List.iter (fun evbox -> connect_key evbox#event key ?modifiers callback)
keyBindingBoxes
method private setQuitCallback callback =
(fun _ -> callback ();true));
self#addKeyBinding GdkKeysyms._q callback
+ method private chooseFileOrDir ok_not_exists only_directory =
+ let fileSel = GWindow.file_chooser_dialog
+ ~action:`OPEN
+ ~title:"Select file"
+ ~modal:true
+ ~type_hint:`DIALOG
+ ~position:`CENTER
+ () in
+ fileSel#add_select_button_stock `OPEN `OK;
+ fileSel#add_button_stock `CANCEL `CANCEL;
+ ignore (fileSel#set_current_folder(Sys.getcwd ())) ;
+ let res =
+ let rec aux () =
+ match fileSel#run () with
+ | `OK ->
+ (match fileSel#filename with
+ None -> aux ()
+ | Some fname ->
+ if Sys.file_exists fname then
+ begin
+ if HExtlib.is_regular fname && not (only_directory) then
+ Some fname
+ else if only_directory && HExtlib.is_dir fname then
+ Some fname
+ else
+ aux ()
+ end
+ else if ok_not_exists then Some fname else aux ())
+ | `CANCEL -> None
+ | `DELETE_EVENT -> None in
+ aux () in
+ fileSel#destroy () ;
+ res
+
method private chooseFile ?(ok_not_exists = false) () =
- _ok_not_exists <- ok_not_exists;
- _only_directory <- false;
- fileSel#fileSelectionWin#show ();
- GtkThread.main ();
- chosen_file
+ self#chooseFileOrDir ok_not_exists false
method private chooseDir ?(ok_not_exists = false) () =
- _ok_not_exists <- ok_not_exists;
- _only_directory <- true;
- fileSel#fileSelectionWin#show ();
- GtkThread.main ();
(* we should check that this is a directory *)
- chosen_file
+ self#chooseFileOrDir ok_not_exists true
end
let gui () =
let g = new gui () in
- gui_instance := Some g;
- MatitaMisc.set_gui g;
- g
+ let rg = (g :> MatitaGuiTypes.gui) in
+ MatitaMisc.set_gui rg;
+ g#newScript ();
+ rg
let instance = singleton gui
let interactive_string_choice
- text prefix_len ?(title = "") ?(msg = "") () ~id locs uris
+ text prefix_len ?(title = "") ?msg:(_ = "") () ~id:_ locs uris
=
- let gui = instance () in
- let dialog = gui#newUriDialog () in
- dialog#uriEntryHBox#misc#hide ();
- dialog#uriChoiceSelectedButton#misc#hide ();
- dialog#uriChoiceAutoButton#misc#hide ();
- dialog#uriChoiceConstantsButton#misc#hide ();
- dialog#uriChoiceTreeView#selection#set_mode
- (`SINGLE :> Gtk.Tags.selection_mode);
- let model = new stringListModel dialog#uriChoiceTreeView in
- let choices = ref None in
- dialog#uriChoiceDialog#set_title title;
- let hack_len = MatitaGtkMisc.utf8_string_length text in
- let rec colorize acc_len = function
- | [] ->
- let floc = HExtlib.floc_of_loc (acc_len,hack_len) in
- escape_pango_markup (fst(MatitaGtkMisc.utf8_parsed_text text floc))
- | he::tl ->
- let start, stop = HExtlib.loc_of_floc he in
- let floc1 = HExtlib.floc_of_loc (acc_len,start) in
- let str1,_=MatitaGtkMisc.utf8_parsed_text text floc1 in
- let str2,_ = MatitaGtkMisc.utf8_parsed_text text he in
- escape_pango_markup str1 ^ "<b>" ^
- escape_pango_markup str2 ^ "</b>" ^
- colorize stop tl
- in
+ GtkThread.sync (fun _ ->
+ let dialog = new uriChoiceDialog () in
+ dialog#uriEntryHBox#misc#hide ();
+ dialog#uriChoiceSelectedButton#misc#hide ();
+ dialog#uriChoiceAutoButton#misc#hide ();
+ dialog#uriChoiceConstantsButton#misc#hide ();
+ dialog#uriChoiceTreeView#selection#set_mode
+ (`SINGLE :> Gtk.Tags.selection_mode);
+ let model = new stringListModel dialog#uriChoiceTreeView in
+ let choices = ref [] in
+ dialog#uriChoiceDialog#set_title title;
+ let hack_len = MatitaGtkMisc.utf8_string_length text in
+ let rec colorize acc_len = function
+ | [] ->
+ let floc = HExtlib.floc_of_loc (acc_len,hack_len) in
+ escape_pango_markup (fst(MatitaGtkMisc.utf8_parsed_text text floc))
+ | he::tl ->
+ let start, stop = HExtlib.loc_of_floc he in
+ let floc1 = HExtlib.floc_of_loc (acc_len,start) in
+ let str1,_=MatitaGtkMisc.utf8_parsed_text text floc1 in
+ let str2,_ = MatitaGtkMisc.utf8_parsed_text text he in
+ escape_pango_markup str1 ^ "<b>" ^
+ escape_pango_markup str2 ^ "</b>" ^
+ colorize stop tl
+ in
(* List.iter (fun l -> let start, stop = HExtlib.loc_of_floc l in
- Printf.eprintf "(%d,%d)" start stop) locs; *)
- let locs =
- List.sort
- (fun loc1 loc2 ->
- fst (HExtlib.loc_of_floc loc1) - fst (HExtlib.loc_of_floc loc2))
- locs
- in
+ Printf.eprintf "(%d,%d)" start stop) locs; *)
+ let locs =
+ List.sort
+ (fun loc1 loc2 ->
+ fst (HExtlib.loc_of_floc loc1) - fst (HExtlib.loc_of_floc loc2))
+ locs
+ in
(* prerr_endline "XXXXXXXXXXXXXXXXXXXX";
- List.iter (fun l -> let start, stop = HExtlib.loc_of_floc l in
- Printf.eprintf "(%d,%d)" start stop) locs;
- prerr_endline "XXXXXXXXXXXXXXXXXXXX2"; *)
- dialog#uriChoiceLabel#set_use_markup true;
- let txt = colorize 0 locs in
- let txt,_ = MatitaGtkMisc.utf8_parsed_text txt
- (HExtlib.floc_of_loc (prefix_len,MatitaGtkMisc.utf8_string_length txt))
- in
- dialog#uriChoiceLabel#set_label txt;
- List.iter model#easy_append uris;
- let return v =
- choices := v;
- dialog#uriChoiceDialog#destroy ();
- GMain.Main.quit ()
- in
- ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
- connect_button dialog#uriChoiceForwardButton (fun _ ->
- match model#easy_selection () with
- | [] -> ()
- | uris -> return (Some uris));
- connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
- dialog#uriChoiceDialog#show ();
- GtkThread.main ();
- (match !choices with
- | None -> raise MatitaTypes.Cancel
- | Some uris -> uris)
+ List.iter (fun l -> let start, stop = HExtlib.loc_of_floc l in
+ Printf.eprintf "(%d,%d)" start stop) locs;
+ prerr_endline "XXXXXXXXXXXXXXXXXXXX2"; *)
+ dialog#uriChoiceLabel#set_use_markup true;
+ let txt = colorize 0 locs in
+ let txt,_ = MatitaGtkMisc.utf8_parsed_text txt
+ (HExtlib.floc_of_loc (prefix_len,MatitaGtkMisc.utf8_string_length txt))
+ in
+ dialog#uriChoiceLabel#set_label txt;
+ List.iter model#easy_append uris;
+ connect_button dialog#uriChoiceForwardButton (fun _ ->
+ match model#easy_selection () with
+ | [] -> ()
+ | uris -> choices := uris; dialog#toplevel#response `OK);
+ connect_button dialog#uriChoiceAbortButton (fun _ -> dialog#toplevel#response `DELETE_EVENT);
+ dialog#uriChoiceDialog#show ();
+ let res =
+ match dialog#toplevel#run () with
+ | `DELETE_EVENT -> dialog#toplevel#destroy() ; raise MatitaTypes.Cancel
+ | `OK -> !choices
+ | _ -> assert false in
+ dialog#toplevel#destroy () ;
+ res) ()
let interactive_interp_choice () text prefix_len choices =
(*List.iter (fun l -> prerr_endline "==="; List.iter (fun (_,id,dsc) -> prerr_endline (id ^ " = " ^ dsc)) l) choices;*)
let _ =
(* disambiguator callbacks *)
Disambiguate.set_choose_uris_callback
- (fun ~selection_mode ?ok ?(enable_button_for_non_vars=false) ~title ~msg ->
+ (fun ~selection_mode ?ok ?enable_button_for_non_vars:(_=false) ~title ~msg ->
interactive_uri_choice ~selection_mode ?ok_label:ok ~title ~msg ());
Disambiguate.set_choose_interp_callback (interactive_interp_choice ());
(* gtk initialization *)
- GtkMain.Rc.add_default_file BuildTimeConf.gtkrc_file; (* loads gtk rc *)
- ignore (GMain.Main.init ())
-
+ GtkMain.Rc.add_default_file BuildTimeConf.gtkrc_file (* loads gtk rc *)