matita/matitaGui.ml

   1 (* Copyright (C) 2004-2005, HELM Team.
   2  *
   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.
   6  *
   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.
  11  *
  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.
  16  *
  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,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://helm.cs.unibo.it/
  24  *)
  25
  26 (* $Id$ *)
  27
  28 open Printf
  29
  30 open MatitaGeneratedGui
  31 open MatitaGtkMisc
  32 open MatitaMisc
  33
  34 exception Found of int
  35
  36 let gui_instance = ref None
  37
  38 class type browserWin =
  39   (* this class exists only because GEdit.combo_box_entry is not supported by
  40    * lablgladecc :-(((( *)
  41 object
  42   inherit MatitaGeneratedGui.browserWin
  43   method browserUri: GEdit.combo_box_entry
  44 end
  45
  46 class console ~(buffer: GText.buffer) () =
  47   object (self)
  48     val error_tag   = buffer#create_tag [ `FOREGROUND "red" ]
  49     val warning_tag = buffer#create_tag [ `FOREGROUND "orange" ]
  50     val message_tag = buffer#create_tag []
  51     val debug_tag   = buffer#create_tag [ `FOREGROUND "#888888" ]
  52     method message s = buffer#insert ~iter:buffer#end_iter ~tags:[message_tag] s
  53     method error s   = buffer#insert ~iter:buffer#end_iter ~tags:[error_tag] s
  54     method warning s = buffer#insert ~iter:buffer#end_iter ~tags:[warning_tag] s
  55     method debug s   = buffer#insert ~iter:buffer#end_iter ~tags:[debug_tag] s
  56     method clear () =
  57       buffer#delete ~start:buffer#start_iter ~stop:buffer#end_iter
  58     method log_callback (tag: HLog.log_tag) s =
  59       match tag with
  60       | `Debug -> self#debug (s ^ "\n")
  61       | `Error -> self#error (s ^ "\n")
  62       | `Message -> self#message (s ^ "\n")
  63       | `Warning -> self#warning (s ^ "\n")
  64   end
  65
  66 let clean_current_baseuri grafite_status =
  67     try
  68       let baseuri = GrafiteTypes.get_string_option grafite_status "baseuri" in
  69       let basedir = Helm_registry.get "matita.basedir" in
  70       LibraryClean.clean_baseuris ~basedir [baseuri]
  71     with GrafiteTypes.Option_error _ -> ()
  72
  73 let ask_and_save_moo_if_needed parent fname lexicon_status grafite_status =
  74   let basedir = Helm_registry.get "matita.basedir" in
  75   let baseuri = DependenciesParser.baseuri_of_script ~include_paths:[] fname in
  76   let moo_fname = LibraryMisc.obj_file_of_baseuri ~basedir ~baseuri in
  77   let save () =
  78     let metadata_fname =
  79      LibraryMisc.metadata_file_of_baseuri ~basedir ~baseuri in
  80     let lexicon_fname =
  81      LibraryMisc.lexicon_file_of_baseuri ~basedir ~baseuri
  82     in
  83      GrafiteMarshal.save_moo moo_fname
  84       grafite_status.GrafiteTypes.moo_content_rev;
  85      LibraryNoDb.save_metadata metadata_fname
  86       lexicon_status.LexiconEngine.metadata;
  87      LexiconMarshal.save_lexicon lexicon_fname
  88       lexicon_status.LexiconEngine.lexicon_content_rev
  89   in
  90   if (MatitaScript.current ())#eos &&
  91      grafite_status.GrafiteTypes.proof_status = GrafiteTypes.No_proof
  92   then
  93     begin
  94       let rc =
  95         MatitaGtkMisc.ask_confirmation
  96         ~title:"A .moo can be generated"
  97         ~message:(Printf.sprintf
  98           "%s can be generated for %s.\n<i>Should I generate it?</i>"
  99           (Filename.basename moo_fname) (Filename.basename fname))
 100         ~parent ()
 101       in
 102       let b =
 103         match rc with
 104         | `YES -> true
 105         | `NO -> false
 106         | `CANCEL -> raise MatitaTypes.Cancel
 107       in
 108       if b then
 109           save ()
 110       else
 111         clean_current_baseuri grafite_status
 112     end
 113   else
 114     clean_current_baseuri grafite_status
 115
 116 let ask_unsaved parent =
 117   MatitaGtkMisc.ask_confirmation
 118     ~parent ~title:"Unsaved work!"
 119     ~message:("Your work is <b>unsaved</b>!\n\n"^
 120          "<i>Do you want to save the script before continuing?</i>")
 121     ()
 122
 123 (** Selection handling
 124  * Two clipboards are used: "clipboard" and "primary".
 125  * "primary" is used by X, when you hit the middle button mouse is content is
 126  *    pasted between applications. In Matita this selection always contain the
 127  *    textual version of the selected term.
 128  * "clipboard" is used inside Matita only and support ATM two different targets:
 129  *    "TERM" and "PATTERN", in the future other targets like "MATHMLCONTENT" may
 130  *    be added
 131  *)
 132
 133 class gui () =
 134     (* creation order _is_ relevant for windows placement *)
 135   let main = new mainWin () in
 136   let fileSel = new fileSelectionWin () in
 137   let findRepl = new findReplWin () in
 138   let develList = new develListWin () in
 139   let newDevel = new newDevelWin () in
 140   let keyBindingBoxes = (* event boxes which should receive global key events *)
 141     [ main#mainWinEventBox ]
 142   in
 143   let console = new console ~buffer:main#logTextView#buffer () in
 144   let (source_view: GSourceView.source_view) =
 145     GSourceView.source_view
 146       ~auto_indent:true
 147       ~insert_spaces_instead_of_tabs:true ~tabs_width:2
 148       ~margin:80 ~show_margin:true
 149       ~smart_home_end:true
 150       ~packing:main#scriptScrolledWin#add
 151       ()
 152   in
 153   let default_font_size =
 154     Helm_registry.get_opt_default Helm_registry.int
 155       ~default:BuildTimeConf.default_font_size "matita.font_size"
 156   in
 157   let source_buffer = source_view#source_buffer in
 158   object (self)
 159     val mutable chosen_file = None
 160     val mutable _ok_not_exists = false
 161     val mutable _only_directory = false
 162     val mutable script_fname = None
 163     val mutable font_size = default_font_size
 164     val mutable next_devel_must_contain = None
 165     val mutable next_ligatures = []
 166     val clipboard = GData.clipboard Gdk.Atom.clipboard
 167     val primary = GData.clipboard Gdk.Atom.primary
 168
 169     initializer
 170         (* glade's check widgets *)
 171       List.iter (fun w -> w#check_widgets ())
 172         (let c w = (w :> <check_widgets: unit -> unit>) in
 173         [ c fileSel; c main; c findRepl]);
 174         (* key bindings *)
 175       List.iter (* global key bindings *)
 176         (fun (key, callback) -> self#addKeyBinding key callback)
 177 (*
 178         [ GdkKeysyms._F3,
 179             toggle_win ~check:main#showProofMenuItem proof#proofWin;
 180           GdkKeysyms._F4,
 181             toggle_win ~check:main#showCheckMenuItem check#checkWin;
 182 *)
 183         [ ];
 184         (* about win *)
 185       let parse_txt_file file =
 186        let ch = open_in (BuildTimeConf.runtime_base_dir ^ "/" ^ file) in
 187        let l_rev = ref [] in
 188        try
 189         while true do
 190          l_rev := input_line ch :: !l_rev;
 191         done;
 192         assert false
 193        with
 194         End_of_file ->
 195          close_in ch;
 196          List.rev !l_rev in
 197       let about_dialog =
 198        GWindow.about_dialog
 199         ~authors:(parse_txt_file "AUTHORS")
 200         (*~comments:"comments"*)
 201         ~copyright:"Copyright (C) 2005, the HELM team"
 202         ~license:(String.concat "\n" (parse_txt_file "LICENSE"))
 203         ~logo:(GdkPixbuf.from_file (MatitaMisc.image_path "/matita_medium.png"))
 204         ~name:"Matita"
 205         ~version:BuildTimeConf.version
 206         ~website:"http://helm.cs.unibo.it"
 207         ()
 208       in
 209       connect_menu_item main#contentsMenuItem
 210        (fun () -> ignore (Sys.command "gnome-help ghelp:///home/claudio/miohelm/matita/help/C/matita.xml &"));
 211       connect_menu_item main#aboutMenuItem about_dialog#present;
 212         (* findRepl win *)
 213       let show_find_Repl () =
 214         findRepl#toplevel#misc#show ();
 215         findRepl#toplevel#misc#grab_focus ()
 216       in
 217       let hide_find_Repl () = findRepl#toplevel#misc#hide () in
 218       let find_forward _ =
 219           let highlight start end_ =
 220             source_buffer#move_mark `INSERT ~where:start;
 221             source_buffer#move_mark `SEL_BOUND ~where:end_;
 222             source_view#scroll_mark_onscreen `INSERT
 223           in
 224           let text = findRepl#findEntry#text in
 225           let iter = source_buffer#get_iter `SEL_BOUND in
 226           match iter#forward_search text with
 227           | None ->
 228               (match source_buffer#start_iter#forward_search text with
 229               | None -> ()
 230               | Some (start,end_) -> highlight start end_)
 231           | Some (start,end_) -> highlight start end_
 232       in
 233       let replace _ =
 234         let text = findRepl#replaceEntry#text in
 235         let ins = source_buffer#get_iter `INSERT in
 236         let sel = source_buffer#get_iter `SEL_BOUND in
 237         if ins#compare sel < 0 then
 238           begin
 239             ignore(source_buffer#delete_selection ());
 240             source_buffer#insert text
 241           end
 242       in
 243       connect_button findRepl#findButton find_forward;
 244       connect_button findRepl#findReplButton replace;
 245       connect_button findRepl#cancelButton (fun _ -> hide_find_Repl ());
 246       ignore(findRepl#toplevel#event#connect#delete
 247         ~callback:(fun _ -> hide_find_Repl ();true));
 248       let safe_undo =
 249        fun () ->
 250         (* phase 1: we save the actual status of the marks and we undo *)
 251         let locked_mark = `MARK ((MatitaScript.current ())#locked_mark) in
 252         let locked_iter = source_view#buffer#get_iter_at_mark locked_mark in
 253         let locked_iter_offset = locked_iter#offset in
 254         let mark2 =
 255          `MARK
 256            (source_view#buffer#create_mark ~name:"lock_point"
 257              ~left_gravity:true locked_iter) in
 258         source_view#source_buffer#undo ();
 259         (* phase 2: we save the cursor position and we redo, restoring
 260            the previous status of all the marks *)
 261         let cursor_iter = source_view#buffer#get_iter_at_mark `INSERT in
 262         let mark =
 263          `MARK
 264            (source_view#buffer#create_mark ~name:"undo_point"
 265              ~left_gravity:true cursor_iter)
 266         in
 267          source_view#source_buffer#redo ();
 268          let mark_iter = source_view#buffer#get_iter_at_mark mark in
 269          let mark2_iter = source_view#buffer#get_iter_at_mark mark2 in
 270          let mark2_iter = mark2_iter#set_offset locked_iter_offset in
 271           source_view#buffer#move_mark locked_mark ~where:mark2_iter;
 272           source_view#buffer#delete_mark mark;
 273           source_view#buffer#delete_mark mark2;
 274           (* phase 3: if after the undo the cursor was in the locked area,
 275              then we move it there again and we perform a goto *)
 276           if mark_iter#offset < locked_iter_offset then
 277            begin
 278             source_view#buffer#move_mark `INSERT ~where:mark_iter;
 279             (MatitaScript.current ())#goto `Cursor ();
 280            end;
 281           (* phase 4: we perform again the undo. This time we are sure that
 282              the text to undo is not locked *)
 283           source_view#source_buffer#undo ();
 284           source_view#misc#grab_focus () in
 285       let safe_redo =
 286        fun () ->
 287         (* phase 1: we save the actual status of the marks, we redo and
 288            we undo *)
 289         let locked_mark = `MARK ((MatitaScript.current ())#locked_mark) in
 290         let locked_iter = source_view#buffer#get_iter_at_mark locked_mark in
 291         let locked_iter_offset = locked_iter#offset in
 292         let mark2 =
 293          `MARK
 294            (source_view#buffer#create_mark ~name:"lock_point"
 295              ~left_gravity:true locked_iter) in
 296         source_view#source_buffer#redo ();
 297         source_view#source_buffer#undo ();
 298         (* phase 2: we save the cursor position and we restore
 299            the previous status of all the marks *)
 300         let cursor_iter = source_view#buffer#get_iter_at_mark `INSERT in
 301         let mark =
 302          `MARK
 303            (source_view#buffer#create_mark ~name:"undo_point"
 304              ~left_gravity:true cursor_iter)
 305         in
 306          let mark_iter = source_view#buffer#get_iter_at_mark mark in
 307          let mark2_iter = source_view#buffer#get_iter_at_mark mark2 in
 308          let mark2_iter = mark2_iter#set_offset locked_iter_offset in
 309           source_view#buffer#move_mark locked_mark ~where:mark2_iter;
 310           source_view#buffer#delete_mark mark;
 311           source_view#buffer#delete_mark mark2;
 312           (* phase 3: if after the undo the cursor is in the locked area,
 313              then we move it there again and we perform a goto *)
 314           if mark_iter#offset < locked_iter_offset then
 315            begin
 316             source_view#buffer#move_mark `INSERT ~where:mark_iter;
 317             (MatitaScript.current ())#goto `Cursor ();
 318            end;
 319           (* phase 4: we perform again the redo. This time we are sure that
 320              the text to redo is not locked *)
 321           source_view#source_buffer#redo ();
 322           source_view#misc#grab_focus ()
 323       in
 324       connect_menu_item main#undoMenuItem safe_undo;
 325       ignore(source_view#source_buffer#connect#can_undo
 326         ~callback:main#undoMenuItem#misc#set_sensitive);
 327       connect_menu_item main#redoMenuItem safe_redo;
 328       ignore(source_view#source_buffer#connect#can_redo
 329         ~callback:main#redoMenuItem#misc#set_sensitive);
 330       ignore(source_view#connect#after#populate_popup
 331        ~callback:(fun pre_menu ->
 332          let menu = new GMenu.menu pre_menu in
 333          let menuItems = menu#children in
 334          let undoMenuItem, redoMenuItem =
 335           match menuItems with
 336              [undo;redo;sep1;cut;copy;paste;delete;sep2;
 337               selectall;sep3;inputmethod;insertunicodecharacter] ->
 338                 List.iter menu#remove [ copy; cut; delete; paste ];
 339                 undo,redo
 340            | _ -> assert false in
 341          let add_menu_item =
 342            let i = ref 2 in (* last occupied position *)
 343            fun ?label ?stock () ->
 344              incr i;
 345              GMenu.image_menu_item ?label ?stock ~packing:(menu#insert ~pos:!i)
 346               ()
 347          in
 348          let copy = add_menu_item ~stock:`COPY () in
 349          let cut = add_menu_item ~stock:`CUT () in
 350          let delete = add_menu_item ~stock:`DELETE () in
 351          let paste = add_menu_item ~stock:`PASTE () in
 352          let paste_pattern = add_menu_item ~label:"Paste as pattern" () in
 353          copy#misc#set_sensitive self#canCopy;
 354          cut#misc#set_sensitive self#canCut;
 355          delete#misc#set_sensitive self#canDelete;
 356          paste#misc#set_sensitive self#canPaste;
 357          paste_pattern#misc#set_sensitive self#canPastePattern;
 358          connect_menu_item copy self#copy;
 359          connect_menu_item cut self#cut;
 360          connect_menu_item delete self#delete;
 361          connect_menu_item paste self#paste;
 362          connect_menu_item paste_pattern self#pastePattern;
 363          let new_undoMenuItem =
 364           GMenu.image_menu_item
 365            ~image:(GMisc.image ~stock:`UNDO ())
 366            ~use_mnemonic:true
 367            ~label:"_Undo"
 368            ~packing:(menu#insert ~pos:0) () in
 369          new_undoMenuItem#misc#set_sensitive
 370           (undoMenuItem#misc#get_flag `SENSITIVE);
 371          menu#remove (undoMenuItem :> GMenu.menu_item);
 372          connect_menu_item new_undoMenuItem safe_undo;
 373          let new_redoMenuItem =
 374           GMenu.image_menu_item
 375            ~image:(GMisc.image ~stock:`REDO ())
 376            ~use_mnemonic:true
 377            ~label:"_Redo"
 378            ~packing:(menu#insert ~pos:1) () in
 379          new_redoMenuItem#misc#set_sensitive
 380           (redoMenuItem#misc#get_flag `SENSITIVE);
 381           menu#remove (redoMenuItem :> GMenu.menu_item);
 382           connect_menu_item new_redoMenuItem safe_redo));
 383
 384       connect_menu_item main#editMenu (fun () ->
 385         main#copyMenuItem#misc#set_sensitive self#canCopy;
 386         main#cutMenuItem#misc#set_sensitive self#canCut;
 387         main#deleteMenuItem#misc#set_sensitive self#canDelete;
 388         main#pasteMenuItem#misc#set_sensitive self#canPaste;
 389         main#pastePatternMenuItem#misc#set_sensitive self#canPastePattern);
 390       connect_menu_item main#copyMenuItem self#copy;
 391       connect_menu_item main#cutMenuItem self#cut;
 392       connect_menu_item main#deleteMenuItem self#delete;
 393       connect_menu_item main#pasteMenuItem self#paste;
 394       connect_menu_item main#pastePatternMenuItem self#pastePattern;
 395       connect_menu_item main#selectAllMenuItem (fun () ->
 396         source_buffer#move_mark `INSERT source_buffer#start_iter;
 397         source_buffer#move_mark `SEL_BOUND source_buffer#end_iter);
 398       connect_menu_item main#findReplMenuItem show_find_Repl;
 399       connect_menu_item main#externalEditorMenuItem self#externalEditor;
 400       connect_menu_item main#ligatureButton self#nextLigature;
 401       ignore (findRepl#findEntry#connect#activate find_forward);
 402         (* interface lockers *)
 403       let lock_world _ =
 404         main#buttonsToolbar#misc#set_sensitive false;
 405         develList#buttonsHbox#misc#set_sensitive false;
 406         source_view#set_editable false
 407       in
 408       let unlock_world _ =
 409         main#buttonsToolbar#misc#set_sensitive true;
 410         develList#buttonsHbox#misc#set_sensitive true;
 411         source_view#set_editable true
 412       in
 413       let locker f =
 414         fun () ->
 415           lock_world ();
 416           try f ();unlock_world () with exc -> unlock_world (); raise exc in
 417       let keep_focus f =
 418         fun () ->
 419          try
 420           f (); source_view#misc#grab_focus ()
 421          with
 422           exc -> source_view#misc#grab_focus (); raise exc in
 423         (* developments win *)
 424       let model =
 425         new MatitaGtkMisc.multiStringListModel
 426           ~cols:2 develList#developmentsTreeview
 427       in
 428       let refresh_devels_win () =
 429         model#list_store#clear ();
 430         List.iter
 431           (fun (name, root) -> model#easy_mappend [name;root])
 432           (MatitamakeLib.list_known_developments ())
 433       in
 434       let get_devel_selected () =
 435         match model#easy_mselection () with
 436         | [[name;_]] -> MatitamakeLib.development_for_name name
 437         | _ -> None
 438       in
 439       let refresh () =
 440         while Glib.Main.pending () do
 441           ignore(Glib.Main.iteration false);
 442         done
 443       in
 444       connect_button develList#newButton
 445         (fun () ->
 446           next_devel_must_contain <- None;
 447           newDevel#toplevel#misc#show());
 448       connect_button develList#deleteButton
 449         (locker (fun () ->
 450           (match get_devel_selected () with
 451           | None -> ()
 452           | Some d -> MatitamakeLib.destroy_development_in_bg refresh d);
 453           refresh_devels_win ()));
 454       connect_button develList#buildButton
 455         (locker (fun () ->
 456           match get_devel_selected () with
 457           | None -> ()
 458           | Some d ->
 459               let build = locker
 460                 (fun () -> MatitamakeLib.build_development_in_bg refresh d)
 461               in
 462               ignore(build ())));
 463       connect_button develList#cleanButton
 464         (locker (fun () ->
 465           match get_devel_selected () with
 466           | None -> ()
 467           | Some d ->
 468               let clean = locker
 469                 (fun () -> MatitamakeLib.clean_development_in_bg refresh d)
 470               in
 471               ignore(clean ())));
 472       connect_button develList#closeButton
 473         (fun () -> develList#toplevel#misc#hide());
 474       ignore(develList#toplevel#event#connect#delete
 475         (fun _ -> develList#toplevel#misc#hide();true));
 476       connect_menu_item main#developmentsMenuItem
 477         (fun () -> refresh_devels_win ();develList#toplevel#misc#show ());
 478
 479         (* add development win *)
 480       let check_if_root_contains root =
 481         match next_devel_must_contain with
 482         | None -> true
 483         | Some path ->
 484             let is_prefix_of d1 d2 =
 485               let len1 = String.length d1 in
 486               let len2 = String.length d2 in
 487               if len2 < len1 then
 488                 false
 489               else
 490                 let pref = String.sub d2 0 len1 in
 491                 pref = d1
 492             in
 493             is_prefix_of root path
 494       in
 495       connect_button newDevel#addButton
 496        (fun () ->
 497           let name = newDevel#nameEntry#text in
 498           let root = newDevel#rootEntry#text in
 499           if check_if_root_contains root then
 500             begin
 501               ignore (MatitamakeLib.initialize_development name root);
 502               refresh_devels_win ();
 503               newDevel#nameEntry#set_text "";
 504               newDevel#rootEntry#set_text "";
 505               newDevel#toplevel#misc#hide()
 506             end
 507           else
 508             HLog.error ("The selected root does not contain " ^
 509               match next_devel_must_contain with
 510               | Some x -> x
 511               | _ -> assert false));
 512       connect_button newDevel#chooseRootButton
 513        (fun () ->
 514          let path = self#chooseDir () in
 515          match path with
 516          | Some path -> newDevel#rootEntry#set_text path
 517          | None -> ());
 518       connect_button newDevel#cancelButton
 519        (fun () -> newDevel#toplevel#misc#hide ());
 520       ignore(newDevel#toplevel#event#connect#delete
 521         (fun _ -> newDevel#toplevel#misc#hide();true));
 522
 523         (* file selection win *)
 524       ignore (fileSel#fileSelectionWin#event#connect#delete (fun _ -> true));
 525       ignore (fileSel#fileSelectionWin#connect#response (fun event ->
 526         let return r =
 527           chosen_file <- r;
 528           fileSel#fileSelectionWin#misc#hide ();
 529           GMain.Main.quit ()
 530         in
 531         match event with
 532         | `OK ->
 533             let fname = fileSel#fileSelectionWin#filename in
 534             if Sys.file_exists fname then
 535               begin
 536                 if HExtlib.is_regular fname && not (_only_directory) then
 537                   return (Some fname)
 538                 else if _only_directory && HExtlib.is_dir fname then
 539                   return (Some fname)
 540               end
 541             else
 542               begin
 543                 if _ok_not_exists then
 544                   return (Some fname)
 545               end
 546         | `CANCEL -> return None
 547         | `HELP -> ()
 548         | `DELETE_EVENT -> return None));
 549         (* menus *)
 550       List.iter (fun w -> w#misc#set_sensitive false) [ main#saveMenuItem ];
 551         (* console *)
 552       let adj = main#logScrolledWin#vadjustment in
 553         ignore (adj#connect#changed
 554                 (fun _ -> adj#set_value (adj#upper -. adj#page_size)));
 555       console#message (sprintf "\tMatita version %s\n" BuildTimeConf.version);
 556         (* toolbar *)
 557       let module A = GrafiteAst in
 558       let hole = CicNotationPt.UserInput in
 559       let loc = HExtlib.dummy_floc in
 560       let tac ast _ =
 561         if (MatitaScript.current ())#onGoingProof () then
 562           (MatitaScript.current ())#advance
 563             ~statement:("\n"
 564               ^ GrafiteAstPp.pp_tactical ~term_pp:CicNotationPp.pp_term
 565                 ~lazy_term_pp:CicNotationPp.pp_term (A.Tactic (loc, ast)))
 566             ()
 567       in
 568       let tac_w_term ast _ =
 569         if (MatitaScript.current ())#onGoingProof () then
 570           let buf = source_buffer in
 571           buf#insert ~iter:(buf#get_iter_at_mark (`NAME "locked"))
 572             ("\n"
 573             ^ GrafiteAstPp.pp_tactic ~term_pp:CicNotationPp.pp_term
 574               ~lazy_term_pp:CicNotationPp.pp_term ast)
 575       in
 576       let tbar = main in
 577       connect_button tbar#introsButton (tac (A.Intros (loc, None, [])));
 578       connect_button tbar#applyButton (tac_w_term (A.Apply (loc, hole)));
 579       connect_button tbar#exactButton (tac_w_term (A.Exact (loc, hole)));
 580       connect_button tbar#elimButton (tac_w_term
 581         (A.Elim (loc, hole, None, None, [])));
 582       connect_button tbar#elimTypeButton (tac_w_term
 583         (A.ElimType (loc, hole, None, None, [])));
 584       connect_button tbar#splitButton (tac (A.Split loc));
 585       connect_button tbar#leftButton (tac (A.Left loc));
 586       connect_button tbar#rightButton (tac (A.Right loc));
 587       connect_button tbar#existsButton (tac (A.Exists loc));
 588       connect_button tbar#reflexivityButton (tac (A.Reflexivity loc));
 589       connect_button tbar#symmetryButton (tac (A.Symmetry loc));
 590       connect_button tbar#transitivityButton
 591         (tac_w_term (A.Transitivity (loc, hole)));
 592       connect_button tbar#assumptionButton (tac (A.Assumption loc));
 593       connect_button tbar#cutButton (tac_w_term (A.Cut (loc, None, hole)));
 594       connect_button tbar#autoButton (tac (A.Auto (loc,None,None,None,None)));
 595       MatitaGtkMisc.toggle_widget_visibility
 596        ~widget:(main#tacticsButtonsHandlebox :> GObj.widget)
 597        ~check:main#tacticsBarMenuItem;
 598       let module Hr = Helm_registry in
 599       if
 600         not (Hr.get_opt_default Hr.bool ~default:false "matita.tactics_bar")
 601       then
 602         main#tacticsBarMenuItem#set_active false;
 603       MatitaGtkMisc.toggle_callback
 604         ~callback:(function
 605           | true -> main#toplevel#fullscreen ()
 606           | false -> main#toplevel#unfullscreen ())
 607         ~check:main#fullscreenMenuItem;
 608       main#fullscreenMenuItem#set_active false;
 609         (* log *)
 610       HLog.set_log_callback self#console#log_callback;
 611       GtkSignal.user_handler :=
 612         (function
 613         | MatitaScript.ActionCancelled -> ()
 614         | exn ->
 615           if not (Helm_registry.get_bool "matita.debug") then
 616            let floc, msg = MatitaExcPp.to_string exn in
 617             begin
 618              match floc with
 619                 None -> ()
 620               | Some floc ->
 621                  let (x, y) = HExtlib.loc_of_floc floc in
 622                  let script = MatitaScript.current () in
 623                  let locked_mark = script#locked_mark in
 624                  let error_tag = script#error_tag in
 625                  let baseoffset =
 626                   (source_buffer#get_iter_at_mark (`MARK locked_mark))#offset in
 627                  let x' = baseoffset + x in
 628                  let y' = baseoffset + y in
 629                  let x_iter = source_buffer#get_iter (`OFFSET x') in
 630                  let y_iter = source_buffer#get_iter (`OFFSET y') in
 631                  source_buffer#apply_tag error_tag ~start:x_iter ~stop:y_iter;
 632                  let id = ref None in
 633                  id := Some (source_buffer#connect#changed ~callback:(fun () ->
 634                    source_buffer#remove_tag error_tag
 635                      ~start:source_buffer#start_iter
 636                      ~stop:source_buffer#end_iter;
 637                    match !id with
 638                    | None -> assert false (* a race condition occurred *)
 639                    | Some id ->
 640                        (new GObj.gobject_ops source_buffer#as_buffer)#disconnect id));
 641                  source_buffer#place_cursor
 642                   (source_buffer#get_iter (`OFFSET x'));
 643             end;
 644             HLog.error msg
 645           else raise exn);
 646         (* script *)
 647       ignore (source_buffer#connect#mark_set (fun _ _ -> next_ligatures <- []));
 648       let _ =
 649         match GSourceView.source_language_from_file BuildTimeConf.lang_file with
 650         | None ->
 651             HLog.warn (sprintf "can't load language file %s"
 652               BuildTimeConf.lang_file)
 653         | Some matita_lang ->
 654             source_buffer#set_language matita_lang;
 655             source_buffer#set_highlight true
 656       in
 657       let s () = MatitaScript.current () in
 658       let disableSave () =
 659         script_fname <- None;
 660         main#saveMenuItem#misc#set_sensitive false
 661       in
 662       let saveAsScript () =
 663         let script = s () in
 664         match self#chooseFile ~ok_not_exists:true () with
 665         | Some f ->
 666               script#assignFileName f;
 667               script#saveToFile ();
 668               console#message ("'"^f^"' saved.\n");
 669               self#_enableSaveTo f
 670         | None -> ()
 671       in
 672       let saveScript () =
 673         match script_fname with
 674         | None -> saveAsScript ()
 675         | Some f ->
 676               (s ())#assignFileName f;
 677               (s ())#saveToFile ();
 678               console#message ("'"^f^"' saved.\n");
 679       in
 680       let abandon_script () =
 681         let lexicon_status = (s ())#lexicon_status in
 682         let grafite_status = (s ())#grafite_status in
 683         if source_view#buffer#modified then
 684           (match ask_unsaved main#toplevel with
 685           | `YES -> saveScript ()
 686           | `NO -> ()
 687           | `CANCEL -> raise MatitaTypes.Cancel);
 688         (match script_fname with
 689         | None -> ()
 690         | Some fname ->
 691            ask_and_save_moo_if_needed main#toplevel fname
 692             lexicon_status grafite_status);
 693       in
 694       let loadScript () =
 695         let script = s () in
 696         try
 697           match self#chooseFile () with
 698           | Some f ->
 699               abandon_script ();
 700               script#reset ();
 701               script#assignFileName f;
 702               source_view#source_buffer#begin_not_undoable_action ();
 703               script#loadFromFile f;
 704               source_view#source_buffer#end_not_undoable_action ();
 705               console#message ("'"^f^"' loaded.\n");
 706               self#_enableSaveTo f
 707           | None -> ()
 708         with MatitaTypes.Cancel -> ()
 709       in
 710       let newScript () =
 711         abandon_script ();
 712         source_view#source_buffer#begin_not_undoable_action ();
 713         (s ())#reset ();
 714         (s ())#template ();
 715         source_view#source_buffer#end_not_undoable_action ();
 716         disableSave ();
 717         script_fname <- None
 718       in
 719       let cursor () =
 720         source_buffer#place_cursor
 721           (source_buffer#get_iter_at_mark (`NAME "locked")) in
 722       let advance _ = (MatitaScript.current ())#advance (); cursor () in
 723       let retract _ = (MatitaScript.current ())#retract (); cursor () in
 724       let top _ = (MatitaScript.current ())#goto `Top (); cursor () in
 725       let bottom _ = (MatitaScript.current ())#goto `Bottom (); cursor () in
 726       let jump _ = (MatitaScript.current ())#goto `Cursor (); cursor () in
 727       let advance = locker (keep_focus advance) in
 728       let retract = locker (keep_focus retract) in
 729       let top = locker (keep_focus top) in
 730       let bottom = locker (keep_focus bottom) in
 731       let jump = locker (keep_focus jump) in
 732         (* quit *)
 733       self#setQuitCallback (fun () ->
 734         let lexicon_status = (MatitaScript.current ())#lexicon_status in
 735         let grafite_status = (MatitaScript.current ())#grafite_status in
 736         if source_view#buffer#modified then
 737           begin
 738             let rc = ask_unsaved main#toplevel in
 739             try
 740               match rc with
 741               | `YES -> saveScript ();
 742                         if not source_view#buffer#modified then
 743                           begin
 744                             (match script_fname with
 745                             | None -> ()
 746                             | Some fname ->
 747                                ask_and_save_moo_if_needed main#toplevel
 748                                 fname lexicon_status grafite_status);
 749                           GMain.Main.quit ()
 750                           end
 751               | `NO -> GMain.Main.quit ()
 752               | `CANCEL -> raise MatitaTypes.Cancel
 753             with MatitaTypes.Cancel -> ()
 754           end
 755         else
 756           begin
 757             (match script_fname with
 758             | None -> clean_current_baseuri grafite_status; GMain.Main.quit ()
 759             | Some fname ->
 760                 try
 761                   ask_and_save_moo_if_needed main#toplevel fname lexicon_status
 762                    grafite_status;
 763                   GMain.Main.quit ()
 764                 with MatitaTypes.Cancel -> ())
 765           end);
 766       connect_button main#scriptAdvanceButton advance;
 767       connect_button main#scriptRetractButton retract;
 768       connect_button main#scriptTopButton top;
 769       connect_button main#scriptBottomButton bottom;
 770       connect_button main#scriptJumpButton jump;
 771       connect_menu_item main#scriptAdvanceMenuItem advance;
 772       connect_menu_item main#scriptRetractMenuItem retract;
 773       connect_menu_item main#scriptTopMenuItem top;
 774       connect_menu_item main#scriptBottomMenuItem bottom;
 775       connect_menu_item main#scriptJumpMenuItem jump;
 776       connect_menu_item main#openMenuItem   loadScript;
 777       connect_menu_item main#saveMenuItem   saveScript;
 778       connect_menu_item main#saveAsMenuItem saveAsScript;
 779       connect_menu_item main#newMenuItem    newScript;
 780          (* script monospace font stuff *)
 781       self#updateFontSize ();
 782         (* debug menu *)
 783       main#debugMenu#misc#hide ();
 784         (* status bar *)
 785       main#hintLowImage#set_file (image_path "matita-bulb-low.png");
 786       main#hintMediumImage#set_file (image_path "matita-bulb-medium.png");
 787       main#hintHighImage#set_file (image_path "matita-bulb-high.png");
 788         (* focus *)
 789       self#sourceView#misc#grab_focus ();
 790         (* main win dimension *)
 791       let width = Gdk.Screen.width () in
 792       let height = Gdk.Screen.height () in
 793       let main_w = width * 90 / 100 in
 794       let main_h = height * 80 / 100 in
 795       let script_w = main_w * 6 / 10 in
 796       main#toplevel#resize ~width:main_w ~height:main_h;
 797       main#hpaneScriptSequent#set_position script_w;
 798         (* source_view *)
 799       ignore(source_view#connect#after#paste_clipboard
 800         ~callback:(fun () -> (MatitaScript.current ())#clean_dirty_lock));
 801       (* clean_locked is set to true only "during" a PRIMARY paste
 802          operation (i.e. by clicking with the second mouse button) *)
 803       let clean_locked = ref false in
 804       ignore(source_view#event#connect#button_press
 805         ~callback:
 806           (fun button ->
 807             if GdkEvent.Button.button button = 2 then
 808              clean_locked := true;
 809             false
 810           ));
 811       ignore(source_view#event#connect#button_release
 812         ~callback:(fun button -> clean_locked := false; false));
 813       ignore(source_view#buffer#connect#after#apply_tag
 814        ~callback:(
 815          fun tag ~start:_ ~stop:_ ->
 816           if !clean_locked &&
 817              tag#get_oid = (MatitaScript.current ())#locked_tag#get_oid
 818           then
 819            begin
 820             clean_locked := false;
 821             (MatitaScript.current ())#clean_dirty_lock;
 822             clean_locked := true
 823            end));
 824       (* math view handling *)
 825       connect_menu_item main#newCicBrowserMenuItem (fun () ->
 826         ignore (MatitaMathView.cicBrowser ()));
 827       connect_menu_item main#increaseFontSizeMenuItem (fun () ->
 828         self#increaseFontSize ();
 829         MatitaMathView.increase_font_size ();
 830         MatitaMathView.update_font_sizes ());
 831       connect_menu_item main#decreaseFontSizeMenuItem (fun () ->
 832         self#decreaseFontSize ();
 833         MatitaMathView.decrease_font_size ();
 834         MatitaMathView.update_font_sizes ());
 835       connect_menu_item main#normalFontSizeMenuItem (fun () ->
 836         self#resetFontSize ();
 837         MatitaMathView.reset_font_size ();
 838         MatitaMathView.update_font_sizes ());
 839       MatitaMathView.reset_font_size ();
 840
 841       (** selections / clipboards handling *)
 842
 843     method markupSelected = MatitaMathView.has_selection ()
 844     method private textSelected =
 845       (source_buffer#get_iter_at_mark `INSERT)#compare
 846         (source_buffer#get_iter_at_mark `SEL_BOUND) <> 0
 847     method private somethingSelected = self#markupSelected || self#textSelected
 848     method private markupStored = MatitaMathView.has_clipboard ()
 849     method private textStored = clipboard#text <> None
 850     method private somethingStored = self#markupStored || self#textStored
 851
 852     method canCopy = self#somethingSelected
 853     method canCut = self#textSelected
 854     method canDelete = self#textSelected
 855     method canPaste = self#somethingStored
 856     method canPastePattern = self#markupStored
 857
 858     method copy () =
 859       if self#textSelected
 860       then begin
 861         MatitaMathView.empty_clipboard ();
 862         source_view#buffer#copy_clipboard clipboard;
 863       end else
 864         MatitaMathView.copy_selection ()
 865     method cut () =
 866       source_view#buffer#cut_clipboard clipboard;
 867       MatitaMathView.empty_clipboard ()
 868     method delete () = ignore (source_view#buffer#delete_selection ())
 869     method paste () =
 870       if MatitaMathView.has_clipboard ()
 871       then source_view#buffer#insert (MatitaMathView.paste_clipboard `Term)
 872       else source_view#buffer#paste_clipboard clipboard;
 873       (MatitaScript.current ())#clean_dirty_lock
 874     method pastePattern () =
 875       source_view#buffer#insert (MatitaMathView.paste_clipboard `Pattern)
 876
 877     method private nextLigature () =
 878       let iter = source_buffer#get_iter_at_mark `INSERT in
 879       let write_ligature len s =
 880         source_buffer#delete ~start:iter ~stop:(iter#copy#backward_chars len);
 881         source_buffer#insert ~iter:(source_buffer#get_iter_at_mark `INSERT) s
 882       in
 883       let get_ligature word =
 884         let len = String.length word in
 885         let aux_tex () =
 886           try
 887             for i = len - 1 downto 0 do
 888               if HExtlib.is_alpha word.[i] then ()
 889               else
 890                 (if word.[i] = '\\' then raise (Found i) else raise (Found ~-1))
 891             done;
 892             None
 893           with Found i ->
 894             if i = ~-1 then None else Some (String.sub word i (len - i))
 895         in
 896         let aux_ligature () =
 897           try
 898             for i = len - 1 downto 0 do
 899               if CicNotationLexer.is_ligature_char word.[i] then ()
 900               else raise (Found (i+1))
 901             done;
 902             raise (Found 0)
 903           with
 904           | Found i ->
 905               (try
 906                 Some (String.sub word i (len - i))
 907               with Invalid_argument _ -> None)
 908         in
 909         match aux_tex () with
 910         | Some macro -> macro
 911         | None -> (match aux_ligature () with Some l -> l | None -> word)
 912       in
 913       (match next_ligatures with
 914       | [] -> (* find ligatures and fill next_ligatures, then try again *)
 915           let last_word =
 916             iter#get_slice
 917               ~stop:(iter#copy#backward_find_char Glib.Unichar.isspace)
 918           in
 919           let ligature = get_ligature last_word in
 920           (match CicNotationLexer.lookup_ligatures ligature with
 921           | [] -> ()
 922           | hd :: tl ->
 923               write_ligature (String.length ligature) hd;
 924               next_ligatures <- tl @ [ hd ])
 925       | hd :: tl ->
 926           write_ligature 1 hd;
 927           next_ligatures <- tl @ [ hd ])
 928
 929     method private externalEditor () =
 930       let cmd = Helm_registry.get "matita.external_editor" in
 931 (* ZACK uncomment to enable interactive ask of external editor command *)
 932 (*      let cmd =
 933          let msg =
 934           "External editor command:
 935 %f  will be substitute for the script name,
 936 %p  for the cursor position in bytes,
 937 %l  for the execution point in bytes."
 938         in
 939         ask_text ~gui:self ~title:"External editor" ~msg ~multiline:false
 940           ~default:(Helm_registry.get "matita.external_editor") ()
 941       in *)
 942       let fname = (MatitaScript.current ())#filename in
 943       let slice mark =
 944         source_buffer#start_iter#get_slice
 945           ~stop:(source_buffer#get_iter_at_mark mark)
 946       in
 947       let script = MatitaScript.current () in
 948       let locked = `MARK script#locked_mark in
 949       let string_pos mark = string_of_int (String.length (slice mark)) in
 950       let cursor_pos = string_pos `INSERT in
 951       let locked_pos = string_pos locked in
 952       let cmd =
 953         Pcre.replace ~pat:"%f" ~templ:fname
 954           (Pcre.replace ~pat:"%p" ~templ:cursor_pos
 955             (Pcre.replace ~pat:"%l" ~templ:locked_pos
 956               cmd))
 957       in
 958       let locked_before = slice locked in
 959       let locked_offset = (source_buffer#get_iter_at_mark locked)#offset in
 960       ignore (Unix.system cmd);
 961       source_buffer#set_text (HExtlib.input_file fname);
 962       let locked_iter = source_buffer#get_iter (`OFFSET locked_offset) in
 963       source_buffer#move_mark locked locked_iter;
 964       source_buffer#apply_tag script#locked_tag
 965         ~start:source_buffer#start_iter ~stop:locked_iter;
 966       let locked_after = slice locked in
 967       let line = ref 0 in
 968       let col = ref 0 in
 969       try
 970         for i = 0 to String.length locked_before - 1 do
 971           if locked_before.[i] <> locked_after.[i] then begin
 972             source_buffer#place_cursor
 973               ~where:(source_buffer#get_iter (`LINEBYTE (!line, !col)));
 974             script#goto `Cursor ();
 975             raise Exit
 976           end else if locked_before.[i] = '\n' then begin
 977             incr line;
 978             col := 0
 979           end
 980         done
 981       with
 982       | Exit -> ()
 983       | Invalid_argument _ -> script#goto `Bottom ()
 984
 985     method loadScript file =
 986       let script = MatitaScript.current () in
 987       script#reset ();
 988       script#assignFileName file;
 989       let content =
 990        if Sys.file_exists file then file
 991        else BuildTimeConf.script_template
 992       in
 993        source_view#source_buffer#begin_not_undoable_action ();
 994        script#loadFromFile content;
 995        source_view#source_buffer#end_not_undoable_action ();
 996        console#message ("'"^file^"' loaded.");
 997        self#_enableSaveTo file
 998
 999     method setStar name b =
1000       let l = main#scriptLabel in
1001       if b then
1002         l#set_text (name ^  " *")
1003       else
1004         l#set_text (name)
1005
1006     method private _enableSaveTo file =
1007       script_fname <- Some file;
1008       self#main#saveMenuItem#misc#set_sensitive true
1009
1010     method console = console
1011     method sourceView: GSourceView.source_view =
1012       (source_view: GSourceView.source_view)
1013     method fileSel = fileSel
1014     method findRepl = findRepl
1015     method main = main
1016     method develList = develList
1017     method newDevel = newDevel
1018
1019     method newBrowserWin () =
1020       object (self)
1021         inherit browserWin ()
1022         val combo = GEdit.combo_box_entry ()
1023         initializer
1024           self#check_widgets ();
1025           let combo_widget = combo#coerce in
1026           uriHBox#pack ~from:`END ~fill:true ~expand:true combo_widget;
1027           combo#entry#misc#grab_focus ()
1028         method browserUri = combo
1029       end
1030
1031     method newUriDialog () =
1032       let dialog = new uriChoiceDialog () in
1033       dialog#check_widgets ();
1034       dialog
1035
1036     method newRecordDialog () =
1037       let dialog = new recordChoiceDialog () in
1038       dialog#check_widgets ();
1039       dialog
1040
1041     method newConfirmationDialog () =
1042       let dialog = new confirmationDialog () in
1043       dialog#check_widgets ();
1044       dialog
1045
1046     method newEmptyDialog () =
1047       let dialog = new emptyDialog () in
1048       dialog#check_widgets ();
1049       dialog
1050
1051     method private addKeyBinding key callback =
1052       List.iter (fun evbox -> add_key_binding key callback evbox)
1053         keyBindingBoxes
1054
1055     method setQuitCallback callback =
1056       connect_menu_item main#quitMenuItem callback;
1057       ignore (main#toplevel#event#connect#delete
1058         (fun _ -> callback ();true));
1059       self#addKeyBinding GdkKeysyms._q callback
1060
1061     method chooseFile ?(ok_not_exists = false) () =
1062       _ok_not_exists <- ok_not_exists;
1063       _only_directory <- false;
1064       fileSel#fileSelectionWin#show ();
1065       GtkThread.main ();
1066       chosen_file
1067
1068     method private chooseDir ?(ok_not_exists = false) () =
1069       _ok_not_exists <- ok_not_exists;
1070       _only_directory <- true;
1071       fileSel#fileSelectionWin#show ();
1072       GtkThread.main ();
1073       (* we should check that this is a directory *)
1074       chosen_file
1075
1076     method createDevelopment ~containing =
1077       next_devel_must_contain <- containing;
1078       newDevel#toplevel#misc#show()
1079
1080     method askText ?(title = "") ?(msg = "") () =
1081       let dialog = new textDialog () in
1082       dialog#textDialog#set_title title;
1083       dialog#textDialogLabel#set_label msg;
1084       let text = ref None in
1085       let return v =
1086         text := v;
1087         dialog#textDialog#destroy ();
1088         GMain.Main.quit ()
1089       in
1090       ignore (dialog#textDialog#event#connect#delete (fun _ -> true));
1091       connect_button dialog#textDialogCancelButton (fun _ -> return None);
1092       connect_button dialog#textDialogOkButton (fun _ ->
1093         let text = dialog#textDialogTextView#buffer#get_text () in
1094         return (Some text));
1095       dialog#textDialog#show ();
1096       GtkThread.main ();
1097       !text
1098
1099     method private updateFontSize () =
1100       self#sourceView#misc#modify_font_by_name
1101         (sprintf "%s %d" BuildTimeConf.script_font font_size)
1102
1103     method increaseFontSize () =
1104       font_size <- font_size + 1;
1105       self#updateFontSize ()
1106
1107     method decreaseFontSize () =
1108       font_size <- font_size - 1;
1109       self#updateFontSize ()
1110
1111     method resetFontSize () =
1112       font_size <- default_font_size;
1113       self#updateFontSize ()
1114
1115   end
1116
1117 let gui () =
1118   let g = new gui () in
1119   gui_instance := Some g;
1120   MatitaMathView.set_gui g;
1121   g
1122
1123 let instance = singleton gui
1124
1125 let non p x = not (p x)
1126
1127 (* this is a shit and should be changed :-{ *)
1128 let interactive_uri_choice
1129   ?(selection_mode:[`SINGLE|`MULTIPLE] = `MULTIPLE) ?(title = "")
1130   ?(msg = "") ?(nonvars_button = false) ?(hide_uri_entry=false)
1131   ?(hide_try=false) ?(ok_label="_Auto") ?(ok_action:[`SELECT|`AUTO] = `AUTO)
1132   ?copy_cb ()
1133   ~id uris
1134 =
1135   let gui = instance () in
1136   let nonvars_uris = lazy (List.filter (non UriManager.uri_is_var) uris) in
1137   if (selection_mode <> `SINGLE) &&
1138     (Helm_registry.get_opt_default Helm_registry.get_bool ~default:true "matita.auto_disambiguation")
1139   then
1140     Lazy.force nonvars_uris
1141   else begin
1142     let dialog = gui#newUriDialog () in
1143     if hide_uri_entry then
1144       dialog#uriEntryHBox#misc#hide ();
1145     if hide_try then
1146       begin
1147       dialog#uriChoiceSelectedButton#misc#hide ();
1148       dialog#uriChoiceConstantsButton#misc#hide ();
1149       end;
1150     dialog#okLabel#set_label ok_label;
1151     dialog#uriChoiceTreeView#selection#set_mode
1152       (selection_mode :> Gtk.Tags.selection_mode);
1153     let model = new stringListModel dialog#uriChoiceTreeView in
1154     let choices = ref None in
1155     (match copy_cb with
1156     | None -> ()
1157     | Some cb ->
1158         dialog#copyButton#misc#show ();
1159         connect_button dialog#copyButton
1160         (fun _ ->
1161           match model#easy_selection () with
1162           | [u] -> (cb u)
1163           | _ -> ()));
1164     dialog#uriChoiceDialog#set_title title;
1165     dialog#uriChoiceLabel#set_text msg;
1166     List.iter model#easy_append (List.map UriManager.string_of_uri uris);
1167     dialog#uriChoiceConstantsButton#misc#set_sensitive nonvars_button;
1168     let return v =
1169       choices := v;
1170       dialog#uriChoiceDialog#destroy ();
1171       GMain.Main.quit ()
1172     in
1173     ignore (dialog#uriChoiceDialog#event#connect#delete (fun _ -> true));
1174     connect_button dialog#uriChoiceConstantsButton (fun _ ->
1175       return (Some (Lazy.force nonvars_uris)));
1176     if ok_action = `AUTO then
1177       connect_button dialog#uriChoiceAutoButton (fun _ ->
1178         Helm_registry.set_bool "matita.auto_disambiguation" true;
1179         return (Some (Lazy.force nonvars_uris)))
1180     else
1181       connect_button dialog#uriChoiceAutoButton (fun _ ->
1182         match model#easy_selection () with
1183         | [] -> ()
1184         | uris -> return (Some (List.map UriManager.uri_of_string uris)));
1185     connect_button dialog#uriChoiceSelectedButton (fun _ ->
1186       match model#easy_selection () with
1187       | [] -> ()
1188       | uris -> return (Some (List.map UriManager.uri_of_string uris)));
1189     connect_button dialog#uriChoiceAbortButton (fun _ -> return None);
1190     dialog#uriChoiceDialog#show ();
1191     GtkThread.main ();
1192     (match !choices with
1193     | None -> raise MatitaTypes.Cancel
1194     | Some uris -> uris)
1195   end
1196
1197 class interpModel =
1198   let cols = new GTree.column_list in
1199   let id_col = cols#add Gobject.Data.string in
1200   let dsc_col = cols#add Gobject.Data.string in
1201   let interp_no_col = cols#add Gobject.Data.int in
1202   let tree_store = GTree.tree_store cols in
1203   let id_renderer = GTree.cell_renderer_text [], ["text", id_col] in
1204   let dsc_renderer = GTree.cell_renderer_text [], ["text", dsc_col] in
1205   let id_view_col = GTree.view_column ~renderer:id_renderer () in
1206   let dsc_view_col = GTree.view_column ~renderer:dsc_renderer () in
1207   fun tree_view choices ->
1208     object
1209       initializer
1210         tree_view#set_model (Some (tree_store :> GTree.model));
1211         ignore (tree_view#append_column id_view_col);
1212         ignore (tree_view#append_column dsc_view_col);
1213         let name_of_interp =
1214           (* try to find a reasonable name for an interpretation *)
1215           let idx = ref 0 in
1216           fun interp ->
1217             try
1218               List.assoc "0" interp
1219             with Not_found ->
1220               incr idx; string_of_int !idx
1221         in
1222         tree_store#clear ();
1223         let idx = ref ~-1 in
1224         List.iter
1225           (fun interp ->
1226             incr idx;
1227             let interp_row = tree_store#append () in
1228             tree_store#set ~row:interp_row ~column:id_col
1229               (name_of_interp interp);
1230             tree_store#set ~row:interp_row ~column:interp_no_col !idx;
1231             List.iter
1232               (fun (id, dsc) ->
1233                 let row = tree_store#append ~parent:interp_row () in
1234                 tree_store#set ~row ~column:id_col id;
1235                 tree_store#set ~row ~column:dsc_col dsc;
1236                 tree_store#set ~row ~column:interp_no_col !idx)
1237               interp)
1238           choices
1239
1240       method get_interp_no tree_path =
1241         let iter = tree_store#get_iter tree_path in
1242         tree_store#get ~row:iter ~column:interp_no_col
1243     end
1244
1245 let interactive_interp_choice () choices =
1246   let gui = instance () in
1247   assert (choices <> []);
1248   let dialog = gui#newRecordDialog () in
1249   let model = new interpModel dialog#recordChoiceTreeView choices in
1250   dialog#recordChoiceDialog#set_title "Interpretation choice";
1251   dialog#recordChoiceDialogLabel#set_label "Choose an interpretation:";
1252   let interp_no = ref None in
1253   let return _ =
1254     dialog#recordChoiceDialog#destroy ();
1255     GMain.Main.quit ()
1256   in
1257   let fail _ = interp_no := None; return () in
1258   ignore (dialog#recordChoiceDialog#event#connect#delete (fun _ -> true));
1259   connect_button dialog#recordChoiceOkButton (fun _ ->
1260     match !interp_no with None -> () | Some _ -> return ());
1261   connect_button dialog#recordChoiceCancelButton fail;
1262   ignore (dialog#recordChoiceTreeView#connect#row_activated (fun path _ ->
1263     interp_no := Some (model#get_interp_no path);
1264     return ()));
1265   let selection = dialog#recordChoiceTreeView#selection in
1266   ignore (selection#connect#changed (fun _ ->
1267     match selection#get_selected_rows with
1268     | [path] -> interp_no := Some (model#get_interp_no path)
1269     | _ -> assert false));
1270   dialog#recordChoiceDialog#show ();
1271   GtkThread.main ();
1272   (match !interp_no with Some row -> [row] | _ -> raise MatitaTypes.Cancel)
1273
1274 let _ =
1275   (* disambiguator callbacks *)
1276   GrafiteDisambiguator.set_choose_uris_callback (interactive_uri_choice ());
1277   GrafiteDisambiguator.set_choose_interp_callback (interactive_interp_choice ());
1278   (* gtk initialization *)
1279   GtkMain.Rc.add_default_file BuildTimeConf.gtkrc_file; (* loads gtk rc *)
1280   GMathView.add_configuration_path BuildTimeConf.gtkmathview_conf;
1281   ignore (GMain.Main.init ())
1282