- added support for -debug, which avoid catching top level exceptions (still useless...

[helm.git] / helm / matita / matita.ml

diff --git a/helm/matita/matita.ml b/helm/matita/matita.ml
index b9019a035bf809c0be3871750c5c76cd7ac9f3c3..bc06a56e50c6e3c1edc4efecd8e316fda4afc321 100644 (file)
--- a/helm/matita/matita.ml
+++ b/helm/matita/matita.ml
@@ -91,17 +91,14 @@ let _ =
     | Incomplete_proof ((proof, goal) as status) ->
         sequents_viewer#load_sequents status;
         sequents_viewer#goto_sequent goal
-    | Proof proof -> 
-        sequents_viewer#load_logo_with_qed
-    | No_proof -> 
-        sequents_viewer#load_logo
-    | Intermediate _ -> 
-        assert false (* only the engine may be in this state *)
+    | Proof proof -> sequents_viewer#load_logo_with_qed
+    | No_proof -> sequents_viewer#load_logo
+    | Intermediate _ -> assert false (* only the engine may be in this state *)
   in
   script#addObserver sequents_observer;
   script#addObserver browser_observer
 
-  (** <DEBUGGING> *)
+  (** {{{ Debugging *)
 let _ =
   if BuildTimeConf.debug then begin
     gui#main#debugMenu#misc#show ();
@@ -139,7 +136,7 @@ let _ =
     addDebugItem "dump metasenv"
       (fun _ ->
          if script#onGoingProof () then
-           MatitaLog.debug (CicMetaSubst.ppmetasenv script#proofMetasenv []));
+           MatitaLog.debug (CicMetaSubst.ppmetasenv [] script#proofMetasenv));
     addDebugItem "dump coercions Db" (fun _ ->
       List.iter
         (fun (s,t,u) -> 
@@ -149,34 +146,66 @@ let _ =
         (CoercDb.to_list ()));
     addDebugItem "print top-level grammar entries"
       CicNotationParser.print_l2_pattern;
+    addDebugItem "dump moo to stderr" (fun _ ->
+      let status = (MatitaScript.instance ())#status in
+      List.iter (fun cmd -> prerr_endline
+        (GrafiteAstPp.pp_command cmd)) (List.rev status.moo_content_rev));
     addDebugItem "rotate light bulbs"
       (fun _ ->
          let nb = gui#main#hintNotebook in
          nb#goto_page ((nb#current_page + 1) mod 3));
   end
+  (** Debugging }}} *)
 
-  (** </DEBUGGING> *)
+  (** {2 Command line parsing} *)
+
+let debug = ref false
+let args = ref []
+let add_arg arg = args := arg :: !args
+
+let arg_spec =
+  let std_arg_spec = [] in
+  let debug_arg_spec =
+    if BuildTimeConf.debug then
+      [ "-debug", Arg.Set debug,
+        "Do not catch top-level exception (useful for backtrace inspection)"; ]
+    else []
+  in
+  std_arg_spec @ debug_arg_spec
+
+let usage () =
+  let heading = sprintf "Matita v%s\nUsage: " BuildTimeConf.version in
+  if Helm_registry.get "matita.mode" = "cicbrowser" then
+    heading ^ "cicbrowser [ URL | Whelp query ]\nOptions:"
+  else
+    heading ^  "matita [ FILE ]"
+
+let set_matita_mode () =
+  let matita_mode =
+    if Filename.basename Sys.argv.(0) = "cicbrowser"
+    then "cicbrowser"
+    else "matita"
+  in
+  Helm_registry.set "matita.mode" matita_mode
+
+  (** {2 Main} *)
 
 let _ =
+  set_matita_mode ();
+  Arg.parse arg_spec add_arg (usage ());
+  Helm_registry.set_bool "matita.catch_top_level_exn" (not !debug);
   at_exit (fun () -> print_endline "\nThanks for using Matita!\n");
   Sys.catch_break true;
-  if Filename.basename Sys.argv.(0) = "cicbrowser" then begin (* cicbrowser *)
-    Helm_registry.set "matita.mode" "cicbrowser";
+  if Helm_registry.get "matita.mode" = "cicbrowser" then  (* cicbrowser *)
     let browser = MatitaMathView.cicBrowser () in
-    let entry =
-      try
-        `Uri (UriManager.uri_of_string Sys.argv.(1))
-      with Invalid_argument _ -> `Dir "cic:/"
-    in
-    browser#load entry
-  end else begin  (* matita *)
-    Helm_registry.set "matita.mode" "matita";
-    (try
-       gui#loadScript Sys.argv.(1);
-     with Invalid_argument _ -> ());
+    let uri = match !args with [] -> "cic:/" | _ -> String.concat " " !args in
+    browser#loadInput uri
+  else begin  (* matita *)
+    (try gui#loadScript (List.hd !args) with Failure _ -> ());
     gui#main#mainWin#show ();
   end;
   try
     GtkThread.main ()
   with Sys.Break -> ()
 
+(* vim:set foldmethod=marker: *)