]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/matita/matitaGui.ml
coercion command now requires an uri
[helm.git] / helm / matita / matitaGui.ml
index d4157677feabd3573bae00edf5c4d84d52795c3d..5aa3d59e9c69edb491a4bd3c0189d33d16cf6489 100644 (file)
@@ -29,6 +29,8 @@ open MatitaGeneratedGui
 open MatitaGtkMisc
 open MatitaMisc
 
+exception Found of int
+
 let gui_instance = ref None
 
 class type browserWin =
@@ -51,7 +53,7 @@ class console ~(buffer: GText.buffer) () =
     method debug s   = buffer#insert ~iter:buffer#end_iter ~tags:[debug_tag] s
     method clear () =
       buffer#delete ~start:buffer#start_iter ~stop:buffer#end_iter
-    method log_callback (tag: MatitaLog.log_tag) s =
+    method log_callback (tag: HLog.log_tag) s =
       match tag with
       | `Debug -> self#debug (s ^ "\n")
       | `Error -> self#error (s ^ "\n")
@@ -61,27 +63,30 @@ class console ~(buffer: GText.buffer) () =
         
 let clean_current_baseuri status = 
     try  
-      let baseuri = MatitaTypes.get_string_option status "baseuri" in
-      MatitacleanLib.clean_baseuris [baseuri]
-    with MatitaTypes.Option_error _ -> ()
+      let baseuri = GrafiteTypes.get_string_option status "baseuri" in
+      let basedir = Helm_registry.get "matita.basedir" in
+      LibraryClean.clean_baseuris ~basedir [baseuri]
+    with GrafiteTypes.Option_error _ -> ()
 
 let ask_and_save_moo_if_needed parent fname status = 
+  let basedir = Helm_registry.get "matita.basedir" in
+  let baseuri = GrafiteParserMisc.baseuri_of_script ~include_paths:[] fname in
+  let moo_fname = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
   let save () =
-    let moo_fname = MatitacleanLib.obj_file_of_script fname in
-    MatitaMoo.save_moo moo_fname status.MatitaTypes.moo_content_rev in
+    let metadata_fname= LibraryMisc.metadata_file_of_baseuri ~basedir ~baseuri in
+    GrafiteMarshal.save_moo moo_fname status.GrafiteTypes.moo_content_rev;
+    LibraryNoDb.save_metadata metadata_fname status.GrafiteTypes.metadata
+  in
   if (MatitaScript.current ())#eos &&
-     status.MatitaTypes.proof_status = MatitaTypes.No_proof
+     status.GrafiteTypes.proof_status = GrafiteTypes.No_proof
   then
     begin
-      let mooname = 
-        MatitacleanLib.obj_file_of_script fname
-      in
       let rc = 
         MatitaGtkMisc.ask_confirmation
         ~title:"A .moo can be generated"
         ~message:(Printf.sprintf 
           "%s can be generated for %s.\n<i>Should I generate it?</i>"
-          (Filename.basename mooname) (Filename.basename fname))
+          (Filename.basename moo_fname) (Filename.basename fname))
         ~parent ()
       in
       let b = 
@@ -91,7 +96,7 @@ let ask_and_save_moo_if_needed parent fname status =
         | `CANCEL -> raise MatitaTypes.Cancel 
       in
       if b then
-        save ()
+          save ()
       else
         clean_current_baseuri status
     end
@@ -102,9 +107,19 @@ let ask_unsaved parent =
   MatitaGtkMisc.ask_confirmation 
     ~parent ~title:"Unsaved work!" 
     ~message:("Your work is <b>unsaved</b>!\n\n"^
-         "<i>Do you want to save the script before exiting?</i>")
+         "<i>Do you want to save the script before continuing?</i>")
     ()
 
+(** Selection handling
+ * Two clipboards are used: "clipboard" and "primary".
+ * "primary" is used by X, when you hit the middle button mouse is content is
+ *    pasted between applications. In Matita this selection always contain the
+ *    textual version of the selected term.
+ * "clipboard" is used inside Matita only and support ATM two different targets:
+ *    "TERM" and "PATTERN", in the future other targets like "MATHMLCONTENT" may
+ *    be added
+ *)
+
 class gui () =
     (* creation order _is_ relevant for windows placement *)
   let main = new mainWin () in
@@ -137,6 +152,9 @@ class gui () =
     val mutable script_fname = None
     val mutable font_size = default_font_size
     val mutable next_devel_must_contain = None
+    val mutable next_ligatures = []
+    val clipboard = GData.clipboard Gdk.Atom.clipboard
+    val primary = GData.clipboard Gdk.Atom.primary
    
     initializer
         (* glade's check widgets *)
@@ -304,8 +322,32 @@ class gui () =
          let undoMenuItem, redoMenuItem =
           match menuItems with
              [undo;redo;sep1;cut;copy;paste;delete;sep2;
-              selectall;sep3;inputmethod;insertunicodecharacter] -> undo,redo
+              selectall;sep3;inputmethod;insertunicodecharacter] ->
+                List.iter menu#remove [ copy; cut; delete; paste ];
+                undo,redo
            | _ -> assert false in
+         let add_menu_item =
+           let i = ref 2 in (* last occupied position *)
+           fun ?label ?stock () ->
+             incr i;
+             GMenu.image_menu_item ?label ?stock ~packing:(menu#insert ~pos:!i)
+              ()
+         in
+         let copy = add_menu_item ~stock:`COPY () in
+         let cut = add_menu_item ~stock:`CUT () in
+         let delete = add_menu_item ~stock:`DELETE () in
+         let paste = add_menu_item ~stock:`PASTE () in
+         let paste_pattern = add_menu_item ~label:"Paste as pattern" () in
+         copy#misc#set_sensitive self#canCopy;
+         cut#misc#set_sensitive self#canCut;
+         delete#misc#set_sensitive self#canDelete;
+         paste#misc#set_sensitive self#canPaste;
+         paste_pattern#misc#set_sensitive self#canPastePattern;
+         connect_menu_item copy self#copy;
+         connect_menu_item cut self#cut;
+         connect_menu_item delete self#delete;
+         connect_menu_item paste self#paste;
+         connect_menu_item paste_pattern self#pastePattern;
          let new_undoMenuItem =
           GMenu.image_menu_item
            ~image:(GMisc.image ~stock:`UNDO ())
@@ -326,40 +368,24 @@ class gui () =
           (redoMenuItem#misc#get_flag `SENSITIVE);
           menu#remove (redoMenuItem :> GMenu.menu_item);
           connect_menu_item new_redoMenuItem safe_redo));
-      let clipboard = GData.clipboard Gdk.Atom.clipboard in
-      let text_selected () =
-        (source_buffer#get_iter_at_mark `INSERT)#compare
-          (source_buffer#get_iter_at_mark `SEL_BOUND) <> 0
-      in
-      let markup_selected () = MatitaMathView.get_selections () <> None in
+
       connect_menu_item main#editMenu (fun () ->
-        let text_selected = text_selected () in
-        let markup_selected = markup_selected () in
-        let something_selected = text_selected || markup_selected in
-        main#cutMenuItem#misc#set_sensitive text_selected;
-        main#copyMenuItem#misc#set_sensitive something_selected;
-        main#deleteMenuItem#misc#set_sensitive text_selected;
-        main#pasteMenuItem#misc#set_sensitive (clipboard#text <> None));
-      connect_menu_item main#cutMenuItem (fun () ->
-        source_view#buffer#cut_clipboard clipboard);
-      connect_menu_item main#copyMenuItem (fun () ->
-        if text_selected () then
-          source_view#buffer#copy_clipboard clipboard
-        else if markup_selected () then
-          match MatitaMathView.get_selections () with
-          | None
-          | Some [] -> ()
-          | Some (s :: _) -> clipboard#set_text s);
-      connect_menu_item main#pasteMenuItem (fun () ->
-        source_view#buffer#paste_clipboard clipboard;
-        (MatitaScript.current ())#clean_dirty_lock);
-      connect_menu_item main#deleteMenuItem (fun () ->
-        ignore (source_view#buffer#delete_selection ()));
+        main#copyMenuItem#misc#set_sensitive self#canCopy;
+        main#cutMenuItem#misc#set_sensitive self#canCut;
+        main#deleteMenuItem#misc#set_sensitive self#canDelete;
+        main#pasteMenuItem#misc#set_sensitive self#canPaste;
+        main#pastePatternMenuItem#misc#set_sensitive self#canPastePattern);
+      connect_menu_item main#copyMenuItem self#copy;
+      connect_menu_item main#cutMenuItem self#cut;
+      connect_menu_item main#deleteMenuItem self#delete;
+      connect_menu_item main#pasteMenuItem self#paste;
+      connect_menu_item main#pastePatternMenuItem self#pastePattern;
       connect_menu_item main#selectAllMenuItem (fun () ->
         source_buffer#move_mark `INSERT source_buffer#start_iter;
         source_buffer#move_mark `SEL_BOUND source_buffer#end_iter);
       connect_menu_item main#findReplMenuItem show_find_Repl;
       connect_menu_item main#externalEditorMenuItem self#externalEditor;
+      connect_menu_item main#ligatureButton self#nextLigature;
       ignore (findRepl#findEntry#connect#activate find_forward);
         (* interface lockers *)
       let lock_world _ =
@@ -435,7 +461,6 @@ class gui () =
         (fun () -> develList#toplevel#misc#hide());
       ignore(develList#toplevel#event#connect#delete 
         (fun _ -> develList#toplevel#misc#hide();true));
-      let selected_devel = ref None in
       connect_menu_item main#developmentsMenuItem
         (fun () -> refresh_devels_win ();develList#toplevel#misc#show ());
       
@@ -468,7 +493,7 @@ class gui () =
               newDevel#toplevel#misc#hide()
             end
           else
-            MatitaLog.error ("The selected root does not contain " ^ 
+            HLog.error ("The selected root does not contain " ^ 
               match next_devel_must_contain with 
               | Some x -> x 
               | _ -> assert false));
@@ -566,17 +591,46 @@ class gui () =
         ~check:main#fullscreenMenuItem;
       main#fullscreenMenuItem#set_active false;
         (* log *)
-      MatitaLog.set_log_callback self#console#log_callback;
+      HLog.set_log_callback self#console#log_callback;
       GtkSignal.user_handler :=
         (fun exn ->
           if not (Helm_registry.get_bool "matita.debug") then
-            MatitaLog.error (MatitaExcPp.to_string exn)
+           let floc, msg = MatitaExcPp.to_string exn in
+            begin
+             match floc with
+                None -> ()
+              | Some floc ->
+                 let (x, y) = HExtlib.loc_of_floc floc in
+                 let script = MatitaScript.current () in
+                 let locked_mark = script#locked_mark in
+                 let error_tag = script#error_tag in
+                 let baseoffset =
+                  (source_buffer#get_iter_at_mark (`MARK locked_mark))#offset in
+                 let x' = baseoffset + x in
+                 let y' = baseoffset + y in
+                 let x_iter = source_buffer#get_iter (`OFFSET x') in
+                 let y_iter = source_buffer#get_iter (`OFFSET y') in
+                 source_buffer#apply_tag error_tag ~start:x_iter ~stop:y_iter;
+                 let id = ref None in
+                 id := Some (source_buffer#connect#changed ~callback:(fun () ->
+                   source_buffer#remove_tag error_tag
+                     ~start:source_buffer#start_iter
+                     ~stop:source_buffer#end_iter;
+                   match !id with
+                   | None -> assert false (* a race condition occurred *)
+                   | Some id ->
+                       (new GObj.gobject_ops source_buffer#as_buffer)#disconnect id));
+                 source_buffer#place_cursor
+                  (source_buffer#get_iter (`OFFSET x'));
+            end;
+            HLog.error msg
           else raise exn);
         (* script *)
+      ignore (source_buffer#connect#mark_set (fun _ _ -> next_ligatures <- []));
       let _ =
         match GSourceView.source_language_from_file BuildTimeConf.lang_file with
         | None ->
-            MatitaLog.warn (sprintf "can't load language file %s"
+            HLog.warn (sprintf "can't load language file %s"
               BuildTimeConf.lang_file)
         | Some matita_lang ->
             source_buffer#set_language matita_lang;
@@ -605,34 +659,35 @@ class gui () =
               (s ())#saveToFile ();
               console#message ("'"^f^"' saved.\n");
       in
+      let abandon_script () =
+        let status = (s ())#status in
+        if source_view#buffer#modified then
+          (match ask_unsaved main#toplevel with
+          | `YES -> saveScript ()
+          | `NO -> ()
+          | `CANCEL -> raise MatitaTypes.Cancel);
+        (match script_fname with
+        | None -> ()
+        | Some fname -> ask_and_save_moo_if_needed main#toplevel fname status);
+      in
       let loadScript () =
         let script = s () in 
-        let status = script#status in
         try 
           match self#chooseFile () with
           | Some f -> 
-                if source_view#buffer#modified then
-                  begin
-                    match ask_unsaved main#toplevel with
-                    | `YES -> saveScript ()
-                    | `NO -> ()
-                    | `CANCEL -> raise MatitaTypes.Cancel
-                  end;
-                (match script_fname with
-                | None -> ()
-                | Some fname -> 
-                    ask_and_save_moo_if_needed main#toplevel fname status);
-                script#reset (); 
-                script#assignFileName f;
-                source_view#source_buffer#begin_not_undoable_action ();
-                script#loadFromFile f; 
-                source_view#source_buffer#end_not_undoable_action ();
-                console#message ("'"^f^"' loaded.\n");
-                self#_enableSaveTo f
+              abandon_script ();
+              script#reset (); 
+              script#assignFileName f;
+              source_view#source_buffer#begin_not_undoable_action ();
+              script#loadFromFile f; 
+              source_view#source_buffer#end_not_undoable_action ();
+              console#message ("'"^f^"' loaded.\n");
+              self#_enableSaveTo f
           | None -> ()
         with MatitaTypes.Cancel -> ()
       in
       let newScript () = 
+        abandon_script ();
         source_view#source_buffer#begin_not_undoable_action ();
         (s ())#reset (); 
         (s ())#template (); 
@@ -695,25 +750,16 @@ class gui () =
       connect_button main#scriptRetractButton retract;
       connect_button main#scriptTopButton top;
       connect_button main#scriptBottomButton bottom;
-      connect_key GdkKeysyms._Down advance;
-      connect_key GdkKeysyms._Up retract;
-      connect_key GdkKeysyms._Home top;
-      connect_key GdkKeysyms._End bottom;
       connect_button main#scriptJumpButton jump;
+      connect_menu_item main#scriptAdvanceMenuItem advance;
+      connect_menu_item main#scriptRetractMenuItem retract;
+      connect_menu_item main#scriptTopMenuItem top;
+      connect_menu_item main#scriptBottomMenuItem bottom;
+      connect_menu_item main#scriptJumpMenuItem jump;
       connect_menu_item main#openMenuItem   loadScript;
       connect_menu_item main#saveMenuItem   saveScript;
       connect_menu_item main#saveAsMenuItem saveAsScript;
       connect_menu_item main#newMenuItem    newScript;
-      connect_key GdkKeysyms._period
-        (fun () ->
-          source_buffer#insert ~iter:(source_buffer#get_iter_at_mark `INSERT)
-            ".\n";
-          advance ());
-      connect_key GdkKeysyms._Return
-        (fun () ->
-          source_buffer#insert ~iter:(source_buffer#get_iter_at_mark `INSERT)
-            "\n";
-          advance ());
          (* script monospace font stuff *)  
       self#updateFontSize ();
         (* debug menu *)
@@ -774,7 +820,96 @@ class gui () =
         MatitaMathView.reset_font_size ();
         MatitaMathView.update_font_sizes ());
       MatitaMathView.reset_font_size ();
+
+      (** selections / clipboards handling *)
+
+    method private markup_selected = MatitaMathView.has_selection ()
+    method private text_selected =
+      (source_buffer#get_iter_at_mark `INSERT)#compare
+        (source_buffer#get_iter_at_mark `SEL_BOUND) <> 0
+    method private something_selected =
+      self#markup_selected || self#text_selected
+    method private markup_stored = MatitaMathView.has_clipboard ()
+    method private text_stored = clipboard#text <> None
+    method private something_stored = self#markup_stored || self#text_stored
+
+    method canCopy = self#something_selected
+    method canCut = self#text_selected
+    method canDelete = self#text_selected
+    method canPaste = self#something_stored
+    method canPastePattern = self#markup_stored
+
+    method copy () =
+      if self#text_selected
+      then begin
+        MatitaMathView.empty_clipboard ();
+        source_view#buffer#copy_clipboard clipboard;
+      end else
+        MatitaMathView.copy_selection ()
+    method cut () =
+      source_view#buffer#cut_clipboard clipboard;
+      MatitaMathView.empty_clipboard ()
+    method delete () = ignore (source_view#buffer#delete_selection ())
+    method paste () =
+      if MatitaMathView.has_clipboard ()
+      then source_view#buffer#insert (MatitaMathView.paste_clipboard `Term)
+      else source_view#buffer#paste_clipboard clipboard;
+      (MatitaScript.current ())#clean_dirty_lock
+    method pastePattern () =
+      source_view#buffer#insert (MatitaMathView.paste_clipboard `Pattern)
     
+    method private nextLigature () =
+      let iter = source_buffer#get_iter_at_mark `INSERT in
+      let write_ligature len s =
+        source_buffer#delete ~start:iter ~stop:(iter#copy#backward_chars len);
+        source_buffer#insert ~iter:(source_buffer#get_iter_at_mark `INSERT) s
+      in
+      let get_ligature word =
+        let len = String.length word in
+        let aux_tex () =
+          try
+            for i = len - 1 downto 0 do
+              if HExtlib.is_alpha word.[i] then ()
+              else
+                (if word.[i] = '\\' then raise (Found i) else raise (Found ~-1))
+            done;
+            None
+          with Found i ->
+            if i = ~-1 then None else Some (String.sub word i (len - i))
+        in
+        let aux_ligature () =
+          try
+            for i = len - 1 downto 0 do
+              if CicNotationLexer.is_ligature_char word.[i] then ()
+              else raise (Found (i+1))
+            done;
+            raise (Found 0)
+          with
+          | Found i ->
+              (try
+                Some (String.sub word i (len - i))
+              with Invalid_argument _ -> None)
+        in
+        match aux_tex () with
+        | Some macro -> macro
+        | None -> (match aux_ligature () with Some l -> l | None -> word)
+      in
+      (match next_ligatures with
+      | [] -> (* find ligatures and fill next_ligatures, then try again *)
+          let last_word =
+            iter#get_slice
+              ~stop:(iter#copy#backward_find_char Glib.Unichar.isspace)
+          in
+          let ligature = get_ligature last_word in
+          (match CicNotationLexer.lookup_ligatures ligature with
+          | [] -> ()
+          | hd :: tl ->
+              write_ligature (String.length ligature) hd;
+              next_ligatures <- tl @ [ hd ])
+      | hd :: tl ->
+          write_ligature 1 hd;
+          next_ligatures <- tl @ [ hd ])
+
     method private externalEditor () =
       let cmd = Helm_registry.get "matita.external_editor" in
 (* ZACK uncomment to enable interactive ask of external editor command *)
@@ -1001,7 +1136,6 @@ let interactive_uri_choice
       (selection_mode :> Gtk.Tags.selection_mode);
     let model = new stringListModel dialog#uriChoiceTreeView in
     let choices = ref None in
-    let nonvars = ref false in
     (match copy_cb with
     | None -> ()
     | Some cb ->
@@ -1097,7 +1231,6 @@ let interactive_interp_choice () choices =
   assert (choices <> []);
   let dialog = gui#newRecordDialog () in
   let model = new interpModel dialog#recordChoiceTreeView choices in
-  let interp_len = List.length (List.hd choices) in
   dialog#recordChoiceDialog#set_title "Interpretation choice";
   dialog#recordChoiceDialogLabel#set_label "Choose an interpretation:";
   let interp_no = ref None in