diff options
Diffstat (limited to 'ide')
47 files changed, 5031 insertions, 6274 deletions
@@ -6,8 +6,8 @@ R0: A powerfull graphical interface for Coq. See http://coq.inria.fr. for more i Q1) How to enable Emacs keybindings? R1: Insert gtk-key-theme-name = "Emacs" - in your ".coqide-gtk2rc" file. It may be in the current dir - or in $HOME dir. This is done by default. + in your "coqide-gtk2rc" file. It should be in $XDG_CONFIG_DIRS/coq dir. + This is done by default. Q2) How to enable antialiased fonts? R2) Set the GDK_USE_XFT variable to 1. This is by default with Gtk >= 2.2. @@ -41,7 +41,7 @@ R5)-First solution : type "<CONTROL><SHIFT>2200" to enter a forall in the script and then to add bind "F13" {"insert-at-cursor" ("∀")} bind "F14" {"insert-at-cursor" ("∃")} - to your "binding "text"" section in .coqiderc-gtk2rc. + to your "binding "text"" section in coqiderc-gtk2rc. The strange ("∀") argument is the UTF-8 encoding for 0x2200. You can compute these encodings using the lablgtk2 toplevel with @@ -49,21 +49,15 @@ R5)-First solution : type "<CONTROL><SHIFT>2200" to enter a forall in the script Further symbols can be bound on higher Fxx keys or on even on other keys you do not need . -Q6) How to build a custom CoqIde with user ml code? -R6) Use - coqmktop -ide -byte m1.cmo...mi.cmo - or - coqmktop -ide -opt m1.cmx...mi.cmx - -Q7) How to customize the shortcuts for menus? -R7) Two solutions are offered: - - Edit $HOME/.coqide.keys by hand or - - Add "gtk-can-change-accels = 1" in your .coqide-gtk2rc file. Then +Q6) How to customize the shortcuts for menus? +R6) Two solutions are offered: + - Edit $XDG_CONFIG_HOME/coq/coqide.keys by hand or + - Add "gtk-can-change-accels = 1" in your coqide-gtk2rc file. Then from CoqIde, you may select a menu entry and press the desired shortcut. -Q8) What encoding should I use? What is this \x{iiii} in my file? -R8) The encoding option is related to the way files are saved. +Q7) What encoding should I use? What is this \x{iiii} in my file? +R7) The encoding option is related to the way files are saved. Keep it as UTF-8 until it becomes important for you to exchange files with non UTF-8 aware applications. If you choose something else than UTF-8, then missing characters will diff --git a/ide/command_windows.ml b/ide/command_windows.ml index 1df83803..470bd5b4 100644 --- a/ide/command_windows.ml +++ b/ide/command_windows.ml @@ -1,20 +1,19 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: command_windows.ml 14641 2011-11-06 11:59:10Z herbelin $ *) - -class command_window () = +class command_window coqtop current = (* let window = GWindow.window ~allow_grow:true ~allow_shrink:true ~width:500 ~height:250 ~position:`CENTER ~title:"CoqIde queries" ~show:false () in *) + let views = ref [] in let frame = GBin.frame ~label:"Command Pane" ~shadow_type:`IN () in let _ = frame#misc#hide () in let _ = GtkData.AccelGroup.create () in @@ -51,12 +50,17 @@ class command_window () = () in + let remove_cb () = + let index = notebook#current_page in + let () = notebook#remove_page index in + views := Minilib.list_filter_i (fun i x -> i <> index) !views + in let _ = toolbar#insert_button ~tooltip:"Delete Page" ~text:"Delete Page" ~icon:(Ideutils.stock_to_widget `DELETE) - ~callback:(fun () -> notebook#remove_page notebook#current_page) + ~callback:remove_cb () in object(self) @@ -65,25 +69,21 @@ object(self) val new_page_menu = new_page_menu val notebook = notebook + method frame = frame method new_command ?command ?term () = - let appendp x = ignore (notebook#append_page x) in let frame = GBin.frame ~shadow_type:`ETCHED_OUT - ~packing:appendp () in + let _ = notebook#append_page frame#coerce in notebook#goto_page (notebook#page_num frame#coerce); let vbox = GPack.vbox ~homogeneous:false ~packing:frame#add () in let hbox = GPack.hbox ~homogeneous:false ~packing:vbox#pack () in - let combo = GEdit.combo ~popdown_strings:Coq_commands.state_preserving - ~enable_arrow_keys:true - ~allow_empty:false - ~value_in_list:false (* true is not ok with disable_activate...*) + let (combo,_) = GEdit.combo_box_entry_text ~strings:Coq_commands.state_preserving ~packing:hbox#pack () in - combo#disable_activate (); let on_activate c () = if List.mem combo#entry#text Coq_commands.state_preserving then c () else prerr_endline "Not a state preserving command" @@ -97,6 +97,10 @@ object(self) ~packing:(vbox#pack ~fill:true ~expand:true) () in let ok_b = GButton.button ~label:"Ok" ~packing:(hbox#pack ~expand:false) () in let result = GText.view ~packing:r_bin#add () in + let () = views := !views @ [result] in + result#misc#modify_font !current.Preferences.text_font; + let clr = Tags.color_of_string !current.Preferences.background_color in + result#misc#modify_base [`NORMAL, `COLOR clr]; result#misc#set_can_focus true; (* false causes problems for selection *) result#set_editable false; let callback () = @@ -106,11 +110,14 @@ object(self) then com ^ " " else com ^ " " ^ entry#text ^" . " in try - ignore(Coq.interp false phrase); - result#buffer#set_text - ("Result for command " ^ phrase ^ ":\n" ^ Ideutils.read_stdout ()) + result#buffer#set_text + (match Coq.interp !coqtop ~raw:true phrase with + | Interface.Fail (l,str) -> + ("Error while interpreting "^phrase^":\n"^str) + | Interface.Good results -> + ("Result for command " ^ phrase ^ ":\n" ^ results)) with e -> - let (s,loc) = Coq.process_exn e in + let s = Printexc.to_string e in assert (Glib.Utf8.validate s); result#buffer#set_text s in @@ -136,15 +143,16 @@ object(self) ignore (combo#entry#connect#activate ~callback); self#frame#misc#show () + method refresh_font () = + let iter view = view#misc#modify_font !current.Preferences.text_font in + List.iter iter !views + + method refresh_color () = + let clr = Tags.color_of_string !current.Preferences.background_color in + let iter view = view#misc#modify_base [`NORMAL, `COLOR clr] in + List.iter iter !views + initializer - ignore (new_page_menu#connect#clicked self#new_command); + ignore (new_page_menu#connect#clicked ~callback:self#new_command); (* ignore (window#event#connect#delete (fun _ -> window#misc#hide(); true));*) end - -let command_window = ref None - -let main () = command_window := Some (new command_window ()) - -let command_window () = match !command_window with - | None -> failwith "No command window." - | Some c -> c diff --git a/ide/command_windows.mli b/ide/command_windows.mli index 0f5c208b..30e953be 100644 --- a/ide/command_windows.mli +++ b/ide/command_windows.mli @@ -1,22 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: command_windows.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) - class command_window : - unit -> + Coq.coqtop ref -> Preferences.pref ref -> object method new_command : ?command:string -> ?term:string -> unit -> unit method frame : GBin.frame + method refresh_font : unit -> unit + method refresh_color : unit -> unit end - - val main : unit -> unit - -val command_window : unit -> command_window - - diff --git a/ide/config_lexer.mll b/ide/config_lexer.mll index 3724f2bf..4d91a11a 100644 --- a/ide/config_lexer.mll +++ b/ide/config_lexer.mll @@ -1,19 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: config_lexer.mll 14641 2011-11-06 11:59:10Z herbelin $ *) - { open Lexing open Format - open Config_parser - open Util + open Minilib let string_buffer = Buffer.create 1024 @@ -22,34 +19,36 @@ let space = [' ' '\010' '\013' '\009' '\012'] let char = ['A'-'Z' 'a'-'z' '_' '0'-'9'] let ident = char+ +let ignore = space | ('#' [^ '\n']*) -rule token = parse - | space+ { token lexbuf } - | '#' [^ '\n']* { token lexbuf } - | ident { IDENT (lexeme lexbuf) } - | '=' { EQUAL } - | '"' { Buffer.reset string_buffer; - Buffer.add_char string_buffer '"'; - string lexbuf; - let s = Buffer.contents string_buffer in - STRING (Scanf.sscanf s "%S" (fun s -> s)) } +rule prefs m = parse + |ignore* (ident as id) ignore* '=' { let conf = str_list [] lexbuf in + prefs (Stringmap.add id conf m) lexbuf } | _ { let c = lexeme_start lexbuf in - eprintf ".coqiderc: invalid character (%d)\n@." c; - token lexbuf } - | eof { EOF } + eprintf "coqiderc: invalid character (%d)\n@." c; + prefs m lexbuf } + | eof { m } + +and str_list l = parse + | ignore* '"' { Buffer.reset string_buffer; + Buffer.add_char string_buffer '"'; + string lexbuf; + let s = Buffer.contents string_buffer in + str_list ((Scanf.sscanf s "%S" (fun s -> s))::l) lexbuf } + |ignore+ { List.rev l} and string = parse | '"' { Buffer.add_char string_buffer '"' } | '\\' '"' | _ { Buffer.add_string string_buffer (lexeme lexbuf); string lexbuf } - | eof { eprintf ".coqiderc: unterminated string\n@." } + | eof { eprintf "coqiderc: unterminated string\n@." } { let load_file f = let c = open_in f in let lb = from_channel c in - let m = Config_parser.prefs token lb in + let m = prefs Stringmap.empty lb in close_in c; m diff --git a/ide/config_parser.mly b/ide/config_parser.mly deleted file mode 100644 index d49e22eb..00000000 --- a/ide/config_parser.mly +++ /dev/null @@ -1,43 +0,0 @@ -/************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************/ - -/* $Id: config_parser.mly 14641 2011-11-06 11:59:10Z herbelin $ */ - -%{ - - open Parsing - open Util - -%} - -%token <string> IDENT STRING -%token EQUAL EOF - -%type <(string list) Util.Stringmap.t> prefs -%start prefs - -%% - -prefs: - pref_list EOF { $1 } -; - -pref_list: - pref_list pref { let (k,d) = $2 in Stringmap.add k d $1 } - | /* epsilon */ { Stringmap.empty } -; - -pref: - IDENT EQUAL string_list { ($1, List.rev $3) } -; - -string_list: - string_list STRING { $2 :: $1 } - | /* epsilon */ { [] } -; - @@ -1,53 +1,14 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coq.ml 15025 2012-03-09 14:27:07Z glondu $ *) - -open Vernac -open Vernacexpr -open Pfedit -open Pp -open Util -open Names -open Term -open Printer -open Environ -open Evarutil -open Evd -open Decl_mode -open Hipattern -open Tacmach -open Reductionops -open Termops -open Namegen open Ideutils -let msg m = - let b = Buffer.create 103 in - Pp.msg_with (Format.formatter_of_buffer b) m; - Buffer.contents b - -let msgnl m = - (msg m)^"\n" - -let init () = - (* To hide goal in lower window. - Problem: should not hide "xx is assumed" - messages *) -(**) - Flags.make_silent true; - (* don't set a too large undo stack because Edit.create allocates an array *) - Pfedit.set_undo (Some 5000); -(**) - Coqtop.init_ide () - - -let i = ref 0 +(** * Version and date *) let get_version_date () = let date = @@ -55,7 +16,12 @@ let get_version_date () = then Coq_config.date else "<date not printable>" in try - let ch = open_in (Coq_config.coqsrc^"/revision") in + (* the following makes sense only when running with local layout *) + let coqroot = Filename.concat + (Filename.dirname Sys.executable_name) + Filename.parent_dir_name + in + let ch = open_in (Filename.concat coqroot "revision") in let ver = input_line ch in let rev = input_line ch in (ver,rev) @@ -71,656 +37,279 @@ let version () = "The Coq Proof Assistant, version %s (%s)\ \nArchitecture %s running %s operating system\ \nGtk version is %s\ - \nThis is the %s version (%s is the best one for this architecture and OS)\ + \nThis is %s (%s is the best one for this architecture and OS)\ \n" ver date Coq_config.arch Sys.os_type (let x,y,z = GMain.Main.version in Printf.sprintf "%d.%d.%d" x y z) - (if Mltop.is_native then "native" else "bytecode") - (if Coq_config.best="opt" then "native" else "bytecode") - -let is_in_coq_lib dir = - prerr_endline ("Is it a coq theory ? : "^dir); - let is_same_file = same_file dir in - List.exists - (fun s -> - let fdir = - Filename.concat (Envars.coqlib ()) (Filename.concat "theories" s) in - prerr_endline (" Comparing to: "^fdir); - if is_same_file fdir then (prerr_endline " YES";true) - else (prerr_endline"NO";false)) - Coq_config.theories_dirs - -let is_in_loadpath dir = - Library.is_in_load_paths (System.physical_path_of_string dir) - -let is_in_coq_path f = - try - let base = Filename.chop_extension (Filename.basename f) in - let _ = Library.locate_qualified_library false - (Libnames.make_qualid Names.empty_dirpath - (Names.id_of_string base)) in - prerr_endline (f ^ " is in coq path"); - true - with _ -> - prerr_endline (f ^ " is NOT in coq path"); - false - -let is_in_proof_mode () = - match Decl_mode.get_current_mode () with - Decl_mode.Mode_none -> false - | _ -> true - -let user_error_loc l s = - raise (Compat.Exc_located (l, Util.UserError ("CoqIde", s))) - -type printing_state = { - mutable printing_implicit : bool; - mutable printing_coercions : bool; - mutable printing_raw_matching : bool; - mutable printing_no_notation : bool; - mutable printing_all : bool; - mutable printing_evar_instances : bool; - mutable printing_universes : bool; - mutable printing_full_all : bool -} + (Filename.basename Sys.executable_name) + Coq_config.best -let printing_state = { - printing_implicit = false; - printing_coercions = false; - printing_raw_matching = false; - printing_no_notation = false; - printing_all = false; - printing_evar_instances = false; - printing_universes = false; - printing_full_all = false; -} -let printing_implicit_data = ["Printing";"Implicit"], false -let printing_coercions_data = ["Printing";"Coercions"], false -let printing_raw_matching_data = ["Printing";"Matching"], true -let printing_no_synth_data = ["Printing";"Synth"], true -let printing_no_notation_data = ["Printing";"Notations"], true -let printing_all_data = ["Printing";"All"], false -let printing_evar_instances_data = ["Printing";"Existential";"Instances"],false -let printing_universes_data = ["Printing";"Universes"], false - -let known_options = ref [] - -let prepare_option (l,dft) = - known_options := l :: !known_options; - let set = (String.concat " " ("Set"::l)) ^ "." in - let unset = (String.concat " " ("Unset"::l)) ^ "." in - if dft then unset,set else set,unset - -let coqide_known_option table = List.mem table !known_options - -let with_printing_implicit = prepare_option printing_implicit_data -let with_printing_coercions = prepare_option printing_coercions_data -let with_printing_raw_matching = prepare_option printing_raw_matching_data -let with_printing_no_synth = prepare_option printing_no_synth_data -let with_printing_no_notation = prepare_option printing_no_notation_data -let with_printing_all = prepare_option printing_all_data -let with_printing_evar_instances = prepare_option printing_evar_instances_data -let with_printing_universes = prepare_option printing_universes_data - -let make_option_commands () = - let p = printing_state in - (if p.printing_implicit then [with_printing_implicit] else [])@ - (if p.printing_coercions then [with_printing_coercions] else [])@ - (if p.printing_raw_matching then [with_printing_raw_matching;with_printing_no_synth] else [])@ - (if p.printing_no_notation then [with_printing_no_notation] else [])@ - (if p.printing_all then [with_printing_all] else [])@ - (if p.printing_evar_instances then [with_printing_evar_instances] else [])@ - (if p.printing_universes then [with_printing_universes] else [])@ - (if p.printing_full_all then [with_printing_all;with_printing_evar_instances;with_printing_universes] else []) - -let make_option_commands () = - let l = make_option_commands () in - List.iter (fun (a,b) -> prerr_endline a; prerr_endline b) l; - l - -type command_attribute = - NavigationCommand | QueryCommand | DebugCommand | KnownOptionCommand - | OtherStatePreservingCommand | GoalStartingCommand | SolveCommand - | ProofEndingCommand - -let rec attribute_of_vernac_command = function - (* Control *) - | VernacTime com -> attribute_of_vernac_command com - | VernacTimeout(_,com) -> attribute_of_vernac_command com - | VernacFail com -> attribute_of_vernac_command com - | VernacList _ -> [] (* unsupported *) - | VernacLoad _ -> [] - - (* Syntax *) - | VernacTacticNotation _ -> [] - | VernacSyntaxExtension _ -> [] - | VernacDelimiters _ -> [] - | VernacBindScope _ -> [] - | VernacOpenCloseScope _ -> [] - | VernacArgumentsScope _ -> [] - | VernacInfix _ -> [] - | VernacNotation _ -> [] - - (* Gallina *) - | VernacDefinition (_,_,DefineBody _,_) -> [] - | VernacDefinition (_,_,ProveBody _,_) -> [GoalStartingCommand] - | VernacStartTheoremProof _ -> [GoalStartingCommand] - | VernacEndProof _ -> [ProofEndingCommand] - | VernacExactProof _ -> [ProofEndingCommand] - - | VernacAssumption _ -> [] - | VernacInductive _ -> [] - | VernacFixpoint _ -> [] - | VernacCoFixpoint _ -> [] - | VernacScheme _ -> [] - | VernacCombinedScheme _ -> [] - - (* Modules *) - | VernacDeclareModule _ -> [] - | VernacDefineModule _ -> [] - | VernacDeclareModuleType _ -> [] - | VernacInclude _ -> [] - - (* Gallina extensions *) - | VernacBeginSection _ -> [] - | VernacEndSegment _ -> [] - | VernacRequire _ -> [] - | VernacImport _ -> [] - | VernacCanonical _ -> [] - | VernacCoercion _ -> [] - | VernacIdentityCoercion _ -> [] - - (* Type classes *) - | VernacInstance _ -> [] - | VernacContext _ -> [] - | VernacDeclareInstance _ -> [] - | VernacDeclareClass _ -> [] - - (* Solving *) - | VernacSolve _ -> [SolveCommand] - | VernacSolveExistential _ -> [SolveCommand] - - (* MMode *) - | VernacDeclProof -> [SolveCommand] - | VernacReturn -> [SolveCommand] - | VernacProofInstr _ -> [SolveCommand] - - (* Auxiliary file and library management *) - | VernacRequireFrom _ -> [] - | VernacAddLoadPath _ -> [] - | VernacRemoveLoadPath _ -> [] - | VernacAddMLPath _ -> [] - | VernacDeclareMLModule _ -> [] - | VernacChdir _ -> [OtherStatePreservingCommand] - - (* State management *) - | VernacWriteState _ -> [] - | VernacRestoreState _ -> [] - - (* Resetting *) - | VernacRemoveName _ -> [NavigationCommand] - | VernacResetName _ -> [NavigationCommand] - | VernacResetInitial -> [NavigationCommand] - | VernacBack _ -> [NavigationCommand] - | VernacBackTo _ -> [NavigationCommand] - - (* Commands *) - | VernacDeclareTacticDefinition _ -> [] - | VernacCreateHintDb _ -> [] - | VernacHints _ -> [] - | VernacSyntacticDefinition _ -> [] - | VernacDeclareImplicits _ -> [] - | VernacDeclareReduction _ -> [] - | VernacReserve _ -> [] - | VernacGeneralizable _ -> [] - | VernacSetOpacity _ -> [] - | VernacSetOption (_,["Ltac";"Debug"], _) -> [DebugCommand] - | VernacSetOption (_,o,BoolValue true) | VernacUnsetOption (_,o) -> - if coqide_known_option o then [KnownOptionCommand] else [] - | VernacSetOption _ -> [] - | VernacRemoveOption _ -> [] - | VernacAddOption _ -> [] - | VernacMemOption _ -> [QueryCommand] - - | VernacPrintOption _ -> [QueryCommand] - | VernacCheckMayEval _ -> [QueryCommand] - | VernacGlobalCheck _ -> [QueryCommand] - | VernacPrint _ -> [QueryCommand] - | VernacSearch _ -> [QueryCommand] - | VernacLocate _ -> [QueryCommand] - - | VernacComments _ -> [OtherStatePreservingCommand] - | VernacNop -> [OtherStatePreservingCommand] - - (* Proof management *) - | VernacGoal _ -> [GoalStartingCommand] - - | VernacAbort _ -> [] - | VernacAbortAll -> [NavigationCommand] - | VernacRestart -> [NavigationCommand] - | VernacSuspend -> [NavigationCommand] - | VernacResume _ -> [NavigationCommand] - | VernacUndo _ -> [NavigationCommand] - | VernacUndoTo _ -> [NavigationCommand] - | VernacBacktrack _ -> [NavigationCommand] - - | VernacFocus _ -> [SolveCommand] - | VernacUnfocus -> [SolveCommand] - | VernacGo _ -> [] - | VernacShow _ -> [OtherStatePreservingCommand] - | VernacCheckGuard -> [OtherStatePreservingCommand] - | VernacProof (Tacexpr.TacId []) -> [OtherStatePreservingCommand] - | VernacProof _ -> [] - - (* Toplevel control *) - | VernacToplevelControl _ -> [] - - (* Extensions *) - | VernacExtend ("Subtac_Obligations", _) -> [GoalStartingCommand] - | VernacExtend _ -> [] - -let is_vernac_goal_starting_command com = - List.mem GoalStartingCommand (attribute_of_vernac_command com) - -let is_vernac_navigation_command com = - List.mem NavigationCommand (attribute_of_vernac_command com) - -let is_vernac_query_command com = - List.mem QueryCommand (attribute_of_vernac_command com) - -let is_vernac_known_option_command com = - List.mem KnownOptionCommand (attribute_of_vernac_command com) - -let is_vernac_debug_command com = - List.mem DebugCommand (attribute_of_vernac_command com) - -let is_vernac_goal_printing_command com = - let attribute = attribute_of_vernac_command com in - List.mem GoalStartingCommand attribute or - List.mem SolveCommand attribute - -let is_vernac_state_preserving_command com = - let attribute = attribute_of_vernac_command com in - List.mem OtherStatePreservingCommand attribute or - List.mem QueryCommand attribute - -let is_vernac_tactic_command com = - List.mem SolveCommand (attribute_of_vernac_command com) - -let is_vernac_proof_ending_command com = - List.mem ProofEndingCommand (attribute_of_vernac_command com) - -type undo_info = identifier list - -let undo_info () = Pfedit.get_all_proof_names () - -type reset_mark = Libnames.object_name - -type reset_status = - | NoReset - | ResetAtSegmentStart of Names.identifier - | ResetAtRegisteredObject of reset_mark - -type reset_info = { - status : reset_status; - proofs : identifier list; - cur_prf : (identifier * int) option; - loc_ast : Util.loc * Vernacexpr.vernac_expr; +(** * Initial checks by launching test coqtop processes *) + +let rec read_all_lines in_chan = + try + let arg = input_line in_chan in + arg::(read_all_lines in_chan) + with End_of_file -> [] + +let fatal_error_popup msg = + let popup = GWindow.message_dialog ~buttons:GWindow.Buttons.ok + ~message_type:`ERROR ~message:msg () + in ignore (popup#run ()); exit 1 + +let final_info_popup small msg = + if small then + let popup = GWindow.message_dialog ~buttons:GWindow.Buttons.ok + ~message_type:`INFO ~message:msg () + in + let _ = popup#run () in + exit 0 + else + let popup = GWindow.dialog () in + let button = GButton.button ~label:"ok" ~packing:popup#action_area#add () + in + let scroll = GBin.scrolled_window ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC + ~packing:popup#vbox#add ~height:500 () + in + let _ = GMisc.label ~text:msg ~packing:scroll#add_with_viewport () in + let _ = popup#connect#destroy ~callback:(fun _ -> exit 0) in + let _ = button#connect#clicked ~callback:(fun _ -> exit 0) in + let _ = popup#run () in + exit 0 + +let connection_error cmd lines exn = + fatal_error_popup + ("Connection with coqtop failed!\n"^ + "Command was: "^cmd^"\n"^ + "Answer was: "^(String.concat "\n " lines)^"\n"^ + "Exception was: "^Printexc.to_string exn) + +let display_coqtop_answer cmd lines = + final_info_popup (List.length lines < 30) + ("Coqtop exited\n"^ + "Command was: "^cmd^"\n"^ + "Answer was: "^(String.concat "\n " lines)) + +let check_remaining_opt arg = + if arg <> "" && arg.[0] = '-' then fatal_error_popup ("Illegal option: "^arg) + +let rec filter_coq_opts args = + let argstr = String.concat " " (List.map Filename.quote args) in + let cmd = Filename.quote (coqtop_path ()) ^" -nois -filteropts " ^ argstr in + let cmd = requote cmd in + let filtered_args = ref [] in + let errlines = ref [] in + try + let oc,ic,ec = Unix.open_process_full cmd (Unix.environment ()) in + filtered_args := read_all_lines oc; + errlines := read_all_lines ec; + match Unix.close_process_full (oc,ic,ec) with + | Unix.WEXITED 0 -> + List.iter check_remaining_opt !filtered_args; !filtered_args + | Unix.WEXITED 127 -> asks_for_coqtop args + | _ -> display_coqtop_answer cmd (!filtered_args @ !errlines) + with Sys_error _ -> asks_for_coqtop args + | e -> connection_error cmd (!filtered_args @ !errlines) e + +and asks_for_coqtop args = + let pb_mes = GWindow.message_dialog + ~message:"Failed to load coqtop. Reset the preference to default ?" + ~message_type:`QUESTION ~buttons:GWindow.Buttons.yes_no () in + match pb_mes#run () with + | `YES -> + let () = !Preferences.current.Preferences.cmd_coqtop <- None in + let () = custom_coqtop := None in + let () = pb_mes#destroy () in + filter_coq_opts args + | `DELETE_EVENT | `NO -> + let () = pb_mes#destroy () in + let cmd_sel = GWindow.file_selection + ~title:"Coqtop to execute (edit your preference then)" + ~filename:(coqtop_path ()) ~urgency_hint:true () in + match cmd_sel#run () with + | `OK -> + let () = custom_coqtop := (Some cmd_sel#filename) in + let () = cmd_sel#destroy () in + filter_coq_opts args + | `CANCEL | `DELETE_EVENT | `HELP -> exit 0 + +exception WrongExitStatus of string + +let print_status = function + | Unix.WEXITED n -> "WEXITED "^string_of_int n + | Unix.WSIGNALED n -> "WSIGNALED "^string_of_int n + | Unix.WSTOPPED n -> "WSTOPPED "^string_of_int n + +let check_connection args = + let lines = ref [] in + let argstr = String.concat " " (List.map Filename.quote args) in + let cmd = Filename.quote (coqtop_path ()) ^ " -batch " ^ argstr in + let cmd = requote cmd in + try + let ic = Unix.open_process_in cmd in + lines := read_all_lines ic; + match Unix.close_process_in ic with + | Unix.WEXITED 0 -> () (* coqtop seems ok *) + | st -> raise (WrongExitStatus (print_status st)) + with e -> connection_error cmd !lines e + +(** * The structure describing a coqtop sub-process *) + +type coqtop = { + pid : int; (* Unix process id *) + cout : in_channel ; + cin : out_channel ; + sup_args : string list; } -let compute_reset_info loc_ast = - let status,cur_prf = match snd loc_ast with - | com when is_vernac_proof_ending_command com -> NoReset,None - | VernacEndSegment _ -> NoReset,None - | com when is_vernac_tactic_command com -> - NoReset,Some (Pfedit.get_current_proof_name (), Pfedit.current_proof_depth ()) - | _ -> - (match Lib.has_top_frozen_state () with - | Some sp -> - prerr_endline ("On top of state "^Libnames.string_of_path (fst sp)); - ResetAtRegisteredObject sp,None - | None -> NoReset,None) - in - { status = status; - proofs = Pfedit.get_all_proof_names (); - cur_prf = cur_prf; - loc_ast = loc_ast; - } - -let reset_initial () = - prerr_endline "Reset initial called"; - Vernacentries.abort_refine Lib.reset_initial () - -let reset_to sp = - prerr_endline - ("Reset called with state "^(Libnames.string_of_path (fst sp))); - Lib.reset_to_state sp - -let raw_interp s = - Vernac.raw_do_vernac (Pcoq.Gram.parsable (Stream.of_string s)) - -let interp_with_options verbosely options s = - prerr_endline "Starting interp..."; - prerr_endline s; - let pa = Pcoq.Gram.parsable (Stream.of_string s) in - let pe = Pcoq.Gram.Entry.parse Pcoq.main_entry pa in - (* Temporary hack to make coqide.byte work (WTF???) - now with less screen - * pollution *) - (try Pervasives.prerr_string " \r"; Pervasives.flush stderr with _ -> ()); - match pe with - | None -> assert false - | Some((loc,vernac) as last) -> - if is_vernac_debug_command vernac then - user_error_loc loc (str "Debug mode not available within CoqIDE"); - if is_vernac_navigation_command vernac then - user_error_loc loc (str "Use CoqIDE navigation instead"); - if is_vernac_known_option_command vernac then - user_error_loc loc (str "Use CoqIDE display menu instead"); - if is_vernac_query_command vernac then - flash_info - "Warning: query commands should not be inserted in scripts"; - if not (is_vernac_goal_printing_command vernac) then - (* Verbose if in small step forward and not a tactic *) - Flags.make_silent (not verbosely); - let reset_info = compute_reset_info last in - List.iter (fun (set_option,_) -> raw_interp set_option) options; - raw_interp s; - Flags.make_silent true; - List.iter (fun (_,unset_option) -> raw_interp unset_option) options; - prerr_endline ("...Done with interp of : "^s); - reset_info - -let interp verbosely phrase = - interp_with_options verbosely (make_option_commands ()) phrase - -let interp_and_replace s = - let result = interp false s in - let msg = read_stdout () in - result,msg - -let rec is_pervasive_exn = function - | Out_of_memory | Stack_overflow | Sys.Break -> true - | Error_in_file (_,_,e) -> is_pervasive_exn e - | Compat.Exc_located (_,e) -> is_pervasive_exn e - | DuringCommandInterp (_,e) -> is_pervasive_exn e - | _ -> false - -let print_toplevel_error exc = - let (dloc,exc) = - match exc with - | DuringCommandInterp (loc,ie) -> - if loc = dummy_loc then (None,ie) else (Some loc, ie) - | _ -> (None, exc) - in - let (loc,exc) = - match exc with - | Compat.Exc_located (loc, ie) -> (Some loc),ie - | Error_in_file (s, (_,fname, loc), ie) -> None, ie - | _ -> dloc,exc - in - match exc with - | End_of_input -> str "Please report: End of input",None - | Vernacexpr.Drop -> str "Drop is not allowed by coqide!",None - | Vernacexpr.Quit -> str "Quit is not allowed by coqide! Use menus.",None - | _ -> - (try Cerrors.explain_exn exc with e -> - str "Failed to explain error. This is an internal Coq error. Please report.\n" - ++ str (Printexc.to_string e)), - (if is_pervasive_exn exc then None else loc) - -let process_exn e = let s,loc= print_toplevel_error e in (msgnl s,loc) - -let interp_last last = - prerr_string "*"; +(** * Count of all active coqtops *) + +let toplvl_ctr = ref 0 + +let toplvl_ctr_mtx = Mutex.create () + +let coqtop_zombies () = + Mutex.lock toplvl_ctr_mtx; + let res = !toplvl_ctr in + Mutex.unlock toplvl_ctr_mtx; + res + + +(** * Starting / signaling / ending a real coqtop sub-process *) + +(** We simulate a Unix.open_process that also returns the pid of + the created process. Note: this uses Unix.create_process, which + doesn't call bin/sh, so args shouldn't be quoted. The process + cannot be terminated by a Unix.close_process, but rather by a + kill of the pid. + + >--ide2top_w--[pipe]--ide2top_r--> + coqide coqtop + <--top2ide_r--[pipe]--top2ide_w--< + + Note: we use Unix.stderr in Unix.create_process to get debug + messages from the coqtop's Ide_slave loop. + + NB: it's important to close coqide's descriptors (ide2top_w and top2ide_r) + in coqtop. We do this indirectly via [Unix.set_close_on_exec]. + This way, coqide has the only remaining copies of these descriptors, + and closing them later will have visible effects in coqtop. Cf man 7 pipe : + + - If all file descriptors referring to the write end of a pipe have been + closed, then an attempt to read(2) from the pipe will see end-of-file + (read(2) will return 0). + - If all file descriptors referring to the read end of a pipe have been + closed, then a write(2) will cause a SIGPIPE signal to be generated for + the calling process. If the calling process is ignoring this signal, + then write(2) fails with the error EPIPE. + + Symmetrically, coqtop's descriptors (ide2top_r and top2ide_w) should be + closed in coqide. +*) + +let open_process_pid prog args = + let (ide2top_r,ide2top_w) = Unix.pipe () in + let (top2ide_r,top2ide_w) = Unix.pipe () in + Unix.set_close_on_exec ide2top_w; + Unix.set_close_on_exec top2ide_r; + let pid = Unix.create_process prog args ide2top_r top2ide_w Unix.stderr in + assert (pid <> 0); + Unix.close ide2top_r; + Unix.close top2ide_w; + let oc = Unix.out_channel_of_descr ide2top_w in + let ic = Unix.in_channel_of_descr top2ide_r in + set_binary_mode_out oc true; + set_binary_mode_in ic true; + (pid,ic,oc) + +let spawn_coqtop sup_args = + Mutex.lock toplvl_ctr_mtx; try - vernac_com Vernacentries.interp last; - Lib.add_frozen_state() + let prog = coqtop_path () in + let args = Array.of_list (prog :: "-ideslave" :: sup_args) in + let (pid,ic,oc) = open_process_pid prog args in + incr toplvl_ctr; + Mutex.unlock toplvl_ctr_mtx; + { pid = pid; cin = oc; cout = ic ; sup_args = sup_args } with e -> - let s,_ = process_exn e in prerr_endline ("Replay during undo failed because: "^s); + Mutex.unlock toplvl_ctr_mtx; raise e -let push_phrase cmd_stk reset_info ide_payload = - Stack.push (ide_payload,reset_info) cmd_stk - -type backtrack = - | BacktrackToNextActiveMark - | BacktrackToMark of reset_mark - | NoBacktrack - -let apply_reset = function - | BacktrackToMark mark -> reset_to mark - | NoBacktrack -> () - | BacktrackToNextActiveMark -> assert false - -let rewind sequence cmd_stk = - let undo_ops = Hashtbl.create 31 in - let current_proofs = undo_info () in - let pop_state cont seq coq reset_op prev_proofs curprf = - prerr_endline "pop"; - let curprf = - Option.map - (fun (curprf,depth) -> - (if Hashtbl.mem undo_ops curprf then Hashtbl.replace else Hashtbl.add) - undo_ops curprf depth; - curprf) - coq.cur_prf in - let reset_op = - match coq.status with - | ResetAtRegisteredObject mark -> - BacktrackToMark mark - | _ when is_vernac_state_preserving_command (snd coq.loc_ast) -> - reset_op - | _ when is_vernac_tactic_command (snd coq.loc_ast) -> - reset_op - | _ -> - BacktrackToNextActiveMark in - cont seq reset_op coq.proofs curprf - in - let rec do_rewind seq reset_op prev_proofs curprf = - match seq with - | [] when ((reset_op <> BacktrackToNextActiveMark) && - (Util.list_subset prev_proofs current_proofs)) -> - begin - Hashtbl.iter - (fun id depth -> - if List.mem id prev_proofs then begin - Pfedit.resume_proof (Util.dummy_loc,id); - Pfedit.undo_todepth depth - end) - undo_ops; - prerr_endline "OK for undos"; - Option.iter (fun id -> if List.mem id prev_proofs then - Pfedit.resume_proof (Util.dummy_loc,id)) curprf; - prerr_endline "OK for focusing"; - List.iter - (fun id -> Pfedit.delete_proof (Util.dummy_loc,id)) - (Util.list_subtract current_proofs prev_proofs); - prerr_endline "OK for aborts"; - apply_reset reset_op; - prerr_endline "OK for reset" - end - | [] -> - begin - try - let ide,coq = Stack.pop cmd_stk in - pop_state do_rewind [] coq reset_op prev_proofs curprf; - prerr_endline "push"; - let reset_info = compute_reset_info coq.loc_ast in - interp_last coq.loc_ast; - push_phrase cmd_stk reset_info ide - with Stack.Empty -> reset_initial () - end - | coq::rem -> - pop_state do_rewind rem coq reset_op prev_proofs curprf - in - do_rewind sequence NoBacktrack current_proofs None - -type tried_tactic = - | Interrupted - | Success of int (* nb of goals after *) - | Failed - -type hyp = env * evar_map * - ((identifier * string) * constr option * constr) * - (string * string) -type concl = env * evar_map * constr * string -type meta = env * evar_map * string -type goal = hyp list * concl - -let prepare_hyp sigma env ((i,c,d) as a) = - env, sigma, - ((i,string_of_id i),c,d), - (msg (pr_var_decl env a), msg (pr_ltype_env env d)) - -let prepare_hyps sigma env = - assert (rel_context env = []); - let hyps = - fold_named_context - (fun env d acc -> let hyp = prepare_hyp sigma env d in hyp :: acc) - env ~init:[] - in - List.rev hyps - -let prepare_goal_main sigma g = - let env = evar_env g in - (prepare_hyps sigma env, - (env, sigma, g.evar_concl, msg (pr_ltype_env_at_top env g.evar_concl))) - -let prepare_goal sigma g = - let options = make_option_commands () in - List.iter (fun (set_option,_) -> raw_interp set_option) options; - let x = prepare_goal_main sigma g in - List.iter (fun (_,unset_option) -> raw_interp unset_option) options; - x - -let get_current_pm_goal () = - let pfts = get_pftreestate () in - let gls = try nth_goal_of_pftreestate 1 pfts with _ -> raise Not_found in - let sigma= sig_sig gls in - let gl = sig_it gls in - prepare_goal sigma gl - -let get_current_goals () = - let pfts = get_pftreestate () in - let gls = fst (Refiner.frontier (Tacmach.proof_of_pftreestate pfts)) in - let sigma = Tacmach.evc_of_pftreestate pfts in - List.map (prepare_goal sigma) gls - -let print_no_goal () = - (* Fall back on standard coq goal printer for completed goal printing *) - msg (pr_open_subgoals ()) - -let hyp_menu (env, sigma, ((coqident,ident),_,ast),(s,pr_ast)) = - [("clear "^ident),("clear "^ident^"."); - - ("apply "^ident), - ("apply "^ident^"."); - - ("exact "^ident), - ("exact "^ident^"."); - - ("generalize "^ident), - ("generalize "^ident^"."); - - ("absurd <"^ident^">"), - ("absurd "^ - pr_ast - ^".") ] @ - - (if is_equality_type ast then - [ "discriminate "^ident, "discriminate "^ident^"."; - "injection "^ident, "injection "^ident^"." ] - else - []) @ - - (let _,t = splay_prod env sigma ast in - if is_equality_type t then - [ "rewrite "^ident, "rewrite "^ident^"."; - "rewrite <- "^ident, "rewrite <- "^ident^"." ] - else - []) @ - - [("elim "^ident), - ("elim "^ident^"."); - - ("inversion "^ident), - ("inversion "^ident^"."); - - ("inversion clear "^ident), - ("inversion_clear "^ident^".")] - -let concl_menu (_,_,concl,_) = - let is_eq = is_equality_type concl in - ["intro", "intro."; - "intros", "intros."; - "intuition","intuition." ] @ - - (if is_eq then - ["reflexivity", "reflexivity."; - "discriminate", "discriminate."; - "symmetry", "symmetry." ] - else - []) @ - - ["assumption" ,"assumption."; - "omega", "omega."; - "ring", "ring."; - "auto with *", "auto with *."; - "eauto with *", "eauto with *."; - "tauto", "tauto."; - "trivial", "trivial."; - "decide equality", "decide equality."; - - "simpl", "simpl."; - "subst", "subst."; - - "red", "red."; - "split", "split."; - "left", "left."; - "right", "right."; - ] - - -let id_of_name = function - | Names.Anonymous -> id_of_string "x" - | Names.Name x -> x - -let make_cases s = - let qualified_name = Libnames.qualid_of_string s in - let glob_ref = Nametab.locate qualified_name in - match glob_ref with - | Libnames.IndRef i -> - let {Declarations.mind_nparams = np}, - {Declarations.mind_consnames = carr ; - Declarations.mind_nf_lc = tarr } - = Global.lookup_inductive i - in - Util.array_fold_right2 - (fun n t l -> - let (al,_) = Term.decompose_prod t in - let al,_ = Util.list_chop (List.length al - np) al in - let rec rename avoid = function - | [] -> [] - | (n,_)::l -> - let n' = next_ident_away_in_goal - (id_of_name n) - avoid - in (string_of_id n')::(rename (n'::avoid) l) - in - let al' = rename [] (List.rev al) in - (string_of_id n :: al') :: l - ) - carr - tarr - [] - | _ -> raise Not_found - -let current_status () = - let path = msg (Libnames.pr_dirpath (Lib.cwd ())) in - let path = if path = "Top" then "Ready" else "Ready in " ^ String.sub path 4 (String.length path - 4) in - try - path ^ ", proving " ^ (Names.string_of_id (Pfedit.get_current_proof_name ())) - with _ -> path +let respawn_coqtop coqtop = spawn_coqtop coqtop.sup_args +let interrupter = ref (fun pid -> Unix.kill pid Sys.sigint) +let killer = ref (fun pid -> Unix.kill pid Sys.sigkill) + +let break_coqtop coqtop = + try !interrupter coqtop.pid + with _ -> prerr_endline "Error while sending Ctrl-C" + +let kill_coqtop coqtop = + let pid = coqtop.pid in + begin + try !killer pid + with _ -> prerr_endline "Kill -9 failed. Process already terminated ?" + end; + try + ignore (Unix.waitpid [] pid); + Mutex.lock toplvl_ctr_mtx; decr toplvl_ctr; Mutex.unlock toplvl_ctr_mtx + with _ -> prerr_endline "Error while waiting for child" + +(** * Calls to coqtop *) + +(** Cf [Ide_intf] for more details *) + +let p = Xml_parser.make () +let () = Xml_parser.check_eof p false + +let eval_call coqtop (c:'a Ide_intf.call) = + Xml_utils.print_xml coqtop.cin (Ide_intf.of_call c); + flush coqtop.cin; + let xml = Xml_parser.parse p (Xml_parser.SChannel coqtop.cout) in + (Ide_intf.to_answer xml c : 'a Interface.value) + +let interp coqtop ?(raw=false) ?(verbose=true) s = + eval_call coqtop (Ide_intf.interp (raw,verbose,s)) +let rewind coqtop i = eval_call coqtop (Ide_intf.rewind i) +let inloadpath coqtop s = eval_call coqtop (Ide_intf.inloadpath s) +let mkcases coqtop s = eval_call coqtop (Ide_intf.mkcases s) +let status coqtop = eval_call coqtop Ide_intf.status +let hints coqtop = eval_call coqtop Ide_intf.hints + +module PrintOpt = +struct + type t = string list + let implicit = ["Printing"; "Implicit"] + let coercions = ["Printing"; "Coercions"] + let raw_matching = ["Printing"; "Matching"; "Synth"] + let notations = ["Printing"; "Notations"] + let all_basic = ["Printing"; "All"] + let existential = ["Printing"; "Existential"; "Instances"] + let universes = ["Printing"; "Universes"] + + let state_hack = Hashtbl.create 11 + let _ = List.iter (fun opt -> Hashtbl.add state_hack opt false) + [ implicit; coercions; raw_matching; notations; all_basic; existential; universes ] + + let set coqtop options = + let () = List.iter (fun (name, v) -> Hashtbl.replace state_hack name v) options in + let options = List.map (fun (name, v) -> (name, Interface.BoolValue v)) options in + match eval_call coqtop (Ide_intf.set_options options) with + | Interface.Good () -> () + | _ -> raise (Failure "Cannot set options.") + + let enforce_hack coqtop = + let elements = Hashtbl.fold (fun opt v acc -> (opt, v) :: acc) state_hack [] in + set coqtop elements + +end + +let goals coqtop = + let () = PrintOpt.enforce_hack coqtop in + eval_call coqtop Ide_intf.goals + +let evars coqtop = + let () = PrintOpt.enforce_hack coqtop in + eval_call coqtop Ide_intf.evars diff --git a/ide/coq.mli b/ide/coq.mli index 9dec52c6..f25268ef 100644 --- a/ide/coq.mli +++ b/ide/coq.mli @@ -1,84 +1,74 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: coq.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) +(** Coq : Interaction with the Coq toplevel *) -open Names -open Term -open Environ -open Evd +(** * Version and date *) val short_version : unit -> string val version : unit -> string -type printing_state = { - mutable printing_implicit : bool; - mutable printing_coercions : bool; - mutable printing_raw_matching : bool; - mutable printing_no_notation : bool; - mutable printing_all : bool; - mutable printing_evar_instances : bool; - mutable printing_universes : bool; - mutable printing_full_all : bool -} +(** * Launch a test coqtop processes, ask for a correct coqtop if it fails. + @return the list of arguments that coqtop did not understand + (the files probably ..). This command may terminate coqide in + case of trouble. *) +val filter_coq_opts : string list -> string list -val printing_state : printing_state +(** Launch a coqtop with the user args in order to be sure that it works, + checking in particular that initial.coq is found. This command + may terminate coqide in case of trouble *) +val check_connection : string list -> unit -type reset_info +(** * The structure describing a coqtop sub-process *) -val reset_initial : unit -> unit +type coqtop -val init : unit -> string list -val interp : bool -> string -> reset_info -val interp_last : Util.loc * Vernacexpr.vernac_expr -> unit -val interp_and_replace : string -> - reset_info * string +(** * Count of all active coqtops *) -val push_phrase : ('a * reset_info) Stack.t -> reset_info -> 'a -> unit +val coqtop_zombies : unit -> int -val rewind : reset_info list -> ('a * reset_info) Stack.t -> unit +(** * Starting / signaling / ending a real coqtop sub-process *) -val is_vernac_tactic_command : Vernacexpr.vernac_expr -> bool -val is_vernac_state_preserving_command : Vernacexpr.vernac_expr -> bool -val is_vernac_goal_starting_command : Vernacexpr.vernac_expr -> bool -val is_vernac_proof_ending_command : Vernacexpr.vernac_expr -> bool +val spawn_coqtop : string list -> coqtop +val respawn_coqtop : coqtop -> coqtop +val kill_coqtop : coqtop -> unit +val break_coqtop : coqtop -> unit -(* type hyp = (identifier * constr option * constr) * string *) +(** In win32, we'll use a different kill function than Unix.kill *) -type hyp = env * evar_map * - ((identifier*string) * constr option * constr) * (string * string) -type meta = env * evar_map * string -type concl = env * evar_map * constr * string -type goal = hyp list * concl +val killer : (int -> unit) ref +val interrupter : (int -> unit) ref -val get_current_goals : unit -> goal list +(** * Calls to Coqtop, cf [Ide_intf] for more details *) -val get_current_pm_goal : unit -> goal +val interp : + coqtop -> ?raw:bool -> ?verbose:bool -> string -> string Interface.value +val rewind : coqtop -> int -> int Interface.value +val status : coqtop -> Interface.status Interface.value +val goals : coqtop -> Interface.goals option Interface.value +val evars : coqtop -> Interface.evar list option Interface.value +val hints : coqtop -> (Interface.hint list * Interface.hint) option Interface.value +val inloadpath : coqtop -> string -> bool Interface.value +val mkcases : coqtop -> string -> string list list Interface.value -val print_no_goal : unit -> string +(** A specialized version of [raw_interp] dedicated to + set/unset options. *) -val process_exn : exn -> string*(Util.loc option) +module PrintOpt : +sig + type t + val implicit : t + val coercions : t + val raw_matching : t + val notations : t + val all_basic : t + val existential : t + val universes : t -val hyp_menu : hyp -> (string * string) list -val concl_menu : concl -> (string * string) list - -val is_in_coq_lib : string -> bool -val is_in_coq_path : string -> bool -val is_in_loadpath : string -> bool - -val make_cases : string -> string list list - - -type tried_tactic = - | Interrupted - | Success of int (* nb of goals after *) - | Failed - -(* Message to display in lower status bar. *) - -val current_status : unit -> string + val set : coqtop -> (t * bool) list -> unit +end diff --git a/ide/coq_commands.ml b/ide/coq_commands.ml index d41bcf29..26dbcb12 100644 --- a/ide/coq_commands.ml +++ b/ide/coq_commands.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coq_commands.ml 14641 2011-11-06 11:59:10Z herbelin $ *) - let commands = [ [(* "Abort"; *) "Add Abstract Ring A Aplus Amult Aone Azero Ainv Aeq T."; @@ -16,8 +14,10 @@ let commands = [ "Add LoadPath"; "Add ML Path"; "Add Morphism"; + "Add Printing Constructor"; "Add Printing If"; "Add Printing Let"; + "Add Printing Record"; "Add Rec LoadPath"; "Add Rec ML Path"; "Add Ring A Aplus Amult Aone Azero Ainv Aeq T [ c1 ... cn ]. "; @@ -94,8 +94,10 @@ let commands = [ "Record"; "Remark"; "Remove LoadPath"; + "Remove Printing Constructor"; "Remove Printing If"; "Remove Printing Let"; + "Remove Printing Record"; "Require"; "Require Export"; "Require Import"; @@ -125,7 +127,6 @@ let commands = [ "Show Script"; "Show Tree";*) "Structure"; - (* "Suspend"; *) "Syntactic Definition"; "Syntax";]; [ diff --git a/ide/coq_lex.mll b/ide/coq_lex.mll index 02e21166..8a4aa91c 100644 --- a/ide/coq_lex.mll +++ b/ide/coq_lex.mll @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id$ *) - { open Lexing @@ -21,60 +19,56 @@ (* Without this table, the automaton would be too big and ocamllex would fail *) - let is_one_word_command = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ "Add" ; "Check"; "Eval"; "Extraction" ; - "Load" ; "Undo"; "Goal"; - "Proof" ; "Print";"Save" ; - "End" ; "Section"; "Chapter"; "Transparent"; "Opaque"; "Comments" - ]; - Hashtbl.mem h - - let is_constr_kw = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "for"; - "end"; "as"; "let"; "in"; "if"; "then"; "else"; "return"; - "Prop"; "Set"; "Type" ]; - Hashtbl.mem h - (* Without this table, the automaton would be too big and - ocamllex would fail *) - let is_one_word_declaration = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ (* Definitions *) - "Definition" ; "Let" ; "Example" ; "SubClass" ; - "Fixpoint" ; "CoFixpoint" ; "Scheme" ; "Function" ; - (* Assumptions *) - "Hypothesis" ; "Variable" ; "Axiom" ; "Parameter" ; "Conjecture" ; - "Hypotheses" ; "Variables" ; "Axioms" ; "Parameters"; - (* Inductive *) - "Inductive" ; "CoInductive" ; "Record" ; "Structure" ; - (* Other *) - "Ltac" ; "Typeclasses"; "Instance"; "Include"; "Context"; "Class" - ]; - Hashtbl.mem h - - let is_proof_declaration = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) + let tag_of_ident = + let one_word_commands = + [ "Add" ; "Check"; "Eval"; "Extraction" ; + "Load" ; "Undo"; "Goal"; + "Proof" ; "Print";"Save" ; "Restart"; + "End" ; "Section"; "Chapter"; "Transparent"; "Opaque"; "Comments" ] + in + let one_word_declarations = + [ (* Definitions *) + "Definition" ; "Let" ; "Example" ; "SubClass" ; + "Fixpoint" ; "CoFixpoint" ; "Scheme" ; "Function" ; + (* Assumptions *) + "Hypothesis" ; "Variable" ; "Axiom" ; "Parameter" ; "Conjecture" ; + "Hypotheses" ; "Variables" ; "Axioms" ; "Parameters"; + (* Inductive *) + "Inductive" ; "CoInductive" ; "Record" ; "Structure" ; + (* Other *) + "Ltac" ; "Instance"; "Include"; "Context"; "Class" ; + "Arguments" ] + in + let proof_declarations = [ "Theorem" ; "Lemma" ; " Fact" ; "Remark" ; "Corollary" ; - "Proposition" ; "Property" ]; - Hashtbl.mem h - - let is_proof_end = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ "Qed" ; "Defined" ; "Admitted"; "Abort" ]; - Hashtbl.mem h + "Proposition" ; "Property" ] + in + let proof_ends = + [ "Qed" ; "Defined" ; "Admitted"; "Abort" ] + in + let constr_keywords = + [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "for"; + "end"; "as"; "let"; "in"; "if"; "then"; "else"; "return"; + "Prop"; "Set"; "Type" ] + in + let h = Hashtbl.create 97 in (* for vernac *) + let h' = Hashtbl.create 97 in (* for constr *) + List.iter (fun s -> Hashtbl.add h s Keyword) one_word_commands; + List.iter (fun s -> Hashtbl.add h s Declaration) one_word_declarations; + List.iter (fun s -> Hashtbl.add h s ProofDeclaration) proof_declarations; + List.iter (fun s -> Hashtbl.add h s Qed) proof_ends; + List.iter (fun s -> Hashtbl.add h' s Keyword) constr_keywords; + (fun initial id -> Hashtbl.find (if initial then h else h') id) + + exception Unterminated + + let here f lexbuf = f (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) - let start = ref true } let space = - [' ' '\010' '\013' '\009' '\012'] + [' ' '\n' '\r' '\t' '\012'] (* '\012' is form-feed *) let firstchar = ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'] @@ -82,41 +76,38 @@ let identchar = ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] let ident = firstchar identchar* -let sentence_sep = '.' [ ' ' '\n' '\t' ] +let undotted_sep = [ '{' '}' '-' '+' '*' ] + +let dot_sep = '.' (space | eof) let multiword_declaration = "Module" (space+ "Type")? | "Program" space+ ident -| "Existing" space+ "Instance" +| "Existing" space+ "Instance" "s"? | "Canonical" space+ "Structure" -let locality = ("Local" space+)? +let locality = (space+ "Local")? let multiword_command = - "Set" (space+ ident)* -| "Unset" (space+ ident)* -| "Open" space+ locality "Scope" -| "Close" space+ locality "Scope" -| "Bind" space+ "Scope" -| "Arguments" space+ "Scope" -| "Reserved" space+ "Notation" space+ locality -| "Delimit" space+ "Scope" + ("Uns" | "S")" et" (space+ ident)* +| (("Open" | "Close") locality | "Bind" | " Delimit" ) + space+ "Scope" +| (("Reserved" space+)? "Notation" | "Infix") locality space+ | "Next" space+ "Obligation" | "Solve" space+ "Obligations" | "Require" space+ ("Import"|"Export")? -| "Infix" space+ locality -| "Notation" space+ locality -| "Hint" space+ locality ident +| "Hint" locality space+ ident | "Reset" (space+ "Initial")? | "Tactic" space+ "Notation" -| "Implicit" space+ "Arguments" -| "Implicit" space+ ("Type"|"Types") +| "Implicit" space+ "Type" "s"? | "Combined" space+ "Scheme" | "Extraction" space+ (("Language" space+ ("Ocaml"|"Haskell"|"Scheme"|"Toplevel"))| ("Library"|"Inline"|"NoInline"|"Blacklist")) | "Recursive" space+ "Extraction" (space+ "Library")? | ("Print"|"Reset") space+ "Extraction" space+ ("Inline"|"Blacklist") | "Extract" space+ (("Inlined" space+) "Constant"| "Inductive") +| "Typeclasses" space+ ("eauto" | "Transparent" | "Opaque") +| ("Generalizable" space+) ("All" | "No")? "Variable" "s"? (* At least still missing: "Inline" + decl, variants of "Identity Coercion", variants of Print, Add, ... *) @@ -130,65 +121,75 @@ rule coq_string = parse and comment = parse | "(*" { ignore (comment lexbuf); comment lexbuf } | "\"" { ignore (coq_string lexbuf); comment lexbuf } - | "*)" { Lexing.lexeme_end lexbuf } - | eof { Lexing.lexeme_end lexbuf } + | "*)" { (true, Lexing.lexeme_start lexbuf + 2) } + | eof { (false, Lexing.lexeme_end lexbuf) } | _ { comment lexbuf } -and sentence stamp = parse - | space+ { sentence stamp lexbuf } +and sentence initial stamp = parse | "(*" { let comm_start = Lexing.lexeme_start lexbuf in - let comm_end = comment lexbuf in + let trully_terminated,comm_end = comment lexbuf in stamp comm_start comm_end Comment; - sentence stamp lexbuf + if not trully_terminated then raise Unterminated; + (* A comment alone is a sentence. + A comment in a sentence doesn't terminate the sentence. + Note: comm_end is the first position _after_ the comment, + as required when tagging a zone, hence the -1 to locate the + ")" terminating the comment. + *) + if initial then comm_end - 1 else sentence false stamp lexbuf } | "\"" { let str_start = Lexing.lexeme_start lexbuf in let str_end = coq_string lexbuf in stamp str_start str_end String; - start := false; - sentence stamp lexbuf + sentence false stamp lexbuf } | multiword_declaration { - if !start then begin - start := false; - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) Declaration - end; - sentence stamp lexbuf + if initial then here stamp lexbuf Declaration; + sentence false stamp lexbuf } | multiword_command { - if !start then begin - start := false; - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) Keyword - end; - sentence stamp lexbuf } + if initial then here stamp lexbuf Keyword; + sentence false stamp lexbuf + } | ident as id { - if !start then begin - start := false; - if id <> "Time" then begin - if is_proof_end id then - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) Qed - else if is_one_word_command id then - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) Keyword - else if is_one_word_declaration id then - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) Declaration - else if is_proof_declaration id then - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) ProofDeclaration - end - end else begin - if is_constr_kw id then - stamp (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf) Keyword - end; - sentence stamp lexbuf } - | ".." - | _ { sentence stamp lexbuf} - | sentence_sep { } - | eof { raise Not_found } + (try here stamp lexbuf (tag_of_ident initial id) with Not_found -> ()); + sentence false stamp lexbuf } + | ".." { + (* We must have a particular rule for parsing "..", where no dot + is a terminator, even if we have a blank afterwards + (cf. for instance the syntax for recursive notation). + This rule and the following one also allow to treat the "..." + special case, where the third dot is a terminator. *) + sentence false stamp lexbuf + } + | dot_sep { Lexing.lexeme_start lexbuf } (* The usual "." terminator *) + | undotted_sep { + (* Separators like { or } and bullets * - + are only active + at the start of a sentence *) + if initial then Lexing.lexeme_start lexbuf + else sentence false stamp lexbuf + } + | space+ { + (* Parsing spaces is the only situation preserving initiality *) + sentence initial stamp lexbuf + } + | _ { + (* Any other characters *) + sentence false stamp lexbuf + } + | eof { raise Unterminated } { - let find_end_offset stamp slice = - let lb = Lexing.from_string slice in - start := true; - sentence stamp lb; - Lexing.lexeme_end lb + + (** Parse a sentence in string [slice], tagging relevant parts with + function [stamp], and returning the position of the first + sentence delimitor (either "." or "{" or "}" or the end of a comment). + It will raise [Unterminated] when no end of sentence is found. + *) + + let delimit_sentence stamp slice = + sentence true stamp (Lexing.from_string slice) + } diff --git a/ide/coq_tactics.ml b/ide/coq_tactics.ml deleted file mode 100644 index 568594bd..00000000 --- a/ide/coq_tactics.ml +++ /dev/null @@ -1,131 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(* $Id: coq_tactics.ml 14641 2011-11-06 11:59:10Z herbelin $ *) - -let tactics = [ - "Abstract"; - "Absurd"; - "Apply"; - "Apply ... with"; - "Assert"; - "Assumption"; - "Auto"; - "AutoRewrite"; - "Binding list"; - "Case"; - "Case ... with"; - "Cbv"; - "Change"; - "Change ... in"; - "Clear"; - "ClearBody"; - "Compare"; - "Compute"; - "Constructor"; - "Constructor ... with"; - "Contradiction"; - "Conversion tactics"; - "Cut"; - "CutRewrite"; - "Decide Equality"; - "Decompose"; - "Decompose Record"; - "Decompose Sum"; - "Dependent Inversion"; - "Dependent Inversion ... with"; - "Dependent Inversion_clear"; - "Dependent Inversion_clear ... with"; - "Dependent Rewrite ->"; - "Dependent Rewrite <-"; - "Derive Inversion"; - "Destruct"; - "Discriminate"; - "DiscrR"; - "Do"; - "Double Induction"; - "EApply"; - "EAuto"; - "Elim ... using"; - "Elim ... with"; - "ElimType"; - "Exact"; - "Exists"; - "Fail"; - "Field"; - "First"; - "Fold"; - "Fourier"; - "Generalize"; - "Generalize Dependent"; - "Print Hint"; - "Hnf"; - "Idtac"; - "Induction"; - "Info"; - "Injection"; - "Intro"; - "Intro ... after"; - "Intro after"; - "Intros"; - "Intros pattern"; - "Intros until"; - "Intuition"; - "Inversion"; - "Inversion ... in"; - "Inversion ... using"; - "Inversion ... using ... in"; - "Inversion_clear"; - "Inversion_clear ... in"; - "LApply"; - "Lazy"; - "Left"; - "LetTac"; - "Move"; - "NewDestruct"; - "NewInduction"; - "Omega"; - "Orelse"; - "Pattern"; - "Pose"; - "Prolog"; - "Quote"; - "Red"; - "Refine"; - "Reflexivity"; - "Rename"; - "Repeat"; - "Replace ... with"; - "Rewrite"; - "Rewrite ->"; - "Rewrite -> ... in"; - "Rewrite <-"; - "Rewrite <- ... in"; - "Rewrite ... in"; - "Right"; - "Ring"; - "Setoid_replace"; - "Setoid_rewrite"; - "Simpl"; - "Simple Inversion"; - "Simplify_eq"; - "Solve"; - "Split"; - "SplitAbsolu"; - "SplitRmult"; - "Subst"; - "Symmetry"; - "Tacticals"; - "Tauto"; - "Transitivity"; - "Trivial"; - "Try"; - "tactic macros"; - "Unfold"; - "Unfold ... in"; -] diff --git a/ide/coq_tactics.mli b/ide/coq_tactics.mli deleted file mode 100644 index 4c583d3a..00000000 --- a/ide/coq_tactics.mli +++ /dev/null @@ -1,12 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*i $Id: coq_tactics.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) - -val tactics : string list - diff --git a/ide/.coqide-gtk2rc b/ide/coqide-gtk2rc index 11c53dad..9da99551 100644 --- a/ide/.coqide-gtk2rc +++ b/ide/coqide-gtk2rc @@ -1,5 +1,5 @@ -# Some default functions for CoqIde. You may copy the file in your HOME and -# edit as you want. See +# Some default functions for CoqIde. You may copy the file in $XDG_CONFIG_HOME +# ($HOME/.config/coq/) and edit as you want. See # http://developer.gnome.org/doc/API/2.0/gtk/gtk-Resource-Files.html # for a complete set of options # To set the font of the text windows, edit the .coqiderc file through the menus. @@ -23,16 +23,6 @@ binding "text" { class "GtkTextView" binding "text" -style "views" { -base[NORMAL] = "CornSilk" -# bg_pixmap[NORMAL] = "background.jpg" -} -class "GtkTextView" style "views" - -widget "*.*.*.*.*.ScriptWindow" style "views" -widget "*.*.*.*.GoalWindow" style "views" -widget "*.*.*.*.MessageWindow" style "views" - gtk-font-name = "Sans 12" style "location" { diff --git a/ide/coqide.ml b/ide/coqide.ml index 0c99b8a2..94be8318 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -1,16 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqide.ml 15023 2012-03-08 22:35:31Z pboutill $ *) - open Preferences -open Vernacexpr -open Coq open Gtk_parsing open Ideutils @@ -19,11 +15,18 @@ type ide_info = { stop : GText.mark; } +(** Have we used admit or declarative mode's daimon ? + If yes, we color differently *) + +type safety = Safe | Unsafe + +let safety_tag = function + | Safe -> Tags.Script.processed + | Unsafe -> Tags.Script.unjustified class type analyzed_views= -object('self) +object val mutable act_id : GtkSignal.id option - val mutable deact_id : GtkSignal.id option val input_buffer : GText.buffer val input_view : Undo.undoable_view val last_array : string array @@ -32,22 +35,17 @@ object('self) val message_view : GText.view val proof_buffer : GText.buffer val proof_view : GText.view - val cmd_stack : (ide_info * Coq.reset_info) Stack.t + val cmd_stack : ide_info Stack.t + val mycoqtop : Coq.coqtop ref val mutable is_active : bool val mutable read_only : bool val mutable filename : string option val mutable stats : Unix.stats option - val mutable detached_views : GWindow.window list method without_auto_complete : 'a 'b. ('a -> 'b) -> 'a -> 'b method set_auto_complete : bool -> unit - method kill_detached_views : unit -> unit - method add_detached_view : GWindow.window -> unit - method remove_detached_view : GWindow.window -> unit - method filename : string option method stats : Unix.stats option - method set_filename : string option -> unit method update_stats : unit method revert : unit method auto_save : unit @@ -61,31 +59,25 @@ object('self) method backtrack_to : GText.iter -> unit method backtrack_to_no_lock : GText.iter -> unit method clear_message : unit - method deactivate : unit -> unit - method disconnected_keypress_handler : GdkEvent.Key.t -> bool - method electric_handler : GtkSignal.id method find_phrase_starting_at : GText.iter -> (GText.iter * GText.iter) option method get_insert : GText.iter method get_start_of_input : GText.iter method go_to_insert : unit method indent_current_line : unit + method go_to_next_occ_of_cur_word : unit + method go_to_prev_occ_of_cur_word : unit method insert_command : string -> string -> unit method tactic_wizard : string list -> unit method insert_message : string -> unit - method insert_this_phrase_on_success : - bool -> bool -> bool -> string -> string -> bool - method process_next_phrase : bool -> bool -> bool -> bool + method process_next_phrase : bool -> unit method process_until_iter_or_error : GText.iter -> unit method process_until_end_or_error : unit method recenter_insert : unit method reset_initial : unit - method send_to_coq : - bool -> bool -> string -> - bool -> bool -> bool -> - (bool*reset_info) option + method force_reset_initial : unit method set_message : string -> unit - method show_pm_goal : unit + method raw_coq_query : string -> unit method show_goals : unit method show_goals_full : unit method undo_last_step : unit @@ -102,72 +94,74 @@ type viewable_script = proof_view : GText.view; message_view : GText.view; analyzed_view : analyzed_views; - command_stack : (ide_info * Coq.reset_info) Stack.t; + toplvl : Coq.coqtop ref; + command : Command_windows.command_window; } - -let notebook_page_of_session {script=script;tab_label=bname;proof_view=proof;message_view=message} = - let session_paned = - GPack.paned `HORIZONTAL ~border_width:5 () in - let script_frame = - GBin.frame ~shadow_type:`IN ~packing:session_paned#add1 () in - let script_scroll = - GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC ~packing:script_frame#add () in - let state_paned = - GPack.paned `VERTICAL ~packing:session_paned#add2 () in - let proof_frame = - GBin.frame ~shadow_type:`IN ~packing:state_paned#add1 () in - let proof_scroll = - GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC ~packing:proof_frame#add () in - let message_frame = - GBin.frame ~shadow_type:`IN ~packing:state_paned#add2 () in - let message_scroll = - GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC ~packing:message_frame#add () in - let session_tab = - GPack.hbox ~homogeneous:false () in - let img = - GMisc.image ~packing:session_tab#pack ~icon_size:`SMALL_TOOLBAR () in +let kill_session s = + (* To close the detached views of this script, we call manually + [destroy] on it, triggering some callbacks in [detach_view]. + In a more modern lablgtk, rather use the page-removed signal ? *) + s.script#destroy (); + Coq.kill_coqtop !(s.toplvl) + +let build_session s = + let session_paned = GPack.paned `VERTICAL () in + let eval_paned = GPack.paned `HORIZONTAL ~border_width:5 + ~packing:(session_paned#pack1 ~shrink:false ~resize:true) () in + let script_frame = GBin.frame ~shadow_type:`IN + ~packing:eval_paned#add1 () in + let script_scroll = GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC + ~packing:script_frame#add () in + let state_paned = GPack.paned `VERTICAL + ~packing:eval_paned#add2 () in + let proof_frame = GBin.frame ~shadow_type:`IN + ~packing:state_paned#add1 () in + let proof_scroll = GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC + ~packing:proof_frame#add () in + let message_frame = GBin.frame ~shadow_type:`IN + ~packing:state_paned#add2 () in + let message_scroll = GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC + ~packing:message_frame#add () in + let session_tab = GPack.hbox ~homogeneous:false () in + let img = GMisc.image ~icon_size:`SMALL_TOOLBAR + ~packing:session_tab#pack () in let _ = - script#buffer#connect#modified_changed - ~callback:(fun () -> if script#buffer#modified - then img#set_stock `SAVE - else img#set_stock `YES) in + s.script#buffer#connect#modified_changed + ~callback:(fun () -> if s.script#buffer#modified + then img#set_stock `SAVE + else img#set_stock `YES) in let _ = - session_paned#misc#connect#size_allocate + eval_paned#misc#connect#size_allocate + ~callback: (let old_paned_width = ref 2 in let old_paned_height = ref 2 in - (fun {Gtk.width=paned_width;Gtk.height=paned_height} -> - if !old_paned_width <> paned_width || !old_paned_height <> paned_height then ( - session_paned#set_position (session_paned#position * paned_width / !old_paned_width); - state_paned#set_position (state_paned#position * paned_height / !old_paned_height); - old_paned_width := paned_width; - old_paned_height := paned_height; - ))) in - script_scroll#add script#coerce; - proof_scroll#add proof#coerce; - message_scroll#add message#coerce; - session_tab#pack bname#coerce; - img#set_stock `YES; - session_paned#set_position 1; - state_paned#set_position 1; - (Some session_tab#coerce,None,session_paned#coerce) + (fun {Gtk.width=paned_width;Gtk.height=paned_height} -> + if !old_paned_width <> paned_width || !old_paned_height <> paned_height then ( + eval_paned#set_position (eval_paned#position * paned_width / !old_paned_width); + state_paned#set_position (state_paned#position * paned_height / !old_paned_height); + old_paned_width := paned_width; + old_paned_height := paned_height; + ))) + in + session_paned#pack2 ~shrink:false ~resize:false (s.command#frame#coerce); + script_scroll#add s.script#coerce; + proof_scroll#add s.proof_view#coerce; + message_scroll#add s.message_view#coerce; + session_tab#pack s.tab_label#coerce; + img#set_stock `YES; + eval_paned#set_position 1; + state_paned#set_position 1; + (Some session_tab#coerce,None,session_paned#coerce) let session_notebook = - Typed_notebook.create notebook_page_of_session ~border_width:2 ~show_border:false ~scrollable:true () - -let active_view = ref (~-1) - -let on_active_view f = - if !active_view < 0 - then failwith "no active view !" - else f (session_notebook#get_nth_term !active_view) + Typed_notebook.create build_session kill_session + ~border_width:2 ~show_border:false ~scrollable:true () let cb = GData.clipboard Gdk.Atom.primary - let last_cb_content = ref "" - let update_notebook_pos () = let pos = match !current.vertical_tabs, !current.opposite_tabs with @@ -178,21 +172,13 @@ let update_notebook_pos () = in session_notebook#set_tab_pos pos - -let set_active_view i = - prerr_endline "entering set_active_view"; - (try on_active_view (fun {tab_label=lbl} -> lbl#set_text lbl#text) with _ -> ()); - session_notebook#goto_page i; - let s = session_notebook#current_term in - s.tab_label#set_use_markup true; - s.tab_label#set_label ("<span background=\"light green\">"^s.tab_label#text^"</span>"); - active_view := i; - prerr_endline "exiting set_active_view" - +let to_do_on_page_switch = ref [] -let to_do_on_page_switch = ref [] +(** * Coqide's handling of signals *) +(** We ignore Ctrl-C, and for most of the other catchable signals + we launch an emergency save of opened files and then exit *) let signals_to_crash = [Sys.sigabrt; Sys.sigalrm; Sys.sigfpe; Sys.sighup; Sys.sigill; Sys.sigpipe; Sys.sigquit; @@ -200,75 +186,83 @@ let signals_to_crash = [Sys.sigabrt; Sys.sigalrm; Sys.sigfpe; Sys.sighup; let crash_save i = (* ignore (Unix.sigprocmask Unix.SIG_BLOCK signals_to_crash);*) - safe_prerr_endline "Trying to save all buffers in .crashcoqide files"; + Minilib.safe_prerr_endline "Trying to save all buffers in .crashcoqide files"; let count = ref 0 in - List.iter - (function {script=view; analyzed_view = av } -> - (let filename = match av#filename with - | None -> - incr count; - "Unnamed_coqscript_"^(string_of_int !count)^".crashcoqide" - | Some f -> f^".crashcoqide" - in - try - if try_export filename (view#buffer#get_text ()) then - safe_prerr_endline ("Saved "^filename) - else safe_prerr_endline ("Could not save "^filename) - with _ -> safe_prerr_endline ("Could not save "^filename)) - ) - session_notebook#pages; - safe_prerr_endline "Done. Please report."; - if i <> 127 then exit i + List.iter + (function {script=view; analyzed_view = av } -> + (let filename = match av#filename with + | None -> + incr count; + "Unnamed_coqscript_"^(string_of_int !count)^".crashcoqide" + | Some f -> f^".crashcoqide" + in + try + if try_export filename (view#buffer#get_text ()) then + Minilib.safe_prerr_endline ("Saved "^filename) + else Minilib.safe_prerr_endline ("Could not save "^filename) + with _ -> Minilib.safe_prerr_endline ("Could not save "^filename)) + ) + session_notebook#pages; + Minilib.safe_prerr_endline "Done. Please report."; + if i <> 127 then exit i let ignore_break () = List.iter (fun i -> - try Sys.set_signal i (Sys.Signal_handle crash_save) - with _ -> prerr_endline "Signal ignored (normal if Win32)") + try Sys.set_signal i (Sys.Signal_handle crash_save) + with _ -> prerr_endline "Signal ignored (normal if Win32)") signals_to_crash; + (* We ignore the Ctrl-C, this is required for the Stop button to work, + since we will actually send Ctrl-C to all processes sharing + our console (including us) *) Sys.set_signal Sys.sigint Sys.Signal_ignore + +(** * Locks *) + (* Locking machinery for Coq kernel *) let coq_computing = Mutex.create () (* To prevent Coq from interrupting during undoing...*) let coq_may_stop = Mutex.create () +(* To prevent a force_reset_initial during a force_reset_initial *) +let resetting = Mutex.create () + +exception RestartCoqtop +exception Unsuccessful + +let force_reset_initial () = + prerr_endline "Reset Initial"; + session_notebook#current_term.analyzed_view#force_reset_initial + let break () = - prerr_endline "User break received:"; - if not (Mutex.try_lock coq_computing) then - begin - prerr_endline " trying to stop computation:"; - if Mutex.try_lock coq_may_stop then begin - Util.interrupt := true; - prerr_endline " interrupt flag set. Computation should stop soon..."; - Mutex.unlock coq_may_stop - end else prerr_endline " interruption refused (may not stop now)"; - end - else begin - Mutex.unlock coq_computing; - prerr_endline " ignored (not computing)" - end + prerr_endline "User break received"; + Coq.break_coqtop !(session_notebook#current_term.toplvl) let do_if_not_computing text f x = let threaded_task () = - (* Beware: mutexes must be locked and unlocked in the same thread - on at least FreeBSD (see bug #2431) *) if Mutex.try_lock coq_computing then begin - prerr_endline "Getting lock"; - try - f x; - prerr_endline "Releasing lock"; - Mutex.unlock coq_computing; - with e -> - prerr_endline "Releasing lock (on error)"; - Mutex.unlock coq_computing; - raise e + prerr_endline "Getting lock"; + List.iter + (fun elt -> try f elt with + | RestartCoqtop -> elt.analyzed_view#reset_initial + | Sys_error str -> + elt.analyzed_view#reset_initial; + elt.analyzed_view#set_message + ("Unable to communicate with coqtop, restarting coqtop.\n"^ + "Error was: "^str) + | e -> + Mutex.unlock coq_computing; + elt.analyzed_view#set_message + ("Unknown error, please report:\n"^(Printexc.to_string e))) + x; + prerr_endline "Releasing lock"; + Mutex.unlock coq_computing; end else - prerr_endline - "Discarded order (computations are ongoing)" + prerr_endline "Discarded order (computations are ongoing)" in prerr_endline ("Launching thread " ^ text); ignore (Glib.Timeout.add ~ms:300 ~callback: @@ -277,69 +271,77 @@ let do_if_not_computing text f x = else (pbar#pulse (); true))); ignore (Thread.create threaded_task ()) -(* XXX - 1 appel *) -let kill_input_view i = - let v = session_notebook#get_nth_term i in - v.analyzed_view#kill_detached_views (); - v.script#destroy (); - v.tab_label#destroy (); - v.proof_view#destroy (); - v.message_view#destroy (); - session_notebook#remove_page i - let warning msg = GToolbox.message_box ~title:"Warning" ~icon:(let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) msg -(* -(* XXX - beaucoups d'appels, a garder *) -let get_current_view = - focused_session - *) let remove_current_view_page () = let do_remove () = let c = session_notebook#current_page in - kill_input_view c + session_notebook#remove_page c in let current = session_notebook#current_term in - if not current.script#buffer#modified then do_remove () - else - match GToolbox.question_box ~title:"Close" - ~buttons:["Save Buffer and Close"; - "Close without Saving"; - "Don't Close"] - ~default:0 - ~icon:(let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) - "This buffer has unsaved modifications" - with - | 1 -> - begin match current.analyzed_view#filename with - | None -> - begin match select_file_for_save ~title:"Save file" () with - | None -> () - | Some f -> - if current.analyzed_view#save_as f then begin - flash_info ("File " ^ f ^ " saved") ; - do_remove () - end else - warning ("Save Failed (check if " ^ f ^ " is writable)") - end + if not current.script#buffer#modified then do_remove () + else + match GToolbox.question_box ~title:"Close" + ~buttons:["Save Buffer and Close"; + "Close without Saving"; + "Don't Close"] + ~default:0 + ~icon:(let img = GMisc.image () in + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) + "This buffer has unsaved modifications" + with + | 1 -> + begin match current.analyzed_view#filename with + | None -> + begin match select_file_for_save ~title:"Save file" () with + | None -> () | Some f -> - if current.analyzed_view#save f then begin - flash_info ("File " ^ f ^ " saved") ; - do_remove () - end else - warning ("Save Failed (check if " ^ f ^ " is writable)") + if current.analyzed_view#save_as f then begin + flash_info ("File " ^ f ^ " saved") ; + do_remove () + end else + warning ("Save Failed (check if " ^ f ^ " is writable)") end - | 2 -> do_remove () - | _ -> () + | Some f -> + if current.analyzed_view#save f then begin + flash_info ("File " ^ f ^ " saved") ; + do_remove () + end else + warning ("Save Failed (check if " ^ f ^ " is writable)") + end + | 2 -> do_remove () + | _ -> () + +module Opt = Coq.PrintOpt + +let print_items = [ + ([Opt.implicit],"Display implicit arguments","Display _implicit arguments", + "i",false); + ([Opt.coercions],"Display coercions","Display _coercions","c",false); + ([Opt.raw_matching],"Display raw matching expressions", + "Display raw _matching expressions","m",true); + ([Opt.notations],"Display notations","Display _notations","n",true); + ([Opt.all_basic],"Display all basic low-level contents", + "Display _all basic low-level contents","a",false); + ([Opt.existential],"Display existential variable instances", + "Display _existential variable instances","e",false); + ([Opt.universes],"Display universe levels","Display _universe levels", + "u",false); + ([Opt.all_basic;Opt.existential;Opt.universes], "Display all low-level contents", + "Display all _low-level contents","l",false) +] + +let setopts ct opts v = + let opts = List.map (fun o -> (o, v)) opts in + Coq.PrintOpt.set ct opts (* Reset this to None on page change ! *) let (last_completion:(string*int*int*bool) option ref) = ref None @@ -351,64 +353,64 @@ let rec complete input_buffer w (offset:int) = match !last_completion with | Some (lw,loffset,lpos,backward) when lw=w && loffset=offset -> - begin - let iter = input_buffer#get_iter (`OFFSET lpos) in - if backward then - match complete_backward w iter with - | None -> - last_completion := - Some (lw,loffset, - (find_word_end - (input_buffer#get_iter (`OFFSET loffset)))#offset , - false); - None - | Some (ss,start,stop) as result -> - last_completion := - Some (w,offset,ss#offset,true); - result - else - match complete_forward w iter with - | None -> - last_completion := None; - None - | Some (ss,start,stop) as result -> - last_completion := - Some (w,offset,ss#offset,false); - result - end - | _ -> begin - match complete_backward w (input_buffer#get_iter (`OFFSET offset)) with + begin + let iter = input_buffer#get_iter (`OFFSET lpos) in + if backward then + match complete_backward w iter with + | None -> + last_completion := + Some (lw,loffset, + (find_word_end + (input_buffer#get_iter (`OFFSET loffset)))#offset , + false); + None + | Some (ss,start,stop) as result -> + last_completion := + Some (w,offset,ss#offset,true); + result + else + match complete_forward w iter with | None -> - last_completion := - Some (w,offset,(find_word_end (input_buffer#get_iter - (`OFFSET offset)))#offset,false); - complete input_buffer w offset + last_completion := None; + None | Some (ss,start,stop) as result -> - last_completion := Some (w,offset,ss#offset,true); - result + last_completion := + Some (w,offset,ss#offset,false); + result end + | _ -> begin + match complete_backward w (input_buffer#get_iter (`OFFSET offset)) with + | None -> + last_completion := + Some (w,offset,(find_word_end (input_buffer#get_iter + (`OFFSET offset)))#offset,false); + complete input_buffer w offset + | Some (ss,start,stop) as result -> + last_completion := Some (w,offset,ss#offset,true); + result + end let get_current_word () = match session_notebook#current_term,cb#text with | {script=script; analyzed_view=av;},None -> - prerr_endline "None selected"; - let it = av#get_insert in - let start = find_word_start it in - let stop = find_word_end start in - script#buffer#move_mark `SEL_BOUND start; - script#buffer#move_mark `INSERT stop; - script#buffer#get_text ~slice:true ~start ~stop () - | _,Some t -> - prerr_endline "Some selected"; - prerr_endline t; - t + prerr_endline "None selected"; + let it = av#get_insert in + let start = find_word_start it in + let stop = find_word_end start in + script#buffer#move_mark `SEL_BOUND ~where:start; + script#buffer#move_mark `INSERT ~where:stop; + script#buffer#get_text ~slice:true ~start ~stop () + | _,Some t -> + prerr_endline "Some selected"; + prerr_endline t; + t let input_channel b ic = let buf = String.create 1024 and len = ref 0 in - while len := input ic buf 0 1024; !len > 0 do - Buffer.add_substring b buf 0 !len - done + while len := input ic buf 0 1024; !len > 0 do + Buffer.add_substring b buf 0 !len + done let with_file handler name ~f = try @@ -416,116 +418,136 @@ let with_file handler name ~f = try f ic; close_in ic with e -> close_in ic; raise e with Sys_error s -> handler s - -(* For electric handlers *) -exception Found - (* For find_phrase_starting_at *) exception Stop of int -(* XXX *) -let activate_input i = - prerr_endline "entering activate_input"; - (try on_active_view (fun {analyzed_view=a_v} -> a_v#reset_initial; a_v#deactivate ()) - with _ -> ()); - (session_notebook#get_nth_term i).analyzed_view#activate (); - set_active_view i; - prerr_endline "exiting activate_input" +let tag_of_sort = function + | Coq_lex.Comment -> Tags.Script.comment + | Coq_lex.Keyword -> Tags.Script.kwd + | Coq_lex.Declaration -> Tags.Script.decl + | Coq_lex.ProofDeclaration -> Tags.Script.proof_decl + | Coq_lex.Qed -> Tags.Script.qed + | Coq_lex.String -> failwith "No tag" let apply_tag (buffer:GText.buffer) orig off_conv from upto sort = - let conv_and_apply start stop tag = + try + let tag = tag_of_sort sort in let start = orig#forward_chars (off_conv from) in let stop = orig#forward_chars (off_conv upto) in buffer#apply_tag ~start ~stop tag - in match sort with - | Coq_lex.Comment -> - conv_and_apply from upto Tags.Script.comment - | Coq_lex.Keyword -> - conv_and_apply from upto Tags.Script.kwd - | Coq_lex.Declaration -> - conv_and_apply from upto Tags.Script.decl - | Coq_lex.ProofDeclaration -> - conv_and_apply from upto Tags.Script.proof_decl - | Coq_lex.Qed -> - conv_and_apply from upto Tags.Script.qed - | Coq_lex.String -> () + with _ -> () let remove_tags (buffer:GText.buffer) from upto = List.iter (buffer#remove_tag ~start:from ~stop:upto) [ Tags.Script.comment; Tags.Script.kwd; Tags.Script.decl; Tags.Script.proof_decl; Tags.Script.qed ] +(** Cut a part of the buffer in sentences and tag them. + Invariant: either this slice ends the buffer, or it ends with ".". + May raise [Coq_lex.Unterminated] when the zone ends with + an unterminated sentence. *) + let split_slice_lax (buffer:GText.buffer) from upto = remove_tags buffer from upto; - buffer#remove_tag ~start:from ~stop:upto Tags.Script.lax_end; + buffer#remove_tag ~start:from ~stop:upto Tags.Script.sentence; let slice = buffer#get_text ~start:from ~stop:upto () in - let slice = slice ^ " " in let rec split_substring str = let off_conv = byte_offset_to_char_offset str in let slice_len = String.length str in - let sentence_len = Coq_lex.find_end_offset (apply_tag buffer from off_conv) str in - - let stop = from#forward_chars (pred (off_conv sentence_len)) in - let start = stop#backward_char in - buffer#apply_tag ~start ~stop Tags.Script.lax_end; - - if 1 < slice_len - sentence_len then begin (* remember that we added a trailing space *) - ignore (from#nocopy#forward_chars (off_conv sentence_len)); - split_substring (String.sub str sentence_len (slice_len - sentence_len)) + let end_off = Coq_lex.delimit_sentence (apply_tag buffer from off_conv) str + in + let start = from#forward_chars (off_conv end_off) in + let stop = start#forward_char in + buffer#apply_tag ~start ~stop Tags.Script.sentence; + let next = end_off + 1 in + if next < slice_len then begin + ignore (from#nocopy#forward_chars (off_conv next)); + split_substring (String.sub str next (slice_len - next)) end in split_substring slice -let rec grab_safe_sentence_start (iter:GText.iter) soi = - let lax_back = iter#backward_char#has_tag Tags.Script.lax_end in - let on_space = List.mem iter#char [0x09;0x0A;0x20] in - let full_ending = iter#is_start || (lax_back & on_space) in - if full_ending then iter - else if iter#compare soi <= 0 then raise Not_found - else - let prev = iter#backward_to_tag_toggle (Some Tags.Script.lax_end) in - (if prev#has_tag Tags.Script.lax_end then - ignore (prev#nocopy#backward_to_tag_toggle (Some Tags.Script.lax_end))); - grab_safe_sentence_start prev soi - -let grab_sentence_end_from (start:GText.iter) = - let stop = start#forward_to_tag_toggle (Some Tags.Script.lax_end) in - stop#forward_char - -let get_sentence_bounds (iter:GText.iter) = - let start = iter#backward_to_tag_toggle (Some Tags.Script.lax_end) in - (if start#has_tag Tags.Script.lax_end then ignore ( - start#nocopy#backward_to_tag_toggle (Some Tags.Script.lax_end))); - let stop = start#forward_to_tag_toggle (Some Tags.Script.lax_end) in - let stop = stop#forward_char in - start,stop - -let end_tag_present end_iter = - end_iter#backward_char#has_tag Tags.Script.lax_end - -let tag_on_insert = - let skip_last = ref (ref true) in (* ref to the mutable flag created on last call *) - fun buffer -> - try - let insert = buffer#get_iter_at_mark `INSERT in - let start = grab_safe_sentence_start insert - (buffer#get_iter_at_mark (`NAME "start_of_input")) in - let stop = grab_sentence_end_from insert in - let skip_curr = ref true in (* shall the callback be skipped ? by default yes*) - (!skip_last) := true; (* skip the previously created callback *) - skip_last := skip_curr; - try split_slice_lax buffer start stop - with Not_found -> - skip_curr := false; - ignore (Glib.Timeout.add ~ms:1500 - ~callback:(fun () -> if not !skip_curr then ( - try split_slice_lax buffer start buffer#end_iter with _ -> ()); false)) - with Not_found -> - let err_pos = buffer#get_iter_at_mark (`NAME "start_of_input") in - buffer#apply_tag Tags.Script.error ~start:err_pos ~stop:err_pos#forward_char +(** Searching forward and backward a position fulfilling some condition *) + +let rec forward_search cond (iter:GText.iter) = + if iter#is_end || cond iter then iter + else forward_search cond iter#forward_char + +let rec backward_search cond (iter:GText.iter) = + if iter#is_start || cond iter then iter + else backward_search cond iter#backward_char + +let is_sentence_end s = s#has_tag Tags.Script.sentence +let is_char s c = s#char = Char.code c + +(** Search backward the first character of a sentence, starting at [iter] + and going at most up to [soi] (meant to be the end of the locked zone). + Raise [StartError] when no proper sentence start has been found. + A character following a ending "." is considered as a sentence start + only if this character is a blank. In particular, when a final "." + at the end of the locked zone isn't followed by a blank, then this + non-blank character will be signaled as erroneous in [tag_on_insert] below. +*) + +exception StartError + +let grab_sentence_start (iter:GText.iter) soi = + let cond iter = + if iter#compare soi < 0 then raise StartError; + let prev = iter#backward_char in + is_sentence_end prev && + (not (is_char prev '.') || + List.exists (is_char iter) [' ';'\n';'\r';'\t']) + in + backward_search cond iter + +(** Search forward the first character immediately after a sentence end *) + +let rec grab_sentence_stop (start:GText.iter) = + (forward_search is_sentence_end start)#forward_char + +(** Search forward the first character immediately after a "." sentence end + (and not just a "{" or "}" or comment end *) + +let rec grab_ending_dot (start:GText.iter) = + let is_ending_dot s = is_sentence_end s && s#char = Char.code '.' in + (forward_search is_ending_dot start)#forward_char + +(** Retag a zone that has been edited *) + +let tag_on_insert buffer = + (* the start of the non-locked zone *) + let soi = buffer#get_iter_at_mark (`NAME "start_of_input") in + (* the inserted zone is between [prev_insert] and [insert] *) + let insert = buffer#get_iter_at_mark `INSERT in + let prev = buffer#get_iter_at_mark (`NAME "prev_insert") in + (* [prev] is normally always before [insert] even when deleting. + Let's check this nonetheless *) + let prev, insert = + if insert#compare prev < 0 then insert, prev else prev, insert + in + try + let start = grab_sentence_start prev soi in + (** The status of "{" "}" as sentence delimiters is too fragile. + We retag up to the next "." instead. *) + let stop = grab_ending_dot insert in + try split_slice_lax buffer start stop + with Coq_lex.Unterminated -> + (* This shouldn't happen frequently. Either: + - we are at eof, with indeed an unfinished sentence. + - we have just inserted an opening of comment or string. + - the inserted text ends with a "." that interacts with the "." + found by [grab_ending_dot] to form a non-ending "..". + In any case, we retag up to eof, since this isn't that costly. *) + if not stop#is_end then + try split_slice_lax buffer start buffer#end_iter + with Coq_lex.Unterminated -> () + with StartError -> + buffer#apply_tag Tags.Script.error ~start:soi ~stop:soi#forward_char let force_retag buffer = - try split_slice_lax buffer buffer#start_iter buffer#end_iter with _ -> () + try split_slice_lax buffer buffer#start_iter buffer#end_iter + with Coq_lex.Unterminated -> () let toggle_proof_visibility (buffer:GText.buffer) (cursor:GText.iter) = (* move back twice if not into proof_decl, @@ -537,8 +559,8 @@ let toggle_proof_visibility (buffer:GText.buffer) (cursor:GText.iter) = ignore (cursor#nocopy#backward_to_tag_toggle (Some Tags.Script.proof_decl)); let decl_start = cursor in let prf_end = decl_start#forward_to_tag_toggle (Some Tags.Script.qed) in - let decl_end = grab_sentence_end_from decl_start in - let prf_end = grab_sentence_end_from prf_end in + let decl_end = grab_ending_dot decl_start in + let prf_end = grab_ending_dot prf_end in let prf_end = prf_end#forward_char in if decl_start#has_tag Tags.Script.folded then ( buffer#remove_tag ~start:decl_start ~stop:decl_end Tags.Script.folded; @@ -547,7 +569,12 @@ let toggle_proof_visibility (buffer:GText.buffer) (cursor:GText.iter) = buffer#apply_tag ~start:decl_start ~stop:decl_end Tags.Script.folded; buffer#apply_tag ~start:decl_end ~stop:prf_end Tags.Script.hidden) -class analyzed_view (_script:Undo.undoable_view) (_pv:GText.view) (_mv:GText.view) _cs = +(** The arguments that will be passed to coqtop. No quoting here, since + no /bin/sh when using create_process instead of open_process. *) +let custom_project_files = ref [] +let sup_args = ref [] + +class analyzed_view (_script:Undo.undoable_view) (_pv:GText.view) (_mv:GText.view) _cs _ct _fn = object(self) val input_view = _script val input_buffer = _script#buffer @@ -556,13 +583,14 @@ object(self) val message_view = _mv val message_buffer = _mv#buffer val cmd_stack = _cs + val mycoqtop = _ct val mutable is_active = false val mutable read_only = false - val mutable filename = None + val mutable filename = _fn val mutable stats = None val mutable last_modification_time = 0. val mutable last_auto_save_time = 0. - val mutable detached_views = [] + val mutable find_forward_instead_of_backward = false val mutable auto_complete_on = !current.auto_complete val hidden_proofs = Hashtbl.create 32 @@ -572,27 +600,13 @@ object(self) method set_auto_complete t = auto_complete_on <- t method without_auto_complete : 'a 'b. ('a -> 'b) -> 'a -> 'b = fun f x -> let old = auto_complete_on in - self#set_auto_complete false; - let y = f x in - self#set_auto_complete old; - y - method add_detached_view (w:GWindow.window) = - detached_views <- w::detached_views - method remove_detached_view (w:GWindow.window) = - detached_views <- List.filter (fun e -> w#misc#get_oid<>e#misc#get_oid) detached_views - - method kill_detached_views () = - List.iter (fun w -> w#destroy ()) detached_views; - detached_views <- [] + self#set_auto_complete false; + let y = f x in + self#set_auto_complete old; + y method filename = filename method stats = stats - method set_filename f = - filename <- f; - match f with - | Some f -> stats <- my_stat f - | None -> () - method update_stats = match filename with | Some f -> stats <- my_stat f @@ -601,44 +615,44 @@ object(self) method revert = match filename with | Some f -> begin - let do_revert () = begin - push_info "Reverting buffer"; - try - if is_active then self#reset_initial; - let b = Buffer.create 1024 in - with_file flash_info f ~f:(input_channel b); - let s = try_convert (Buffer.contents b) in - input_buffer#set_text s; - self#update_stats; - input_buffer#place_cursor input_buffer#start_iter; - input_buffer#set_modified false; - pop_info (); - flash_info "Buffer reverted"; - force_retag input_buffer; - with _ -> - pop_info (); - flash_info "Warning: could not revert buffer"; - end - in - if input_buffer#modified then - match (GToolbox.question_box - ~title:"Modified buffer changed on disk" - ~buttons:["Revert from File"; - "Overwrite File"; - "Disable Auto Revert"] - ~default:0 - ~icon:(stock_to_widget `DIALOG_WARNING) - "Some unsaved buffers changed on disk" - ) - with 1 -> do_revert () - | 2 -> if self#save f then flash_info "Overwritten" else - flash_info "Could not overwrite file" - | _ -> - prerr_endline "Auto revert set to false"; - !current.global_auto_revert <- false; - disconnect_revert_timer () - else do_revert () + let do_revert () = begin + push_info "Reverting buffer"; + try + if is_active then self#force_reset_initial; + let b = Buffer.create 1024 in + with_file flash_info f ~f:(input_channel b); + let s = try_convert (Buffer.contents b) in + input_buffer#set_text s; + self#update_stats; + input_buffer#place_cursor ~where:input_buffer#start_iter; + input_buffer#set_modified false; + pop_info (); + flash_info "Buffer reverted"; + force_retag input_buffer; + with _ -> + pop_info (); + flash_info "Warning: could not revert buffer"; end + in + if input_buffer#modified then + match (GToolbox.question_box + ~title:"Modified buffer changed on disk" + ~buttons:["Revert from File"; + "Overwrite File"; + "Disable Auto Revert"] + ~default:0 + ~icon:(stock_to_widget `DIALOG_WARNING) + "Some unsaved buffers changed on disk" + ) + with 1 -> do_revert () + | 2 -> if self#save f then flash_info "Overwritten" else + flash_info "Could not overwrite file" + | _ -> + prerr_endline "Auto revert set to false"; + !current.global_auto_revert <- false; + disconnect_revert_timer () + else do_revert () + end | None -> () method save f = @@ -647,8 +661,8 @@ object(self) input_buffer#set_modified false; stats <- my_stat f; (match self#auto_save_name with - | None -> () - | Some fn -> try Sys.remove fn with _ -> ()); + | None -> () + | Some fn -> try Sys.remove fn with _ -> ()); true end else false @@ -657,31 +671,31 @@ object(self) match filename with | None -> None | Some f -> - let dir = Filename.dirname f in - let base = (fst !current.auto_save_name) ^ - (Filename.basename f) ^ - (snd !current.auto_save_name) - in Some (Filename.concat dir base) + let dir = Filename.dirname f in + let base = (fst !current.auto_save_name) ^ + (Filename.basename f) ^ + (snd !current.auto_save_name) + in Some (Filename.concat dir base) method private need_auto_save = input_buffer#modified && - last_modification_time > last_auto_save_time + last_modification_time > last_auto_save_time method auto_save = if self#need_auto_save then begin match self#auto_save_name with | None -> () | Some fn -> - try - last_auto_save_time <- Unix.time(); - prerr_endline ("Autosave time : "^(string_of_float (Unix.time()))); - if try_export fn (input_buffer#get_text ()) then begin - flash_info ~delay:1000 "Autosaved" - end - else warning - ("Autosave failed (check if " ^ fn ^ " is writable)") - with _ -> - warning ("Autosave: unexpected error while writing "^fn) + try + last_auto_save_time <- Unix.time(); + prerr_endline ("Autosave time : "^(string_of_float (Unix.time()))); + if try_export fn (input_buffer#get_text ()) then begin + flash_info ~delay:1000 "Autosaved" + end + else warning + ("Autosave failed (check if " ^ fn ^ " is writable)") + with _ -> + warning ("Autosave: unexpected error while writing "^fn) end method save_as f = @@ -690,16 +704,16 @@ object(self) ~buttons:["Overwrite"; "Cancel";] ~default:1 - ~icon: - (let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) - ("File "^f^"already exists") + ~icon: + (let img = GMisc.image () in + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) + ("File "^f^" already exists") ) with 1 -> self#save f | _ -> false - else self#save f + else self#save f method set_read_only b = read_only<-b method read_only = read_only @@ -721,9 +735,9 @@ object(self) method recenter_insert = (* BUG : to investigate further: - FIXED : Never call GMain.* in thread ! - PLUS : GTK BUG ??? Cannot be called from a thread... - ADDITION: using sync instead of async causes deadlock...*) + FIXED : Never call GMain.* in thread ! + PLUS : GTK BUG ??? Cannot be called from a thread... + ADDITION: using sync instead of async causes deadlock...*) ignore (GtkThread.async ( input_view#scroll_to_mark ~use_align:false @@ -737,466 +751,431 @@ object(self) let it = it#copy in let nb_sep = ref 0 in let continue = ref true in - while !continue do - if it#char = space then begin - incr nb_sep; - if not it#nocopy#forward_char then continue := false; - end else continue := false - done; - !nb_sep + while !continue do + if it#char = space then begin + incr nb_sep; + if not it#nocopy#forward_char then continue := false; + end else continue := false + done; + !nb_sep in let previous_line = self#get_insert in - if previous_line#nocopy#backward_line then begin - let previous_line_spaces = get_nb_space previous_line in + if previous_line#nocopy#backward_line then begin + let previous_line_spaces = get_nb_space previous_line in + let current_line_start = self#get_insert#set_line_offset 0 in + let current_line_spaces = get_nb_space current_line_start in + if input_buffer#delete_interactive + ~start:current_line_start + ~stop:(current_line_start#forward_chars current_line_spaces) + () + then let current_line_start = self#get_insert#set_line_offset 0 in - let current_line_spaces = get_nb_space current_line_start in - if input_buffer#delete_interactive - ~start:current_line_start - ~stop:(current_line_start#forward_chars current_line_spaces) - () - then - let current_line_start = self#get_insert#set_line_offset 0 in - input_buffer#insert - ~iter:current_line_start - (String.make previous_line_spaces ' ') - end + input_buffer#insert + ~iter:current_line_start + (String.make previous_line_spaces ' ') + end - method show_pm_goal = - proof_buffer#insert - (Printf.sprintf " *** Declarative Mode ***\n"); - try - let (hyps,concl) = get_current_pm_goal () in - List.iter - (fun ((_,_,_,(s,_)) as _hyp) -> - proof_buffer#insert (s^"\n")) - hyps; - proof_buffer#insert - (String.make 38 '_' ^ "\n"); - let (_,_,_,s) = concl in - proof_buffer#insert ("thesis := \n "^s^"\n"); - let my_mark = `NAME "end_of_conclusion" in - proof_buffer#move_mark - ~where:((proof_buffer#get_iter_at_mark `INSERT)) - my_mark; - ignore (proof_view#scroll_to_mark my_mark) - with Not_found -> - match Decl_mode.get_end_command (Pfedit.get_pftreestate ()) with - Some endc -> - proof_buffer#insert - ("Subproof completed, now type "^endc^".") - | None -> - proof_buffer#insert "Proof completed." + method go_to_next_occ_of_cur_word = + let cv = session_notebook#current_term in + let av = cv.analyzed_view in + let b = (cv.script)#buffer in + let start = find_word_start (av#get_insert) in + let stop = find_word_end start in + let text = b#get_text ~start ~stop () in + match stop#forward_search text with + | None -> () + | Some(start, _) -> + (b#place_cursor start; + self#recenter_insert) + + method go_to_prev_occ_of_cur_word = + let cv = session_notebook#current_term in + let av = cv.analyzed_view in + let b = (cv.script)#buffer in + let start = find_word_start (av#get_insert) in + let stop = find_word_end start in + let text = b#get_text ~start ~stop () in + match start#backward_search text with + | None -> () + | Some(start, _) -> + (b#place_cursor start; + self#recenter_insert) val mutable full_goal_done = true method show_goals_full = if not full_goal_done then - begin - try - proof_buffer#set_text ""; - match Decl_mode.get_current_mode () with - Decl_mode.Mode_none -> () - | Decl_mode.Mode_tactic -> - begin - match Coq.get_current_goals () with - [] -> proof_buffer#insert (Coq.print_no_goal()) - | ((hyps,concl)::r) as s -> - let last_shown_area = Tags.Proof.highlight - in - let goal_nb = List.length s in - proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" - goal_nb - (if goal_nb<=1 then "" else "s")); - let coq_menu commands = - let tag = proof_buffer#create_tag [] - in - ignore - (tag#connect#event ~callback: - (fun ~origin ev it -> - match GdkEvent.get_type ev with - | `BUTTON_PRESS -> - let ev = (GdkEvent.Button.cast ev) in - if (GdkEvent.Button.button ev) = 3 - then ( - let loc_menu = GMenu.menu () in - let factory = - new GMenu.factory loc_menu in - let add_coq_command (cp,ip) = - ignore - (factory#add_item cp - ~callback: - (fun () -> ignore - (self#insert_this_phrase_on_success - true - true - false - ("progress "^ip^"\n") - (ip^"\n")) - ) - ) - in - List.iter add_coq_command commands; - loc_menu#popup - ~button:3 - ~time:(GdkEvent.Button.time ev); - true) - else false - | `MOTION_NOTIFY -> - proof_buffer#remove_tag - ~start:proof_buffer#start_iter - ~stop:proof_buffer#end_iter - last_shown_area; - prerr_endline "Before find_tag_limits"; - - let s,e = find_tag_limits tag - (new GText.iter it) - in - prerr_endline "After find_tag_limits"; - proof_buffer#apply_tag - ~start:s - ~stop:e - last_shown_area; - - prerr_endline "Applied tag"; - false - | _ -> - false - ) - ); - tag - in - List.iter - (fun ((_,_,_,(s,_)) as hyp) -> - let tag = coq_menu (hyp_menu hyp) in - proof_buffer#insert ~tags:[tag] (s^"\n")) - hyps; - proof_buffer#insert - (String.make 38 '_' ^"(1/"^ - (string_of_int goal_nb)^ - ")\n") - ; - let tag = coq_menu (concl_menu concl) in - let _,_,_,sconcl = concl in - proof_buffer#insert ~tags:[tag] sconcl; - proof_buffer#insert "\n"; - let my_mark = `NAME "end_of_conclusion" in - proof_buffer#move_mark - ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark; - proof_buffer#insert "\n\n"; - let i = ref 1 in - List.iter - (function (_,(_,_,_,concl)) -> - incr i; - proof_buffer#insert - (String.make 38 '_' ^"("^ - (string_of_int !i)^ - "/"^ - (string_of_int goal_nb)^ - ")\n"); - proof_buffer#insert concl; - proof_buffer#insert "\n\n"; - ) - r; - ignore (proof_view#scroll_to_mark my_mark) ; - full_goal_done <- true - end - | Decl_mode.Mode_proof -> - self#show_pm_goal - with e -> prerr_endline (Printexc.to_string e) - end + proof_view#buffer#set_text ""; + begin + let menu_callback = if !current.contextual_menus_on_goal then + (fun s () -> ignore (self#insert_this_phrase_on_success + true true false ("progress "^s) s)) + else + (fun _ _ -> ()) in + try + begin match Coq.goals !mycoqtop with + | Interface.Fail (l, str) -> + self#set_message ("Error in coqtop :\n"^str) + | Interface.Good goals -> + begin match Coq.evars !mycoqtop with + | Interface.Fail (l, str) -> + self#set_message ("Error in coqtop :\n"^str) + | Interface.Good evs -> + let hints = match Coq.hints !mycoqtop with + | Interface.Fail (_, _) -> None + | Interface.Good hints -> hints + in + Ideproof.display + (Ideproof.mode_tactic menu_callback) + proof_view goals hints evs + end + end + with + | e -> prerr_endline (Printexc.to_string e) + end method show_goals = self#show_goals_full - - method send_to_coq verbosely replace phrase show_output show_error localize = + method private send_to_coq ct verbose phrase show_output show_error localize = let display_output msg = self#insert_message (if show_output then msg else "") in - let display_error e = - let (s,loc) = Coq.process_exn e in - assert (Glib.Utf8.validate s); - self#insert_message s; - message_view#misc#draw None; - if localize then - (match Option.map Util.unloc loc with - | None -> () - | Some (start,stop) -> - let convert_pos = byte_offset_to_char_offset phrase in - let start = convert_pos start in - let stop = convert_pos stop in - let i = self#get_start_of_input in - let starti = i#forward_chars start in - let stopi = i#forward_chars stop in - input_buffer#apply_tag Tags.Script.error - ~start:starti - ~stop:stopi; - input_buffer#place_cursor starti) in - try - full_goal_done <- false; - prerr_endline "Send_to_coq starting now"; - Decl_mode.clear_daimon_flag (); - if replace then begin - let r,info = Coq.interp_and_replace ("info " ^ phrase) in - let is_complete = not (Decl_mode.get_daimon_flag ()) in - let msg = read_stdout () in - sync display_output msg; - Some (is_complete,r) - end else begin - let r = Coq.interp verbosely phrase in - let is_complete = not (Decl_mode.get_daimon_flag ()) in - let msg = read_stdout () in - sync display_output msg; - Some (is_complete,r) + let display_error (loc,s) = + if show_error then begin + if not (Glib.Utf8.validate s) then + flash_info "This error is so nasty that I can't even display it." + else begin + self#insert_message s; + message_view#misc#draw None; + if localize then + (match loc with + | None -> () + | Some (start,stop) -> + let convert_pos = byte_offset_to_char_offset phrase in + let start = convert_pos start in + let stop = convert_pos stop in + let i = self#get_start_of_input in + let starti = i#forward_chars start in + let stopi = i#forward_chars stop in + input_buffer#apply_tag Tags.Script.error + ~start:starti + ~stop:stopi; + input_buffer#place_cursor ~where:starti) end - with e -> - if show_error then sync display_error e; - None + end in + try + full_goal_done <- false; + prerr_endline "Send_to_coq starting now"; + (* It's important here to work with [ct] and not [!mycoqtop], otherwise + we could miss a restart of coqtop and continue sending it orders. *) + match Coq.interp ct ~verbose phrase with + | Interface.Fail (l,str) -> sync display_error (l,str); None + | Interface.Good msg -> sync display_output msg; Some Safe + (* TODO: Restore someday the access to Decl_mode.get_damon_flag, + and also detect the use of admit, and then return Unsafe *) + with + | End_of_file -> (* Coqtop has died, let's trigger a reset_initial. *) + raise RestartCoqtop + | e -> sync display_error (None, Printexc.to_string e); None + + (* This method is intended to perform stateless commands *) + method raw_coq_query phrase = + let () = prerr_endline "raw_coq_query starting now" in + let display_error s = + if not (Glib.Utf8.validate s) then + flash_info "This error is so nasty that I can't even display it." + else begin + self#insert_message s; + message_view#misc#draw None + end + in + try + match Coq.interp !mycoqtop ~raw:true ~verbose:false phrase with + | Interface.Fail (_, err) -> sync display_error err + | Interface.Good msg -> sync self#insert_message msg + with + | End_of_file -> raise RestartCoqtop + | e -> sync display_error (Printexc.to_string e) method find_phrase_starting_at (start:GText.iter) = try - let start = grab_safe_sentence_start start self#get_start_of_input in - let stop = grab_sentence_end_from start in - if stop#backward_char#has_tag Tags.Script.lax_end then - Some (start,stop) - else - None - with Not_found -> None + let start = grab_sentence_start start self#get_start_of_input in + let stop = grab_sentence_stop start in + (* Is this phrase non-empty and complete ? *) + if stop#compare start > 0 && is_sentence_end stop#backward_char + then Some (start,stop) + else None + with StartError -> None method complete_at_offset (offset:int) = prerr_endline ("Completion at offset : " ^ string_of_int offset); let it () = input_buffer#get_iter (`OFFSET offset) in let iit = it () in let start = find_word_start iit in - if ends_word iit then - let w = input_buffer#get_text - ~start - ~stop:iit - () - in - if String.length w <> 0 then begin - prerr_endline ("Completion of prefix : '" ^ w^"'"); - match complete input_buffer w start#offset with - | None -> false - | Some (ss,start,stop) -> - let completion = input_buffer#get_text ~start ~stop () in - ignore (input_buffer#delete_selection ()); - ignore (input_buffer#insert_interactive completion); - input_buffer#move_mark `SEL_BOUND (it())#backward_char; - true - end else false - else false + if ends_word iit then + let w = input_buffer#get_text + ~start + ~stop:iit + () + in + if String.length w <> 0 then begin + prerr_endline ("Completion of prefix : '" ^ w^"'"); + match complete input_buffer w start#offset with + | None -> false + | Some (ss,start,stop) -> + let completion = input_buffer#get_text ~start ~stop () in + ignore (input_buffer#delete_selection ()); + ignore (input_buffer#insert_interactive completion); + input_buffer#move_mark `SEL_BOUND ~where:(it())#backward_char; + true + end else false + else false - method process_next_phrase verbosely display_goals do_highlight = + method private process_one_phrase ct verbosely display_goals do_highlight = let get_next_phrase () = self#clear_message; - prerr_endline "process_next_phrase starting now"; + prerr_endline "process_one_phrase starting now"; if do_highlight then begin push_info "Coq is computing"; input_view#set_editable false; end; match self#find_phrase_starting_at self#get_start_of_input with | None -> - if do_highlight then begin - input_view#set_editable true; - pop_info (); - end; - None + if do_highlight then begin + input_view#set_editable true; + pop_info (); + end; + None | Some(start,stop) -> - prerr_endline "process_next_phrase : to_process highlight"; - if do_highlight then begin - input_buffer#apply_tag Tags.Script.to_process ~start ~stop; - prerr_endline "process_next_phrase : to_process applied"; - end; - prerr_endline "process_next_phrase : getting phrase"; - Some((start,stop),start#get_slice ~stop) in + prerr_endline "process_one_phrase : to_process highlight"; + if do_highlight then begin + input_buffer#apply_tag Tags.Script.to_process ~start ~stop; + prerr_endline "process_one_phrase : to_process applied"; + end; + prerr_endline "process_one_phrase : getting phrase"; + Some((start,stop),start#get_slice ~stop) in let remove_tag (start,stop) = if do_highlight then begin input_buffer#remove_tag Tags.Script.to_process ~start ~stop; input_view#set_editable true; pop_info (); end in - let mark_processed reset_info is_complete (start,stop) = + let mark_processed safe (start,stop) = let b = input_buffer in b#move_mark ~where:stop (`NAME "start_of_input"); - b#apply_tag - (if is_complete then Tags.Script.processed else Tags.Script.unjustified) ~start ~stop; - if (self#get_insert#compare) stop <= 0 then - begin - b#place_cursor stop; - self#recenter_insert - end; - let ide_payload = { start = `MARK (b#create_mark start); - stop = `MARK (b#create_mark stop); } in - push_phrase - cmd_stack - reset_info - ide_payload; - if display_goals then self#show_goals; - remove_tag (start,stop) in - begin - match sync get_next_phrase () with - None -> false - | Some (loc,phrase) -> - (match self#send_to_coq verbosely false phrase true true true with - | Some (is_complete,reset_info) -> - sync (mark_processed reset_info is_complete) loc; true - | None -> sync remove_tag loc; false) - end + b#apply_tag (safety_tag safe) ~start ~stop; + if (self#get_insert#compare) stop <= 0 then + begin + b#place_cursor ~where:stop; + self#recenter_insert + end; + let ide_payload = { start = `MARK (b#create_mark start); + stop = `MARK (b#create_mark stop); } in + Stack.push ide_payload cmd_stack; + if display_goals then self#show_goals; + remove_tag (start,stop) + in + match sync get_next_phrase () with + | None -> raise Unsuccessful + | Some ((_,stop) as loc,phrase) -> + if stop#backward_char#has_tag Tags.Script.comment + then sync mark_processed Safe loc + else try match self#send_to_coq ct verbosely phrase true true true with + | Some safe -> sync mark_processed safe loc + | None -> sync remove_tag loc; raise Unsuccessful + with + | RestartCoqtop -> sync remove_tag loc; raise RestartCoqtop + + method process_next_phrase verbosely = + try self#process_one_phrase !mycoqtop verbosely true true + with Unsuccessful -> () - method insert_this_phrase_on_success - show_output show_msg localize coqphrase insertphrase = - let mark_processed reset_info is_complete = + method private insert_this_phrase_on_success + show_output show_msg localize coqphrase insertphrase = + let mark_processed safe = let stop = self#get_start_of_input in - if stop#starts_line then - input_buffer#insert ~iter:stop insertphrase - else input_buffer#insert ~iter:stop ("\n"^insertphrase); - let start = self#get_start_of_input in - input_buffer#move_mark ~where:stop (`NAME "start_of_input"); - input_buffer#apply_tag - (if is_complete then Tags.Script.processed else Tags.Script.unjustified) ~start ~stop; - if (self#get_insert#compare) stop <= 0 then - input_buffer#place_cursor stop; - let ide_payload = { start = `MARK (input_buffer#create_mark start); - stop = `MARK (input_buffer#create_mark stop); } in - push_phrase cmd_stack reset_info ide_payload; - self#show_goals; - (*Auto insert save on success... - try (match Coq.get_current_goals () with - | [] -> - (match self#send_to_coq "Save.\n" true true true with - | Some ast -> - begin - let stop = self#get_start_of_input in - if stop#starts_line then - input_buffer#insert ~iter:stop "Save.\n" - else input_buffer#insert ~iter:stop "\nSave.\n"; - let start = self#get_start_of_input in - input_buffer#move_mark ~where:stop (`NAME"start_of_input"); - input_buffer#apply_tag_by_name "processed" ~start ~stop; - if (self#get_insert#compare) stop <= 0 then - input_buffer#place_cursor stop; - let start_of_phrase_mark = - `MARK (input_buffer#create_mark start) in - let end_of_phrase_mark = - `MARK (input_buffer#create_mark stop) in - push_phrase - reset_info start_of_phrase_mark end_of_phrase_mark ast - end - | None -> ()) - | _ -> ()) - with _ -> ()*) in - match self#send_to_coq false false coqphrase show_output show_msg localize with - | Some (is_complete,reset_info) -> - sync (mark_processed reset_info) is_complete; true - | None -> - sync - (fun _ -> self#insert_message ("Unsuccessfully tried: "^coqphrase)) - (); - false + if stop#starts_line then + input_buffer#insert ~iter:stop insertphrase + else input_buffer#insert ~iter:stop ("\n"^insertphrase); + tag_on_insert input_buffer; + let start = self#get_start_of_input in + input_buffer#move_mark ~where:stop (`NAME "start_of_input"); + input_buffer#apply_tag (safety_tag safe) ~start ~stop; + if (self#get_insert#compare) stop <= 0 then + input_buffer#place_cursor ~where:stop; + let ide_payload = { start = `MARK (input_buffer#create_mark start); + stop = `MARK (input_buffer#create_mark stop); } in + Stack.push ide_payload cmd_stack; + self#show_goals; + (*Auto insert save on success... + try (match Coq.get_current_goals () with + | [] -> + (match self#send_to_coq "Save.\n" true true true with + | Some ast -> + begin + let stop = self#get_start_of_input in + if stop#starts_line then + input_buffer#insert ~iter:stop "Save.\n" + else input_buffer#insert ~iter:stop "\nSave.\n"; + let start = self#get_start_of_input in + input_buffer#move_mark ~where:stop (`NAME"start_of_input"); + input_buffer#apply_tag_by_name "processed" ~start ~stop; + if (self#get_insert#compare) stop <= 0 then + input_buffer#place_cursor stop; + let start_of_phrase_mark = + `MARK (input_buffer#create_mark start) in + let end_of_phrase_mark = + `MARK (input_buffer#create_mark stop) in + push_phrase + reset_info start_of_phrase_mark end_of_phrase_mark ast + end + | None -> ()) + | _ -> ()) + with _ -> ()*) in + match self#send_to_coq !mycoqtop false coqphrase show_output show_msg localize with + | Some safe -> sync mark_processed safe; true + | None -> + sync + (fun _ -> self#insert_message ("Unsuccessfully tried: "^coqphrase)) + (); + false method process_until_iter_or_error stop = let stop' = `OFFSET stop#offset in let start = self#get_start_of_input#copy in let start' = `OFFSET start#offset in + sync (fun _ -> + input_buffer#apply_tag Tags.Script.to_process ~start ~stop; + input_view#set_editable false) (); + push_info "Coq is computing"; + let get_current () = + if !current.stop_before then + match self#find_phrase_starting_at self#get_start_of_input with + | None -> self#get_start_of_input + | Some (_, stop2) -> stop2 + else begin + self#get_start_of_input + end + in + let unlock () = sync (fun _ -> - input_buffer#apply_tag Tags.Script.to_process ~start ~stop; - input_view#set_editable false) (); - push_info "Coq is computing"; - let get_current () = - if !current.stop_before then - match self#find_phrase_starting_at self#get_start_of_input with - | None -> self#get_start_of_input - | Some (_, stop2) -> stop2 - else begin - self#get_start_of_input - end - in - (try - while ((stop#compare (get_current())>=0) - && (self#process_next_phrase false false false)) - do Util.check_for_interrupt () done - with Sys.Break -> - prerr_endline "Interrupted during process_until_iter_or_error"); - sync (fun _ -> - self#show_goals; - (* Start and stop might be invalid if an eol was added at eof *) - let start = input_buffer#get_iter start' in - let stop = input_buffer#get_iter stop' in - input_buffer#remove_tag Tags.Script.to_process ~start ~stop; - input_view#set_editable true) (); - pop_info() + self#show_goals; + (* Start and stop might be invalid if an eol was added at eof *) + let start = input_buffer#get_iter start' in + let stop = input_buffer#get_iter stop' in + input_buffer#remove_tag Tags.Script.to_process ~start ~stop; + input_view#set_editable true) () + in + (* All the [process_one_phrase] below should be done with the same [ct] + instead of accessing multiple time [mycoqtop]. Otherwise a restart of + coqtop could go unnoticed, and the new coqtop could receive strange + things. *) + let ct = !mycoqtop in + (try + while stop#compare (get_current()) >= 0 + do self#process_one_phrase ct false false false done + with + | Unsuccessful -> () + | RestartCoqtop -> unlock (); raise RestartCoqtop); + unlock (); + pop_info() method process_until_end_or_error = self#process_until_iter_or_error input_buffer#end_iter method reset_initial = - sync (fun _ -> - Stack.iter - (function (inf,_) -> - let start = input_buffer#get_iter_at_mark inf.start in - let stop = input_buffer#get_iter_at_mark inf.stop in - input_buffer#move_mark ~where:start (`NAME "start_of_input"); - input_buffer#remove_tag Tags.Script.processed ~start ~stop; - input_buffer#remove_tag Tags.Script.unjustified ~start ~stop; - input_buffer#delete_mark inf.start; - input_buffer#delete_mark inf.stop; - ) - cmd_stack; - Stack.clear cmd_stack; - self#clear_message)(); - Coq.reset_initial () + mycoqtop := Coq.respawn_coqtop !mycoqtop; + sync (fun () -> + Stack.iter + (function inf -> + let start = input_buffer#get_iter_at_mark inf.start in + let stop = input_buffer#get_iter_at_mark inf.stop in + input_buffer#move_mark ~where:start (`NAME "start_of_input"); + input_buffer#remove_tag Tags.Script.processed ~start ~stop; + input_buffer#remove_tag Tags.Script.unjustified ~start ~stop; + input_buffer#delete_mark inf.start; + input_buffer#delete_mark inf.stop; + ) + cmd_stack; + Stack.clear cmd_stack; + self#clear_message) () + + method force_reset_initial = + (* Do nothing if a force_reset_initial is already ongoing *) + if Mutex.try_lock resetting then begin + Coq.kill_coqtop !mycoqtop; + (* If a computation is ongoing, an exception will trigger + the reset_initial in do_if_not_computing, not here. *) + if Mutex.try_lock coq_computing then begin + self#reset_initial; + Mutex.unlock coq_computing + end; + Mutex.unlock resetting + end + + (* Internal method for dialoging with coqtop about a backtrack. + The ide's cmd_stack has already been cleared up to the desired point. + The [finish] function is used to handle minor differences between + [go_to_insert] and [undo_last_step] *) + + method private do_backtrack finish n = + (* pop n more commands if coqtop has said so (e.g. for undoing a proof) *) + let rec n_pop n = + if n = 0 then () + else + let phrase = Stack.pop cmd_stack in + let stop = input_buffer#get_iter_at_mark phrase.stop in + if stop#backward_char#has_tag Tags.Script.comment + then n_pop n + else n_pop (pred n) + in + match Coq.rewind !mycoqtop n with + | Interface.Good n -> + n_pop n; + sync (fun _ -> + let start = + if Stack.is_empty cmd_stack then input_buffer#start_iter + else input_buffer#get_iter_at_mark (Stack.top cmd_stack).stop in + let stop = self#get_start_of_input in + input_buffer#remove_tag Tags.Script.processed ~start ~stop; + input_buffer#remove_tag Tags.Script.unjustified ~start ~stop; + input_buffer#move_mark ~where:start (`NAME "start_of_input"); + self#show_goals; + self#clear_message; + finish start) () + | Interface.Fail (l,str) -> + sync self#set_message + ("Error while backtracking :\n" ^ str ^ "\n" ^ + "CoqIDE and coqtop may be out of sync, you may want to use Restart.") (* backtrack Coq to the phrase preceding iterator [i] *) method backtrack_to_no_lock i = prerr_endline "Backtracking_to iter starts now."; + full_goal_done <- false; (* pop Coq commands until we reach iterator [i] *) - let rec pop_cmds popped = - if Stack.is_empty cmd_stack then - popped - else - let (ide,coq) = Stack.pop cmd_stack in - if i#compare (input_buffer#get_iter_at_mark ide.stop) < 0 then - begin - prerr_endline "popped command"; - pop_cmds (coq::popped) - end - else - begin - Stack.push (ide,coq) cmd_stack; - popped - end + let rec n_step n = + if Stack.is_empty cmd_stack then n else + let phrase = Stack.top cmd_stack in + let stop = input_buffer#get_iter_at_mark phrase.stop in + if i#compare stop >= 0 then n + else begin + ignore (Stack.pop cmd_stack); + if stop#backward_char#has_tag Tags.Script.comment + then n_step n + else n_step (succ n) + end in - let seq = List.rev (pop_cmds []) in - prerr_endline "Popped commands"; - if 0 < List.length seq then - begin - try - rewind seq cmd_stack; - sync (fun _ -> - let start = - if Stack.is_empty cmd_stack then input_buffer#start_iter - else input_buffer#get_iter_at_mark (fst (Stack.top cmd_stack)).stop in - prerr_endline "Removing (long) processed tag..."; - input_buffer#remove_tag - Tags.Script.processed - ~start - ~stop:self#get_start_of_input; - input_buffer#remove_tag - Tags.Script.unjustified - ~start - ~stop:self#get_start_of_input; - prerr_endline "Moving (long) start_of_input..."; - input_buffer#move_mark ~where:start (`NAME "start_of_input"); - full_goal_done <- false; - self#show_goals; - clear_stdout (); - self#clear_message) - (); - with _ -> - push_info "WARNING: undo failed badly -> Coq might be in an inconsistent state. - Please restart and report NOW."; - end - else prerr_endline "backtrack_to : discarded (...)" + begin + try + self#do_backtrack (fun _ -> ()) (n_step 0); + (* We may have backtracked too much: let's replay *) + self#process_until_iter_or_error i + with _ -> + push_info + ("WARNING: undo failed badly.\n" ^ + "Coq might be in an inconsistent state.\n" ^ + "Please restart and report."); + end method backtrack_to i = if Mutex.try_lock coq_may_stop then @@ -1207,41 +1186,26 @@ object(self) method go_to_insert = let point = self#get_insert in - if point#compare self#get_start_of_input>=0 - then self#process_until_iter_or_error point - else self#backtrack_to point + if point#compare self#get_start_of_input>=0 + then self#process_until_iter_or_error point + else self#backtrack_to point method undo_last_step = + full_goal_done <- false; if Mutex.try_lock coq_may_stop then (push_info "Undoing last step..."; (try - let (ide_ri,_) = Stack.top cmd_stack in - let start = input_buffer#get_iter_at_mark ide_ri.start in - let update_input () = - prerr_endline "Removing processed tag..."; - input_buffer#remove_tag - Tags.Script.processed - ~start - ~stop:(input_buffer#get_iter_at_mark ide_ri.stop); - input_buffer#remove_tag - Tags.Script.unjustified - ~start - ~stop:(input_buffer#get_iter_at_mark ide_ri.stop); - prerr_endline "Moving start_of_input"; - input_buffer#move_mark - ~where:start - (`NAME "start_of_input"); - input_buffer#place_cursor start; - self#recenter_insert; - full_goal_done <- false; - self#show_goals; - self#clear_message - in - let _,coq = Stack.pop cmd_stack in - rewind [coq] cmd_stack; - sync update_input () - with - | Stack.Empty -> (* flash_info "Nothing to Undo"*)() + let phrase = Stack.pop cmd_stack in + let stop = input_buffer#get_iter_at_mark phrase.stop in + let count = + if stop#backward_char#has_tag Tags.Script.comment then 0 else 1 + in + let finish where = + input_buffer#place_cursor ~where; + self#recenter_insert; + in + self#do_backtrack finish count + with Stack.Empty -> () ); pop_info (); Mutex.unlock coq_may_stop) @@ -1257,231 +1221,197 @@ object(self) ignore (List.exists (fun p -> - self#insert_this_phrase_on_success true false false - ("progress "^p^".\n") (p^".\n")) l) + self#insert_this_phrase_on_success true false false + ("progress "^p^".") (p^".")) l) method active_keypress_handler k = let state = GdkEvent.Key.state k in - begin - match state with - | l when List.mem `MOD1 l -> - let k = GdkEvent.Key.keyval k in - if GdkKeysyms._Return=k - then let _ = - if (input_buffer#insert_interactive "\n") then - begin - let i= self#get_insert#backward_word_start in - prerr_endline "active_kp_hf: Placing cursor"; - self#process_until_iter_or_error i - end in - true else false - | l when List.mem `CONTROL l -> - let k = GdkEvent.Key.keyval k in - if GdkKeysyms._Break=k - then break (); - false - | l -> - if GdkEvent.Key.keyval k = GdkKeysyms._Tab then begin - prerr_endline "active_kp_handler for Tab"; - self#indent_current_line; - true - end else false - end - - - method disconnected_keypress_handler k = - match GdkEvent.Key.state k with - | l when List.mem `CONTROL l -> - let k = GdkEvent.Key.keyval k in - if GdkKeysyms._c=k - then break (); - false - | l -> false - + begin + match state with + | l -> + if GdkEvent.Key.keyval k = GdkKeysyms._Tab then begin + prerr_endline "active_kp_handler for Tab"; + self#indent_current_line; + true + end else false + end - val mutable deact_id = None val mutable act_id = None - method deactivate () = - is_active <- false; - (match act_id with None -> () - | Some id -> - reset_initial (); - input_view#misc#disconnect id; - prerr_endline "DISCONNECTED old active : "; - print_id id; - )(*; - deact_id <- Some - (input_view#event#connect#key_press self#disconnected_keypress_handler); - prerr_endline "CONNECTED inactive : "; - print_id (Option.get deact_id)*) - - (* XXX *) - method activate () = - is_active <- true;(* - (match deact_id with None -> () - | Some id -> input_view#misc#disconnect id; - prerr_endline "DISCONNECTED old inactive : "; - print_id id - );*) + method activate () = if not is_active then begin + is_active <- true; act_id <- Some - (input_view#event#connect#key_press self#active_keypress_handler); + (input_view#event#connect#key_press ~callback:self#active_keypress_handler); prerr_endline "CONNECTED active : "; - print_id (Option.get act_id); - match - filename - with + print_id (match act_id with Some x -> x | None -> assert false); + match filename with | None -> () - | Some f -> let dir = Filename.dirname f in - if not (is_in_loadpath dir) then - begin - ignore (Coq.interp false - (Printf.sprintf "Add LoadPath \"%s\". " dir)) - end - - method electric_handler = - input_buffer#connect#insert_text ~callback: - (fun it x -> - begin try - if last_index then begin - last_array.(0)<-x; - if (last_array.(1) ^ last_array.(0) = ".\n") then raise Found - end else begin - last_array.(1)<-x; - if (last_array.(0) ^ last_array.(1) = ".\n") then raise Found - end - with Found -> - begin - ignore (self#process_next_phrase false true true) - end; - end; - last_index <- not last_index;) + | Some f -> + let dir = Filename.dirname f in + let ct = !mycoqtop in + match Coq.inloadpath ct dir with + | Interface.Fail (_,str) -> + self#set_message + ("Could not determine lodpath, this might lead to problems:\n"^str) + | Interface.Good true -> () + | Interface.Good false -> + let cmd = Printf.sprintf "Add LoadPath \"%s\". " dir in + match Coq.interp ct cmd with + | Interface.Fail (l,str) -> + self#set_message ("Couln't add loadpath:\n"^str) + | Interface.Good _ -> () + end method private electric_paren tag = - let oparen_code = Glib.Utf8.to_unichar "(" (ref 0) in - let cparen_code = Glib.Utf8.to_unichar ")" (ref 0) in - ignore (input_buffer#connect#insert_text ~callback: - (fun it x -> - input_buffer#remove_tag - ~start:input_buffer#start_iter - ~stop:input_buffer#end_iter - tag; - if x = "" then () else - match x.[String.length x - 1] with - | ')' -> - let hit = self#get_insert in - let count = ref 0 in - if hit#nocopy#backward_find_char - (fun c -> - if c = oparen_code && !count = 0 then true - else if c = cparen_code then - (incr count;false) - else if c = oparen_code then - (decr count;false) - else false - ) - then - begin - prerr_endline "Found matching parenthesis"; - input_buffer#apply_tag tag ~start:hit ~stop:hit#forward_char - end - else () - | _ -> ()) - ) + let oparen_code = Glib.Utf8.to_unichar "(" ~pos:(ref 0) in + let cparen_code = Glib.Utf8.to_unichar ")" ~pos:(ref 0) in + ignore (input_buffer#connect#insert_text ~callback: + (fun it x -> + input_buffer#remove_tag + ~start:input_buffer#start_iter + ~stop:input_buffer#end_iter + tag; + if x = "" then () else + match x.[String.length x - 1] with + | ')' -> + let hit = self#get_insert in + let count = ref 0 in + if hit#nocopy#backward_find_char + (fun c -> + if c = oparen_code && !count = 0 then true + else if c = cparen_code then + (incr count;false) + else if c = oparen_code then + (decr count;false) + else false + ) + then + begin + prerr_endline "Found matching parenthesis"; + input_buffer#apply_tag tag ~start:hit ~stop:hit#forward_char + end + else () + | _ -> ()) + ) method help_for_keyword () = - browse_keyword (self#insert_message) (get_current_word ()) +(** NB: Events during text edition: + + - [begin_user_action] + - [insert_text] (or [delete_range] when deleting) + - [changed] + - [end_user_action] + + When pasting a text containing tags (e.g. the sentence terminators), + there is actually many [insert_text] and [changed]. For instance, + for "a. b.": + + - [begin_user_action] + - [insert_text] (for "a") + - [changed] + - [insert_text] (for ".") + - [changed] + - [apply_tag] (for the tag of ".") + - [insert_text] (for " b") + - [changed] + - [insert_text] (for ".") + - [changed] + - [apply_tag] (for the tag of ".") + - [end_user_action] + + Since these copy-pasted tags may interact badly with the retag mechanism, + we now don't monitor the "changed" event, but rather the "begin_user_action" + and "end_user_action". We begin by setting a mark at the initial cursor + point. At the end, the zone between the mark and the cursor is to be + untagged and then retagged. *) + initializer ignore (message_buffer#connect#insert_text ~callback:(fun it s -> ignore - (message_view#scroll_to_mark - ~use_align:false - ~within_margin:0.49 - `INSERT))); + (message_view#scroll_to_mark + ~use_align:false + ~within_margin:0.49 + `INSERT))); ignore (input_buffer#connect#insert_text ~callback:(fun it s -> - if (it#compare self#get_start_of_input)<0 - then GtkSignal.stop_emit (); - if String.length s > 1 then - (prerr_endline "insert_text: Placing cursor";input_buffer#place_cursor it))); + if (it#compare self#get_start_of_input)<0 + then GtkSignal.stop_emit (); + if String.length s > 1 then + (prerr_endline "insert_text: Placing cursor";input_buffer#place_cursor ~where:it))); ignore (input_buffer#connect#after#apply_tag ~callback:(fun tag ~start ~stop -> - if (start#compare self#get_start_of_input)>=0 - then - begin - input_buffer#remove_tag - Tags.Script.processed - ~start - ~stop; - input_buffer#remove_tag - Tags.Script.unjustified - ~start - ~stop - end + if (start#compare self#get_start_of_input)>=0 + then + begin + input_buffer#remove_tag + Tags.Script.processed + ~start + ~stop; + input_buffer#remove_tag + Tags.Script.unjustified + ~start + ~stop + end ) ); ignore (input_buffer#connect#after#insert_text ~callback:(fun it s -> - if auto_complete_on && - String.length s = 1 && s <> " " && s <> "\n" - then - let v = session_notebook#current_term.analyzed_view - in - let has_completed = - v#complete_at_offset - ((input_view#buffer#get_iter `SEL_BOUND)#offset) - in - if has_completed then - input_buffer#move_mark `SEL_BOUND (input_buffer#get_iter `SEL_BOUND)#forward_char; - - + if auto_complete_on && + String.length s = 1 && s <> " " && s <> "\n" + then + let v = session_notebook#current_term.analyzed_view + in + let has_completed = + v#complete_at_offset + ((input_view#buffer#get_iter `SEL_BOUND)#offset) + in + if has_completed then + input_buffer#move_mark `SEL_BOUND ~where:(input_buffer#get_iter `SEL_BOUND)#forward_char; ) ); - ignore (input_buffer#connect#changed + ignore (input_buffer#connect#begin_user_action + ~callback:(fun () -> + let where = self#get_insert in + input_buffer#move_mark (`NAME "prev_insert") ~where; + let start = self#get_start_of_input in + let stop = input_buffer#end_iter in + input_buffer#remove_tag Tags.Script.error ~start ~stop) + ); + ignore (input_buffer#connect#end_user_action ~callback:(fun () -> - last_modification_time <- Unix.time (); - let r = input_view#visible_rect in - let stop = - input_view#get_iter_at_location - ~x:(Gdk.Rectangle.x r + Gdk.Rectangle.width r) - ~y:(Gdk.Rectangle.y r + Gdk.Rectangle.height r) - in - input_buffer#remove_tag - Tags.Script.error - ~start:self#get_start_of_input - ~stop; - tag_on_insert input_buffer + last_modification_time <- Unix.time (); + tag_on_insert input_buffer ) ); ignore (input_buffer#add_selection_clipboard cb); ignore (proof_buffer#add_selection_clipboard cb); ignore (message_buffer#add_selection_clipboard cb); - self#electric_paren Tags.Script.paren; - ignore (input_buffer#connect#after#mark_set - ~callback:(fun it (m:Gtk.text_mark) -> - !set_location - (Printf.sprintf - "Line: %5d Char: %3d" (self#get_insert#line + 1) - (self#get_insert#line_offset + 1)); - match GtkText.Mark.get_name m with - | Some "insert" -> - input_buffer#remove_tag - ~start:input_buffer#start_iter - ~stop:input_buffer#end_iter - Tags.Script.paren; - | Some s -> - prerr_endline (s^" moved") - | None -> () ) - ); - ignore (input_buffer#connect#insert_text - (fun it s -> - prerr_endline "Should recenter ?"; - if String.contains s '\n' then begin - prerr_endline "Should recenter : yes"; - self#recenter_insert - end)); + self#electric_paren Tags.Script.paren; + ignore (input_buffer#connect#after#mark_set + ~callback:(fun it (m:Gtk.text_mark) -> + !set_location + (Printf.sprintf + "Line: %5d Char: %3d" (self#get_insert#line + 1) + (self#get_insert#line_offset + 1)); + match GtkText.Mark.get_name m with + | Some "insert" -> + input_buffer#remove_tag + ~start:input_buffer#start_iter + ~stop:input_buffer#end_iter + Tags.Script.paren; + | Some s -> + prerr_endline (s^" moved") + | None -> () ) + ); + ignore (input_buffer#connect#insert_text + ~callback:(fun it s -> + prerr_endline "Should recenter ?"; + if String.contains s '\n' then begin + prerr_endline "Should recenter : yes"; + self#recenter_insert + end)); end let last_make = ref "";; @@ -1498,9 +1428,9 @@ let search_next_error () = and e = int_of_string (Str.matched_group 4 !last_make) and msg_index = Str.match_beginning () in - last_make_index := Str.group_end 4; - (f,l,b,e, - String.sub !last_make msg_index (String.length !last_make - msg_index)) + last_make_index := Str.group_end 4; + (f,l,b,e, + String.sub !last_make msg_index (String.length !last_make - msg_index)) @@ -1508,7 +1438,7 @@ let search_next_error () = (* session creation and primitive handling *) (**********************************************************************) -let create_session () = +let create_session file = let script = Undo.undoable_view ~buffer:(GText.buffer ~tag_table:Tags.Script.table ()) @@ -1521,70 +1451,93 @@ let create_session () = GText.view ~buffer:(GText.buffer ~tag_table:Tags.Message.table ()) ~editable:false ~wrap_mode:`WORD () in - let basename = - GMisc.label ~text:"*scratch*" () in - let stack = - Stack.create () in - let legacy_av = - new analyzed_view script proof message stack in + let basename = GMisc.label ~text:(match file with + |None -> "*scratch*" + |Some f -> (Glib.Convert.filename_to_utf8 (Filename.basename f)) + ) () in + let stack = Stack.create () in + let coqtop_args = match file with + |None -> !sup_args + |Some the_file -> match !current.read_project with + |Ignore_args -> !sup_args + |Append_args -> (Project_file.args_from_project the_file !custom_project_files !current.project_file_name) + @(!sup_args) + |Subst_args -> Project_file.args_from_project the_file !custom_project_files !current.project_file_name + in + let ct = ref (Coq.spawn_coqtop coqtop_args) in + let command = new Command_windows.command_window ct current in + let legacy_av = new analyzed_view script proof message stack ct file in + let () = legacy_av#update_stats in let _ = script#buffer#create_mark ~name:"start_of_input" script#buffer#start_iter in let _ = + script#buffer#create_mark ~name:"prev_insert" script#buffer#start_iter in + let _ = proof#buffer#create_mark ~name:"end_of_conclusion" proof#buffer#start_iter in let _ = GtkBase.Widget.add_events proof#as_widget [`ENTER_NOTIFY;`POINTER_MOTION] in + let () = + List.iter (fun (opts,_,_,_,dflt) -> setopts !ct opts dflt) print_items in + let _ = legacy_av#activate () in let _ = proof#event#connect#motion_notify ~callback: (fun e -> - let win = match proof#get_window `WIDGET with - | None -> assert false - | Some w -> w in - let x,y = Gdk.Window.get_pointer_location win in - let b_x,b_y = proof#window_to_buffer_coords ~tag:`WIDGET ~x ~y in - let it = proof#get_iter_at_location ~x:b_x ~y:b_y in - let tags = it#tags in - List.iter - (fun t -> - ignore (GtkText.Tag.event t#as_tag proof#as_widget e it#as_iter)) - tags; - false) in - script#misc#set_name "ScriptWindow"; - script#buffer#place_cursor ~where:(script#buffer#start_iter); - proof#misc#set_can_focus true; - message#misc#set_can_focus true; - script#misc#modify_font !current.text_font; - proof#misc#modify_font !current.text_font; - message#misc#modify_font !current.text_font; - { tab_label=basename; - filename=""; - script=script; - proof_view=proof; - message_view=message; - analyzed_view=legacy_av; - command_stack=stack; - encoding="" - } + let win = match proof#get_window `WIDGET with + | None -> assert false + | Some w -> w in + let x,y = Gdk.Window.get_pointer_location win in + let b_x,b_y = proof#window_to_buffer_coords ~tag:`WIDGET ~x ~y in + let it = proof#get_iter_at_location ~x:b_x ~y:b_y in + let tags = it#tags in + List.iter + (fun t -> + ignore (GtkText.Tag.event t#as_tag proof#as_widget e it#as_iter)) + tags; + false) in + script#misc#set_name "ScriptWindow"; + script#buffer#place_cursor ~where:(script#buffer#start_iter); + proof#misc#set_can_focus true; + message#misc#set_can_focus true; + (* setting fonts *) + script#misc#modify_font !current.text_font; + proof#misc#modify_font !current.text_font; + message#misc#modify_font !current.text_font; + (* setting colors *) + script#misc#modify_base [`NORMAL, `NAME !current.background_color]; + proof#misc#modify_base [`NORMAL, `NAME !current.background_color]; + message#misc#modify_base [`NORMAL, `NAME !current.background_color]; + + { tab_label=basename; + filename=begin match file with None -> "" |Some f -> f end; + script=script; + proof_view=proof; + message_view=message; + analyzed_view=legacy_av; + encoding=""; + toplvl=ct; + command=command + } (* XXX - to be used later -let load_session session filename encs = - session.encoding <- List.find (IdeIO.load filename session.script#buffer) encs; - session.tab_label#set_text (Glib.Convert.filename_to_utf8 (Filename.basename filename)); - session.filename <- filename; - session.script#buffer#set_modified false + let load_session session filename encs = + session.encoding <- List.find (IdeIO.load filename session.script#buffer) encs; + session.tab_label#set_text (Glib.Convert.filename_to_utf8 (Filename.basename filename)); + session.filename <- filename; + session.script#buffer#set_modified false -let save_session session filename encs = - session.encoding <- List.find (IdeIO.save session.script#buffer filename) encs; - session.tab_label#set_text (Glib.Convert.filename_to_utf8 (Filename.basename filename)); - session.filename <- filename; - session.script#buffer#set_modified false + let save_session session filename encs = + session.encoding <- List.find (IdeIO.save session.script#buffer filename) encs; + session.tab_label#set_text (Glib.Convert.filename_to_utf8 (Filename.basename filename)); + session.filename <- filename; + session.script#buffer#set_modified false -let init_session session = - session.script#buffer#set_modified false; - session.script#clear_undo; - session.script#buffer#place_cursor session.script#buffer#start_iter - *) + let init_session session = + session.script#buffer#set_modified false; + session.script#clear_undo; + session.script#buffer#place_cursor session.script#buffer#start_iter +*) @@ -1593,93 +1546,93 @@ let init_session session = (* functions called by the user interface *) (*********************************************************************) (* XXX - to be used later -let do_open session filename = - try - load_session session filename ["UTF-8";"ISO-8859-1";"ISO-8859-15"]; - init_session session; - ignore (session_notebook#append_term session) - with _ -> () - - -let do_save session = - try - if session.script#buffer#modified then - save_session session session.filename [session.encoding] - with _ -> () - - -let choose_open = - let last_filename = ref "" in fun session -> - let open_dialog = GWindow.file_chooser_dialog ~action:`OPEN ~title:"Open file" ~modal:true () in - let enc_frame = GBin.frame ~label:"File encoding" ~packing:(open_dialog#vbox#pack ~fill:false) () in - let enc_entry = GEdit.entry ~text:(String.concat " " ["UTF-8";"ISO-8859-1";"ISO-8859-15"]) ~packing:enc_frame#add () in - let error_dialog = GWindow.message_dialog ~message_type:`ERROR ~modal:true ~buttons:GWindow.Buttons.ok - ~message:"Invalid encoding, please indicate the encoding to use." () in - let open_response = function - | `OPEN -> begin - match open_dialog#filename with - | Some fn -> begin - try - load_session session fn (Util.split_string_at ' ' enc_entry#text); - session.analyzed_view <- Some (new analyzed_view session); - init_session session; - session_notebook#goto_page (session_notebook#append_term session); - last_filename := fn - with - | Not_found -> open_dialog#misc#hide (); error_dialog#show () - | _ -> - error_dialog#set_markup "Unknown error while loading file, aborting."; - open_dialog#destroy (); error_dialog#destroy () - end - | None -> () - end - | `DELETE_EVENT -> open_dialog#destroy (); error_dialog#destroy () - in - let _ = open_dialog#connect#response open_response in - let _ = error_dialog#connect#response (fun x -> error_dialog#misc#hide (); open_dialog#show ()) in - let filter_any = GFile.filter ~name:"Any" ~patterns:["*"] () in - let filter_coq = GFile.filter ~name:"Coq source" ~patterns:["*.v"] () in - open_dialog#add_select_button_stock `OPEN `OPEN; - open_dialog#add_button_stock `CANCEL `DELETE_EVENT; - open_dialog#add_filter filter_any; - open_dialog#add_filter filter_coq; - ignore(open_dialog#set_filename !last_filename); - open_dialog#show () - - -let choose_save session = - let save_dialog = GWindow.file_chooser_dialog ~action:`SAVE ~title:"Save file" ~modal:true () in - let enc_frame = GBin.frame ~label:"File encoding" ~packing:(save_dialog#vbox#pack ~fill:false) () in - let enc_entry = GEdit.entry ~text:(String.concat " " [session.encoding;"UTF-8";"ISO-8859-1";"ISO-8859-15"]) ~packing:enc_frame#add () in - let error_dialog = GWindow.message_dialog ~message_type:`ERROR ~modal:true ~buttons:GWindow.Buttons.ok - ~message:"Invalid encoding, please indicate the encoding to use." () in - let save_response = function - | `SAVE -> begin - match save_dialog#filename with - | Some fn -> begin - try - save_session session fn (Util.split_string_at ' ' enc_entry#text) - with - | Not_found -> save_dialog#misc#hide (); error_dialog#show () - | _ -> - error_dialog#set_markup "Unknown error while saving file, aborting."; - save_dialog#destroy (); error_dialog#destroy () - end - | None -> () - end - | `DELETE_EVENT -> save_dialog#destroy (); error_dialog#destroy () - in - let _ = save_dialog#connect#response save_response in - let _ = error_dialog#connect#response (fun x -> error_dialog#misc#hide (); save_dialog#show ()) in - let filter_any = GFile.filter ~name:"Any" ~patterns:["*"] () in - let filter_coq = GFile.filter ~name:"Coq source" ~patterns:["*.v"] () in - save_dialog#add_select_button_stock `SAVE `SAVE; - save_dialog#add_button_stock `CANCEL `DELETE_EVENT; - save_dialog#add_filter filter_any; - save_dialog#add_filter filter_coq; - ignore(save_dialog#set_filename session.filename); - save_dialog#show () - *) + let do_open session filename = + try + load_session session filename ["UTF-8";"ISO-8859-1";"ISO-8859-15"]; + init_session session; + ignore (session_notebook#append_term session) + with _ -> () + + + let do_save session = + try + if session.script#buffer#modified then + save_session session session.filename [session.encoding] + with _ -> () + + + let choose_open = + let last_filename = ref "" in fun session -> + let open_dialog = GWindow.file_chooser_dialog ~action:`OPEN ~title:"Open file" ~modal:true () in + let enc_frame = GBin.frame ~label:"File encoding" ~packing:(open_dialog#vbox#pack ~fill:false) () in + let enc_entry = GEdit.entry ~text:(String.concat " " ["UTF-8";"ISO-8859-1";"ISO-8859-15"]) ~packing:enc_frame#add () in + let error_dialog = GWindow.message_dialog ~message_type:`ERROR ~modal:true ~buttons:GWindow.Buttons.ok + ~message:"Invalid encoding, please indicate the encoding to use." () in + let open_response = function + | `OPEN -> begin + match open_dialog#filename with + | Some fn -> begin + try + load_session session fn (Util.split_string_at ' ' enc_entry#text); + session.analyzed_view <- Some (new analyzed_view session); + init_session session; + session_notebook#goto_page (session_notebook#append_term session); + last_filename := fn + with + | Not_found -> open_dialog#misc#hide (); error_dialog#show () + | _ -> + error_dialog#set_markup "Unknown error while loading file, aborting."; + open_dialog#destroy (); error_dialog#destroy () + end + | None -> () + end + | `DELETE_EVENT -> open_dialog#destroy (); error_dialog#destroy () + in + let _ = open_dialog#connect#response open_response in + let _ = error_dialog#connect#response (fun x -> error_dialog#misc#hide (); open_dialog#show ()) in + let filter_any = GFile.filter ~name:"Any" ~patterns:["*"] () in + let filter_coq = GFile.filter ~name:"Coq source" ~patterns:["*.v"] () in + open_dialog#add_select_button_stock `OPEN `OPEN; + open_dialog#add_button_stock `CANCEL `DELETE_EVENT; + open_dialog#add_filter filter_any; + open_dialog#add_filter filter_coq; + ignore(open_dialog#set_filename !last_filename); + open_dialog#show () + + + let choose_save session = + let save_dialog = GWindow.file_chooser_dialog ~action:`SAVE ~title:"Save file" ~modal:true () in + let enc_frame = GBin.frame ~label:"File encoding" ~packing:(save_dialog#vbox#pack ~fill:false) () in + let enc_entry = GEdit.entry ~text:(String.concat " " [session.encoding;"UTF-8";"ISO-8859-1";"ISO-8859-15"]) ~packing:enc_frame#add () in + let error_dialog = GWindow.message_dialog ~message_type:`ERROR ~modal:true ~buttons:GWindow.Buttons.ok + ~message:"Invalid encoding, please indicate the encoding to use." () in + let save_response = function + | `SAVE -> begin + match save_dialog#filename with + | Some fn -> begin + try + save_session session fn (Util.split_string_at ' ' enc_entry#text) + with + | Not_found -> save_dialog#misc#hide (); error_dialog#show () + | _ -> + error_dialog#set_markup "Unknown error while saving file, aborting."; + save_dialog#destroy (); error_dialog#destroy () + end + | None -> () + end + | `DELETE_EVENT -> save_dialog#destroy (); error_dialog#destroy () + in + let _ = save_dialog#connect#response save_response in + let _ = error_dialog#connect#response (fun x -> error_dialog#misc#hide (); save_dialog#show ()) in + let filter_any = GFile.filter ~name:"Any" ~patterns:["*"] () in + let filter_coq = GFile.filter ~name:"Coq source" ~patterns:["*.v"] () in + save_dialog#add_select_button_stock `SAVE `SAVE; + save_dialog#add_button_stock `CANCEL `DELETE_EVENT; + save_dialog#add_filter filter_any; + save_dialog#add_filter filter_coq; + ignore(save_dialog#set_filename session.filename); + save_dialog#show () +*) (* Nota: using && here has the advantage of working both under win32 and unix. If someday we want the main command to be tried even if the "cd" has failed, @@ -1691,36 +1644,143 @@ let local_cd file = let do_print session = let av = session.analyzed_view in - match av#filename with - |None -> flash_info "Cannot print: this buffer has no name" - |Some f_name -> begin - let cmd = - local_cd session.filename ^ - !current.cmd_coqdoc ^ " --coqlib_path " ^ Envars.coqlib () ^ - " -ps " ^ Filename.quote (Filename.basename f_name) ^ - " | " ^ !current.cmd_print - in - let print_window = GWindow.window ~title:"Print" ~modal:true ~position:`CENTER ~wm_class:"CoqIDE" ~wm_name: "CoqIDE" () in - let vbox_print = GPack.vbox ~spacing:10 ~border_width:10 ~packing:print_window#add () in - let _ = GMisc.label ~justify:`LEFT ~text:"Print using the following command:" ~packing:vbox_print#add () in - let print_entry = GEdit.entry ~text:cmd ~editable:true ~width_chars:80 ~packing:vbox_print#add () in - let hbox_print = GPack.hbox ~spacing:10 ~packing:vbox_print#add () in - let print_cancel_button = GButton.button ~stock:`CANCEL ~label:"Cancel" ~packing:hbox_print#add () in - let print_button = GButton.button ~stock:`PRINT ~label:"Print" ~packing:hbox_print#add () in - let callback_print () = - let cmd = print_entry#text in - let s,_ = run_command av#insert_message cmd in - flash_info (cmd ^ if s = Unix.WEXITED 0 then " succeeded" else " failed"); - print_window#destroy () - in - ignore (print_cancel_button#connect#clicked ~callback:print_window#destroy) ; - ignore (print_button#connect#clicked ~callback:callback_print); - print_window#misc#show () + match av#filename with + |None -> flash_info "Cannot print: this buffer has no name" + |Some f_name -> begin + let cmd = + local_cd f_name ^ + !current.cmd_coqdoc ^ " -ps " ^ Filename.quote (Filename.basename f_name) ^ + " | " ^ !current.cmd_print + in + let print_window = GWindow.window ~title:"Print" ~modal:true ~position:`CENTER ~wm_class:"CoqIDE" ~wm_name: "CoqIDE" () in + let vbox_print = GPack.vbox ~spacing:10 ~border_width:10 ~packing:print_window#add () in + let _ = GMisc.label ~justify:`LEFT ~text:"Print using the following command:" ~packing:vbox_print#add () in + let print_entry = GEdit.entry ~text:cmd ~editable:true ~width_chars:80 ~packing:vbox_print#add () in + let hbox_print = GPack.hbox ~spacing:10 ~packing:vbox_print#add () in + let print_cancel_button = GButton.button ~stock:`CANCEL ~label:"Cancel" ~packing:hbox_print#add () in + let print_button = GButton.button ~stock:`PRINT ~label:"Print" ~packing:hbox_print#add () in + let callback_print () = + let cmd = print_entry#text in + let s,_ = run_command av#insert_message cmd in + flash_info (cmd ^ if s = Unix.WEXITED 0 then " succeeded" else " failed"); + print_window#destroy () + in + ignore (print_cancel_button#connect#clicked ~callback:print_window#destroy) ; + ignore (print_button#connect#clicked ~callback:callback_print); + print_window#misc#show () + end + +let load_file handler f = + let f = absolute_filename f in + try + prerr_endline "Loading file starts"; + let is_f = Minilib.same_file f in + if not (Minilib.list_fold_left_i + (fun i found x -> if found then found else + let {analyzed_view=av} = x in + (match av#filename with + | None -> false + | Some fn -> + if is_f fn + then (session_notebook#goto_page i; true) + else false)) + 0 false session_notebook#pages) + then begin + prerr_endline "Loading: must open"; + let b = Buffer.create 1024 in + prerr_endline "Loading: get raw content"; + with_file handler f ~f:(input_channel b); + prerr_endline "Loading: convert content"; + let s = do_convert (Buffer.contents b) in + prerr_endline "Loading: create view"; + let session = create_session (Some f) in + prerr_endline "Loading: adding view"; + let index = session_notebook#append_term session in + let av = session.analyzed_view in + prerr_endline "Loading: stats"; + av#update_stats; + let input_buffer = session.script#buffer in + prerr_endline "Loading: fill buffer"; + input_buffer#set_text s; + input_buffer#place_cursor ~where:input_buffer#start_iter; + force_retag input_buffer; + prerr_endline ("Loading: switch to view "^ string_of_int index); + session_notebook#goto_page index; + prerr_endline "Loading: highlight"; + input_buffer#set_modified false; + prerr_endline "Loading: clear undo"; + session.script#clear_undo; + prerr_endline "Loading: success" + end + with + | e -> handler ("Load failed: "^(Printexc.to_string e)) + +let do_load = load_file flash_info + +let saveall_f () = + List.iter + (function + | {script = view ; analyzed_view = av} -> + begin match av#filename with + | None -> () + | Some f -> + ignore (av#save f) + end + ) session_notebook#pages + +let forbid_quit_to_save () = + begin try save_pref() with e -> flash_info "Cannot save preferences" end; + (if List.exists + (function + | {script=view} -> view#buffer#modified + ) + session_notebook#pages then + match (GToolbox.question_box ~title:"Quit" + ~buttons:["Save Named Buffers and Quit"; + "Quit without Saving"; + "Don't Quit"] + ~default:0 + ~icon: + (let img = GMisc.image () in + img#set_stock `DIALOG_WARNING; + img#set_icon_size `DIALOG; + img#coerce) + "There are unsaved buffers" + ) + with 1 -> saveall_f () ; false + | 2 -> false + | _ -> true + else false)|| + (let wait_window = + GWindow.window ~modal:true ~wm_class:"CoqIde" ~wm_name:"CoqIde" ~kind:`POPUP + ~title:"Terminating coqtops" () in + let _ = + GMisc.label ~text:"Terminating coqtops processes, please wait ..." + ~packing:wait_window#add () in + let warning_window = + GWindow.message_dialog ~message_type:`WARNING ~buttons:GWindow.Buttons.yes_no + ~message: + ("Some coqtops processes are still running.\n" ^ + "If you quit CoqIDE right now, you may have to kill them manually.\n" ^ + "Do you want to wait for those processes to terminate ?") () in + let () = List.iter (fun _ -> session_notebook#remove_page 0) session_notebook#pages in + let nb_try=ref (0) in + let () = wait_window#show () in + let () = while (Coq.coqtop_zombies () <> 0)&&(!nb_try <= 50) do + incr nb_try; + Thread.delay 0.1 ; + done in + if (!nb_try = 50) then begin + wait_window#misc#hide (); + match warning_window#run () with + | `YES -> warning_window#misc#hide (); true + | `NO | `DELETE_EVENT -> false end + else false) + +let logfile = ref None let main files = - (* Statup preferences *) - load_pref (); (* Main window *) let w = GWindow.window @@ -1729,1626 +1789,1167 @@ let main files = ~width:!current.window_width ~height:!current.window_height ~title:"CoqIde" () in - (try - let icon_image = lib_ide_file "coq.png" in - let icon = GdkPixbuf.from_file icon_image in - w#set_icon (Some icon) - with _ -> ()); + (try + let icon_image = Filename.concat (List.find + (fun x -> Sys.file_exists (Filename.concat x "coq.png")) + Minilib.xdg_data_dirs) "coq.png" in + let icon = GdkPixbuf.from_file icon_image in + w#set_icon (Some icon) + with _ -> ()); - let vbox = GPack.vbox ~homogeneous:false ~packing:w#add () in + let vbox = GPack.vbox ~homogeneous:false ~packing:w#add () in + let new_f _ = + let session = create_session None in + let index = session_notebook#append_term session in + session_notebook#goto_page index + in + let load_f _ = + match select_file_for_open ~title:"Load file" () with + | None -> () + | Some f -> do_load f + in + let save_f _ = + let current = session_notebook#current_term in + try + (match current.analyzed_view#filename with + | None -> + begin match select_file_for_save ~title:"Save file" () + with + | None -> () + | Some f -> + if current.analyzed_view#save_as f then begin + current.tab_label#set_text (Filename.basename f); + flash_info ("File " ^ f ^ " saved") + end + else warning ("Save Failed (check if " ^ f ^ " is writable)") + end + | Some f -> + if current.analyzed_view#save f then + flash_info ("File " ^ f ^ " saved") + else warning ("Save Failed (check if " ^ f ^ " is writable)") - (* Menu bar *) - let menubar = GMenu.menu_bar ~packing:vbox#pack () in + ) + with + | e -> warning "Save: unexpected error" + in + let saveas_f _ = + let current = session_notebook#current_term in + try (match current.analyzed_view#filename with + | None -> + begin match select_file_for_save ~title:"Save file as" () + with + | None -> () + | Some f -> + if current.analyzed_view#save_as f then begin + current.tab_label#set_text (Filename.basename f); + flash_info "Saved" + end + else flash_info "Save Failed" + end + | Some f -> + begin match select_file_for_save + ~dir:(ref (Filename.dirname f)) + ~filename:(Filename.basename f) + ~title:"Save file as" () + with + | None -> () + | Some f -> + if current.analyzed_view#save_as f then begin + current.tab_label#set_text (Filename.basename f); + flash_info "Saved" + end else flash_info "Save Failed" + end); + with e -> flash_info "Save Failed" + in + let revert_f {analyzed_view = av} = + (try + match av#filename,av#stats with + | Some f,Some stats -> + let new_stats = Unix.stat f in + if new_stats.Unix.st_mtime > stats.Unix.st_mtime + then av#revert + | Some _, None -> av#revert + | _ -> () + with _ -> av#revert) + in + let export_f kind _ = + let v = session_notebook#current_term in + let av = v.analyzed_view in + match av#filename with + | None -> + flash_info "Cannot print: this buffer has no name" + | Some f -> + let basef = Filename.basename f in + let output = + let basef_we = try Filename.chop_extension basef with _ -> basef in + match kind with + | "latex" -> basef_we ^ ".tex" + | "dvi" | "ps" | "pdf" | "html" -> basef_we ^ "." ^ kind + | _ -> assert false + in + let cmd = + local_cd f ^ !current.cmd_coqdoc ^ " --" ^ kind ^ + " -o " ^ (Filename.quote output) ^ " " ^ (Filename.quote basef) + in + let s,_ = run_command av#insert_message cmd in + flash_info (cmd ^ + if s = Unix.WEXITED 0 + then " succeeded" + else " failed") + in + let quit_f _ = if not (forbid_quit_to_save ()) then exit 0 in + let get_active_view_for_cp () = + let has_sel (i0,i1) = i0#compare i1 <> 0 in + let current = session_notebook#current_term in + if has_sel current.script#buffer#selection_bounds + then current.script#as_view + else if has_sel current.proof_view#buffer#selection_bounds + then current.proof_view#as_view + else current.message_view#as_view + in + (* + let toggle_auto_complete_i = + edit_f#add_check_item "_Auto Completion" + ~active:!current.auto_complete + ~callback: + in + *) + (* + auto_complete := + (fun b -> match session_notebook#current_term.analyzed_view with + | Some av -> av#set_auto_complete b + | None -> ()); + *) + +(* begin of find/replace mechanism *) + let last_found = ref None in + let search_backward = ref false in + let find_w = GWindow.window + (* ~wm_class:"CoqIde" ~wm_name:"CoqIde" *) + (* ~allow_grow:true ~allow_shrink:true *) + (* ~width:!current.window_width ~height:!current.window_height *) + ~position:`CENTER + ~title:"CoqIde search/replace" () + in + let find_box = GPack.table + ~columns:3 ~rows:5 + ~col_spacings:10 ~row_spacings:10 ~border_width:10 + ~homogeneous:false ~packing:find_w#add () in - (* Toolbar *) - let toolbar = GButton.toolbar - ~orientation:`HORIZONTAL - ~style:`ICONS - ~tooltips:true - ~packing:(* handle#add *) - (vbox#pack ~expand:false ~fill:false) + let _ = + GMisc.label ~text:"Find:" + ~xalign:1.0 + ~packing:(find_box#attach ~left:0 ~top:0 ~fill:`X) () + in + let find_entry = GEdit.entry + ~editable: true + ~packing: (find_box#attach ~left:1 ~top:0 ~expand:`X) + () + in + let _ = + GMisc.label ~text:"Replace with:" + ~xalign:1.0 + ~packing:(find_box#attach ~left:0 ~top:1 ~fill:`X) () + in + let replace_entry = GEdit.entry + ~editable: true + ~packing: (find_box#attach ~left:1 ~top:1 ~expand:`X) + () + in + (* let _ = + GButton.check_button + ~label:"case sensitive" + ~active:true + ~packing: (find_box#attach ~left:1 ~top:2) + () + in + *) + let find_backwards_check = + GButton.check_button + ~label:"search backwards" + ~active:!search_backward + ~packing: (find_box#attach ~left:1 ~top:3) + () + in + let close_find_button = + GButton.button + ~label:"Close" + ~packing: (find_box#attach ~left:2 ~top:2) + () + in + let replace_find_button = + GButton.button + ~label:"Replace and find" + ~packing: (find_box#attach ~left:2 ~top:1) () + in + let find_again_button = + GButton.button + ~label:"_Find again" + ~packing: (find_box#attach ~left:2 ~top:0) + () + in + let last_find () = + let v = session_notebook#current_term.script in + let b = v#buffer in + let start,stop = + match !last_found with + | None -> let i = b#get_iter_at_mark `INSERT in (i,i) + | Some(start,stop) -> + let start = b#get_iter_at_mark start + and stop = b#get_iter_at_mark stop + in + b#remove_tag Tags.Script.found ~start ~stop; + last_found:=None; + start,stop in - show_toolbar := - (fun b -> if b then toolbar#misc#show () else toolbar#misc#hide ()); - - let factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/" menubar in - let accel_group = factory#accel_group in - - (* File Menu *) - let file_menu = factory#add_submenu "_File" in - - let file_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/File/" file_menu ~accel_group in - - (* File/Load Menu *) - let load_file handler f = - let f = absolute_filename f in - try - prerr_endline "Loading file starts"; - if not (Util.list_fold_left_i - (fun i found x -> if found then found else - let {analyzed_view=av} = x in - (match av#filename with - | None -> false - | Some fn -> - if same_file f fn - then (session_notebook#goto_page i; true) - else false)) - 0 false session_notebook#pages) - then begin - prerr_endline "Loading: must open"; - let b = Buffer.create 1024 in - prerr_endline "Loading: get raw content"; - with_file handler f ~f:(input_channel b); - prerr_endline "Loading: convert content"; - let s = do_convert (Buffer.contents b) in - prerr_endline "Loading: create view"; - let session = create_session () in - session.tab_label#set_text (Glib.Convert.filename_to_utf8 (Filename.basename f)); - prerr_endline "Loading: adding view"; - let index = session_notebook#append_term session in - let av = session.analyzed_view in - prerr_endline "Loading: set filename"; - av#set_filename (Some f); - prerr_endline "Loading: stats"; - av#update_stats; - let input_buffer = session.script#buffer in - prerr_endline "Loading: fill buffer"; - input_buffer#set_text s; - input_buffer#place_cursor input_buffer#start_iter; - prerr_endline ("Loading: switch to view "^ string_of_int index); - session_notebook#goto_page index; - prerr_endline "Loading: highlight"; - input_buffer#set_modified false; - prerr_endline "Loading: clear undo"; - session.script#clear_undo; - prerr_endline "Loading: success" - end - with - | e -> handler ("Load failed: "^(Printexc.to_string e)) + (v,b,start,stop) + in + let do_replace () = + let v = session_notebook#current_term.script in + let b = v#buffer in + match !last_found with + | None -> () + | Some(start,stop) -> + let start = b#get_iter_at_mark start + and stop = b#get_iter_at_mark stop + in + b#delete ~start ~stop; + b#insert ~iter:start replace_entry#text; + last_found:=None + in + let find_from (v : Undo.undoable_view) + (b : GText.buffer) (starti : GText.iter) text = + prerr_endline ("Searching for " ^ text); + match (if !search_backward then starti#backward_search text + else starti#forward_search text) + with + | None -> () + | Some(start,stop) -> + b#apply_tag Tags.Script.found ~start ~stop; + let start = `MARK (b#create_mark start) + and stop = `MARK (b#create_mark stop) + in + v#scroll_to_mark ~use_align:false ~yalign:0.75 ~within_margin:0.25 + stop; + last_found := Some(start,stop) + in + let do_find () = + let (v,b,starti,_) = last_find () in + find_from v b starti find_entry#text + in + let do_replace_find () = + do_replace(); + do_find() + in + let close_find () = + let (v,b,_,stop) = last_find () in + b#place_cursor ~where:stop; + find_w#misc#hide(); + v#coerce#misc#grab_focus() + in + to_do_on_page_switch := + (fun i -> if find_w#misc#visible then close_find()):: + !to_do_on_page_switch; + let find_again () = + let (v,b,start,_) = last_find () in + let start = + if !search_backward + then start#backward_chars 1 + else start#forward_chars 1 + in + find_from v b start find_entry#text + in + let click_on_backward () = + search_backward := not !search_backward + in + let key_find ev = + let s = GdkEvent.Key.state ev and k = GdkEvent.Key.keyval ev in + if k = GdkKeysyms._Escape then + begin + let (v,b,_,stop) = last_find () in + find_w#misc#hide(); + v#coerce#misc#grab_focus(); + true + end + else if k = GdkKeysyms._Escape then + begin + close_find(); + true + end + else if k = GdkKeysyms._Return || + List.mem `CONTROL s && k = GdkKeysyms._f then + begin + find_again (); + true + end + else if List.mem `CONTROL s && k = GdkKeysyms._b then + begin + find_backwards_check#set_active (not !search_backward); + true + end + else false (* to let default callback execute *) + in + let find_f ~backward () = + let save_dir = !search_backward in + search_backward := backward; + find_w#show (); + find_w#present (); + find_entry#misc#grab_focus (); + search_backward := save_dir + in + let _ = find_again_button#connect#clicked find_again in + let _ = close_find_button#connect#clicked close_find in + let _ = replace_find_button#connect#clicked do_replace_find in + let _ = find_backwards_check#connect#clicked click_on_backward in + let _ = find_entry#connect#changed do_find in + let _ = find_entry#event#connect#key_press ~callback:key_find in + let _ = find_w#event#connect#delete ~callback:(fun _ -> find_w#misc#hide(); true) in + (* + let search_if = edit_f#add_item "Search _forward" + ~key:GdkKeysyms._greater + in + let search_ib = edit_f#add_item "Search _backward" + ~key:GdkKeysyms._less + in + *) + (* + let complete_i = edit_f#add_item "_Complete" + ~key:GdkKeysyms._comma + ~callback: + (do_if_not_computing + (fun b -> + let v = session_notebook#current_term.analyzed_view + + in v#complete_at_offset + ((v#view#buffer#get_iter `SEL_BOUND)#offset) + )) + in + complete_i#misc#set_state `INSENSITIVE; + *) +(* end of find/replace mechanism *) +(* begin Preferences *) + let reset_revert_timer () = + disconnect_revert_timer (); + if !current.global_auto_revert then + revert_timer := Some + (GMain.Timeout.add ~ms:!current.global_auto_revert_delay + ~callback: + (fun () -> + do_if_not_computing "revert" (sync revert_f) session_notebook#pages; + true)) + in reset_revert_timer (); (* to enable statup preferences timer *) + (* XXX *) + let auto_save_f {analyzed_view = av} = + (try + av#auto_save + with _ -> ()) + in + + let reset_auto_save_timer () = + disconnect_auto_save_timer (); + if !current.auto_save then + auto_save_timer := Some + (GMain.Timeout.add ~ms:!current.auto_save_delay + ~callback: + (fun () -> + do_if_not_computing "autosave" (sync auto_save_f) session_notebook#pages; + true)) + in reset_auto_save_timer (); (* to enable statup preferences timer *) +(* end Preferences *) + + let do_or_activate f () = + do_if_not_computing "do_or_activate" + (fun current -> + let av = current.analyzed_view in + ignore (f av); + pop_info (); + let msg = match Coq.status !(current.toplvl) with + | Interface.Fail (l, str) -> + "Oops, problem while fetching coq status." + | Interface.Good status -> + let path = match status.Interface.status_path with + | [] | _ :: [] -> "" (* Drop the topmost level, usually "Top" *) + | _ :: l -> " in " ^ String.concat "." l + in + let name = match status.Interface.status_proofname with + | None -> "" + | Some n -> ", proving " ^ n + in + "Ready" ^ path ^ name + in + push_info msg + ) + [session_notebook#current_term] + in + let do_if_active f _ = + do_if_not_computing "do_if_active" + (fun sess -> ignore (f sess.analyzed_view)) + [session_notebook#current_term] in + let match_callback _ = + let w = get_current_word () in + let cur_ct = !(session_notebook#current_term.toplvl) in + try + match Coq.mkcases cur_ct w with + | Interface.Fail _ -> raise Not_found + | Interface.Good cases -> + let print_branch c l = + Format.fprintf c " | @[<hov 1>%a@]=> _@\n" + (print_list (fun c s -> Format.fprintf c "%s@ " s)) l + in + let b = Buffer.create 1024 in + let fmt = Format.formatter_of_buffer b in + Format.fprintf fmt "@[match var with@\n%aend@]@." + (print_list print_branch) cases; + let s = Buffer.contents b in + prerr_endline s; + let {script = view } = session_notebook#current_term in + ignore (view#buffer#delete_selection ()); + let m = view#buffer#create_mark + (view#buffer#get_iter `INSERT) + in + if view#buffer#insert_interactive s then + let i = view#buffer#get_iter (`MARK m) in + let _ = i#nocopy#forward_chars 9 in + view#buffer#place_cursor ~where:i; + view#buffer#move_mark ~where:(i#backward_chars 3) + `SEL_BOUND + with Not_found -> flash_info "Not an inductive type" + in +(* External command callback *) + let compile_f _ = + let v = session_notebook#current_term in + let av = v.analyzed_view in + save_f (); + match av#filename with + | None -> + flash_info "Active buffer has no name" + | Some f -> + let cmd = !current.cmd_coqc ^ " -I " + ^ (Filename.quote (Filename.dirname f)) + ^ " " ^ (Filename.quote f) in + let s,res = run_command av#insert_message cmd in + if s = Unix.WEXITED 0 then + flash_info (f ^ " successfully compiled") + else begin + flash_info (f ^ " failed to compile"); + av#process_until_end_or_error; + av#insert_message "Compilation output:\n"; + av#insert_message res + end + in + let make_f _ = + let v = session_notebook#current_term in + let av = v.analyzed_view in + match av#filename with + | None -> + flash_info "Cannot make: this buffer has no name" + | Some f -> + let cmd = local_cd f ^ !current.cmd_make in + + (* + save_f (); + *) + av#insert_message "Command output:\n"; + let s,res = run_command av#insert_message cmd in + last_make := res; + last_make_index := 0; + flash_info (!current.cmd_make ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") + in + let next_error _ = + try + let file,line,start,stop,error_msg = search_next_error () in + do_load file; + let v = session_notebook#current_term in + let av = v.analyzed_view in + let input_buffer = v.script#buffer in + (* + let init = input_buffer#start_iter in + let i = init#forward_lines (line-1) in + *) + (* + let convert_pos = byte_offset_to_char_offset phrase in + let start = convert_pos start in + let stop = convert_pos stop in + *) + (* + let starti = i#forward_chars start in + let stopi = i#forward_chars stop in + *) + let starti = input_buffer#get_iter_at_byte ~line:(line-1) start in + let stopi = input_buffer#get_iter_at_byte ~line:(line-1) stop in + input_buffer#apply_tag Tags.Script.error + ~start:starti + ~stop:stopi; + input_buffer#place_cursor ~where:starti; + av#set_message error_msg; + v.script#misc#grab_focus () + with Not_found -> + last_make_index := 0; + let v = session_notebook#current_term in + let av = v.analyzed_view in + av#set_message "No more errors.\n" + in + let coq_makefile_f _ = + let v = session_notebook#current_term in + let av = v.analyzed_view in + match av#filename with + | None -> + flash_info "Cannot make makefile: this buffer has no name" + | Some f -> + let cmd = local_cd f ^ !current.cmd_coqmakefile in + let s,res = run_command av#insert_message cmd in + flash_info + (!current.cmd_coqmakefile ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") + in + + let file_actions = GAction.action_group ~name:"File" () in + let edit_actions = GAction.action_group ~name:"Edit" () in + let view_actions = GAction.action_group ~name:"View" () in + let export_actions = GAction.action_group ~name:"Export" () in + let navigation_actions = GAction.action_group ~name:"Navigation" () in + let tactics_actions = GAction.action_group ~name:"Tactics" () in + let templates_actions = GAction.action_group ~name:"Templates" () in + let queries_actions = GAction.action_group ~name:"Queries" () in + let compile_actions = GAction.action_group ~name:"Compile" () in + let windows_actions = GAction.action_group ~name:"Windows" () in + let help_actions = GAction.action_group ~name:"Help" () in + let add_gen_actions menu_name act_grp l = + let no_under = Minilib.string_map (fun x -> if x = '_' then '-' else x) in + let add_simple_template menu_name act_grp text = + let text' = + let l = String.length text - 1 in + if String.get text l = '.' + then text ^"\n" + else text ^" " in - let load f = load_file flash_info f in - let load_m = file_factory#add_item "_New" - ~key:GdkKeysyms._N in - let load_f () = - match select_file_for_save ~title:"Create file" () with - | None -> () - | Some f -> load f + GAction.add_action (menu_name^" "^(no_under text)) ~label:text + ~callback:(fun _ -> let {script = view } = session_notebook#current_term in + ignore (view#buffer#insert_interactive text')) act_grp + in + List.iter (function + | [] -> () + | [s] -> add_simple_template menu_name act_grp s + | s::_ as ll -> let label = "_@..." in label.[1] <- s.[0]; + GAction.add_action (menu_name^" "^(String.make 1 s.[0])) ~label act_grp; + List.iter (add_simple_template menu_name act_grp) ll + ) l + in + let tactic_shortcut s sc = GAction.add_action s ~label:("_"^s) + ~accel:(!current.modifier_for_tactics^sc) + ~callback:(do_if_active (fun a -> a#insert_command + ("progress "^s^".") (s^"."))) in + let query_callback command _ = + let word = get_current_word () in + if not (word = "") then + let term = session_notebook#current_term in + let query = command ^ " " ^ word ^ "." in + term.message_view#buffer#set_text ""; + term.analyzed_view#raw_coq_query query + in + let query_shortcut s accel = + GAction.add_action s ~label:("_"^s) ?accel ~callback:(query_callback s) + in + let add_complex_template (name, label, text, offset, len, key) = + (* Templates/Lemma *) + let callback _ = + let {script = view } = session_notebook#current_term in + if view#buffer#insert_interactive text then begin + let iter = view#buffer#get_iter_at_mark `INSERT in + ignore (iter#nocopy#backward_chars offset); + view#buffer#move_mark `INSERT ~where:iter; + ignore (iter#nocopy#backward_chars len); + view#buffer#move_mark `SEL_BOUND ~where:iter; + end in + match key with + |Some ac -> GAction.add_action name ~label ~callback ~accel:(!current.modifier_for_templates^ac) + |None -> GAction.add_action name ~label ~callback ?accel:None + in + let detach_view _ = + (* Open a separate window containing the current buffer *) + let trm = session_notebook#current_term in + let w = GWindow.window ~show:true + ~width:(!current.window_width*2/3) + ~height:(!current.window_height*2/3) + ~position:`CENTER + ~title:(if trm.filename = "" then "*scratch*" else trm.filename) + () + in + let sb = GBin.scrolled_window ~packing:w#add () + in + let nv = GText.view ~buffer:trm.script#buffer ~packing:sb#add () + in + nv#misc#modify_font !current.text_font; + (* If the buffer in the main window is closed, destroy this detached view *) + ignore (trm.script#connect#destroy ~callback:w#destroy) + in + GAction.add_actions file_actions [ + GAction.add_action "File" ~label:"_File"; + GAction.add_action "New" ~callback:new_f ~stock:`NEW; + GAction.add_action "Open" ~callback:load_f ~stock:`OPEN; + GAction.add_action "Save" ~callback:save_f ~stock:`SAVE ~tooltip:"Save current buffer"; + GAction.add_action "Save as" ~label:"S_ave as" ~callback:saveas_f ~stock:`SAVE_AS; + GAction.add_action "Save all" ~label:"Sa_ve all" ~callback:(fun _ -> saveall_f ()); + GAction.add_action "Revert all buffers" ~label:"_Revert all buffers" ~callback:(fun _ -> List.iter revert_f session_notebook#pages) ~stock:`REVERT_TO_SAVED; + GAction.add_action "Close buffer" ~label:"_Close buffer" ~callback:(fun _ -> remove_current_view_page ()) ~stock:`CLOSE ~tooltip:"Close current buffer"; + GAction.add_action "Print..." ~label:"_Print..." ~callback:(fun _ -> do_print session_notebook#current_term) ~stock:`PRINT ~accel:"<Ctrl>p"; + GAction.add_action "Rehighlight" ~label:"Reh_ighlight" ~accel:"<Ctrl>l" + ~callback:(fun _ -> force_retag + session_notebook#current_term.script#buffer; + session_notebook#current_term.analyzed_view#recenter_insert) + ~stock:`REFRESH; + GAction.add_action "Quit" ~callback:quit_f ~stock:`QUIT; + ]; + GAction.add_actions export_actions [ + GAction.add_action "Export to" ~label:"E_xport to"; + GAction.add_action "Html" ~label:"_Html" ~callback:(export_f "html"); + GAction.add_action "Latex" ~label:"_LaTeX" ~callback:(export_f "latex"); + GAction.add_action "Dvi" ~label:"_Dvi" ~callback:(export_f "dvi"); + GAction.add_action "Pdf" ~label:"_Pdf" ~callback:(export_f "pdf"); + GAction.add_action "Ps" ~label:"_Ps" ~callback:(export_f "ps"); + ]; + GAction.add_actions edit_actions [ + GAction.add_action "Edit" ~label:"_Edit"; + GAction.add_action "Undo" ~accel:"<Ctrl>u" + ~callback:(fun _ -> do_if_not_computing "undo" + (fun sess -> + ignore (sess.analyzed_view#without_auto_complete + (fun () -> session_notebook#current_term.script#undo) ())) + [session_notebook#current_term]) ~stock:`UNDO; + GAction.add_action "Clear Undo Stack" ~label:"_Clear Undo Stack" + ~callback:(fun _ -> ignore session_notebook#current_term.script#clear_undo); + GAction.add_action "Cut" ~callback:(fun _ -> GtkSignal.emit_unit + (get_active_view_for_cp ()) + ~sgn:GtkText.View.S.cut_clipboard + ) ~stock:`CUT; + GAction.add_action "Copy" ~callback:(fun _ -> GtkSignal.emit_unit + (get_active_view_for_cp ()) + ~sgn:GtkText.View.S.copy_clipboard) ~stock:`COPY; + GAction.add_action "Paste" ~callback:(fun _ -> + try GtkSignal.emit_unit + session_notebook#current_term.script#as_view + ~sgn:GtkText.View.S.paste_clipboard + with _ -> prerr_endline "EMIT PASTE FAILED") ~stock:`PASTE; + GAction.add_action "Find in buffer" ~label:"_Find in buffer" ~callback:(fun _ -> find_f ~backward:false ()) ~stock:`FIND; + GAction.add_action "Find backwards" ~label:"Find _backwards" ~callback:(fun _ -> find_f ~backward:true ()) ~accel:"<Ctrl>b"; + GAction.add_action "Complete Word" ~label:"Complete Word" ~callback:(fun _ -> + ignore ( + let av = session_notebook#current_term.analyzed_view in + av#complete_at_offset (av#get_insert)#offset + )) ~accel:"<Ctrl>slash"; + GAction.add_action "External editor" ~label:"External editor" ~callback:(fun _ -> + let av = session_notebook#current_term.analyzed_view in + match av#filename with + | None -> warning "Call to external editor available only on named files" + | Some f -> + save_f (); + let com = Minilib.subst_command_placeholder !current.cmd_editor (Filename.quote f) in + let _ = run_command av#insert_message com in + av#revert) ~stock:`EDIT; + GAction.add_action "Preferences" ~callback:(fun _ -> + begin + try configure ~apply:update_notebook_pos () + with _ -> flash_info "Cannot save preferences" + end; + reset_revert_timer ()) ~accel:"<Ctrl>comma" ~stock:`PREFERENCES; + (* GAction.add_action "Save preferences" ~label:"_Save preferences" ~callback:(fun _ -> save_pref ()); *) ]; + GAction.add_actions view_actions [ + GAction.add_action "View" ~label:"_View"; + GAction.add_action "Previous tab" ~label:"_Previous tab" ~accel:("<ALT>Left") ~stock:`GO_BACK + ~callback:(fun _ -> session_notebook#previous_page ()); + GAction.add_action "Next tab" ~label:"_Next tab" ~accel:("<ALT>Right") ~stock:`GO_FORWARD + ~callback:(fun _ -> session_notebook#next_page ()); + GAction.add_toggle_action "Show Toolbar" ~label:"Show _Toolbar" + ~active:(!current.show_toolbar) ~callback: + (fun _ -> !current.show_toolbar <- not !current.show_toolbar; + !refresh_toolbar_hook ()); + GAction.add_toggle_action "Show Query Pane" ~label:"Show _Query Pane" + ~callback:(fun _ -> let ccw = session_notebook#current_term.command in + if ccw#frame#misc#visible + then ccw#frame#misc#hide () + else ccw#frame#misc#show ()) + ~accel:"Escape"; + ]; + List.iter + (fun (opts,name,label,key,dflt) -> + GAction.add_toggle_action name ~active:dflt ~label + ~accel:(!current.modifier_for_display^key) + ~callback:(fun v -> do_or_activate (fun a -> + let () = setopts !(session_notebook#current_term.toplvl) opts v#get_active in + a#show_goals) ()) view_actions) + print_items; + GAction.add_actions navigation_actions [ + GAction.add_action "Navigation" ~label:"_Navigation"; + GAction.add_action "Forward" ~label:"_Forward" ~stock:`GO_DOWN + ~callback:(fun _ -> do_or_activate (fun a -> a#process_next_phrase true) ()) + ~tooltip:"Forward one command" ~accel:(!current.modifier_for_navigation^"Down"); + GAction.add_action "Backward" ~label:"_Backward" ~stock:`GO_UP + ~callback:(fun _ -> do_or_activate (fun a -> a#undo_last_step) ()) + ~tooltip:"Backward one command" ~accel:(!current.modifier_for_navigation^"Up"); + GAction.add_action "Go to" ~label:"_Go to" ~stock:`JUMP_TO + ~callback:(fun _ -> do_or_activate (fun a -> a#go_to_insert) ()) + ~tooltip:"Go to cursor" ~accel:(!current.modifier_for_navigation^"Right"); + GAction.add_action "Start" ~label:"_Start" ~stock:`GOTO_TOP + ~callback:(fun _ -> force_reset_initial ()) + ~tooltip:"Restart coq" ~accel:(!current.modifier_for_navigation^"Home"); + GAction.add_action "End" ~label:"_End" ~stock:`GOTO_BOTTOM + ~callback:(fun _ -> do_or_activate (fun a -> a#process_until_end_or_error) ()) + ~tooltip:"Go to end" ~accel:(!current.modifier_for_navigation^"End"); + GAction.add_action "Interrupt" ~label:"_Interrupt" ~stock:`STOP + ~callback:(fun _ -> break ()) ~tooltip:"Interrupt computations" + ~accel:(!current.modifier_for_navigation^"Break"); + GAction.add_action "Hide" ~label:"_Hide" ~stock:`MISSING_IMAGE + ~callback:(fun _ -> let sess = session_notebook#current_term in + toggle_proof_visibility sess.script#buffer + sess.analyzed_view#get_insert) ~tooltip:"Hide proof" + ~accel:(!current.modifier_for_navigation^"h"); + GAction.add_action "Previous" ~label:"_Previous" ~stock:`GO_BACK + ~callback:(fun _ -> do_or_activate (fun a -> a#go_to_prev_occ_of_cur_word) ()) + ~tooltip:"Previous occurence" ~accel:(!current.modifier_for_navigation^"less"); + GAction.add_action "Next" ~label:"_Next" ~stock:`GO_FORWARD + ~callback:(fun _ -> do_or_activate (fun a -> a#go_to_next_occ_of_cur_word) ()) + ~tooltip:"Next occurence" ~accel:(!current.modifier_for_navigation^"greater"); + ]; + GAction.add_actions tactics_actions [ + GAction.add_action "Try Tactics" ~label:"_Try Tactics"; + GAction.add_action "Wizard" ~tooltip:"Proof Wizard" ~label:"<Proof Wizard>" + ~stock:`DIALOG_INFO ~callback:(do_if_active (fun a -> a#tactic_wizard + !current.automatic_tactics)) + ~accel:(!current.modifier_for_tactics^"dollar"); + tactic_shortcut "auto" "a"; + tactic_shortcut "auto with *" "asterisk"; + tactic_shortcut "eauto" "e"; + tactic_shortcut "eauto with *" "ampersand"; + tactic_shortcut "intuition" "i"; + tactic_shortcut "omega" "o"; + tactic_shortcut "simpl" "s"; + tactic_shortcut "tauto" "p"; + tactic_shortcut "trivial" "v"; + ]; + add_gen_actions "Tactic" tactics_actions Coq_commands.tactics; + GAction.add_actions templates_actions [ + GAction.add_action "Templates" ~label:"Te_mplates"; + add_complex_template + ("Lemma", "_Lemma __", "Lemma new_lemma : .\nIdeproof.\n\nSave.\n", + 19, 9, Some "L"); + add_complex_template + ("Theorem", "_Theorem __", "Theorem new_theorem : .\nIdeproof.\n\nSave.\n", + 19, 11, Some "T"); + add_complex_template + ("Definition", "_Definition __", "Definition ident := .\n", + 6, 5, Some "D"); + add_complex_template + ("Inductive", "_Inductive __", "Inductive ident : :=\n | : .\n", + 14, 5, Some "I"); + add_complex_template + ("Fixpoint", "_Fixpoint __", "Fixpoint ident (_ : _) {struct _} : _ :=\n.\n", + 29, 5, Some "F"); + add_complex_template ("Scheme", "_Scheme __", + "Scheme new_scheme := Induction for _ Sort _\ +\nwith _ := Induction for _ Sort _.\n",61,10, Some "S"); + GAction.add_action "match" ~label:"match ..." ~callback:match_callback + ~accel:(!current.modifier_for_templates^"C"); + ]; + add_gen_actions "Template" templates_actions Coq_commands.commands; + GAction.add_actions queries_actions [ + GAction.add_action "Queries" ~label:"_Queries"; + query_shortcut "SearchAbout" (Some "F2"); + query_shortcut "Check" (Some "F3"); + query_shortcut "Print" (Some "F4"); + query_shortcut "About" (Some "F5"); + query_shortcut "Locate" None; + query_shortcut "Whelp Locate" None; + ]; + GAction.add_actions compile_actions [ + GAction.add_action "Compile" ~label:"_Compile"; + GAction.add_action "Compile buffer" ~label:"_Compile buffer" ~callback:compile_f; + GAction.add_action "Make" ~label:"_Make" ~callback:make_f ~accel:"F6"; + GAction.add_action "Next error" ~label:"_Next error" ~callback:next_error + ~accel:"F7"; + GAction.add_action "Make makefile" ~label:"Make makefile" ~callback:coq_makefile_f; + ]; + GAction.add_actions windows_actions [ + GAction.add_action "Windows" ~label:"_Windows"; + GAction.add_action "Detach View" ~label:"Detach _View" ~callback:detach_view + ]; + GAction.add_actions help_actions [ + GAction.add_action "Help" ~label:"_Help"; + GAction.add_action "Browse Coq Manual" ~label:"Browse Coq _Manual" + ~callback:(fun _ -> + let av = session_notebook#current_term.analyzed_view in + browse av#insert_message (doc_url ())); + GAction.add_action "Browse Coq Library" ~label:"Browse Coq _Library" + ~callback:(fun _ -> + let av = session_notebook#current_term.analyzed_view in + browse av#insert_message !current.library_url); + GAction.add_action "Help for keyword" ~label:"Help for _keyword" + ~callback:(fun _ -> let av = session_notebook#current_term.analyzed_view in + av#help_for_keyword ()) ~stock:`HELP; + GAction.add_action "About Coq" ~label:"_About" ~stock:`ABOUT; + ]; + Coqide_ui.init (); + Coqide_ui.ui_m#insert_action_group file_actions 0; + Coqide_ui.ui_m#insert_action_group export_actions 0; + Coqide_ui.ui_m#insert_action_group edit_actions 0; + Coqide_ui.ui_m#insert_action_group view_actions 0; + Coqide_ui.ui_m#insert_action_group navigation_actions 0; + Coqide_ui.ui_m#insert_action_group tactics_actions 0; + Coqide_ui.ui_m#insert_action_group templates_actions 0; + Coqide_ui.ui_m#insert_action_group queries_actions 0; + Coqide_ui.ui_m#insert_action_group compile_actions 0; + Coqide_ui.ui_m#insert_action_group windows_actions 0; + Coqide_ui.ui_m#insert_action_group help_actions 0; + w#add_accel_group Coqide_ui.ui_m#get_accel_group ; + GtkMain.Rc.parse_string "gtk-can-change-accels = 1"; + if Coq_config.gtk_platform <> `QUARTZ + then vbox#pack (Coqide_ui.ui_m#get_widget "/CoqIde MenuBar"); + let tbar = GtkButton.Toolbar.cast ((Coqide_ui.ui_m#get_widget "/CoqIde ToolBar")#as_widget) + in let () = GtkButton.Toolbar.set ~orientation:`HORIZONTAL ~style:`ICONS + ~tooltips:true tbar in + let toolbar = new GObj.widget tbar in + vbox#pack toolbar; + + ignore (w#event#connect#delete ~callback:(fun _ -> quit_f (); true)); + + (* The vertical Separator between Scripts and Goals *) + vbox#pack ~expand:true session_notebook#coerce; + update_notebook_pos (); + let nb = session_notebook in + let lower_hbox = GPack.hbox ~homogeneous:false ~packing:vbox#pack () in + lower_hbox#pack ~expand:true status#coerce; + let search_lbl = GMisc.label ~text:"Search:" + ~show:false + ~packing:(lower_hbox#pack ~expand:false) () + in + let search_history = ref [] in + let (search_input,_) = GEdit.combo_box_entry_text ~strings:!search_history ~show:false + ~packing:(lower_hbox#pack ~expand:false) () + in + let ready_to_wrap_search = ref false in + + let start_of_search = ref None in + let start_of_found = ref None in + let end_of_found = ref None in + let search_forward = ref true in + let matched_word = ref None in + + let memo_search () = + matched_word := Some search_input#entry#text + in + let end_search () = + prerr_endline "End Search"; + memo_search (); + let v = session_notebook#current_term.script in + v#buffer#move_mark `SEL_BOUND ~where:(v#buffer#get_iter_at_mark `INSERT); + v#coerce#misc#grab_focus (); + search_input#entry#set_text ""; + search_lbl#misc#hide (); + search_input#misc#hide () + in + let end_search_focus_out () = + prerr_endline "End Search(focus out)"; + memo_search (); + let v = session_notebook#current_term.script in + v#buffer#move_mark `SEL_BOUND ~where:(v#buffer#get_iter_at_mark `INSERT); + search_input#entry#set_text ""; + search_lbl#misc#hide (); + search_input#misc#hide () + in + ignore (search_input#entry#connect#activate ~callback:end_search); + ignore (search_input#entry#event#connect#key_press + ~callback:(fun k -> let kv = GdkEvent.Key.keyval k in + if + kv = GdkKeysyms._Right + || kv = GdkKeysyms._Up + || kv = GdkKeysyms._Left + || (kv = GdkKeysyms._g + && (List.mem `CONTROL (GdkEvent.Key.state k))) + then end_search (); + false)); + ignore (search_input#entry#event#connect#focus_out + ~callback:(fun _ -> end_search_focus_out (); false)); + to_do_on_page_switch := + (fun i -> + start_of_search := None; + ready_to_wrap_search:=false)::!to_do_on_page_switch; + + (* TODO : make it work !!! *) + let rec search_f () = + search_lbl#misc#show (); + search_input#misc#show (); + + prerr_endline "search_f called"; + if !start_of_search = None then begin + (* A full new search is starting *) + start_of_search := + Some (session_notebook#current_term.script#buffer#create_mark + (session_notebook#current_term.script#buffer#get_iter_at_mark `INSERT)); + start_of_found := !start_of_search; + end_of_found := !start_of_search; + matched_word := Some ""; + end; + let txt = search_input#entry#text in + let v = session_notebook#current_term.script in + let iit = v#buffer#get_iter_at_mark `SEL_BOUND + and insert_iter = v#buffer#get_iter_at_mark `INSERT + in + prerr_endline ("SELBOUND="^(string_of_int iit#offset)); + prerr_endline ("INSERT="^(string_of_int insert_iter#offset)); + + (match + if !search_forward then iit#forward_search txt + else let npi = iit#forward_chars (Glib.Utf8.length txt) in + match + (npi#offset = (v#buffer#get_iter_at_mark `INSERT)#offset), + (let t = iit#get_text ~stop:npi in + flash_info (t^"\n"^txt); + t = txt) + with + | true,true -> + (flash_info "T,T";iit#backward_search txt) + | false,true -> flash_info "F,T";Some (iit,npi) + | _,false -> + (iit#backward_search txt) + + with + | None -> + if !ready_to_wrap_search then begin + ready_to_wrap_search := false; + flash_info "Search wrapped"; + v#buffer#place_cursor + ~where:(if !search_forward then v#buffer#start_iter else + v#buffer#end_iter); + search_f () + end else begin + if !search_forward then flash_info "Search at end" + else flash_info "Search at start"; + ready_to_wrap_search := true + end + | Some (start,stop) -> + prerr_endline "search: before moving marks"; + prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); + prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); + + v#buffer#move_mark `SEL_BOUND ~where:start; + v#buffer#move_mark `INSERT ~where:stop; + prerr_endline "search: after moving marks"; + prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); + prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); + v#scroll_to_mark `SEL_BOUND + ) + in + ignore (search_input#entry#event#connect#key_release + ~callback: + (fun ev -> + if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then begin + let v = session_notebook#current_term.script in + (match !start_of_search with + | None -> + prerr_endline "search_key_rel: Placing sel_bound"; + v#buffer#move_mark + `SEL_BOUND + ~where:(v#buffer#get_iter_at_mark `INSERT) + | Some mk -> let it = v#buffer#get_iter_at_mark + (`MARK mk) in + prerr_endline "search_key_rel: Placing cursor"; + v#buffer#place_cursor ~where:it; + start_of_search := None + ); + search_input#entry#set_text ""; + v#coerce#misc#grab_focus (); + end; + false + )); + ignore (search_input#entry#connect#changed ~callback:search_f); + push_info "Ready"; + (* Location display *) + let l = GMisc.label + ~text:"Line: 1 Char: 1" + ~packing:lower_hbox#pack () in + l#coerce#misc#set_name "location"; + set_location := l#set_text; + (* Progress Bar *) + lower_hbox#pack pbar#coerce; + pbar#set_text "CoqIde started"; + + (* Initializing hooks *) + + refresh_toolbar_hook := + (fun () -> if !current.show_toolbar then toolbar#misc#show () else toolbar#misc#hide ()); + refresh_font_hook := + (fun () -> + let fd = !current.text_font in + let iter_page p = + p.script#misc#modify_font fd; + p.proof_view#misc#modify_font fd; + p.message_view#misc#modify_font fd; + p.command#refresh_font () in - ignore (load_m#connect#activate (load_f)); - - let load_m = file_factory#add_item "_Open" - ~key:GdkKeysyms._O in - let load_f () = - match select_file_for_open ~title:"Load file" () with - | None -> () - | Some f -> load f + List.iter iter_page session_notebook#pages; + ); + refresh_background_color_hook := + (fun () -> + let clr = Tags.color_of_string !current.background_color in + let iter_page p = + p.script#misc#modify_base [`NORMAL, `COLOR clr]; + p.proof_view#misc#modify_base [`NORMAL, `COLOR clr]; + p.message_view#misc#modify_base [`NORMAL, `COLOR clr]; + p.command#refresh_color () in - ignore (load_m#connect#activate (load_f)); - - (* File/Save Menu *) - let save_m = file_factory#add_item "_Save" - ~key:GdkKeysyms._S in - let save_f () = - let current = session_notebook#current_term in - try - (match current.analyzed_view#filename with - | None -> - begin match select_file_for_save ~title:"Save file" () - with - | None -> () - | Some f -> - if current.analyzed_view#save_as f then begin - current.tab_label#set_text (Filename.basename f); - flash_info ("File " ^ f ^ " saved") - end - else warning ("Save Failed (check if " ^ f ^ " is writable)") - end - | Some f -> - if current.analyzed_view#save f then - flash_info ("File " ^ f ^ " saved") - else warning ("Save Failed (check if " ^ f ^ " is writable)") - - ) - with - | e -> warning "Save: unexpected error" - in - ignore (save_m#connect#activate save_f); + List.iter iter_page session_notebook#pages; + ); + resize_window_hook := (fun () -> + w#resize + ~width:!current.window_width + ~height:!current.window_height); + refresh_tabs_hook := update_notebook_pos; + + let about_full_string = + "\nCoq is developed by the Coq Development Team\ + \n(INRIA - CNRS - LIX - LRI - PPS)\ + \nWeb site: " ^ Coq_config.wwwcoq ^ + "\nFeature wish or bug report: http://coq.inria.fr/bugs/\ + \n\ + \nCredits for CoqIDE, the Integrated Development Environment for Coq:\ + \n\ + \nMain author : Benjamin Monate\ + \nContributors : Jean-Christophe Filliâtre\ + \n Pierre Letouzey, Claude Marché\ + \n Bruno Barras, Pierre Corbineau\ + \n Julien Narboux, Hugo Herbelin, ... \ + \n\ + \nVersion information\ + \n-------------------\ + \n" + in + let display_log_file (b:GText.buffer) = + if !debug then + let file = match !logfile with None -> "stderr" | Some f -> f in + b#insert ("Debug mode is on, log file is "^file) + in + let initial_about (b:GText.buffer) = + let initial_string = + "Welcome to CoqIDE, an Integrated Development Environment for Coq\n" + in + let coq_version = Coq.short_version () in + display_log_file b; + if Glib.Utf8.validate ("You are running " ^ coq_version) then + b#insert ~iter:b#start_iter ("You are running " ^ coq_version); + if Glib.Utf8.validate initial_string then + b#insert ~iter:b#start_iter initial_string; + (try + let image = Filename.concat (List.find + (fun x -> Sys.file_exists (Filename.concat x "coq.png")) + Minilib.xdg_data_dirs) "coq.png" in + let startup_image = GdkPixbuf.from_file image in + b#insert ~iter:b#start_iter "\n\n"; + b#insert_pixbuf ~iter:b#start_iter ~pixbuf:startup_image; + b#insert ~iter:b#start_iter "\n\n\t\t " + with _ -> ()) + in - (* File/Save As Menu *) - let saveas_m = file_factory#add_item "S_ave as" - in - let saveas_f () = - let current = session_notebook#current_term in - try (match current.analyzed_view#filename with - | None -> - begin match select_file_for_save ~title:"Save file as" () - with - | None -> () - | Some f -> - if current.analyzed_view#save_as f then begin - current.tab_label#set_text (Filename.basename f); - flash_info "Saved" - end - else flash_info "Save Failed" - end - | Some f -> - begin match select_file_for_save - ~dir:(ref (Filename.dirname f)) - ~filename:(Filename.basename f) - ~title:"Save file as" () - with - | None -> () - | Some f -> - if current.analyzed_view#save_as f then begin - current.tab_label#set_text (Filename.basename f); - flash_info "Saved" - end else flash_info "Save Failed" - end); - with e -> flash_info "Save Failed" - in - ignore (saveas_m#connect#activate saveas_f); - (* XXX *) - (* File/Save All Menu *) - let saveall_m = file_factory#add_item "Sa_ve all" in - let saveall_f () = - List.iter - (function - | {script = view ; analyzed_view = av} -> - begin match av#filename with - | None -> () - | Some f -> - ignore (av#save f) - end - ) session_notebook#pages - in - (* XXX *) - let has_something_to_save () = - List.exists - (function - | {script=view} -> view#buffer#modified - ) - session_notebook#pages - in - ignore (saveall_m#connect#activate saveall_f); - (* XXX *) - (* File/Revert Menu *) - let revert_m = file_factory#add_item "_Revert all buffers" in - let revert_f () = - List.iter - (function - {analyzed_view = av} -> - (try - match av#filename,av#stats with - | Some f,Some stats -> - let new_stats = Unix.stat f in - if new_stats.Unix.st_mtime > stats.Unix.st_mtime - then av#revert - | Some _, None -> av#revert - | _ -> () - with _ -> av#revert) - ) session_notebook#pages - in - ignore (revert_m#connect#activate revert_f); - - (* File/Close Menu *) - let close_m = - file_factory#add_item "_Close buffer" ~key:GdkKeysyms._W in - let close_f () = - let v = !active_view in - let act = session_notebook#current_page in - if v = act then flash_info "Cannot close an active view" - else remove_current_view_page () - in - ignore (close_m#connect#activate close_f); - - (* File/Print Menu *) - let _ = file_factory#add_item "_Print..." - ~key:GdkKeysyms._P - ~callback:(fun () -> do_print session_notebook#current_term) in - - (* File/Export to Menu *) - let export_f kind () = - let v = session_notebook#current_term in - let av = v.analyzed_view in - match av#filename with - | None -> - flash_info "Cannot print: this buffer has no name" - | Some f -> - let basef = Filename.basename f in - let output = - let basef_we = try Filename.chop_extension basef with _ -> basef in - match kind with - | "latex" -> basef_we ^ ".tex" - | "dvi" | "ps" | "pdf" | "html" -> basef_we ^ "." ^ kind - | _ -> assert false - in - let cmd = - local_cd f ^ - !current.cmd_coqdoc ^ " --coqlib_path " ^ - Envars.coqlib () ^ " --" ^ kind ^ - " -o " ^ (Filename.quote output) ^ " " ^ - (Filename.quote basef) - in - let s,_ = run_command av#insert_message cmd in - flash_info (cmd ^ - if s = Unix.WEXITED 0 - then " succeeded" - else " failed") - in - let file_export_m = file_factory#add_submenu "E_xport to" in - - let file_export_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Export/" file_export_m ~accel_group in - let _ = - file_export_factory#add_item "_Html" ~callback:(export_f "html") - in - let _ = - file_export_factory#add_item "_LaTeX" ~callback:(export_f "latex") - in - let _ = - file_export_factory#add_item "_Dvi" ~callback:(export_f "dvi") - in - let _ = - file_export_factory#add_item "_Pdf" ~callback:(export_f "pdf") - in - let _ = - file_export_factory#add_item "_Ps" ~callback:(export_f "ps") - in - - (* File/Rehighlight Menu *) - let rehighlight_m = file_factory#add_item "Reh_ighlight" ~key:GdkKeysyms._L in - ignore (rehighlight_m#connect#activate - (fun () -> - force_retag - session_notebook#current_term.script#buffer; - session_notebook#current_term.analyzed_view#recenter_insert)); - - (* File/Quit Menu *) - let quit_f () = - save_pref(); - if has_something_to_save () then - match (GToolbox.question_box ~title:"Quit" - ~buttons:["Save Named Buffers and Quit"; - "Quit without Saving"; - "Don't Quit"] - ~default:0 - ~icon: - (let img = GMisc.image () in - img#set_stock `DIALOG_WARNING; - img#set_icon_size `DIALOG; - img#coerce) - "There are unsaved buffers" - ) - with 1 -> saveall_f () ; exit 0 - | 2 -> exit 0 - | _ -> () - else exit 0 - in - let _ = file_factory#add_item "_Quit" ~key:GdkKeysyms._Q - ~callback:quit_f - in - ignore (w#event#connect#delete (fun _ -> quit_f (); true)); - - (* Edit Menu *) - let edit_menu = factory#add_submenu "_Edit" in - let edit_f = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Edit/" edit_menu ~accel_group in - ignore(edit_f#add_item "_Undo" ~key:GdkKeysyms._u ~callback: - (do_if_not_computing "undo" - (fun () -> - ignore (session_notebook#current_term.analyzed_view# - without_auto_complete - (fun () -> session_notebook#current_term.script#undo) ())))); - ignore(edit_f#add_item "_Clear Undo Stack" - (* ~key:GdkKeysyms._exclam *) - ~callback: - (fun () -> - ignore session_notebook#current_term.script#clear_undo)); - ignore(edit_f#add_separator ()); - let get_active_view_for_cp () = - let has_sel (i0,i1) = i0#compare i1 <> 0 in - let current = session_notebook#current_term in - if has_sel current.script#buffer#selection_bounds - then current.script#as_view - else if has_sel current.proof_view#buffer#selection_bounds - then current.proof_view#as_view - else current.message_view#as_view - in - ignore(edit_f#add_item "Cut" ~key:GdkKeysyms._X ~callback: - (fun () -> GtkSignal.emit_unit - (get_active_view_for_cp ()) - GtkText.View.S.cut_clipboard - )); - ignore(edit_f#add_item "Copy" ~key:GdkKeysyms._C ~callback: - (fun () -> GtkSignal.emit_unit - (get_active_view_for_cp ()) - GtkText.View.S.copy_clipboard)); - ignore(edit_f#add_item "Paste" ~key:GdkKeysyms._V ~callback: - (fun () -> - try GtkSignal.emit_unit - session_notebook#current_term.script#as_view - GtkText.View.S.paste_clipboard - with _ -> prerr_endline "EMIT PASTE FAILED")); - ignore (edit_f#add_separator ()); - - - (* - let toggle_auto_complete_i = - edit_f#add_check_item "_Auto Completion" - ~active:!current.auto_complete - ~callback: - in - *) - (* - auto_complete := - (fun b -> match session_notebook#current_term.analyzed_view with - | Some av -> av#set_auto_complete b - | None -> ()); - *) - - let last_found = ref None in - let search_backward = ref false in - let find_w = GWindow.window - (* ~wm_class:"CoqIde" ~wm_name:"CoqIde" *) - (* ~allow_grow:true ~allow_shrink:true *) - (* ~width:!current.window_width ~height:!current.window_height *) - ~position:`CENTER - ~title:"CoqIde search/replace" () - in - let find_box = GPack.table - ~columns:3 ~rows:5 - ~col_spacings:10 ~row_spacings:10 ~border_width:10 - ~homogeneous:false ~packing:find_w#add () in - - let _ = - GMisc.label ~text:"Find:" - ~xalign:1.0 - ~packing:(find_box#attach ~left:0 ~top:0 ~fill:`X) () - in - let find_entry = GEdit.entry - ~editable: true - ~packing: (find_box#attach ~left:1 ~top:0 ~expand:`X) - () - in - let _ = - GMisc.label ~text:"Replace with:" - ~xalign:1.0 - ~packing:(find_box#attach ~left:0 ~top:1 ~fill:`X) () - in - let replace_entry = GEdit.entry - ~editable: true - ~packing: (find_box#attach ~left:1 ~top:1 ~expand:`X) - () - in - (* let _ = - GButton.check_button - ~label:"case sensitive" - ~active:true - ~packing: (find_box#attach ~left:1 ~top:2) - () - - in - *) - (* - let find_backwards_check = - GButton.check_button - ~label:"search backwards" - ~active:false - ~packing: (find_box#attach ~left:1 ~top:3) - () - in - *) - let close_find_button = - GButton.button - ~label:"Close" - ~packing: (find_box#attach ~left:2 ~top:0) - () - in - let replace_button = - GButton.button - ~label:"Replace" - ~packing: (find_box#attach ~left:2 ~top:1) - () - in - let replace_find_button = - GButton.button - ~label:"Replace and find" - ~packing: (find_box#attach ~left:2 ~top:2) - () - in - let find_again_button = - GButton.button - ~label:"_Find again" - ~packing: (find_box#attach ~left:2 ~top:3) - () - in - let find_again_backward_button = - GButton.button - ~label:"Find _backward" - ~packing: (find_box#attach ~left:2 ~top:4) - () - in - let last_find () = - let v = session_notebook#current_term.script in - let b = v#buffer in - let start,stop = - match !last_found with - | None -> let i = b#get_iter_at_mark `INSERT in (i,i) - | Some(start,stop) -> - let start = b#get_iter_at_mark start - and stop = b#get_iter_at_mark stop - in - b#remove_tag Tags.Script.found ~start ~stop; - last_found:=None; - start,stop - in - (v,b,start,stop) - in - let do_replace () = - let v = session_notebook#current_term.script in - let b = v#buffer in - match !last_found with - | None -> () - | Some(start,stop) -> - let start = b#get_iter_at_mark start - and stop = b#get_iter_at_mark stop - in - b#delete ~start ~stop; - b#insert ~iter:start replace_entry#text; - last_found:=None - in - let find_from (v : Undo.undoable_view) - (b : GText.buffer) (starti : GText.iter) text = - prerr_endline ("Searching for " ^ text); - match (if !search_backward then starti#backward_search text - else starti#forward_search text) - with - | None -> () - | Some(start,stop) -> - b#apply_tag Tags.Script.found ~start ~stop; - let start = `MARK (b#create_mark start) - and stop = `MARK (b#create_mark stop) - in - v#scroll_to_mark ~use_align:false ~yalign:0.75 ~within_margin:0.25 - stop; - last_found := Some(start,stop) - in - let do_find () = - let (v,b,starti,_) = last_find () in - find_from v b starti find_entry#text - in - let do_replace_find () = - do_replace(); - do_find() - in - let close_find () = - let (v,b,_,stop) = last_find () in - b#place_cursor stop; - find_w#misc#hide(); - v#coerce#misc#grab_focus() - in - to_do_on_page_switch := - (fun i -> if find_w#misc#visible then close_find()):: - !to_do_on_page_switch; - let find_again_forward () = - search_backward := false; - let (v,b,start,_) = last_find () in - let start = start#forward_chars 1 in - find_from v b start find_entry#text - in - let find_again_backward () = - search_backward := true; - let (v,b,start,_) = last_find () in - let start = start#backward_chars 1 in - find_from v b start find_entry#text - in - let key_find ev = - let s = GdkEvent.Key.state ev and k = GdkEvent.Key.keyval ev in - if k = GdkKeysyms._Escape then - begin - let (v,b,_,stop) = last_find () in - find_w#misc#hide(); - v#coerce#misc#grab_focus(); - true - end - else if k = GdkKeysyms._Return then - begin - close_find(); - true - end - else if List.mem `CONTROL s && k = GdkKeysyms._f then - begin - find_again_forward (); - true - end - else if List.mem `CONTROL s && k = GdkKeysyms._b then - begin - find_again_backward (); - true - end - else false (* to let default callback execute *) - in - let find_f ~backward () = - search_backward := backward; - find_w#show (); - find_w#present (); - find_entry#misc#grab_focus () - in - let _ = edit_f#add_item "_Find in buffer" - ~key:GdkKeysyms._F - ~callback:(find_f ~backward:false) - in - let _ = edit_f#add_item "Find _backwards" - ~key:GdkKeysyms._B - ~callback:(find_f ~backward:true) - in - let _ = close_find_button#connect#clicked close_find in - let _ = replace_button#connect#clicked do_replace in - let _ = replace_find_button#connect#clicked do_replace_find in - let _ = find_again_button#connect#clicked find_again_forward in - let _ = find_again_backward_button#connect#clicked find_again_backward in - let _ = find_entry#connect#changed do_find in - let _ = find_entry#event#connect#key_press ~callback:key_find in - let _ = find_w#event#connect#delete (fun _ -> find_w#misc#hide(); true) in - (* - let search_if = edit_f#add_item "Search _forward" - ~key:GdkKeysyms._greater - in - let search_ib = edit_f#add_item "Search _backward" - ~key:GdkKeysyms._less - in - *) - (* - let complete_i = edit_f#add_item "_Complete" - ~key:GdkKeysyms._comma - ~callback: - (do_if_not_computing - (fun b -> - let v = session_notebook#current_term.analyzed_view - - in v#complete_at_offset - ((v#view#buffer#get_iter `SEL_BOUND)#offset) - )) - in - complete_i#misc#set_state `INSENSITIVE; - *) - - ignore(edit_f#add_item "Complete Word" ~key:GdkKeysyms._slash ~callback: - (fun () -> - ignore ( - let av = session_notebook#current_term.analyzed_view in - av#complete_at_offset (av#get_insert)#offset - ))); - - ignore(edit_f#add_separator ()); - (* external editor *) - let _ = - edit_f#add_item "External editor" ~callback: - (fun () -> - let av = session_notebook#current_term.analyzed_view in - match av#filename with - | None -> warning "Call to external editor available only on named files" - | Some f -> - save_f (); - let com = Flags.subst_command_placeholder !current.cmd_editor (Filename.quote f) in - let _ = run_command av#insert_message com in - av#revert) - in - let _ = edit_f#add_separator () in - (* Preferences *) - let reset_revert_timer () = - disconnect_revert_timer (); - if !current.global_auto_revert then - revert_timer := Some - (GMain.Timeout.add ~ms:!current.global_auto_revert_delay - ~callback: - (fun () -> - do_if_not_computing "revert" (sync revert_f) (); - true)) - in reset_revert_timer (); (* to enable statup preferences timer *) - (* XXX *) - let auto_save_f () = - List.iter - (function - {script = view ; analyzed_view = av} -> - (try - av#auto_save - with _ -> ()) - ) - session_notebook#pages - in - - let reset_auto_save_timer () = - disconnect_auto_save_timer (); - if !current.auto_save then - auto_save_timer := Some - (GMain.Timeout.add ~ms:!current.auto_save_delay - ~callback: - (fun () -> - do_if_not_computing "autosave" (sync auto_save_f) (); - true)) - in reset_auto_save_timer (); (* to enable statup preferences timer *) - - - let _ = - edit_f#add_item "_Preferences" - ~callback:(fun () -> configure ~apply:update_notebook_pos (); reset_revert_timer ()) - in - (* - let save_prefs_m = - configuration_factory#add_item "_Save preferences" - ~callback:(fun () -> save_pref ()) - in - *) - (* Navigation Menu *) - let navigation_menu = factory#add_submenu "_Navigation" in - let navigation_factory = - new GMenu.factory navigation_menu - ~accel_path:"<CoqIde MenuBar>/Navigation/" - ~accel_group - ~accel_modi:!current.modifier_for_navigation - in - let _do_or_activate f () = - let current = session_notebook#current_term in - let analyzed_view = current.analyzed_view in - if analyzed_view#is_active then begin - prerr_endline ("view "^current.tab_label#text^"already active"); - ignore (f analyzed_view) - end else - begin - flash_info "New proof started"; - prerr_endline ("activating view "^current.tab_label#text); - activate_input session_notebook#current_page; - ignore (f analyzed_view) - end - in - - let do_or_activate f = - do_if_not_computing "do_or_activate" - (_do_or_activate - (fun av -> f av; - pop_info (); - push_info (Coq.current_status()) - ) - ) - in - - let add_to_menu_toolbar text ~tooltip ?key ~callback icon = - begin - match key with None -> () - | Some key -> ignore (navigation_factory#add_item text ~key ~callback) - end; - ignore (toolbar#insert_button - ~tooltip -(* ~text:tooltip*) - ~icon:(stock_to_widget ~size:`LARGE_TOOLBAR icon) - ~callback - ()) - in - add_to_menu_toolbar - "_Save" - ~tooltip:"Save current buffer" - ~callback:save_f - `SAVE; - add_to_menu_toolbar - "_Close" - ~tooltip:"Close current buffer" - ~callback:close_f - `CLOSE; - add_to_menu_toolbar - "_Forward" - ~tooltip:"Forward one command" - ~key:GdkKeysyms._Down - ~callback:(do_or_activate (fun a -> a#process_next_phrase true true true )) - - `GO_DOWN; - add_to_menu_toolbar "_Backward" - ~tooltip:"Backward one command" - ~key:GdkKeysyms._Up - ~callback:(do_or_activate (fun a -> a#undo_last_step)) - `GO_UP; - add_to_menu_toolbar - "_Go to" - ~tooltip:"Go to cursor" - ~key:GdkKeysyms._Right - ~callback:(do_or_activate (fun a-> a#go_to_insert)) - `JUMP_TO; - add_to_menu_toolbar - "_Start" - ~tooltip:"Go to start" - ~key:GdkKeysyms._Home - ~callback:(do_or_activate (fun a -> a#reset_initial)) - `GOTO_TOP; - add_to_menu_toolbar - "_End" - ~tooltip:"Go to end" - ~key:GdkKeysyms._End - ~callback:(do_or_activate (fun a -> a#process_until_end_or_error)) - `GOTO_BOTTOM; - add_to_menu_toolbar "_Interrupt" - ~tooltip:"Interrupt computations" - ~key:GdkKeysyms._Break - ~callback:break - `STOP; - add_to_menu_toolbar "_Hide" - ~tooltip:"Hide proof" - ~key:GdkKeysyms._h - ~callback:(fun x -> - let sess = session_notebook#current_term in - toggle_proof_visibility sess.script#buffer - sess.analyzed_view#get_insert) - `MISSING_IMAGE; - - (* Tactics Menu *) - let tactics_menu = factory#add_submenu "_Try Tactics" in - let tactics_factory = - new GMenu.factory tactics_menu - ~accel_path:"<CoqIde MenuBar>/Tactics/" - ~accel_group - ~accel_modi:!current.modifier_for_tactics - in - let do_if_active_raw f () = - let current = session_notebook#current_term in - let analyzed_view = current.analyzed_view in - if analyzed_view#is_active then ignore (f analyzed_view) - in - let do_if_active f = - do_if_not_computing "do_if_active" (do_if_active_raw f) in - - ignore (tactics_factory#add_item "_auto" - ~key:GdkKeysyms._a - ~callback:(do_if_active (fun a -> a#insert_command "progress auto.\n" "auto.\n")) - ); - ignore (tactics_factory#add_item "_auto with *" - ~key:GdkKeysyms._asterisk - ~callback:(do_if_active (fun a -> a#insert_command - "progress auto with *.\n" - "auto with *.\n"))); - ignore (tactics_factory#add_item "_eauto" - ~key:GdkKeysyms._e - ~callback:(do_if_active (fun a -> a#insert_command - "progress eauto.\n" - "eauto.\n")) - ); - ignore (tactics_factory#add_item "_eauto with *" - ~key:GdkKeysyms._ampersand - ~callback:(do_if_active (fun a -> a#insert_command - "progress eauto with *.\n" - "eauto with *.\n")) - ); - ignore (tactics_factory#add_item "_intuition" - ~key:GdkKeysyms._i - ~callback:(do_if_active (fun a -> a#insert_command - "progress intuition.\n" - "intuition.\n")) - ); - ignore (tactics_factory#add_item "_omega" - ~key:GdkKeysyms._o - ~callback:(do_if_active (fun a -> a#insert_command - "omega.\n" "omega.\n")) - ); - ignore (tactics_factory#add_item "_simpl" - ~key:GdkKeysyms._s - ~callback:(do_if_active (fun a -> a#insert_command "progress simpl.\n" "simpl.\n" )) - ); - ignore (tactics_factory#add_item "_tauto" - ~key:GdkKeysyms._p - ~callback:(do_if_active (fun a -> a#insert_command "tauto.\n" "tauto.\n" )) - ); - ignore (tactics_factory#add_item "_trivial" - ~key:GdkKeysyms._v - ~callback:(do_if_active( fun a -> a#insert_command "progress trivial.\n" "trivial.\n" )) - ); - - - ignore (toolbar#insert_button - ~tooltip:"Proof Wizard" - ~text:"Wizard" - ~icon:(stock_to_widget ~size:`LARGE_TOOLBAR `DIALOG_INFO) - ~callback:(do_if_active (fun a -> a#tactic_wizard - !current.automatic_tactics - )) - ()); - - - - ignore (tactics_factory#add_item "<Proof _Wizard>" - ~key:GdkKeysyms._dollar - ~callback:(do_if_active (fun a -> a#tactic_wizard - !current.automatic_tactics - )) - ); - - ignore (tactics_factory#add_separator ()); - let add_simple_template (factory: GMenu.menu GMenu.factory) - (menu_text, text) = - let text = - let l = String.length text - 1 in - if String.get text l = '.' - then text ^"\n" - else text ^" " - in - ignore (factory#add_item menu_text - ~callback: - (fun () -> let {script = view } = session_notebook#current_term in - ignore (view#buffer#insert_interactive text))) - in - List.iter - (fun l -> - match l with - | [] -> () - | [s] -> add_simple_template tactics_factory ("_"^s, s) - | s::_ -> - let a = "_@..." in - a.[1] <- s.[0]; - let f = tactics_factory#add_submenu a in - let ff = new GMenu.factory f ~accel_group in - List.iter - (fun x -> - add_simple_template - ff - ((String.sub x 0 1)^ - "_"^ - (String.sub x 1 (String.length x - 1)), - x)) - l - ) - Coq_commands.tactics; - - (* Templates Menu *) - let templates_menu = factory#add_submenu "Te_mplates" in - let templates_factory = new GMenu.factory templates_menu - ~accel_path:"<CoqIde MenuBar>/Templates/" - ~accel_group - ~accel_modi:!current.modifier_for_templates - in - let add_complex_template (menu_text, text, offset, len, key) = - (* Templates/Lemma *) - let callback () = - let {script = view } = session_notebook#current_term in - if view#buffer#insert_interactive text then begin - let iter = view#buffer#get_iter_at_mark `INSERT in - ignore (iter#nocopy#backward_chars offset); - view#buffer#move_mark `INSERT iter; - ignore (iter#nocopy#backward_chars len); - view#buffer#move_mark `SEL_BOUND iter; - end in - ignore (templates_factory#add_item menu_text ~callback ?key) - in - add_complex_template - ("_Lemma __", "Lemma new_lemma : .\nProof.\n\nSave.\n", - 19, 9, Some GdkKeysyms._L); - add_complex_template - ("_Theorem __", "Theorem new_theorem : .\nProof.\n\nSave.\n", - 19, 11, Some GdkKeysyms._T); - add_complex_template - ("_Definition __", "Definition ident := .\n", - 6, 5, Some GdkKeysyms._D); - add_complex_template - ("_Inductive __", "Inductive ident : :=\n | : .\n", - 14, 5, Some GdkKeysyms._I); - add_complex_template - ("_Fixpoint __", "Fixpoint ident (_ : _) {struct _} : _ :=\n.\n", - 29, 5, Some GdkKeysyms._F); - add_complex_template("_Scheme __", - "Scheme new_scheme := Induction for _ Sort _ -with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S); - - (* Template for match *) - let callback () = - let w = get_current_word () in - try - let cases = Coq.make_cases w - in - let print c = function - | [x] -> Format.fprintf c " | %s => _@\n" x - | x::l -> Format.fprintf c " | (%s%a) => _@\n" x - (print_list (fun c s -> Format.fprintf c " %s" s)) l - | [] -> assert false - in - let b = Buffer.create 1024 in - let fmt = Format.formatter_of_buffer b in - Format.fprintf fmt "@[match var with@\n%aend@]@." - (print_list print) cases; - let s = Buffer.contents b in - prerr_endline s; - let {script = view } = session_notebook#current_term in - ignore (view#buffer#delete_selection ()); - let m = view#buffer#create_mark - (view#buffer#get_iter `INSERT) - in - if view#buffer#insert_interactive s then - let i = view#buffer#get_iter (`MARK m) in - let _ = i#nocopy#forward_chars 9 in - view#buffer#place_cursor i; - view#buffer#move_mark ~where:(i#backward_chars 3) - `SEL_BOUND - with Not_found -> flash_info "Not an inductive type" - in - ignore (templates_factory#add_item "match ..." - ~key:GdkKeysyms._C - ~callback - ); - - (* - let add_simple_template (factory: GMenu.menu GMenu.factory) - (menu_text, text) = - let text = - let l = String.length text - 1 in - if String.get text l = '.' - then text ^"\n" - else text ^" " - in - ignore (factory#add_item menu_text - ~callback: - (fun () -> let {view = view } = session_notebook#current_term in - ignore (view#buffer#insert_interactive text))) - in - *) - ignore (templates_factory#add_separator ()); - (* - List.iter (add_simple_template templates_factory) - [ "_auto", "auto "; - "_auto with *", "auto with * "; - "_eauto", "eauto "; - "_eauto with *", "eauto with * "; - "_intuition", "intuition "; - "_omega", "omega "; - "_simpl", "simpl "; - "_tauto", "tauto "; - "tri_vial", "trivial "; - ]; - ignore (templates_factory#add_separator ()); - *) - List.iter - (fun l -> - match l with - | [] -> () - | [s] -> add_simple_template templates_factory ("_"^s, s) - | s::_ -> - let a = "_@..." in - a.[1] <- s.[0]; - let f = templates_factory#add_submenu a in - let ff = new GMenu.factory f ~accel_group in - List.iter - (fun x -> - add_simple_template - ff - ((String.sub x 0 1)^ - "_"^ - (String.sub x 1 (String.length x - 1)), - x)) - l - ) - Coq_commands.commands; - - (* Queries Menu *) - let queries_menu = factory#add_submenu "_Queries" in - let queries_factory = new GMenu.factory queries_menu ~accel_group - ~accel_path:"<CoqIde MenuBar>/Queries" - ~accel_modi:[] - in - - (* Command/Show commands *) - let _ = - queries_factory#add_item "_SearchAbout " ~key:GdkKeysyms._F2 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"SearchAbout" - ~term - ()) - in - let _ = - queries_factory#add_item "_Check " ~key:GdkKeysyms._F3 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Check" - ~term - ()) - in - let _ = - queries_factory#add_item "_Print " ~key:GdkKeysyms._F4 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Print" - ~term - ()) - in - let _ = - queries_factory#add_item "_About " ~key:GdkKeysyms._F5 - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"About" - ~term - ()) - in - let _ = - queries_factory#add_item "_Locate" - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Locate" - ~term - ()) - in - let _ = - queries_factory#add_item "_Whelp Locate" - ~callback:(fun () -> let term = get_current_word () in - (Command_windows.command_window ())#new_command - ~command:"Whelp Locate" - ~term - ()) - in - - (* Display menu *) - - let display_menu = factory#add_submenu "_Display" in - let view_factory = new GMenu.factory display_menu - ~accel_path:"<CoqIde MenuBar>/Display/" - ~accel_group - ~accel_modi:!current.modifier_for_display - in - - let _ = ignore (view_factory#add_check_item - "Display _implicit arguments" - ~key:GdkKeysyms._i - ~callback:(fun _ -> printing_state.printing_implicit <- not printing_state.printing_implicit; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Display _coercions" - ~key:GdkKeysyms._c - ~callback:(fun _ -> printing_state.printing_coercions <- not printing_state.printing_coercions; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Display raw _matching expressions" - ~key:GdkKeysyms._m - ~callback:(fun _ -> printing_state.printing_raw_matching <- not printing_state.printing_raw_matching; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Deactivate _notations display" - ~key:GdkKeysyms._n - ~callback:(fun _ -> printing_state.printing_no_notation <- not printing_state.printing_no_notation; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Display _all basic low-level contents" - ~key:GdkKeysyms._a - ~callback:(fun _ -> printing_state.printing_all <- not printing_state.printing_all; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Display _existential variable instances" - ~key:GdkKeysyms._e - ~callback:(fun _ -> printing_state.printing_evar_instances <- not printing_state.printing_evar_instances; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Display _universe levels" - ~key:GdkKeysyms._u - ~callback:(fun _ -> printing_state.printing_universes <- not printing_state.printing_universes; do_or_activate (fun a -> a#show_goals) ())) in - - let _ = ignore (view_factory#add_check_item - "Display all _low-level contents" - ~key:GdkKeysyms._l - ~callback:(fun _ -> printing_state.printing_full_all <- not printing_state.printing_full_all; do_or_activate (fun a -> a#show_goals) ())) in - - - - (* Externals *) - let externals_menu = factory#add_submenu "_Compile" in - let externals_factory = new GMenu.factory externals_menu - ~accel_path:"<CoqIde MenuBar>/Compile/" - ~accel_group - ~accel_modi:[] - in - - (* Command/Compile Menu *) - let compile_f () = - let v = session_notebook#current_term in - let av = v.analyzed_view in - save_f (); - match av#filename with - | None -> - flash_info "Active buffer has no name" - | Some f -> - let cmd = !current.cmd_coqc ^ " -I " - ^ (Filename.quote (Filename.dirname f)) - ^ " " ^ (Filename.quote f) in - let s,res = run_command av#insert_message cmd in - if s = Unix.WEXITED 0 then - flash_info (f ^ " successfully compiled") - else begin - flash_info (f ^ " failed to compile"); - activate_input session_notebook#current_page; - av#process_until_end_or_error; - av#insert_message "Compilation output:\n"; - av#insert_message res - end - in - let _ = - externals_factory#add_item "_Compile Buffer" ~callback:compile_f - in - - (* Command/Make Menu *) - let make_f () = - let v = session_notebook#current_term in - let av = v.analyzed_view in - match av#filename with - | None -> - flash_info "Cannot make: this buffer has no name" - | Some f -> - let cmd = - local_cd f ^ !current.cmd_make in - - (* - save_f (); - *) - av#insert_message "Command output:\n"; - let s,res = run_command av#insert_message cmd in - last_make := res; - last_make_index := 0; - flash_info (!current.cmd_make ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") - in - let _ = externals_factory#add_item "_Make" - ~key:GdkKeysyms._F6 - ~callback:make_f - in - - - (* Compile/Next Error *) - let next_error () = - try - let file,line,start,stop,error_msg = search_next_error () in - load file; - let v = session_notebook#current_term in - let av = v.analyzed_view in - let input_buffer = v.script#buffer in - (* - let init = input_buffer#start_iter in - let i = init#forward_lines (line-1) in - *) - (* - let convert_pos = byte_offset_to_char_offset phrase in - let start = convert_pos start in - let stop = convert_pos stop in - *) - (* - let starti = i#forward_chars start in - let stopi = i#forward_chars stop in - *) - let starti = input_buffer#get_iter_at_byte ~line:(line-1) start in - let stopi = input_buffer#get_iter_at_byte ~line:(line-1) stop in - input_buffer#apply_tag Tags.Script.error - ~start:starti - ~stop:stopi; - input_buffer#place_cursor starti; - av#set_message error_msg; - v.script#misc#grab_focus () - with Not_found -> - last_make_index := 0; - let v = session_notebook#current_term in - let av = v.analyzed_view in - av#set_message "No more errors.\n" - in - let _ = - externals_factory#add_item "_Next error" - ~key:GdkKeysyms._F7 - ~callback:next_error in - - - (* Command/CoqMakefile Menu*) - let coq_makefile_f () = - let v = session_notebook#current_term in - let av = v.analyzed_view in - match av#filename with - | None -> - flash_info "Cannot make makefile: this buffer has no name" - | Some f -> - let cmd = - local_cd f ^ !current.cmd_coqmakefile in - let s,res = run_command av#insert_message cmd in - flash_info - (!current.cmd_coqmakefile ^ if s = Unix.WEXITED 0 then " succeeded" else " failed") - in - let _ = externals_factory#add_item "_Make makefile" ~callback:coq_makefile_f - in - (* Windows Menu *) - let configuration_menu = factory#add_submenu "_Windows" in - let configuration_factory = new GMenu.factory configuration_menu - ~accel_path:"<CoqIde MenuBar>/Windows" - ~accel_modi:[] - ~accel_group - in - let _ = - configuration_factory#add_item - "Show/Hide _Query Pane" - ~key:GdkKeysyms._Escape - ~callback:(fun () -> if (Command_windows.command_window ())#frame#misc#visible then - (Command_windows.command_window ())#frame#misc#hide () - else - (Command_windows.command_window ())#frame#misc#show ()) - in - let _ = - configuration_factory#add_check_item - "Show/Hide _Toolbar" - ~callback:(fun _ -> - !current.show_toolbar <- not !current.show_toolbar; - !show_toolbar !current.show_toolbar) - in - let _ = - configuration_factory#add_item - "Detach _View" - ~callback: - (do_if_not_computing "detach view" - (fun () -> - match session_notebook#current_term with - | {script=v;analyzed_view=av} -> - let w = GWindow.window ~show:true - ~width:(!current.window_width*2/3) - ~height:(!current.window_height*2/3) - ~position:`CENTER - ~title:(match av#filename with - | None -> "*Unnamed*" - | Some f -> f) - () - in - let sb = GBin.scrolled_window - ~packing:w#add () - in - let nv = GText.view - ~buffer:v#buffer - ~packing:sb#add - () - in - nv#misc#modify_font - !current.text_font; - ignore (w#connect#destroy - ~callback: - (fun () -> av#remove_detached_view w)); - av#add_detached_view w - - )) - in - (* Help Menu *) - - let help_menu = factory#add_submenu "_Help" in - let help_factory = new GMenu.factory help_menu - ~accel_path:"<CoqIde MenuBar>/Help/" - ~accel_modi:[] - ~accel_group in - let _ = help_factory#add_item "Browse Coq _Manual" - ~callback: - (fun () -> - let av = session_notebook#current_term.analyzed_view in - browse av#insert_message (doc_url ())) in - let _ = help_factory#add_item "Browse Coq _Library" - ~callback: - (fun () -> - let av = session_notebook#current_term.analyzed_view in - browse av#insert_message !current.library_url) in - let _ = - help_factory#add_item "Help for _keyword" ~key:GdkKeysyms._F1 - ~callback:(fun () -> - let av = session_notebook#current_term.analyzed_view in - av#help_for_keyword ()) - in - let _ = help_factory#add_separator () in - let about_m = help_factory#add_item "_About" in - (* End of menu *) - - (* The vertical Separator between Scripts and Goals *) - let queries_pane = GPack.paned `VERTICAL ~packing:(vbox#pack ~expand:true ) () in - queries_pane#pack1 ~shrink:false ~resize:true session_notebook#coerce; - update_notebook_pos (); - let nb = session_notebook in - let command_object = Command_windows.command_window() in - let queries_frame = command_object#frame in - queries_pane#pack2 ~shrink:false ~resize:false (queries_frame#coerce); - let lower_hbox = GPack.hbox ~homogeneous:false ~packing:vbox#pack () in - lower_hbox#pack ~expand:true status#coerce; - let search_lbl = GMisc.label ~text:"Search:" - ~show:false - ~packing:(lower_hbox#pack ~expand:false) () - in - let search_history = ref [] in - let search_input = GEdit.combo ~popdown_strings:!search_history - ~enable_arrow_keys:true - ~show:false - ~packing:(lower_hbox#pack ~expand:false) () - in - search_input#disable_activate (); - let ready_to_wrap_search = ref false in - - let start_of_search = ref None in - let start_of_found = ref None in - let end_of_found = ref None in - let search_forward = ref true in - let matched_word = ref None in - - let memo_search () = - matched_word := Some search_input#entry#text - in - let end_search () = - prerr_endline "End Search"; - memo_search (); - let v = session_notebook#current_term.script in - v#buffer#move_mark `SEL_BOUND (v#buffer#get_iter_at_mark `INSERT); - v#coerce#misc#grab_focus (); - search_input#entry#set_text ""; - search_lbl#misc#hide (); - search_input#misc#hide () - in - let end_search_focus_out () = - prerr_endline "End Search(focus out)"; - memo_search (); - let v = session_notebook#current_term.script in - v#buffer#move_mark `SEL_BOUND (v#buffer#get_iter_at_mark `INSERT); - search_input#entry#set_text ""; - search_lbl#misc#hide (); - search_input#misc#hide () - in - ignore (search_input#entry#connect#activate ~callback:end_search); - ignore (search_input#entry#event#connect#key_press - ~callback:(fun k -> let kv = GdkEvent.Key.keyval k in - if - kv = GdkKeysyms._Right - || kv = GdkKeysyms._Up - || kv = GdkKeysyms._Left - || (kv = GdkKeysyms._g - && (List.mem `CONTROL (GdkEvent.Key.state k))) - then end_search (); - false)); - ignore (search_input#entry#event#connect#focus_out - ~callback:(fun _ -> end_search_focus_out (); false)); - to_do_on_page_switch := - (fun i -> - start_of_search := None; - ready_to_wrap_search:=false)::!to_do_on_page_switch; - - (* TODO : make it work !!! *) - let rec search_f () = - search_lbl#misc#show (); - search_input#misc#show (); - - prerr_endline "search_f called"; - if !start_of_search = None then begin - (* A full new search is starting *) - start_of_search := - Some (session_notebook#current_term.script#buffer#create_mark - (session_notebook#current_term.script#buffer#get_iter_at_mark `INSERT)); - start_of_found := !start_of_search; - end_of_found := !start_of_search; - matched_word := Some ""; - end; - let txt = search_input#entry#text in - let v = session_notebook#current_term.script in - let iit = v#buffer#get_iter_at_mark `SEL_BOUND - and insert_iter = v#buffer#get_iter_at_mark `INSERT - in - prerr_endline ("SELBOUND="^(string_of_int iit#offset)); - prerr_endline ("INSERT="^(string_of_int insert_iter#offset)); - - (match - if !search_forward then iit#forward_search txt - else let npi = iit#forward_chars (Glib.Utf8.length txt) in - match - (npi#offset = (v#buffer#get_iter_at_mark `INSERT)#offset), - (let t = iit#get_text ~stop:npi in - flash_info (t^"\n"^txt); - t = txt) - with - | true,true -> - (flash_info "T,T";iit#backward_search txt) - | false,true -> flash_info "F,T";Some (iit,npi) - | _,false -> - (iit#backward_search txt) - - with - | None -> - if !ready_to_wrap_search then begin - ready_to_wrap_search := false; - flash_info "Search wrapped"; - v#buffer#place_cursor - (if !search_forward then v#buffer#start_iter else - v#buffer#end_iter); - search_f () - end else begin - if !search_forward then flash_info "Search at end" - else flash_info "Search at start"; - ready_to_wrap_search := true - end - | Some (start,stop) -> - prerr_endline "search: before moving marks"; - prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); - prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); - - v#buffer#move_mark `SEL_BOUND start; - v#buffer#move_mark `INSERT stop; - prerr_endline "search: after moving marks"; - prerr_endline ("SELBOUND="^(string_of_int (v#buffer#get_iter_at_mark `SEL_BOUND)#offset)); - prerr_endline ("INSERT="^(string_of_int (v#buffer#get_iter_at_mark `INSERT)#offset)); - v#scroll_to_mark `SEL_BOUND - ) - in - ignore (search_input#entry#event#connect#key_release - ~callback: - (fun ev -> - if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then begin - let v = session_notebook#current_term.script in - (match !start_of_search with - | None -> - prerr_endline "search_key_rel: Placing sel_bound"; - v#buffer#move_mark - `SEL_BOUND - (v#buffer#get_iter_at_mark `INSERT) - | Some mk -> let it = v#buffer#get_iter_at_mark - (`MARK mk) in - prerr_endline "search_key_rel: Placing cursor"; - v#buffer#place_cursor it; - start_of_search := None - ); - search_input#entry#set_text ""; - v#coerce#misc#grab_focus (); - end; - false - )); - ignore (search_input#entry#connect#changed search_f); - push_info "Ready"; - (* Location display *) - let l = GMisc.label - ~text:"Line: 1 Char: 1" - ~packing:lower_hbox#pack () in - l#coerce#misc#set_name "location"; - set_location := l#set_text; - (* Progress Bar *) - lower_hbox#pack pbar#coerce; - pbar#set_text "CoqIde started"; - (* XXX *) - change_font := - (fun fd -> - List.iter - (fun {script=view; proof_view=prf_v; message_view=msg_v} -> - view#misc#modify_font fd; - prf_v#misc#modify_font fd; - msg_v#misc#modify_font fd - ) - session_notebook#pages; - ); - let about_full_string = - "\nCoq is developed by the Coq Development Team\ - \n(INRIA - CNRS - University Paris 11 and partners)\ - \nWeb site: " ^ Coq_config.wwwcoq ^ - "\nFeature wish or bug report: http://coq.inria.fr/bugs\ - \n\ - \nCredits for CoqIDE, the Integrated Development Environment for Coq:\ - \n\ - \nMain author : Benjamin Monate\ - \nContributors : Jean-Christophe Filliâtre\ - \n Pierre Letouzey, Claude Marché\ - \n Bruno Barras, Pierre Corbineau\ - \n Julien Narboux, Hugo Herbelin, ... \ - \n\ - \nVersion information\ - \n-------------------\ - \n" - in - let initial_about (b:GText.buffer) = - let initial_string = "Welcome to CoqIDE, an Integrated Development Environment for Coq\n" in - let coq_version = Coq.short_version () in - b#insert ~iter:b#start_iter "\n\n"; - if Glib.Utf8.validate ("You are running " ^ coq_version) then b#insert ~iter:b#start_iter ("You are running " ^ coq_version); - if Glib.Utf8.validate initial_string then b#insert ~iter:b#start_iter initial_string; - (try - let image = lib_ide_file "coq.png" in - let startup_image = GdkPixbuf.from_file image in - b#insert ~iter:b#start_iter "\n\n"; - b#insert_pixbuf ~iter:b#start_iter ~pixbuf:startup_image; - b#insert ~iter:b#start_iter "\n\n\t\t " - with _ -> ()) - in - - let about (b:GText.buffer) = - (try - let image = lib_ide_file "coq.png" in - let startup_image = GdkPixbuf.from_file image in - b#insert ~iter:b#start_iter "\n\n"; - b#insert_pixbuf ~iter:b#start_iter ~pixbuf:startup_image; - b#insert ~iter:b#start_iter "\n\n\t\t " - with _ -> ()); - if Glib.Utf8.validate about_full_string - then b#insert about_full_string; - let coq_version = Coq.version () in - if Glib.Utf8.validate coq_version - then b#insert coq_version - - in - w#add_accel_group accel_group; - (* Remove default pango menu for textviews *) - w#show (); - ignore (about_m#connect#activate - ~callback:(fun () -> let prf_v = session_notebook#current_term.proof_view in - prf_v#buffer#set_text ""; about prf_v#buffer)); - (* - - *) - resize_window := (fun () -> - w#resize - ~width:!current.window_width - ~height:!current.window_height); - ignore(nb#connect#switch_page - ~callback: - (fun i -> - prerr_endline ("switch_page: starts " ^ string_of_int i); - List.iter (function f -> f i) !to_do_on_page_switch; - prerr_endline "switch_page: success") - ); - if List.length files >=1 then - begin - List.iter (fun f -> - if Sys.file_exists f then load f else - let f = if Filename.check_suffix f ".v" then f else f^".v" in - load_file (fun s -> print_endline s; exit 1) f) - files; - activate_input 0 - end - else - begin - let session = create_session () in - let index = session_notebook#append_term session in - activate_input index; - end; - initial_about session_notebook#current_term.proof_view#buffer; - !show_toolbar !current.show_toolbar; - session_notebook#current_term.script#misc#grab_focus () - -;; + let about (b:GText.buffer) = + (try + let image = Filename.concat (List.find + (fun x -> Sys.file_exists (Filename.concat x "coq.png")) + Minilib.xdg_data_dirs) "coq.png" in + let startup_image = GdkPixbuf.from_file image in + b#insert ~iter:b#start_iter "\n\n"; + b#insert_pixbuf ~iter:b#start_iter ~pixbuf:startup_image; + b#insert ~iter:b#start_iter "\n\n\t\t " + with _ -> ()); + if Glib.Utf8.validate about_full_string + then b#insert about_full_string; + let coq_version = Coq.version () in + if Glib.Utf8.validate coq_version + then b#insert coq_version; + display_log_file b; + in + (* Remove default pango menu for textviews *) + w#show (); + ignore ((help_actions#get_action "About Coq")#connect#activate + ~callback:(fun _ -> let prf_v = session_notebook#current_term.proof_view in + prf_v#buffer#set_text ""; about prf_v#buffer)); + (* + + *) +(* Begin Color configuration *) + + Tags.set_processing_color (Tags.color_of_string !current.processing_color); + Tags.set_processed_color (Tags.color_of_string !current.processed_color); + +(* End of color configuration *) + ignore(nb#connect#switch_page + ~callback: + (fun i -> + prerr_endline ("switch_page: starts " ^ string_of_int i); + List.iter (function f -> f i) !to_do_on_page_switch; + prerr_endline "switch_page: success") + ); + if List.length files >=1 then + begin + List.iter (fun f -> + if Sys.file_exists f then do_load f else + let f = if Filename.check_suffix f ".v" then f else f^".v" in + load_file (fun s -> print_endline s; exit 1) f) + files; + session_notebook#goto_page 0; + end + else + begin + let session = create_session None in + let index = session_notebook#append_term session in + session_notebook#goto_page index; + end; + initial_about session_notebook#current_term.proof_view#buffer; + !refresh_toolbar_hook (); + session_notebook#current_term.script#misc#grab_focus ();; (* This function check every half of second if GeoProof has send something on his private clipboard *) let rec check_for_geoproof_input () = let cb_Dr = GData.clipboard (Gdk.Atom.intern "_GeoProof") in - while true do - Thread.delay 0.1; - let s = cb_Dr#text in - (match s with - Some s -> - if s <> "Ack" then - session_notebook#current_term.script#buffer#insert (s^"\n"); - cb_Dr#set_text "Ack" - | None -> () - ); - (* cb_Dr#clear does not work so i use : *) - (* cb_Dr#set_text "Ack" *) - done - - -let start () = - let files = Coq.init () in - ignore_break (); - GtkMain.Rc.add_default_file (lib_ide_file ".coqide-gtk2rc"); - (try - GtkMain.Rc.add_default_file (Filename.concat System.home ".coqide-gtk2rc"); - with Not_found -> ()); - ignore (GtkMain.Main.init ()); - GtkData.AccelGroup.set_default_mod_mask - (Some [`CONTROL;`SHIFT;`MOD1;`MOD3;`MOD4]); - ignore ( - Glib.Message.set_log_handler ~domain:"Gtk" ~levels:[`ERROR;`FLAG_FATAL; - `WARNING;`CRITICAL] - (fun ~level msg -> - if level land Glib.Message.log_level `WARNING <> 0 - then Pp.warning msg - else failwith ("Coqide internal error: " ^ msg))); - Command_windows.main (); - init_stdout (); - main files; - if !Coq_config.with_geoproof then ignore (Thread.create check_for_geoproof_input ()); - while true do - try - GtkThread.main () - with - | Sys.Break -> prerr_endline "Interrupted." - | e -> - safe_prerr_endline ("CoqIde unexpected error:" ^ (Printexc.to_string e)); - flush_all (); - crash_save 127 - done - - + while true do + Thread.delay 0.1; + let s = cb_Dr#text in + (match s with + Some s -> + if s <> "Ack" then + session_notebook#current_term.script#buffer#insert (s^"\n"); + cb_Dr#set_text "Ack" + | None -> () + ); + (* cb_Dr#clear does not work so i use : *) + (* cb_Dr#set_text "Ack" *) + done + +(** By default, the coqtop we try to launch is exactly the current coqide + full name, with the last occurrence of "coqide" replaced by "coqtop". + This should correctly handle the ".opt", ".byte", ".exe" situations. + If the replacement fails, we default to "coqtop", hoping it's somewhere + in the path. Note that the -coqtop option to coqide allows to override + this default coqtop path *) + +let read_coqide_args argv = + let rec filter_coqtop coqtop project_files out = function + | "-coqtop" :: prog :: args -> + if coqtop = None then filter_coqtop (Some prog) project_files out args + else + (output_string stderr "Error: multiple -coqtop options"; exit 1) + | "-f" :: file :: args -> + filter_coqtop coqtop + ((Minilib.canonical_path_name (Filename.dirname file), + Project_file.read_project_file file) :: project_files) out args + | "-f" :: [] -> output_string stderr "Error: missing project file name"; exit 1 + | "-coqtop" :: [] -> output_string stderr "Error: missing argument after -coqtop"; exit 1 + | "-debug"::args -> Ideutils.debug := true; + filter_coqtop coqtop project_files ("-debug"::out) args + | arg::args -> filter_coqtop coqtop project_files (arg::out) args + | [] -> (coqtop,List.rev project_files,List.rev out) + in + let coqtop,project_files,argv = filter_coqtop None [] [] argv in + Ideutils.custom_coqtop := coqtop; + custom_project_files := project_files; + argv diff --git a/ide/coqide.mli b/ide/coqide.mli index ea995c71..44de77f7 100644 --- a/ide/coqide.mli +++ b/ide/coqide.mli @@ -1,16 +1,40 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: coqide.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) +(** * The CoqIde main module *) -(* The CoqIde main module. The following function [start] will parse the - command line, initialize the load path, load the input - state, load the files given on the command line, load the ressource file, - produce the output state if any, and finally will launch the interface. *) +(** The arguments that will be passed to coqtop. No quoting here, since + no /bin/sh when using create_process instead of open_process. *) +val sup_args : string list ref -val start : unit -> unit +(** In debug mode under win32, messages are written to a log file *) +val logfile : string option ref + +(** Filter the argv from coqide specific options, and set + Minilib.coqtop_path accordingly *) +val read_coqide_args : string list -> string list + +(** Prepare the widgets, load the given files in tabs *) +val main : string list -> unit + +(** Function to save anything and kill all coqtops + @return [false] if you're allowed to quit. *) +val forbid_quit_to_save : unit -> bool + +(** Function to load of a file. *) +val do_load : string -> unit + +(** Set coqide to ignore Ctrl-C, while launching [crash_save] and + exiting for others received signals *) +val ignore_break : unit -> unit + +(** Emergency saving of opened files as "foo.v.crashcoqide", + and exit (if the integer isn't 127). *) +val crash_save : int -> unit + +val check_for_geoproof_input : unit -> unit diff --git a/ide/coqide_main.ml4 b/ide/coqide_main.ml4 new file mode 100644 index 00000000..aaede465 --- /dev/null +++ b/ide/coqide_main.ml4 @@ -0,0 +1,135 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +let _ = Coqide.ignore_break () +let _ = GtkMain.Main.init () + +(* We handle Gtk warning messages ourselves : + - on win32, we don't want them to end on a non-existing console + - we display critical messages via pop-ups *) + +let catch_gtk_messages () = + let all_levels = + [`FLAG_RECURSION;`FLAG_FATAL;`ERROR;`CRITICAL;`WARNING; + `MESSAGE;`INFO;`DEBUG] + in + let handler ~level msg = + let header = "Coqide internal error: " in + let level_is tag = (level land Glib.Message.log_level tag) <> 0 in + if level_is `ERROR then + let () = GToolbox.message_box ~title:"Error" (header ^ msg) in + Coqide.crash_save 1 + else if level_is `CRITICAL then + GToolbox.message_box ~title:"Error" (header ^ msg) + else if level_is `DEBUG || Sys.os_type = "Win32" then + Ideutils.prerr_endline msg (* no-op unless in debug mode *) + else + Printf.eprintf "%s\n" msg + in + let catch domain = + ignore (Glib.Message.set_log_handler ~domain ~levels:all_levels handler) + in + List.iter catch ["GLib";"Gtk";"Gdk";"Pango"] + +let () = catch_gtk_messages () + +(* We anticipate a bit the argument parsing and look for -debug *) + +let early_set_debug () = + Ideutils.debug := List.mem "-debug" (Array.to_list Sys.argv) + +(* On win32, we add the directory of coqide to the PATH at launch-time + (this used to be done in a .bat script). *) + +let set_win32_path () = + Unix.putenv "PATH" + (Filename.dirname Sys.executable_name ^ ";" ^ + (try Sys.getenv "PATH" with _ -> "")) + +(* On win32, in debug mode we duplicate stdout/stderr in a log file. *) + +let log_stdout_stderr () = + let (name,chan) = Filename.open_temp_file "coqide_" ".log" in + Coqide.logfile := Some name; + let out_descr = Unix.descr_of_out_channel chan in + Unix.set_close_on_exec out_descr; + Unix.dup2 out_descr Unix.stdout; + Unix.dup2 out_descr Unix.stderr + +(* We also provide specific kill and interrupt functions. *) + +IFDEF WIN32 THEN +external win32_kill : int -> unit = "win32_kill" +external win32_interrupt_all : unit -> unit = "win32_interrupt_all" +external win32_hide_console : unit -> unit = "win32_hide_console" + +let () = + set_win32_path (); + Coq.killer := win32_kill; + Coq.interrupter := (fun pid -> win32_interrupt_all ()); + early_set_debug (); + if !Ideutils.debug then + log_stdout_stderr () + else + win32_hide_console () +END + +IFDEF QUARTZ THEN + let osx = GosxApplication.osxapplication () + + let _ = + osx#connect#ns_application_open_file ~callback:(fun x -> Coqide.do_load x; true) in + let _ = + osx#connect#ns_application_block_termination ~callback:Coqide.forbid_quit_to_save in + () +END + +let () = + (try + let gtkrcdir = List.find + (fun x -> Sys.file_exists (Filename.concat x "coqide-gtk2rc")) + Minilib.xdg_config_dirs in + GtkMain.Rc.add_default_file (Filename.concat gtkrcdir "coqide-gtk2rc"); + with Not_found -> ()); + (* Statup preferences *) + begin + try Preferences.load_pref () + with e -> + Ideutils.flash_info ("Could not load preferences ("^Printexc.to_string e^")."); + end; +(* GtkData.AccelGroup.set_default_mod_mask + (Some [`CONTROL;`SHIFT;`MOD1;`MOD3;`MOD4]);*) + let argl = Array.to_list Sys.argv in + let argl = Coqide.read_coqide_args argl in + let files = Coq.filter_coq_opts (List.tl argl) in + let args = List.filter (fun x -> not (List.mem x files)) (List.tl argl) in + Coq.check_connection args; + Coqide.sup_args := args; + Coqide.main files; + if !Coq_config.with_geoproof then ignore (Thread.create Coqide.check_for_geoproof_input ()) + +IFDEF QUARTZ THEN + let () = + GtkosxApplication.Application.set_menu_bar osx#as_osxapplication (GtkMenu.MenuShell.cast (Coqide_ui.ui_m#get_widget "/CoqIde MenuBar")#as_widget) in + let () = + GtkosxApplication.Application.insert_app_menu_item osx#as_osxapplication (Coqide_ui.ui_m#get_widget "/CoqIde MenuBar/Edit/Prefs")#as_widget 1 in + let () = + GtkosxApplication.Application.set_help_menu osx#as_osxapplication (Some (GtkMenu.MenuItem.cast (Coqide_ui.ui_m#get_widget "/CoqIde MenuBar/Help")#as_widget)) in + osx#ready () +END + + while true do + try + GtkThread.main () + with + | Sys.Break -> Ideutils.prerr_endline "Interrupted." + | e -> + Minilib.safe_prerr_endline + ("CoqIde unexpected error:" ^ (Printexc.to_string e)); + Coqide.crash_save 127 + done diff --git a/ide/coqide_ui.ml b/ide/coqide_ui.ml new file mode 100644 index 00000000..eaf1e934 --- /dev/null +++ b/ide/coqide_ui.ml @@ -0,0 +1,155 @@ +let ui_m = GAction.ui_manager ();; + +let no_under = Minilib.string_map (fun x -> if x = '_' then '-' else x) + +let list_items menu li = + let res_buf = Buffer.create 500 in + let tactic_item = function + |[] -> Buffer.create 1 + |[s] -> let b = Buffer.create 16 in + let () = Buffer.add_string b ("<menuitem action='"^menu^" "^(no_under s)^"' />\n") in + b + |s::_ as l -> let b = Buffer.create 50 in + let () = (Buffer.add_string b ("<menu action='"^menu^" "^(String.make 1 s.[0])^"'>\n")) in + let () = (List.iter + (fun x -> Buffer.add_string b ("<menuitem action='"^menu^" "^(no_under x)^"' />\n")) l) in + let () = Buffer.add_string b"</menu>\n" in + b in + let () = List.iter (fun b -> Buffer.add_buffer res_buf (tactic_item b)) li in + res_buf + +let init () = + let theui = Printf.sprintf "<ui> +<menubar name='CoqIde MenuBar'> + <menu action='File'> + <menuitem action='New' /> + <menuitem action='Open' /> + <menuitem action='Save' /> + <menuitem action='Save as' /> + <menuitem action='Save all' /> + <menuitem action='Revert all buffers' /> + <menuitem action='Close buffer' /> + <menuitem action='Print...' /> + <menu action='Export to'> + <menuitem action='Html' /> + <menuitem action='Latex' /> + <menuitem action='Dvi' /> + <menuitem action='Pdf' /> + <menuitem action='Ps' /> + </menu> + <menuitem action='Rehighlight' /> + %s + </menu> + <menu name='Edit' action='Edit'> + <menuitem action='Undo' /> + <menuitem action='Clear Undo Stack' /> + <separator /> + <menuitem action='Cut' /> + <menuitem action='Copy' /> + <menuitem action='Paste' /> + <separator /> + <menuitem action='Find in buffer' /> + <menuitem action='Find backwards' /> + <menuitem action='Complete Word' /> + <separator /> + <menuitem action='External editor' /> + <separator /> + <menuitem name='Prefs' action='Preferences' /> + </menu> + <menu name='View' action='View'> + <menuitem action='Previous tab' /> + <menuitem action='Next tab' /> + <separator/> + <menuitem action='Show Toolbar' /> + <menuitem action='Show Query Pane' /> + <separator/> + <menuitem action='Display implicit arguments' /> + <menuitem action='Display coercions' /> + <menuitem action='Display raw matching expressions' /> + <menuitem action='Display notations' /> + <menuitem action='Display all basic low-level contents' /> + <menuitem action='Display existential variable instances' /> + <menuitem action='Display universe levels' /> + <menuitem action='Display all low-level contents' /> + </menu> + <menu action='Navigation'> + <menuitem action='Forward' /> + <menuitem action='Backward' /> + <menuitem action='Go to' /> + <menuitem action='Start' /> + <menuitem action='End' /> + <menuitem action='Interrupt' /> + <menuitem action='Hide' /> + <menuitem action='Previous' /> + <menuitem action='Next' /> + </menu> + <menu action='Try Tactics'> + <menuitem action='auto' /> + <menuitem action='auto with *' /> + <menuitem action='eauto' /> + <menuitem action='eauto with *' /> + <menuitem action='intuition' /> + <menuitem action='omega' /> + <menuitem action='simpl' /> + <menuitem action='tauto' /> + <menuitem action='trivial' /> + <menuitem action='Wizard' /> + <separator /> + %s + </menu> + <menu action='Templates'> + <menuitem action='Lemma' /> + <menuitem action='Theorem' /> + <menuitem action='Definition' /> + <menuitem action='Inductive' /> + <menuitem action='Fixpoint' /> + <menuitem action='Scheme' /> + <menuitem action='match' /> + <separator /> + %s + </menu> + <menu action='Queries'> + <menuitem action='SearchAbout' /> + <menuitem action='Check' /> + <menuitem action='Print' /> + <menuitem action='About' /> + <menuitem action='Locate' /> + <menuitem action='Whelp Locate' /> + </menu> + <menu action='Compile'> + <menuitem action='Compile buffer' /> + <menuitem action='Make' /> + <menuitem action='Next error' /> + <menuitem action='Make makefile' /> + </menu> + <menu action='Windows'> + <menuitem action='Detach View' /> + </menu> + <menu name='Help' action='Help'> + <menuitem action='Browse Coq Manual' /> + <menuitem action='Browse Coq Library' /> + <menuitem action='Help for keyword' /> + <separator /> + <menuitem name='Abt' action='About Coq' /> + </menu> +</menubar> +<toolbar name='CoqIde ToolBar'> + <toolitem action='Save' /> + <toolitem action='Close buffer' /> + <toolitem action='Forward' /> + <toolitem action='Backward' /> + <toolitem action='Go to' /> + <toolitem action='Start' /> + <toolitem action='End' /> + <toolitem action='Interrupt' /> + <toolitem action='Hide' /> + <toolitem action='Previous' /> + <toolitem action='Next' /> + <toolitem action='Wizard' /> +</toolbar> +</ui>" + (if Coq_config.gtk_platform <> `QUARTZ then "<menuitem action='Quit' />" else "") + (Buffer.contents (list_items "Tactic" Coq_commands.tactics)) + (Buffer.contents (list_items "Template" Coq_commands.commands)) + in + ignore (ui_m#add_ui_from_string theui); diff --git a/ide/gtk_parsing.ml b/ide/gtk_parsing.ml index 1b52dba3..47096e6f 100644 --- a/ide/gtk_parsing.ml +++ b/ide/gtk_parsing.ml @@ -1,22 +1,19 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqide.ml 11952 2009-03-02 15:29:08Z vgross $ *) - open Ideutils - -let underscore = Glib.Utf8.to_unichar "_" (ref 0) -let arobase = Glib.Utf8.to_unichar "@" (ref 0) -let prime = Glib.Utf8.to_unichar "'" (ref 0) -let bn = Glib.Utf8.to_unichar "\n" (ref 0) -let space = Glib.Utf8.to_unichar " " (ref 0) -let tab = Glib.Utf8.to_unichar "\t" (ref 0) +let underscore = Glib.Utf8.to_unichar "_" ~pos:(ref 0) +let arobase = Glib.Utf8.to_unichar "@" ~pos:(ref 0) +let prime = Glib.Utf8.to_unichar "'" ~pos:(ref 0) +let bn = Glib.Utf8.to_unichar "\n" ~pos:(ref 0) +let space = Glib.Utf8.to_unichar " " ~pos:(ref 0) +let tab = Glib.Utf8.to_unichar "\t" ~pos:(ref 0) (* TODO: avoid num and prime at the head of a word *) diff --git a/ide/highlight.mll b/ide/highlight.mll deleted file mode 100644 index c288d6a3..00000000 --- a/ide/highlight.mll +++ /dev/null @@ -1,215 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(* $Id: highlight.mll 14641 2011-11-06 11:59:10Z herbelin $ *) - -{ - - open Lexing - - type color = GText.tag - - type highlight_order = int * int * color - - let comment_start = ref 0 - - (* Without this table, the automaton would be too big and - ocamllex would fail *) - let is_one_word_command = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ "Add" ; "Check"; "Eval"; "Extraction" ; - "Load" ; "Undo"; "Goal"; - "Proof" ; "Print"; "Qed" ; "Defined" ; "Save" ; - "End" ; "Section"; "Chapter"; "Transparent"; "Opaque"; "Comments" - ]; - Hashtbl.mem h - - let is_constr_kw = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "for"; - "end"; "as"; "let"; "in"; "if"; "then"; "else"; "return"; - "Prop"; "Set"; "Type" ]; - Hashtbl.mem h - - (* Without this table, the automaton would be too big and - ocamllex would fail *) - let is_one_word_declaration = - let h = Hashtbl.create 97 in - List.iter (fun s -> Hashtbl.add h s ()) - [ (* Theorems *) - "Theorem" ; "Lemma" ; "Fact" ; "Remark" ; "Corollary" ; - "Proposition" ; "Property" ; - (* Definitions *) - "Definition" ; "Let" ; "Example" ; "SubClass" ; - "Fixpoint" ; "CoFixpoint" ; "Scheme" ; "Function" ; - (* Assumptions *) - "Hypothesis" ; "Variable" ; "Axiom" ; "Parameter" ; "Conjecture" ; - "Hypotheses" ; "Variables" ; "Axioms" ; "Parameters"; - (* Inductive *) - "Inductive" ; "CoInductive" ; "Record" ; "Structure" ; - (* Other *) - "Ltac" ; "Typeclasses"; "Instance"; "Include"; "Context"; "Class" - ]; - Hashtbl.mem h - - let starting = ref true -} - -let space = - [' ' '\010' '\013' '\009' '\012'] -let firstchar = - ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'] -let identchar = - ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] -let ident = firstchar identchar* - -let multiword_declaration = - "Module" (space+ "Type")? -| "Program" space+ ident -| "Existing" space+ "Instance" -| "Canonical" space+ "Structure" - -let locality = ("Local" space+)? - -let multiword_command = - "Set" (space+ ident)* -| "Unset" (space+ ident)* -| "Open" space+ locality "Scope" -| "Close" space+ locality "Scope" -| "Bind" space+ "Scope" -| "Arguments" space+ "Scope" -| "Reserved" space+ "Notation" space+ locality -| "Delimit" space+ "Scope" -| "Next" space+ "Obligation" -| "Solve" space+ "Obligations" -| "Require" space+ ("Import"|"Export")? -| "Infix" space+ locality -| "Notation" space+ locality -| "Hint" space+ locality ident -| "Reset" (space+ "Initial")? -| "Tactic" space+ "Notation" -| "Implicit" space+ "Arguments" -| "Implicit" space+ ("Type"|"Types") -| "Combined" space+ "Scheme" -| "Extraction" space+ (("Language" space+ ("Ocaml"|"Haskell"|"Scheme"))| - ("Library"|"Inline"|"NoInline"|"Blacklist")) -| "Recursive" space+ "Extraction" (space+ "Library")? -| ("Print"|"Reset") space+ "Extraction" space+ ("Inline"|"Blacklist") -| "Extract" space+ (("Inlined" space+) "Constant"| "Inductive") - -(* At least still missing: "Inline" + decl, variants of "Identity - Coercion", variants of Print, Add, ... *) - -rule next_starting_order = parse - | "(*" { comment_start := lexeme_start lexbuf; comment lexbuf } - | space+ { next_starting_order lexbuf } - | multiword_declaration - { starting:=false; lexeme_start lexbuf, lexeme_end lexbuf, Tags.Script.decl } - | multiword_command - { starting:=false; lexeme_start lexbuf, lexeme_end lexbuf, Tags.Script.kwd } - | ident as id - { if id = "Time" then next_starting_order lexbuf else - begin - starting:=false; - if is_one_word_command id then - lexeme_start lexbuf, lexeme_end lexbuf, Tags.Script.kwd - else if is_one_word_declaration id then - lexeme_start lexbuf, lexeme_end lexbuf, Tags.Script.decl - else - next_interior_order lexbuf - end - } - | _ { starting := false; next_interior_order lexbuf} - | eof { raise End_of_file } - -and next_interior_order = parse - | "(*" - { comment_start := lexeme_start lexbuf; comment lexbuf } - | ident as id - { if is_constr_kw id then - lexeme_start lexbuf, lexeme_end lexbuf, Tags.Script.kwd - else - next_interior_order lexbuf } - | "." (" "|"\n"|"\t") { starting := true; next_starting_order lexbuf } - | _ { next_interior_order lexbuf} - | eof { raise End_of_file } - -and comment = parse - | "*)" { !comment_start,lexeme_end lexbuf,Tags.Script.comment } - | "(*" { ignore (comment lexbuf); comment lexbuf } - | "\"" { string_in_comment lexbuf } - | _ { comment lexbuf } - | eof { raise End_of_file } - -and string_in_comment = parse - | "\"\"" { string_in_comment lexbuf } - | "\"" { comment lexbuf } - | _ { string_in_comment lexbuf } - | eof { raise End_of_file } - -{ - open Ideutils - - let highlighting = ref false - - let highlight_slice (input_buffer:GText.buffer) (start:GText.iter) stop = - starting := true; (* approximation: assume the beginning of a sentence *) - if !highlighting then prerr_endline "Rejected highlight" - else begin - highlighting := true; - prerr_endline "Highlighting slice now"; - input_buffer#remove_tag ~start ~stop Tags.Script.error; - input_buffer#remove_tag ~start ~stop Tags.Script.kwd; - input_buffer#remove_tag ~start ~stop Tags.Script.decl; - input_buffer#remove_tag ~start ~stop Tags.Script.comment; - - (try begin - let offset = start#offset in - let s = start#get_slice ~stop in - let convert_pos = byte_offset_to_char_offset s in - let lb = Lexing.from_string s in - try - while true do - let b,e,o = - if !starting then next_starting_order lb - else next_interior_order lb in - - let b,e = convert_pos b,convert_pos e in - let start = input_buffer#get_iter_at_char (offset + b) in - let stop = input_buffer#get_iter_at_char (offset + e) in - input_buffer#apply_tag ~start ~stop o - done - with End_of_file -> () - end - with _ -> ()); - highlighting := false - end - - let highlight_current_line input_buffer = - try - let i = get_insert input_buffer in - highlight_slice input_buffer (i#set_line_offset 0) i - with _ -> () - - let highlight_around_current_line input_buffer = - try - let i = get_insert input_buffer in - highlight_slice input_buffer - (i#backward_lines 10) - (ignore (i#nocopy#forward_lines 10);i) - - with _ -> () - - let highlight_all input_buffer = - try - highlight_slice input_buffer input_buffer#start_iter input_buffer#end_iter - with _ -> () - -} diff --git a/ide/ide.mllib b/ide/ide.mllib index 63935db3..9bbf9b0d 100644 --- a/ide/ide.mllib +++ b/ide/ide.mllib @@ -1,3 +1,4 @@ +Minilib Okey Config_file Configwin_keys @@ -12,12 +13,14 @@ Typed_notebook Config_lexer Utf8_convert Preferences +Project_file Ideutils +Ideproof Coq_lex Gtk_parsing Undo Coq Coq_commands -Coq_tactics Command_windows +Coqide_ui Coqide diff --git a/ide/ide_win32_stubs.c b/ide/ide_win32_stubs.c new file mode 100644 index 00000000..c170b1a9 --- /dev/null +++ b/ide/ide_win32_stubs.c @@ -0,0 +1,51 @@ +#define _WIN32_WINNT 0x0501 /* Cf below, we restrict to */ + +#include <caml/mlvalues.h> +#include <caml/memory.h> +#include <windows.h> + +/* Win32 emulation of kill -9 */ + +/* The pid returned by Unix.create_process is actually a pseudo-pid, + made via a cast of the obtained HANDLE, (cf. win32unix/createprocess.c + in the sources of ocaml). Since we're still in the caller process, + we simply cast back to get an handle... + The 0 is the exit code we want for the terminated process. +*/ + +CAMLprim value win32_kill(value pseudopid) { + CAMLparam1(pseudopid); + TerminateProcess((HANDLE)(Long_val(pseudopid)), 0); + CAMLreturn(Val_unit); +} + +/* Win32 emulation of a kill -2 (SIGINT) */ + +/* For simplicity, we signal all processes sharing a console with coqide. + This shouldn't be an issue since currently at most one coqtop is busy + at a given time. Earlier, we tried to be more precise via + FreeConsole and AttachConsole before generating the Ctrl-C, but + that wasn't working so well (see #2869). + This code rely now on the fact that coqide is a console app, + and that coqide itself ignores Ctrl-C. +*/ + +CAMLprim value win32_interrupt_all(value unit) { + CAMLparam1(unit); + GenerateConsoleCtrlEvent(CTRL_C_EVENT,0); + CAMLreturn(Val_unit); +} + +/* Get rid of the nasty console window (only if we created it) */ + +CAMLprim value win32_hide_console (value unit) { + CAMLparam1(unit); + DWORD pid; + HWND hw = GetConsoleWindow(); + if (hw != NULL) { + GetWindowThreadProcessId(hw, &pid); + if (pid == GetCurrentProcessId()) + ShowWindow(hw, SW_HIDE); + } + CAMLreturn(Val_unit); +} diff --git a/ide/ideproof.ml b/ide/ideproof.ml new file mode 100644 index 00000000..697e7f4f --- /dev/null +++ b/ide/ideproof.ml @@ -0,0 +1,147 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + + +(* tag is the tag to be hooked, item is the item covered by this tag, make_menu + * * is the template for building menu if needed, sel_cb is the callback if + * there + * * is a selection o said menu, hover_cb is the callback when there is only + * * hovering *) +let hook_tag_cb tag menu_content sel_cb hover_cb = + ignore (tag#connect#event ~callback: + (fun ~origin evt it -> + let iter = new GText.iter it in + let start = iter#backward_to_tag_toggle (Some tag) in + let stop = iter#forward_to_tag_toggle (Some tag) in + match GdkEvent.get_type evt with + | `BUTTON_PRESS -> + let ev = GdkEvent.Button.cast evt in + if (GdkEvent.Button.button ev) <> 3 then false else begin + let ctxt_menu = GMenu.menu () in + let factory = new GMenu.factory ctxt_menu in + List.iter + (fun (text,cmd) -> ignore (factory#add_item text ~callback:(sel_cb cmd))) + menu_content; + ctxt_menu#popup ~button:3 ~time:(GdkEvent.Button.time ev); + true + end + | `MOTION_NOTIFY -> + hover_cb start stop; false + | _ -> false)) + +let mode_tactic sel_cb (proof:GText.view) goals hints = match goals with + | [] -> assert false + | { Interface.goal_hyp = hyps; Interface.goal_ccl = cur_goal; } :: rem_goals -> + let on_hover sel_start sel_stop = + proof#buffer#remove_tag + ~start:proof#buffer#start_iter + ~stop:sel_start + Tags.Proof.highlight; + proof#buffer#remove_tag + ~start:sel_stop + ~stop:proof#buffer#end_iter + Tags.Proof.highlight; + proof#buffer#apply_tag ~start:sel_start ~stop:sel_stop Tags.Proof.highlight + in + let goals_cnt = List.length rem_goals + 1 in + let head_str = Printf.sprintf + "%d subgoal%s\n" goals_cnt (if 1 < goals_cnt then "" else "s") + in + let goal_str index total = Printf.sprintf + "______________________________________(%d/%d)\n" index total + in + (* Insert current goal and its hypotheses *) + let hyps_hints, goal_hints = match hints with + | None -> [], [] + | Some (hl, h) -> (hl, h) + in + let rec insert_hyp hints hs = match hs with + | [] -> () + | hyp :: hs -> + let tags, rem_hints = match hints with + | [] -> [], [] + | hint :: hints -> + let tag = proof#buffer#create_tag [] in + let () = hook_tag_cb tag hint sel_cb on_hover in + [tag], hints + in + let () = proof#buffer#insert ~tags (hyp ^ "\n") in + insert_hyp rem_hints hs + in + let () = proof#buffer#insert head_str in + let () = insert_hyp hyps_hints hyps in + let () = + let tags = Tags.Proof.goal :: if goal_hints <> [] then + let tag = proof#buffer#create_tag [] in + let () = hook_tag_cb tag goal_hints sel_cb on_hover in + [tag] + else [] + in + proof#buffer#insert (goal_str 1 goals_cnt); + proof#buffer#insert ~tags cur_goal; + proof#buffer#insert "\n" + in + (* Insert remaining goals (no hypotheses) *) + let fold_goal i _ { Interface.goal_ccl = g } = + proof#buffer#insert (goal_str i goals_cnt); + proof#buffer#insert (g ^ "\n") + in + let () = Minilib.list_fold_left_i fold_goal 2 () rem_goals in + + ignore(proof#buffer#place_cursor + ~where:(proof#buffer#end_iter#backward_to_tag_toggle + (Some Tags.Proof.goal))); + ignore(proof#scroll_to_mark ~use_align:true ~yalign:0.95 `INSERT) + +let mode_cesar (proof:GText.view) = function + | [] -> assert false + | { Interface.goal_hyp = hyps; Interface.goal_ccl = cur_goal; } :: _ -> + proof#buffer#insert " *** Declarative Mode ***\n"; + List.iter + (fun hyp -> proof#buffer#insert (hyp^"\n")) + hyps; + proof#buffer#insert "______________________________________\n"; + proof#buffer#insert ("thesis := \n "^cur_goal^"\n"); + ignore (proof#scroll_to_iter (proof#buffer#get_iter_at_mark `INSERT)) + +let rec flatten = function +| [] -> [] +| (lg, rg) :: l -> + let inner = flatten l in + List.rev_append lg inner @ rg + +let display mode (view:GText.view) goals hints evars = + let () = view#buffer#set_text "" in + match goals with + | None -> () + (* No proof in progress *) + | Some { Interface.fg_goals = []; Interface.bg_goals = bg } -> + let bg = flatten (List.rev bg) in + let evars = match evars with None -> [] | Some evs -> evs in + begin match (bg, evars) with + | [], [] -> + view#buffer#insert "No more subgoals." + | [], _ :: _ -> + (* A proof has been finished, but not concluded *) + view#buffer#insert "No more subgoals but non-instantiated existential variables:\n\n"; + let iter evar = + let msg = Printf.sprintf "%s\n" evar.Interface.evar_info in + view#buffer#insert msg + in + List.iter iter evars + | _, _ -> + (* No foreground proofs, but still unfocused ones *) + view#buffer#insert "This subproof is complete, but there are still unfocused goals:\n\n"; + let iter goal = + let msg = Printf.sprintf "%s\n" goal.Interface.goal_ccl in + view#buffer#insert msg + in + List.iter iter bg + end + | Some { Interface.fg_goals = fg } -> + mode view fg hints diff --git a/ide/ideutils.ml b/ide/ideutils.ml index a6be77f2..164c837a 100644 --- a/ide/ideutils.ml +++ b/ide/ideutils.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: ideutils.ml 14641 2011-11-06 11:59:10Z herbelin $ *) - open Preferences @@ -18,11 +16,11 @@ exception Forbidden let status = GMisc.statusbar () let push_info,pop_info = - let status_context = status#new_context "Messages" in + let status_context = status#new_context ~name:"Messages" in (fun s -> ignore (status_context#push s)),status_context#pop let flash_info = - let flash_context = status#new_context "Flash" in + let flash_context = status#new_context ~name:"Flash" in (fun ?(delay=5000) s -> flash_context#flash ~delay s) @@ -31,20 +29,10 @@ let set_location = ref (function s -> failwith "not ready") let pbar = GRange.progress_bar ~pulse_step:0.2 () -(* On a Win32 application with no console, writing to stderr raise - a Sys_error "bad file descriptor" *) -let safe_prerr_endline msg = try prerr_endline msg with _ -> () - -let debug = Flags.debug +let debug = ref (false) let prerr_endline s = - if !debug then try (prerr_endline s;flush stderr) with _ -> () -let prerr_string s = - if !debug then try (prerr_string s;flush stderr) with _ -> () - -let lib_ide_file f = - let coqlib = Envars.coqlib () in - Filename.concat (Filename.concat coqlib "ide") f + if !debug then try prerr_endline s;flush stderr with _ -> () let get_insert input_buffer = input_buffer#get_iter_at_mark `INSERT @@ -75,51 +63,51 @@ let print_id id = let do_convert s = Utf8_convert.f (if Glib.Utf8.validate s then begin - prerr_endline "Input is UTF-8";s - end else - let from_loc () = - let _,char_set = Glib.Convert.get_charset () in - flash_info - ("Converting from locale ("^char_set^")"); - Glib.Convert.convert_with_fallback ~to_codeset:"UTF-8" ~from_codeset:char_set s - in - let from_manual () = - flash_info - ("Converting from "^ !current.encoding_manual); - Glib.Convert.convert s ~to_codeset:"UTF-8" ~from_codeset:!current.encoding_manual - in - if !current.encoding_use_utf8 || !current.encoding_use_locale then begin - try - from_loc () - with _ -> from_manual () - end else begin - try - from_manual () - with _ -> from_loc () - end) + prerr_endline "Input is UTF-8";s + end else + let from_loc () = + let _,char_set = Glib.Convert.get_charset () in + flash_info + ("Converting from locale ("^char_set^")"); + Glib.Convert.convert_with_fallback ~to_codeset:"UTF-8" ~from_codeset:char_set s + in + let from_manual enc = + flash_info + ("Converting from "^ enc); + Glib.Convert.convert s ~to_codeset:"UTF-8" ~from_codeset:enc + in + match !current.encoding with + |Preferences.Eutf8 | Preferences.Elocale -> from_loc () + |Emanual enc -> + try + from_manual enc + with _ -> from_loc ()) let try_convert s = try do_convert s with _ -> - "(* Fatal error: wrong encoding in input. + "(* Fatal error: wrong encoding in input. \ Please choose a correct encoding in the preference panel.*)";; let try_export file_name s = try let s = - try if !current.encoding_use_utf8 then begin - (prerr_endline "UTF-8 is enforced" ;s) - end else if !current.encoding_use_locale then begin - let is_unicode,char_set = Glib.Convert.get_charset () in - if is_unicode then - (prerr_endline "Locale is UTF-8" ;s) - else - (prerr_endline ("Locale is "^char_set); - Glib.Convert.convert_with_fallback ~from_codeset:"UTF-8" ~to_codeset:char_set s) - end else - (prerr_endline ("Manual charset is "^ !current.encoding_manual); - Glib.Convert.convert_with_fallback ~from_codeset:"UTF-8" ~to_codeset:!current.encoding_manual s) + try match !current.encoding with + |Eutf8 -> begin + (prerr_endline "UTF-8 is enforced" ;s) + end + |Elocale -> begin + let is_unicode,char_set = Glib.Convert.get_charset () in + if is_unicode then + (prerr_endline "Locale is UTF-8" ;s) + else + (prerr_endline ("Locale is "^char_set); + Glib.Convert.convert_with_fallback ~from_codeset:"UTF-8" ~to_codeset:char_set s) + end + |Emanual enc -> + (prerr_endline ("Manual charset is "^ enc); + Glib.Convert.convert_with_fallback ~from_codeset:"UTF-8" ~to_codeset:enc s) with e -> (prerr_endline ("Error ("^(Printexc.to_string e)^") in transcoding: falling back to UTF-8") ;s) in let oc = open_out file_name in @@ -153,26 +141,6 @@ let set_highlight_timer f = Some (GMain.Timeout.add ~ms:2000 ~callback:(fun () -> f (); highlight_timer := None; true)) - -(* Get back the standard coq out channels *) -let init_stdout,read_stdout,clear_stdout = - let out_buff = Buffer.create 100 in - let out_ft = Format.formatter_of_buffer out_buff in - let deep_out_ft = Format.formatter_of_buffer out_buff in - let _ = Pp_control.set_gp deep_out_ft Pp_control.deep_gp in - (fun () -> - Pp_control.std_ft := out_ft; - Pp_control.err_ft := out_ft; - Pp_control.deep_ft := deep_out_ft; -), - (fun () -> Format.pp_print_flush out_ft (); - let r = Buffer.contents out_buff in - prerr_endline "Output from Coq is: "; prerr_endline r; - Buffer.clear out_buff; r), - (fun () -> - Format.pp_print_flush out_ft (); Buffer.clear out_buff) - - let last_dir = ref "" let filter_all_files () = GFile.filter @@ -284,14 +252,40 @@ let stock_to_widget ?(size=`DIALOG) s = in img#set_stock s; img#coerce +let custom_coqtop = ref None + +let coqtop_path () = + let file = match !custom_coqtop with + | Some s -> s + | None -> + match !current.cmd_coqtop with + | Some s -> s + | None -> + let prog = String.copy Sys.executable_name in + try + let pos = String.length prog - 6 in + let i = Str.search_backward (Str.regexp_string "coqide") prog pos in + String.blit "coqtop" 0 prog i 6; + prog + with Not_found -> "coqtop" + in file + let rec print_list print fmt = function | [] -> () | [x] -> print fmt x | x :: r -> print fmt x; print_list print fmt r +(* In win32, when a command-line is to be executed via cmd.exe + (i.e. Sys.command, Unix.open_process, ...), it cannot contain several + quoted "..." zones otherwise some quotes are lost. Solution: we re-quote + everything. Reference: http://ss64.com/nt/cmd.html *) + +let requote cmd = if Sys.os_type = "Win32" then "\""^cmd^"\"" else cmd + (* TODO: allow to report output as soon as it comes (user-fiendlier for long commands like make...) *) let run_command f c = + let c = requote c in let result = Buffer.create 127 in let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in let buff = String.make 127 ' ' in @@ -310,86 +304,54 @@ let run_command f c = (Unix.close_process_full (cin,cout,cerr), Buffer.contents result) let browse f url = - let com = Flags.subst_command_placeholder !current.cmd_browse url in - let s = Sys.command com in + let com = Minilib.subst_command_placeholder !current.cmd_browse url in + let _ = Unix.open_process_out com in () +(* This beautiful message will wait for twt ... if s = 127 then f ("Could not execute\n\""^com^ "\"\ncheck your preferences for setting a valid browser command\n") - +*) let doc_url () = if !current.doc_url = use_default_doc_url || !current.doc_url = "" then - if Sys.file_exists - (String.sub Coq_config.localwwwrefman 7 - (String.length Coq_config.localwwwrefman - 7)) - then - Coq_config.localwwwrefman - else - Coq_config.wwwrefman + let addr = List.fold_left Filename.concat (Coq_config.docdir) ["html";"refman";"index.html"] in + if Sys.file_exists addr then "file://"^addr else Coq_config.wwwrefman else !current.doc_url let url_for_keyword = let ht = Hashtbl.create 97 in - lazy ( - begin try - let cin = - try open_in (lib_ide_file "index_urls.txt") + lazy ( + begin try + let cin = + try let index_urls = Filename.concat (List.find + (fun x -> Sys.file_exists (Filename.concat x "index_urls.txt")) + Minilib.xdg_config_dirs) "index_urls.txt" in + open_in index_urls + with Not_found -> + let doc_url = doc_url () in + let n = String.length doc_url in + if n > 8 && String.sub doc_url 0 7 = "file://" then + open_in (String.sub doc_url 7 (n-7) ^ "index_urls.txt") + else + raise Exit + in + try while true do + let s = input_line cin in + try + let i = String.index s ',' in + let k = String.sub s 0 i in + let u = String.sub s (i + 1) (String.length s - i - 1) in + Hashtbl.add ht k u + with _ -> + Minilib.safe_prerr_endline "Warning: Cannot parse documentation index file." + done with End_of_file -> + close_in cin with _ -> - let doc_url = doc_url () in - let n = String.length doc_url in - if n > 8 && String.sub doc_url 0 7 = "file://" then - open_in (String.sub doc_url 7 (n-7) ^ "index_urls.txt") - else - raise Exit - in - try while true do - let s = input_line cin in - try - let i = String.index s ',' in - let k = String.sub s 0 i in - let u = String.sub s (i + 1) (String.length s - i - 1) in - Hashtbl.add ht k u - with _ -> - Printf.eprintf "Warning: Cannot parse documentation index file.\n"; - flush stderr - done with End_of_file -> - close_in cin - with _ -> - Printf.eprintf "Warning: Cannot find documentation index file.\n"; - flush stderr - end; - Hashtbl.find ht : string -> string) - + Minilib.safe_prerr_endline "Warning: Cannot find documentation index file." + end; + Hashtbl.find ht : string -> string) let browse_keyword f text = try let u = Lazy.force url_for_keyword text in browse f (doc_url() ^ u) with Not_found -> f ("No documentation found for \""^text^"\".\n") - -(* - checks if two file names refer to the same (existing) file by - comparing their device and inode. - It seems that under Windows, inode is always 0, so we cannot - accurately check if - -*) -(* Optimised for partial application (in case many candidates must be - compared to f1). *) -let same_file f1 = - try - let s1 = Unix.stat f1 in - (fun f2 -> - try - let s2 = Unix.stat f2 in - s1.Unix.st_dev = s2.Unix.st_dev && - if Sys.os_type = "Win32" then f1 = f2 - else s1.Unix.st_ino = s2.Unix.st_ino - with - Unix.Unix_error _ -> false) - with - Unix.Unix_error _ -> (fun _ -> false) - -let absolute_filename f = - if Filename.is_relative f then - Filename.concat (Sys.getcwd ()) f - else f - +let absolute_filename f = Minilib.correct_path f (Sys.getcwd ()) diff --git a/ide/ideutils.mli b/ide/ideutils.mli index d6311c78..ff79d689 100644 --- a/ide/ideutils.mli +++ b/ide/ideutils.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ideutils.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) - val async : ('a -> unit) -> 'a -> unit val sync : ('a -> 'b) -> 'a -> 'b @@ -18,8 +16,6 @@ val doc_url : unit -> string val browse : (string -> unit) -> string -> unit val browse_keyword : (string -> unit) -> string -> unit val byte_offset_to_char_offset : string -> int -> int -val init_stdout : unit -> unit -val clear_stdout : unit -> unit val debug : bool ref val disconnect_revert_timer : unit -> unit val disconnect_auto_save_timer : unit -> unit @@ -31,15 +27,13 @@ val get_insert : < get_iter_at_mark : [> `INSERT] -> 'a; .. > -> 'a val is_char_start : char -> bool -val lib_ide_file : string -> string val my_stat : string -> Unix.stats option -val safe_prerr_endline : string -> unit +(** debug printing *) val prerr_endline : string -> unit -val prerr_string : string -> unit + val print_id : 'a -> unit -val read_stdout : unit -> string val revert_timer : GMain.Timeout.id option ref val auto_save_timer : GMain.Timeout.id option ref val select_file_for_open : @@ -58,6 +52,12 @@ val print_list : (formatter -> 'a -> unit) -> formatter -> 'a list -> unit val run_command : (string -> unit) -> string -> Unix.process_status*string +val custom_coqtop : string option ref +(* @return command to call coqtop + - custom_coqtop if set + - from the prefs is set + - try to infer it else *) +val coqtop_path : unit -> string val status : GMisc.statusbar @@ -69,14 +69,14 @@ val set_location : (string -> unit) ref val pbar : GRange.progress_bar - -(* - checks if two file names refer to the same (existing) file -*) - -val same_file : string -> string -> bool - (* returns an absolute filename equivalent to given filename *) val absolute_filename : string -> string + +(* In win32, when a command-line is to be executed via cmd.exe + (i.e. Sys.command, Unix.open_process, ...), it cannot contain several + quoted "..." zones otherwise some quotes are lost. Solution: we re-quote + everything. Reference: http://ss64.com/nt/cmd.html *) + +val requote : string -> string diff --git a/ide/mac_default_accel_map b/ide/mac_default_accel_map new file mode 100644 index 00000000..636447e3 --- /dev/null +++ b/ide/mac_default_accel_map @@ -0,0 +1,376 @@ +; coqide GtkAccelMap rc-file -*- scheme -*- +; this file is an automated accelerator map dump +; +; (gtk_accel_path "<Actions>/Templates/Template Read Module" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic pattern" "") +(gtk_accel_path "<Actions>/Templates/Definition" "<Shift><Primary>d") +; (gtk_accel_path "<Actions>/Templates/Template Program Lemma" "") +(gtk_accel_path "<Actions>/Templates/Lemma" "<Shift><Primary>l") +; (gtk_accel_path "<Actions>/Templates/Template Fact" "") +(gtk_accel_path "<Actions>/Tactics/auto" "<Primary><Control>a") +; (gtk_accel_path "<Actions>/Tactics/Tactic fold" "") +; (gtk_accel_path "<Actions>/Help/About Coq" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Ring A Aplus Amult Aone Azero Ainv Aeq T [ c1 ... cn ]. " "") +; (gtk_accel_path "<Actions>/Templates/Template Hypothesis" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic repeat" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Extraction Optimize" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Printing Constructor" "") +; (gtk_accel_path "<Actions>/Windows/Detach View" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic inversion" "") +; (gtk_accel_path "<Actions>/Templates/Template Write State" "") +; (gtk_accel_path "<Actions>/Export/Export to" "") +(gtk_accel_path "<Actions>/Tactics/auto with *" "<Primary><Control>asterisk") +; (gtk_accel_path "<Actions>/Tactics/Tactic inversion--clear" "") +; (gtk_accel_path "<Actions>/Templates/Template Implicit Arguments" "") +(gtk_accel_path "<Actions>/Edit/Find backwards" "<Primary>b") +; (gtk_accel_path "<Actions>/Edit/Copy" "<Primary>c") +; (gtk_accel_path "<Actions>/Tactics/Tactic inversion -- using" "") +(gtk_accel_path "<Actions>/View/Previous tab" "<Control>Left") +; (gtk_accel_path "<Actions>/Tactics/Tactic change -- in" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic jp" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic red" "") +; (gtk_accel_path "<Actions>/Templates/Template Coercion" "") +; (gtk_accel_path "<Actions>/Templates/Template CoFixpoint" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic intros until" "") +; (gtk_accel_path "<Actions>/Templates/Template Derive Dependent Inversion" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic eapply" "") +; (gtk_accel_path "<Actions>/View/View" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic change" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic firstorder using" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic decompose sum" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic cut" "") +; (gtk_accel_path "<Actions>/Templates/Template Remove Printing Let" "") +; (gtk_accel_path "<Actions>/Templates/Template Structure" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic compute in" "") +; (gtk_accel_path "<Actions>/Queries/Locate" "") +; (gtk_accel_path "<Actions>/Templates/Template Save." "") +; (gtk_accel_path "<Actions>/Templates/Template Canonical Structure" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic compare" "") +; (gtk_accel_path "<Actions>/Templates/Template Next Obligation" "") +(gtk_accel_path "<Actions>/View/Display notations" "<Shift><Control>n") +; (gtk_accel_path "<Actions>/Tactics/Tactic fail" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic left" "") +(gtk_accel_path "<Actions>/Edit/Undo" "<Primary>u") +(gtk_accel_path "<Actions>/Tactics/eauto with *" "<Primary><Control>ampersand") +; (gtk_accel_path "<Actions>/Templates/Template Infix" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic functional induction" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic clear" "") +; (gtk_accel_path "<Actions>/Templates/Template End Silent." "") +; (gtk_accel_path "<Actions>/Tactics/Tactic intros" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic constructor -- with" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic destruct" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic intro after" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic abstract" "") +; (gtk_accel_path "<Actions>/Queries/About" "F5") +; (gtk_accel_path "<Actions>/Templates/Template CoInductive" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Hyps--limit" "") +; (gtk_accel_path "<Actions>/Export/Ps" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic elim" "") +; (gtk_accel_path "<Actions>/Templates/Template Transparent" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic assert (--:--)" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Rec LoadPath" "") +; (gtk_accel_path "<Actions>/Templates/Template Extract Constant" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic compute" "") +; (gtk_accel_path "<Actions>/Compile/Next error" "F7") +; (gtk_accel_path "<Actions>/Templates/Template Add ML Path" "") +; (gtk_accel_path "<Actions>/Templates/Template Test Printing Wildcard" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Implicit Arguments" "") +; (gtk_accel_path "<Actions>/Templates/Template Test Printing Let" "") +; (gtk_accel_path "<Actions>/Windows/Windows" "") +; (gtk_accel_path "<Actions>/Templates/Template Defined." "") +(gtk_accel_path "<Actions>/Templates/match" "<Shift><Primary>c") +; (gtk_accel_path "<Actions>/Tactics/Tactic set (--:=--)" "") +; (gtk_accel_path "<Actions>/Templates/Template Test Printing If" "") +; (gtk_accel_path "<Actions>/Compile/Make" "F6") +; (gtk_accel_path "<Actions>/Templates/Template Module Type" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic apply -- with" "") +; (gtk_accel_path "<Actions>/File/Save as" "") +; (gtk_accel_path "<Actions>/Templates/Template Remove Printing Constructor" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Hyps--limit" "") +; (gtk_accel_path "<Actions>/Templates/Template Global Variable" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic trivial" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Setoid" "") +; (gtk_accel_path "<Actions>/Templates/Template Proof." "") +; (gtk_accel_path "<Actions>/Templates/Template Load Verbose" "") +; (gtk_accel_path "<Actions>/Compile/Compile buffer" "") +; (gtk_accel_path "<Actions>/Queries/Print" "F4") +; (gtk_accel_path "<Actions>/Templates/Template Obligations Tactic" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic cbv" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic first" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic case" "") +; (gtk_accel_path "<Actions>/Templates/Template Hint Constructors" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Abstract Ring A Aplus Amult Aone Azero Ainv Aeq T." "") +; (gtk_accel_path "<Actions>/Templates/Template Coercion Local" "") +; (gtk_accel_path "<Actions>/View/Show Query Pane" "Escape") +; (gtk_accel_path "<Actions>/Templates/Template Add Relation" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic inversion--clear -- in" "") +; (gtk_accel_path "<Actions>/Templates/Template Definition" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Rec ML Path" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic apply" "") +; (gtk_accel_path "<Actions>/Export/Latex" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic inversion -- using -- in" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic generalize" "") +; (gtk_accel_path "<Actions>/Templates/Template Reset Extraction Inline" "") +(gtk_accel_path "<Actions>/Navigation/Hide" "<Primary><Control>h") +; (gtk_accel_path "<Actions>/File/Close buffer" "<Primary>w") +; (gtk_accel_path "<Actions>/Tactics/Tactic induction" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic eauto with" "") +(gtk_accel_path "<Actions>/View/Display raw matching expressions" "<Shift><Control>m") +(gtk_accel_path "<Actions>/Navigation/Backward" "<Primary><Control>Up") +; (gtk_accel_path "<Actions>/Tactics/Tactic u" "") +; (gtk_accel_path "<Actions>/Templates/Templates" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic p" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic lapply" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic t" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic s" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic r" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic case -- with" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic eexact" "") +; (gtk_accel_path "<Actions>/Queries/Check" "F3") +; (gtk_accel_path "<Actions>/Tactics/Tactic omega" "") +; (gtk_accel_path "<Actions>/File/New" "<Primary>n") +; (gtk_accel_path "<Actions>/Tactics/Tactic l" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic intro" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic j" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic i" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic e" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic g" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic f" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic d" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic c" "") +(gtk_accel_path "<Actions>/File/Rehighlight" "<Primary>l") +; (gtk_accel_path "<Actions>/Tactics/Tactic simple inversion" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic a" "") +; (gtk_accel_path "<Actions>/Templates/Template Mutual Inductive" "") +; (gtk_accel_path "<Actions>/Templates/Template Extraction NoInline" "") +(gtk_accel_path "<Actions>/Templates/Theorem" "<Shift><Primary>t") +; (gtk_accel_path "<Actions>/Templates/Template Derive Dependent Inversion--clear" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic unfold" "") +; (gtk_accel_path "<Actions>/Tactics/Try Tactics" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic red in" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic rewrite <- -- in" "") +; (gtk_accel_path "<Actions>/Templates/Template Hint Extern" "") +; (gtk_accel_path "<Actions>/Templates/Template Unfocus" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic dependent inversion--clear" "") +; (gtk_accel_path "<Actions>/Help/Browse Coq Library" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic lazy" "") +; (gtk_accel_path "<Actions>/Templates/Template Scheme" "") +(gtk_accel_path "<Actions>/Tactics/tauto" "<Primary><Control>p") +; (gtk_accel_path "<Actions>/Tactics/Tactic cutrewrite" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic contradiction" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Printing Wildcard" "") +; (gtk_accel_path "<Actions>/Templates/Template Add LoadPath" "") +(gtk_accel_path "<Actions>/Navigation/Previous" "<Primary><Control>less") +; (gtk_accel_path "<Actions>/Templates/Template Require" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic simpl" "") +; (gtk_accel_path "<Actions>/Templates/Template Require Import" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Abstract Semi Ring A Aplus Amult Aone Azero Aeq T." "") +(gtk_accel_path "<Actions>/Navigation/Forward" "<Primary><Control>Down") +; (gtk_accel_path "<Actions>/Tactics/Tactic rename -- into" "") +; (gtk_accel_path "<Actions>/Compile/Compile" "") +; (gtk_accel_path "<Actions>/File/Save all" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic fix" "") +; (gtk_accel_path "<Actions>/Templates/Template Parameter" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic assert" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic do" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic ring" "") +; (gtk_accel_path "<Actions>/Export/Pdf" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic quote" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic symmetry in" "") +; (gtk_accel_path "<Actions>/Help/Help" "") +(gtk_accel_path "<Actions>/Templates/Inductive" "<Shift><Primary>i") +; (gtk_accel_path "<Actions>/Edit/Clear Undo Stack" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic intro -- after" "") +; (gtk_accel_path "<Actions>/Templates/Template Syntax" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic idtac" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic fold -- in" "") +; (gtk_accel_path "<Actions>/Templates/Template Program Definition" "") +(gtk_accel_path "<Actions>/Tactics/Wizard" "<Primary><Control>dollar") +; (gtk_accel_path "<Actions>/Templates/Template Hint Resolve" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Extraction Optimize" "") +; (gtk_accel_path "<Actions>/File/Revert all buffers" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic subst" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic autorewrite" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic pose" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic simplify--eq" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic clearbody" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic eauto" "") +; (gtk_accel_path "<Actions>/Templates/Template Grammar" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic exact" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Implicit Arguments" "") +; (gtk_accel_path "<Actions>/Templates/Template Extract Inductive" "") +(gtk_accel_path "<Actions>/View/Display implicit arguments" "<Shift><Control>i") +; (gtk_accel_path "<Actions>/Tactics/Tactic symmetry" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Printing Let" "") +; (gtk_accel_path "<Actions>/Help/Help for keyword" "<Primary>h") +; (gtk_accel_path "<Actions>/File/Save" "<Primary>s") +; (gtk_accel_path "<Actions>/Compile/Make makefile" "") +; (gtk_accel_path "<Actions>/Templates/Template Remove LoadPath" "") +(gtk_accel_path "<Actions>/Navigation/Interrupt" "<Primary><Control>Break") +(gtk_accel_path "<Actions>/Navigation/End" "<Primary><Control>End") +; (gtk_accel_path "<Actions>/Templates/Template Add Morphism" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic field" "") +; (gtk_accel_path "<Actions>/Templates/Template Axiom" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic solve" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic casetype" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic cbv in" "") +; (gtk_accel_path "<Actions>/Templates/Template Load" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic fourier" "") +; (gtk_accel_path "<Actions>/Templates/Template Goal" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic exists" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic decompose record" "") +(gtk_accel_path "<Actions>/Navigation/Go to" "<Primary><Control>Right") +; (gtk_accel_path "<Actions>/Templates/Template Remark" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Undo" "") +; (gtk_accel_path "<Actions>/Templates/Template Inductive" "") +(gtk_accel_path "<Actions>/Edit/Preferences" "<Primary>VoidSymbol") +; (gtk_accel_path "<Actions>/Export/Html" "") +; (gtk_accel_path "<Actions>/Templates/Template Extraction Inline" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic absurd" "") +(gtk_accel_path "<Actions>/Tactics/intuition" "<Primary><Control>i") +; (gtk_accel_path "<Actions>/Tactics/Tactic simple induction" "") +; (gtk_accel_path "<Actions>/Queries/Queries" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic rewrite -- in" "") +; (gtk_accel_path "<Actions>/Templates/Template Hint Rewrite" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Semi Ring A Aplus Amult Aone Azero Aeq T [ c1 ... cn ]." "") +; (gtk_accel_path "<Actions>/Navigation/Navigation" "") +; (gtk_accel_path "<Actions>/Help/Browse Coq Manual" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic transitivity" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic auto" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic dependent inversion -- with" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic assumption" "") +; (gtk_accel_path "<Actions>/Templates/Template Notation" "") +; (gtk_accel_path "<Actions>/Edit/Cut" "<Primary>x") +; (gtk_accel_path "<Actions>/Templates/Template Theorem" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Printing Wildcard" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic constructor" "") +; (gtk_accel_path "<Actions>/Templates/Template Identity Coercion" "") +; (gtk_accel_path "<Actions>/Queries/Whelp Locate" "") +(gtk_accel_path "<Actions>/View/Display all low-level contents" "<Shift><Control>l") +; (gtk_accel_path "<Actions>/Tactics/Tactic right" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic elim -- with" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic cofix" "") +; (gtk_accel_path "<Actions>/Templates/Template Restore State" "") +; (gtk_accel_path "<Actions>/Templates/Template Lemma" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic refine" "") +; (gtk_accel_path "<Actions>/Templates/Template Section" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic assert (--:=--)" "") +; (gtk_accel_path "<Actions>/Edit/Find in buffer" "<Primary>f") +; (gtk_accel_path "<Actions>/Tactics/Tactic progress" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Printing If" "") +; (gtk_accel_path "<Actions>/Templates/Template Chapter" "") +(gtk_accel_path "<Actions>/File/Print..." "<Primary>p") +; (gtk_accel_path "<Actions>/Templates/Template Record" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic info" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic firstorder with" "") +; (gtk_accel_path "<Actions>/Templates/Template Hint Unfold" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Silent." "") +; (gtk_accel_path "<Actions>/Templates/Template Program Theorem" "") +; (gtk_accel_path "<Actions>/Templates/Template Declare ML Module" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic lazy in" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic unfold -- in" "") +; (gtk_accel_path "<Actions>/Edit/Paste" "<Primary>v") +; (gtk_accel_path "<Actions>/Templates/Template Remove Printing If" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic intuition" "") +; (gtk_accel_path "<Actions>/Queries/SearchAbout" "F2") +; (gtk_accel_path "<Actions>/Tactics/Tactic dependent rewrite ->" "") +; (gtk_accel_path "<Actions>/Templates/Template Module" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Extraction AutoInline" "") +(gtk_accel_path "<Actions>/Templates/Scheme" "<Shift><Primary>s") +; (gtk_accel_path "<Actions>/Templates/Template V" "") +; (gtk_accel_path "<Actions>/Templates/Template Variable" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic decide equality" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic instantiate (--:=--)" "") +; (gtk_accel_path "<Actions>/Templates/Template Syntactic Definition" "") +; (gtk_accel_path "<Actions>/Templates/Template Set Extraction AutoInline" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Undo" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic dependent inversion" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Field" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic setoid--rewrite" "") +; (gtk_accel_path "<Actions>/Templates/Template Require Export" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic rewrite <-" "") +(gtk_accel_path "<Actions>/Tactics/omega" "<Primary><Control>o") +; (gtk_accel_path "<Actions>/Tactics/Tactic split" "") +; (gtk_accel_path "<Actions>/File/Quit" "<Primary>q") +(gtk_accel_path "<Actions>/View/Display existential variable instances" "<Shift><Control>e") +(gtk_accel_path "<Actions>/Navigation/Start" "<Primary><Control>Home") +; (gtk_accel_path "<Actions>/Tactics/Tactic dependent rewrite <-" "") +; (gtk_accel_path "<Actions>/Templates/Template U" "") +; (gtk_accel_path "<Actions>/Templates/Template Variables" "") +; (gtk_accel_path "<Actions>/Templates/Template S" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic move -- after" "") +; (gtk_accel_path "<Actions>/Templates/Template Unset Silent." "") +; (gtk_accel_path "<Actions>/Templates/Template Local" "") +; (gtk_accel_path "<Actions>/Templates/Template T" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic reflexivity" "") +; (gtk_accel_path "<Actions>/Templates/Template R" "") +; (gtk_accel_path "<Actions>/Templates/Template Time" "") +; (gtk_accel_path "<Actions>/Templates/Template P" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic decompose" "") +; (gtk_accel_path "<Actions>/Templates/Template N" "") +; (gtk_accel_path "<Actions>/Templates/Template Eval" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic congruence" "") +; (gtk_accel_path "<Actions>/Templates/Template O" "") +; (gtk_accel_path "<Actions>/Templates/Template E" "") +; (gtk_accel_path "<Actions>/Templates/Template I" "") +; (gtk_accel_path "<Actions>/Templates/Template H" "") +; (gtk_accel_path "<Actions>/Templates/Template Extraction Language" "") +; (gtk_accel_path "<Actions>/Templates/Template M" "") +; (gtk_accel_path "<Actions>/Templates/Template Derive Inversion" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic double induction" "") +; (gtk_accel_path "<Actions>/Templates/Template L" "") +; (gtk_accel_path "<Actions>/Templates/Template Derive Inversion--clear" "") +(gtk_accel_path "<Actions>/View/Display universe levels" "<Shift><Control>u") +; (gtk_accel_path "<Actions>/Templates/Template G" "") +; (gtk_accel_path "<Actions>/Templates/Template F" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic dependent inversion--clear -- with" "") +; (gtk_accel_path "<Actions>/Templates/Template D" "") +; (gtk_accel_path "<Actions>/Edit/Edit" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic firstorder" "") +; (gtk_accel_path "<Actions>/Templates/Template C" "") +(gtk_accel_path "<Actions>/Tactics/simpl" "<Primary><Control>s") +; (gtk_accel_path "<Actions>/Tactics/Tactic replace -- with" "") +; (gtk_accel_path "<Actions>/Templates/Template A" "") +; (gtk_accel_path "<Actions>/Templates/Template Remove Printing Record" "") +; (gtk_accel_path "<Actions>/Templates/Template Qed." "") +; (gtk_accel_path "<Actions>/Templates/Template Program Fixpoint" "") +(gtk_accel_path "<Actions>/View/Display coercions" "<Shift><Control>c") +; (gtk_accel_path "<Actions>/Tactics/Tactic hnf" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic injection" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic rewrite" "") +; (gtk_accel_path "<Actions>/Templates/Template Opaque" "") +; (gtk_accel_path "<Actions>/Templates/Template Focus" "") +; (gtk_accel_path "<Actions>/Templates/Template Ltac" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic simple destruct" "") +(gtk_accel_path "<Actions>/View/Display all basic low-level contents" "<Shift><Control>a") +; (gtk_accel_path "<Actions>/Tactics/Tactic jp <n>" "") +; (gtk_accel_path "<Actions>/Templates/Template Test Printing Synth" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic set" "") +; (gtk_accel_path "<Actions>/Edit/External editor" "") +; (gtk_accel_path "<Actions>/View/Show Toolbar" "") +(gtk_accel_path "<Actions>/Edit/Complete Word" "<Primary>slash") +; (gtk_accel_path "<Actions>/Tactics/Tactic try" "") +(gtk_accel_path "<Actions>/Templates/Fixpoint" "<Shift><Primary>f") +; (gtk_accel_path "<Actions>/Tactics/Tactic discriminate" "") +(gtk_accel_path "<Actions>/Navigation/Next" "<Primary><Control>greater") +; (gtk_accel_path "<Actions>/Tactics/Tactic elimtype" "") +; (gtk_accel_path "<Actions>/Templates/Template End" "") +; (gtk_accel_path "<Actions>/Templates/Template Fixpoint" "") +(gtk_accel_path "<Actions>/View/Next tab" "<Control>Right") +; (gtk_accel_path "<Actions>/File/File" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic setoid--replace" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic generalize dependent" "") +(gtk_accel_path "<Actions>/Tactics/trivial" "<Primary><Control>v") +; (gtk_accel_path "<Actions>/Tactics/Tactic fix -- with" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic pose --:=--)" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic auto with" "") +; (gtk_accel_path "<Actions>/Templates/Template Add Printing Record" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic inversion -- in" "") +(gtk_accel_path "<Actions>/Tactics/eauto" "<Primary><Control>e") +; (gtk_accel_path "<Actions>/File/Open" "<Primary>o") +; (gtk_accel_path "<Actions>/Tactics/Tactic elim -- using" "") +; (gtk_accel_path "<Actions>/Templates/Template Hint" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic tauto" "") +; (gtk_accel_path "<Actions>/Export/Dvi" "") +; (gtk_accel_path "<Actions>/Tactics/Tactic simpl -- in" "") +; (gtk_accel_path "<Actions>/Templates/Template Hint Immediate" "") diff --git a/ide/minilib.ml b/ide/minilib.ml new file mode 100644 index 00000000..74a42b23 --- /dev/null +++ b/ide/minilib.ml @@ -0,0 +1,186 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(** Some excerpt of Util and similar files to avoid loading the whole + module and its dependencies (and hence Compat and Camlp4) *) + +module Stringmap = Map.Make(String) + +let list_fold_left_i f = + let rec it_list_f i a = function + | [] -> a + | b::l -> it_list_f (i+1) (f i a b) l + in + it_list_f + +(* [list_chop i l] splits [l] into two lists [(l1,l2)] such that + [l1++l2=l] and [l1] has length [i]. + It raises [Failure] when [i] is negative or greater than the length of [l] *) + +let list_chop n l = + let rec chop_aux i acc = function + | tl when i=0 -> (List.rev acc, tl) + | h::t -> chop_aux (pred i) (h::acc) t + | [] -> failwith "list_chop" + in + chop_aux n [] l + + +let list_map_i f = + let rec map_i_rec i = function + | [] -> [] + | x::l -> let v = f i x in v :: map_i_rec (i+1) l + in + map_i_rec + + +let list_index x = + let rec index_x n = function + | y::l -> if x = y then n else index_x (succ n) l + | [] -> raise Not_found + in + index_x 1 + +let list_index0 x l = list_index x l - 1 + +let list_filter_i p = + let rec filter_i_rec i = function + | [] -> [] + | x::l -> let l' = filter_i_rec (succ i) l in if p i x then x::l' else l' + in + filter_i_rec 0 + +let string_map f s = + let l = String.length s in + let r = String.create l in + for i= 0 to (l - 1) do r.[i] <- f (s.[i]) done; + r + +let subst_command_placeholder s t = + Str.global_replace (Str.regexp_string "%s") t s + +(* Split the content of a variable such as $PATH in a list of directories. + The separators are either ":" in unix or ";" in win32 *) + +let path_to_list = Str.split (Str.regexp "[:;]") + +(* On win32, the home directory is probably not in $HOME, but in + some other environment variable *) + +let home = + try Sys.getenv "HOME" with Not_found -> + try (Sys.getenv "HOMEDRIVE")^(Sys.getenv "HOMEPATH") with Not_found -> + try Sys.getenv "USERPROFILE" with Not_found -> Filename.current_dir_name + +let opt2list = function None -> [] | Some x -> [x] + +let (/) = Filename.concat + +let coqify d = d / "coq" + +let xdg_config_home = + coqify (try Sys.getenv "XDG_CONFIG_HOME" with Not_found -> home / ".config") + +let relative_base = + Filename.dirname (Filename.dirname Sys.executable_name) + +let xdg_config_dirs = + let sys_dirs = + try List.map coqify (path_to_list (Sys.getenv "XDG_CONFIG_DIRS")) + with + | Not_found when Sys.os_type = "Win32" -> [relative_base / "config"] + | Not_found -> ["/etc/xdg/coq"] + in + xdg_config_home :: sys_dirs @ opt2list Coq_config.configdir + +let xdg_data_home = + coqify + (try Sys.getenv "XDG_DATA_HOME" with Not_found -> home / ".local" / "share") + +let xdg_data_dirs = + let sys_dirs = + try List.map coqify (path_to_list (Sys.getenv "XDG_DATA_DIRS")) + with + | Not_found when Sys.os_type = "Win32" -> [relative_base / "share"] + | Not_found -> ["/usr/local/share/coq";"/usr/share/coq"] + in + xdg_data_home :: sys_dirs @ opt2list Coq_config.datadir + +let coqtop_path = ref "" + +(* On a Win32 application with no console, writing to stderr raise + a Sys_error "bad file descriptor", hence the "try" below. + Ideally, we should re-route message to a log file somewhere, or + print in the response buffer. +*) + +let safe_prerr_endline s = + try prerr_endline s;flush stderr with _ -> () + +(* Hints to partially detects if two paths refer to the same repertory *) +let rec remove_path_dot p = + let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *) + let n = String.length curdir in + let l = String.length p in + if l > n && String.sub p 0 n = curdir then + let n' = + let sl = String.length Filename.dir_sep in + let i = ref n in + while !i <= l - sl && String.sub p !i sl = Filename.dir_sep do i := !i + sl done; !i in + remove_path_dot (String.sub p n' (l - n')) + else + p + +let strip_path p = + let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *) + let n = String.length cwd in + let l = String.length p in + if l > n && String.sub p 0 n = cwd then + let n' = + let sl = String.length Filename.dir_sep in + let i = ref n in + while !i <= l - sl && String.sub p !i sl = Filename.dir_sep do i := !i + sl done; !i in + remove_path_dot (String.sub p n' (l - n')) + else + remove_path_dot p + +let canonical_path_name p = + let current = Sys.getcwd () in + try + Sys.chdir p; + let p' = Sys.getcwd () in + Sys.chdir current; + p' + with Sys_error _ -> + (* We give up to find a canonical name and just simplify it... *) + strip_path p + +let correct_path f dir = if Filename.is_relative f then Filename.concat dir f else f + +(* + checks if two file names refer to the same (existing) file by + comparing their device and inode. + It seems that under Windows, inode is always 0, so we cannot + accurately check if + +*) +(* Optimised for partial application (in case many candidates must be + compared to f1). *) +let same_file f1 = + try + let s1 = Unix.stat f1 in + (fun f2 -> + try + let s2 = Unix.stat f2 in + s1.Unix.st_dev = s2.Unix.st_dev && + if Sys.os_type = "Win32" then f1 = f2 + else s1.Unix.st_ino = s2.Unix.st_ino + with + Unix.Unix_error _ -> false) + with + Unix.Unix_error _ -> (fun _ -> false) diff --git a/ide/minilib.mli b/ide/minilib.mli new file mode 100644 index 00000000..53d6c87c --- /dev/null +++ b/ide/minilib.mli @@ -0,0 +1,44 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +(** Some excerpts of Util and similar files to avoid depending on them + and hence on Compat and Camlp4 *) + +module Stringmap : Map.S with type key = string + +val list_fold_left_i : (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a +val list_map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list +val list_filter_i : (int -> 'a -> bool) -> 'a list -> 'a list +val list_chop : int -> 'a list -> 'a list * 'a list +val list_index0 : 'a -> 'a list -> int + +val string_map : (char -> char) -> string -> string + +val subst_command_placeholder : string -> string -> string + +val home : string +val xdg_config_home : string +val xdg_config_dirs : string list +val xdg_data_home : string +val xdg_data_dirs : string list + +val coqtop_path : string ref + +(** safe version of Pervasives.prerr_endline + (avoid exception in win32 without console) *) +val safe_prerr_endline : string -> unit + +val remove_path_dot : string -> string +val strip_path : string -> string +val canonical_path_name : string -> string +(** correct_path f dir = dir/f if f is relative *) +val correct_path : string -> string -> string + +(** checks if two file names refer to the same (existing) file *) +val same_file : string -> string -> bool + diff --git a/ide/preferences.ml b/ide/preferences.ml index 790bf560..2fb5023f 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -1,56 +1,88 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: preferences.ml 14641 2011-11-06 11:59:10Z herbelin $ *) - open Configwin open Printf -open Util -let pref_file = Filename.concat System.home ".coqiderc" +let pref_file = Filename.concat Minilib.xdg_config_home "coqiderc" +let accel_file = Filename.concat Minilib.xdg_config_home "coqide.keys" + +let get_config_file name = + let find_config dir = Sys.file_exists (Filename.concat dir name) in + let config_dir = List.find find_config Minilib.xdg_config_dirs in + Filename.concat config_dir name + +(* Small hack to handle v8.3 to v8.4 change in configuration file *) +let loaded_pref_file = + try get_config_file "coqiderc" + with Not_found -> Filename.concat Minilib.home ".coqiderc" -let accel_file = Filename.concat System.home ".coqide.keys" +let loaded_accel_file = + try get_config_file "coqide.keys" + with Not_found -> Filename.concat Minilib.home ".coqide.keys" let mod_to_str (m:Gdk.Tags.modifier) = match m with - | `MOD1 -> "MOD1" - | `MOD2 -> "MOD2" - | `MOD3 -> "MOD3" - | `MOD4 -> "MOD4" - | `MOD5 -> "MOD5" - | `BUTTON1 -> "BUTTON1" - | `BUTTON2 -> "BUTTON2" - | `BUTTON3 -> "BUTTON3" - | `BUTTON4 -> "BUTTON4" - | `BUTTON5 -> "BUTTON5" - | `CONTROL -> "CONTROL" - | `LOCK -> "LOCK" - | `SHIFT -> "SHIFT" - -let (str_to_mod:string -> Gdk.Tags.modifier) = - function - | "MOD1" -> `MOD1 - | "MOD2" -> `MOD2 - | "MOD3" -> `MOD3 - | "MOD4" -> `MOD4 - | "MOD5" -> `MOD5 - | "BUTTON1" -> `BUTTON1 - | "BUTTON2" -> `BUTTON2 - | "BUTTON3" -> `BUTTON3 - | "BUTTON4" -> `BUTTON4 - | "BUTTON5" -> `BUTTON5 - | "CONTROL" -> `CONTROL - | "LOCK" -> `LOCK - | "SHIFT" -> `SHIFT - | s -> `MOD1 + | `MOD1 -> "<Alt>" + | `MOD2 -> "<Mod2>" + | `MOD3 -> "<Mod3>" + | `MOD4 -> "<Mod4>" + | `MOD5 -> "<Mod5>" + | `CONTROL -> "<Control>" + | `SHIFT -> "<Shift>" + | `HYPER -> "<Hyper>" + | `META -> "<Meta>" + | `RELEASE -> "" + | `SUPER -> "<Super>" + | `BUTTON1| `BUTTON2| `BUTTON3| `BUTTON4| `BUTTON5| `LOCK -> "" + +let mod_list_to_str l = List.fold_left (fun s m -> (mod_to_str m)^s) "" l + +let str_to_mod_list s = snd (GtkData.AccelGroup.parse s) + +type project_behavior = Ignore_args | Append_args | Subst_args + +let string_of_project_behavior = function + |Ignore_args -> "ignored" + |Append_args -> "appended to arguments" + |Subst_args -> "taken instead of arguments" + +let project_behavior_of_string s = + if s = "taken instead of arguments" then Subst_args + else if s = "appended to arguments" then Append_args + else Ignore_args + +type inputenc = Elocale | Eutf8 | Emanual of string + +let string_of_inputenc = function + |Elocale -> "LOCALE" + |Eutf8 -> "UTF-8" + |Emanual s -> s + +let inputenc_of_string s = + (if s = "UTF-8" then Eutf8 + else if s = "LOCALE" then Elocale + else Emanual s) + + +(** Hooks *) + +let refresh_font_hook = ref (fun () -> ()) +let refresh_background_color_hook = ref (fun () -> ()) +let refresh_toolbar_hook = ref (fun () -> ()) +let auto_complete_hook = ref (fun x -> ()) +let contextual_menus_on_goal_hook = ref (fun x -> ()) +let resize_window_hook = ref (fun () -> ()) +let refresh_tabs_hook = ref (fun () -> ()) type pref = { + mutable cmd_coqtop : string option; mutable cmd_coqc : string; mutable cmd_make : string; mutable cmd_coqmakefile : string; @@ -63,18 +95,19 @@ type pref = mutable auto_save_delay : int; mutable auto_save_name : string * string; - mutable encoding_use_locale : bool; - mutable encoding_use_utf8 : bool; - mutable encoding_manual : string; + mutable read_project : project_behavior; + mutable project_file_name : string; + + mutable encoding : inputenc; mutable automatic_tactics : string list; mutable cmd_print : string; - mutable modifier_for_navigation : Gdk.Tags.modifier list; - mutable modifier_for_templates : Gdk.Tags.modifier list; - mutable modifier_for_tactics : Gdk.Tags.modifier list; - mutable modifier_for_display : Gdk.Tags.modifier list; - mutable modifiers_valid : Gdk.Tags.modifier list; + mutable modifier_for_navigation : string; + mutable modifier_for_templates : string; + mutable modifier_for_tactics : string; + mutable modifier_for_display : string; + mutable modifiers_valid : string; mutable cmd_browse : string; mutable cmd_editor : string; @@ -95,15 +128,20 @@ type pref = *) mutable auto_complete : bool; mutable stop_before : bool; - mutable lax_syntax : bool; mutable vertical_tabs : bool; mutable opposite_tabs : bool; + + mutable background_color : string; + mutable processing_color : string; + mutable processed_color : string; + } let use_default_doc_url = "(automatic)" let (current:pref ref) = ref { + cmd_coqtop = None; cmd_coqc = "coqc"; cmd_make = "make"; cmd_coqmakefile = "coq_makefile -o makefile *.v"; @@ -117,25 +155,28 @@ let (current:pref ref) = auto_save_delay = 10000; auto_save_name = "#","#"; - encoding_use_locale = true; - encoding_use_utf8 = false; - encoding_manual = "ISO_8859-1"; + read_project = Ignore_args; + project_file_name = "_CoqProject"; + + encoding = if Sys.os_type = "Win32" then Eutf8 else Elocale; automatic_tactics = ["trivial"; "tauto"; "auto"; "omega"; "auto with *"; "intuition" ]; - modifier_for_navigation = [`CONTROL; `MOD1]; - modifier_for_templates = [`CONTROL; `SHIFT]; - modifier_for_tactics = [`CONTROL; `MOD1]; - modifier_for_display = [`MOD1;`SHIFT]; - modifiers_valid = [`SHIFT; `CONTROL; `MOD1]; + modifier_for_navigation = "<Control><Alt>"; + modifier_for_templates = "<Control><Shift>"; + modifier_for_tactics = "<Control><Alt>"; + modifier_for_display = "<Alt><Shift>"; + modifiers_valid = "<Alt><Control><Shift>"; cmd_browse = Flags.browser_cmd_fmt; cmd_editor = if Sys.os_type = "Win32" then "NOTEPAD %s" else "emacs %s"; (* text_font = Pango.Font.from_string "sans 12";*) - text_font = Pango.Font.from_string "Monospace 10"; + text_font = Pango.Font.from_string (match Coq_config.gtk_platform with + |`QUARTZ -> "Arial Unicode MS 11" + |_ -> "Monospace 10"); doc_url = Coq_config.wwwrefman; library_url = Coq_config.wwwstdlib; @@ -151,30 +192,25 @@ let (current:pref ref) = *) auto_complete = false; stop_before = true; - lax_syntax = true; vertical_tabs = false; opposite_tabs = false; - } - - -let change_font = ref (fun f -> ()) -let show_toolbar = ref (fun x -> ()) + background_color = "cornsilk"; + processed_color = "light green"; + processing_color = "light blue"; -let auto_complete = ref (fun x -> ()) - -let contextual_menus_on_goal = ref (fun x -> ()) - -let resize_window = ref (fun () -> ()) + } let save_pref () = - (try GtkData.AccelMap.save accel_file - with _ -> ()); + if not (Sys.file_exists Minilib.xdg_config_home) + then Unix.mkdir Minilib.xdg_config_home 0o700; + let () = try GtkData.AccelMap.save accel_file with _ -> () in let p = !current in - try - let add = Stringmap.add in + + let add = Minilib.Stringmap.add in let (++) x f = f x in - Stringmap.empty ++ + Minilib.Stringmap.empty ++ + add "cmd_coqtop" (match p.cmd_coqtop with | None -> [] | Some v-> [v]) ++ add "cmd_coqc" [p.cmd_coqc] ++ add "cmd_make" [p.cmd_make] ++ add "cmd_coqmakefile" [p.cmd_coqmakefile] ++ @@ -186,22 +222,18 @@ let save_pref () = add "auto_save_delay" [string_of_int p.auto_save_delay] ++ add "auto_save_name" [fst p.auto_save_name; snd p.auto_save_name] ++ - add "encoding_use_locale" [string_of_bool p.encoding_use_locale] ++ - add "encoding_use_utf8" [string_of_bool p.encoding_use_utf8] ++ - add "encoding_manual" [p.encoding_manual] ++ + add "project_options" [string_of_project_behavior p.read_project] ++ + add "project_file_name" [p.project_file_name] ++ + + add "encoding" [string_of_inputenc p.encoding] ++ add "automatic_tactics" p.automatic_tactics ++ add "cmd_print" [p.cmd_print] ++ - add "modifier_for_navigation" - (List.map mod_to_str p.modifier_for_navigation) ++ - add "modifier_for_templates" - (List.map mod_to_str p.modifier_for_templates) ++ - add "modifier_for_tactics" - (List.map mod_to_str p.modifier_for_tactics) ++ - add "modifier_for_display" - (List.map mod_to_str p.modifier_for_display) ++ - add "modifiers_valid" - (List.map mod_to_str p.modifiers_valid) ++ + add "modifier_for_navigation" [p.modifier_for_navigation] ++ + add "modifier_for_templates" [p.modifier_for_templates] ++ + add "modifier_for_tactics" [p.modifier_for_tactics] ++ + add "modifier_for_display" [p.modifier_for_display] ++ + add "modifiers_valid" [p.modifiers_valid] ++ add "cmd_browse" [p.cmd_browse] ++ add "cmd_editor" [p.cmd_editor] ++ @@ -218,19 +250,20 @@ let save_pref () = add "query_window_width" [string_of_int p.query_window_width] ++ add "auto_complete" [string_of_bool p.auto_complete] ++ add "stop_before" [string_of_bool p.stop_before] ++ - add "lax_syntax" [string_of_bool p.lax_syntax] ++ add "vertical_tabs" [string_of_bool p.vertical_tabs] ++ add "opposite_tabs" [string_of_bool p.opposite_tabs] ++ + add "background_color" [p.background_color] ++ + add "processing_color" [p.processing_color] ++ + add "processed_color" [p.processed_color] ++ Config_lexer.print_file pref_file - with _ -> prerr_endline "Could not save preferences." let load_pref () = - (try GtkData.AccelMap.load accel_file with _ -> ()); + let () = try GtkData.AccelMap.load loaded_accel_file with _ -> () in let p = !current in - try - let m = Config_lexer.load_file pref_file in + + let m = Config_lexer.load_file loaded_pref_file in let np = { p with cmd_coqc = p.cmd_coqc } in - let set k f = try let v = Stringmap.find k m in f v with _ -> () in + let set k f = try let v = Minilib.Stringmap.find k m in f v with _ -> () in let set_hd k f = set k (fun v -> f (List.hd v)) in let set_bool k f = set_hd k (fun v -> f (bool_of_string v)) in let set_int k f = set_hd k (fun v -> f (int_of_string v)) in @@ -238,6 +271,8 @@ let load_pref () = let set_command_with_pair_compat k f = set k (function [v1;v2] -> f (v1^"%s"^v2) | [v] -> f v | _ -> raise Exit) in + let set_option k f = set k (fun v -> f (match v with |[] -> None |h::_ -> Some h)) in + set_option "cmd_coqtop" (fun v -> np.cmd_coqtop <- v); set_hd "cmd_coqc" (fun v -> np.cmd_coqc <- v); set_hd "cmd_make" (fun v -> np.cmd_make <- v); set_hd "cmd_coqmakefile" (fun v -> np.cmd_coqmakefile <- v); @@ -248,22 +283,23 @@ let load_pref () = set_bool "auto_save" (fun v -> np.auto_save <- v); set_int "auto_save_delay" (fun v -> np.auto_save_delay <- v); set_pair "auto_save_name" (fun v1 v2 -> np.auto_save_name <- (v1,v2)); - set_bool "encoding_use_locale" (fun v -> np.encoding_use_locale <- v); - set_bool "encoding_use_utf8" (fun v -> np.encoding_use_utf8 <- v); - set_hd "encoding_manual" (fun v -> np.encoding_manual <- v); + set_hd "encoding" (fun v -> np.encoding <- (inputenc_of_string v)); + set_hd "project_options" + (fun v -> np.read_project <- (project_behavior_of_string v)); + set_hd "project_file_name" (fun v -> np.project_file_name <- v); set "automatic_tactics" (fun v -> np.automatic_tactics <- v); set_hd "cmd_print" (fun v -> np.cmd_print <- v); - set "modifier_for_navigation" - (fun v -> np.modifier_for_navigation <- List.map str_to_mod v); - set "modifier_for_templates" - (fun v -> np.modifier_for_templates <- List.map str_to_mod v); - set "modifier_for_tactics" - (fun v -> np.modifier_for_tactics <- List.map str_to_mod v); - set "modifier_for_display" - (fun v -> np.modifier_for_display <- List.map str_to_mod v); - set "modifiers_valid" - (fun v -> np.modifiers_valid <- List.map str_to_mod v); + set_hd "modifier_for_navigation" + (fun v -> np.modifier_for_navigation <- v); + set_hd "modifier_for_templates" + (fun v -> np.modifier_for_templates <- v); + set_hd "modifier_for_tactics" + (fun v -> np.modifier_for_tactics <- v); + set_hd "modifier_for_display" + (fun v -> np.modifier_for_display <- v); + set_hd "modifiers_valid" + (fun v -> np.modifiers_valid <- v); set_command_with_pair_compat "cmd_browse" (fun v -> np.cmd_browse <- v); set_command_with_pair_compat "cmd_editor" (fun v -> np.cmd_editor <- v); set_hd "text_font" (fun v -> np.text_font <- Pango.Font.from_string v); @@ -274,7 +310,7 @@ let load_pref () = v <> Coq_config.wwwcoq ^ "doc" && v <> Coq_config.wwwcoq ^ "doc/" then - prerr_endline ("Warning: Non-standard URL for Coq documentation in preference file: "^v); + (*prerr_endline ("Warning: Non-standard URL for Coq documentation in preference file: "^v);*) np.doc_url <- v); set_hd "library_url" (fun v -> np.library_url <- v); set_bool "show_toolbar" (fun v -> np.show_toolbar <- v); @@ -286,26 +322,21 @@ let load_pref () = set_int "query_window_height" (fun v -> np.query_window_height <- v); set_bool "auto_complete" (fun v -> np.auto_complete <- v); set_bool "stop_before" (fun v -> np.stop_before <- v); - set_bool "lax_syntax" (fun v -> np.lax_syntax <- v); set_bool "vertical_tabs" (fun v -> np.vertical_tabs <- v); set_bool "opposite_tabs" (fun v -> np.opposite_tabs <- v); - current := np; + set_hd "background_color" (fun v -> np.background_color <- v); + set_hd "processing_color" (fun v -> np.processing_color <- v); + set_hd "processed_color" (fun v -> np.processed_color <- v); + current := np (* Format.printf "in load_pref: current.text_font = %s@." (Pango.Font.to_string !current.text_font); *) - with e -> - prerr_endline ("Could not load preferences ("^ - (Printexc.to_string e)^").") - -let split_string_format s = - try - let i = Util.string_index_from s 0 "%s" in - let pre = (String.sub s 0 i) in - let post = String.sub s (i+2) (String.length s - i - 2) in - pre,post - with Not_found -> s,"" let configure ?(apply=(fun () -> ())) () = + let cmd_coqtop = + string + ~f:(fun s -> !current.cmd_coqtop <- if s = "AUTO" then None else Some s) + " coqtop" (match !current.cmd_coqtop with |None -> "AUTO" | Some x -> x) in let cmd_coqc = string ~f:(fun s -> !current.cmd_coqc <- s) @@ -332,7 +363,7 @@ let configure ?(apply=(fun () -> ())) () = let w = GMisc.font_selection () in w#set_preview_text "Goal (∃n : nat, n ≤ 0)∧(∀x,y,z, x∈y⋃z↔x∈y∨x∈z)."; - box#pack w#coerce; + box#pack ~expand:true w#coerce; ignore (w#misc#connect#realize ~callback:(fun () -> w#set_font_name (Pango.Font.to_string !current.text_font))); @@ -345,9 +376,67 @@ let configure ?(apply=(fun () -> ())) () = (* Format.printf "in config_font: current.text_font = %s@." (Pango.Font.to_string !current.text_font); *) - !change_font !current.text_font) + !refresh_font_hook ()) true in + + let config_color = + let box = GPack.vbox () in + let table = GPack.table + ~row_spacings:5 + ~col_spacings:5 + ~border_width:2 + ~packing:(box#pack ~expand:true) () + in + let background_label = GMisc.label + ~text:"Background color" + ~packing:(table#attach ~expand:`X ~left:0 ~top:0) () + in + let processed_label = GMisc.label + ~text:"Background color of processed text" + ~packing:(table#attach ~expand:`X ~left:0 ~top:1) () + in + let processing_label = GMisc.label + ~text:"Background color of text being processed" + ~packing:(table#attach ~expand:`X ~left:0 ~top:2) () + in + let () = background_label#set_xalign 0. in + let () = processed_label#set_xalign 0. in + let () = processing_label#set_xalign 0. in + let background_button = GButton.color_button + ~color:(Tags.color_of_string (!current.background_color)) + ~packing:(table#attach ~left:1 ~top:0) () + in + let processed_button = GButton.color_button + ~color:(Tags.get_processed_color ()) + ~packing:(table#attach ~left:1 ~top:1) () + in + let processing_button = GButton.color_button + ~color:(Tags.get_processing_color ()) + ~packing:(table#attach ~left:1 ~top:2) () + in + let reset_button = GButton.button + ~label:"Reset" + ~packing:box#pack () + in + let reset_cb () = + background_button#set_color (Tags.color_of_string "cornsilk"); + processing_button#set_color (Tags.color_of_string "light blue"); + processed_button#set_color (Tags.color_of_string "light green"); + in + let _ = reset_button#connect#clicked ~callback:reset_cb in + let label = "Color configuration" in + let callback () = + !current.background_color <- Tags.string_of_color background_button#color; + !current.processing_color <- Tags.string_of_color processing_button#color; + !current.processed_color <- Tags.string_of_color processed_button#color; + !refresh_background_color_hook (); + Tags.set_processing_color processing_button#color; + Tags.set_processed_color processed_button#color + in + custom ~label box callback true + in + (* let show_toolbar = bool @@ -376,7 +465,7 @@ let configure ?(apply=(fun () -> ())) () = bool ~f:(fun s -> !current.auto_complete <- s; - !auto_complete s) + !auto_complete_hook s) "Auto Complete" !current.auto_complete in @@ -423,85 +512,85 @@ let configure ?(apply=(fun () -> ())) () = "Stop interpreting before the current point" !current.stop_before in - let lax_syntax = - bool - ~f:(fun s -> !current.lax_syntax <- s) - "Relax read-only constraint at end of command" !current.lax_syntax - in - let vertical_tabs = bool - ~f:(fun s -> !current.vertical_tabs <- s) + ~f:(fun s -> !current.vertical_tabs <- s; !refresh_tabs_hook ()) "Vertical tabs" !current.vertical_tabs in let opposite_tabs = bool - ~f:(fun s -> !current.opposite_tabs <- s) + ~f:(fun s -> !current.opposite_tabs <- s; !refresh_tabs_hook ()) "Tabs on opposite side" !current.opposite_tabs in let encodings = combo "File charset encoding " - ~f:(fun s -> - match s with - | "UTF-8" -> - !current.encoding_use_utf8 <- true; - !current.encoding_use_locale <- false - | "LOCALE" -> - !current.encoding_use_utf8 <- false; - !current.encoding_use_locale <- true - | _ -> - !current.encoding_use_utf8 <- false; - !current.encoding_use_locale <- false; - !current.encoding_manual <- s; - ) + ~f:(fun s -> !current.encoding <- (inputenc_of_string s)) ~new_allowed: true - ["UTF-8";"LOCALE";!current.encoding_manual] - (if !current.encoding_use_utf8 then "UTF-8" - else if !current.encoding_use_locale then "LOCALE" else !current.encoding_manual) + ("UTF-8"::"LOCALE":: match !current.encoding with + |Emanual s -> [s] + |_ -> [] + ) + (string_of_inputenc !current.encoding) + in + let read_project = + combo + "Project file options are" + ~f:(fun s -> !current.read_project <- project_behavior_of_string s) + ~editable:false + [string_of_project_behavior Subst_args; + string_of_project_behavior Append_args; + string_of_project_behavior Ignore_args] + (string_of_project_behavior !current.read_project) + in + let project_file_name = + string "Default name for project file" + ~f:(fun s -> !current.project_file_name <- s) + !current.project_file_name in let help_string = "restart to apply" in + let the_valid_mod = str_to_mod_list !current.modifiers_valid in let modifier_for_tactics = modifiers - ~allow:!current.modifiers_valid - ~f:(fun l -> !current.modifier_for_tactics <- l) + ~allow:the_valid_mod + ~f:(fun l -> !current.modifier_for_tactics <- mod_list_to_str l) ~help:help_string "Modifiers for Tactics Menu" - !current.modifier_for_tactics + (str_to_mod_list !current.modifier_for_tactics) in let modifier_for_templates = modifiers - ~allow:!current.modifiers_valid - ~f:(fun l -> !current.modifier_for_templates <- l) + ~allow:the_valid_mod + ~f:(fun l -> !current.modifier_for_templates <- mod_list_to_str l) ~help:help_string "Modifiers for Templates Menu" - !current.modifier_for_templates + (str_to_mod_list !current.modifier_for_templates) in let modifier_for_navigation = modifiers - ~allow:!current.modifiers_valid - ~f:(fun l -> !current.modifier_for_navigation <- l) + ~allow:the_valid_mod + ~f:(fun l -> !current.modifier_for_navigation <- mod_list_to_str l) ~help:help_string "Modifiers for Navigation Menu" - !current.modifier_for_navigation + (str_to_mod_list !current.modifier_for_navigation) in let modifier_for_display = modifiers - ~allow:!current.modifiers_valid - ~f:(fun l -> !current.modifier_for_display <- l) + ~allow:the_valid_mod + ~f:(fun l -> !current.modifier_for_display <- mod_list_to_str l) ~help:help_string "Modifiers for Display Menu" - !current.modifier_for_display + (str_to_mod_list !current.modifier_for_display) in let modifiers_valid = modifiers - ~f:(fun l -> !current.modifiers_valid <- l) + ~f:(fun l -> !current.modifiers_valid <- mod_list_to_str l) "Allowed modifiers" - !current.modifiers_valid + the_valid_mod in let cmd_editor = let predefined = [ "emacs %s"; "vi %s"; "NOTEPAD %s" ] in @@ -520,8 +609,7 @@ let configure ?(apply=(fun () -> ())) () = "netscape -remote \"openURL(%s)\""; "mozilla -remote \"openURL(%s)\""; "firefox -remote \"openURL(%s,new-windows)\" || firefox %s &"; - "seamonkey -remote \"openURL(%s)\" || seamonkey %s &"; - "open -a Safari %s &" + "seamonkey -remote \"openURL(%s)\" || seamonkey %s &" ] in combo ~help:"(%s for url)" @@ -534,6 +622,8 @@ let configure ?(apply=(fun () -> ())) () = in let doc_url = let predefined = [ + "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"refman";""]); + Coq_config.wwwrefman; use_default_doc_url ] in combo @@ -545,11 +635,13 @@ let configure ?(apply=(fun () -> ())) () = !current.doc_url in let library_url = let predefined = [ + "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"stdlib";""]); Coq_config.wwwstdlib ] in combo "Library URL" ~f:(fun s -> !current.library_url <- s) + ~new_allowed: true (predefined@[if List.mem !current.library_url predefined then "" else !current.library_url]) !current.library_url @@ -567,43 +659,46 @@ let configure ?(apply=(fun () -> ())) () = bool ~f:(fun s -> !current.contextual_menus_on_goal <- s; - !contextual_menus_on_goal s) + !contextual_menus_on_goal_hook s) "Contextual menus on goal" !current.contextual_menus_on_goal in - let misc = [contextual_menus_on_goal;auto_complete;stop_before;lax_syntax; + let misc = [contextual_menus_on_goal;auto_complete;stop_before; vertical_tabs;opposite_tabs] in (* ATTENTION !!!!! L'onglet Fonts doit etre en premier pour eviter un bug !!!! (shame on Benjamin) *) let cmds = - [Section("Fonts", + [Section("Fonts", Some `SELECT_FONT, [config_font]); - Section("Files", + Section("Colors", Some `SELECT_COLOR, [config_color]); + Section("Files", Some `DIRECTORY, [global_auto_revert;global_auto_revert_delay; auto_save; auto_save_delay; (* auto_save_name*) encodings; ]); + Section("Project", Some (`STOCK "gtk-page-setup"), + [project_file_name;read_project; + ]); (* Section("Appearance", config_appearance); *) - Section("Externals", - [cmd_coqc;cmd_make;cmd_coqmakefile; cmd_coqdoc; cmd_print; - cmd_editor; - cmd_browse;doc_url;library_url]); - Section("Tactics Wizard", + Section("Externals", None, + [cmd_coqtop;cmd_coqc;cmd_make;cmd_coqmakefile; cmd_coqdoc; + cmd_print;cmd_editor;cmd_browse;doc_url;library_url]); + Section("Tactics Wizard", None, [automatic_tactics]); - Section("Shortcuts", + Section("Shortcuts", Some `PREFERENCES, [modifiers_valid; modifier_for_tactics; modifier_for_templates; modifier_for_display; modifier_for_navigation]); - Section("Misc", + Section("Misc", Some `ADD, misc)] in (* Format.printf "before edit: current.text_font = %s@." (Pango.Font.to_string !current.text_font); *) - let x = edit ~apply ~width:500 "Customizations" cmds in + let x = edit ~apply "Customizations" cmds in (* Format.printf "after edit: current.text_font = %s@." (Pango.Font.to_string !current.text_font); *) diff --git a/ide/preferences.mli b/ide/preferences.mli index 472ae30f..382aa091 100644 --- a/ide/preferences.mli +++ b/ide/preferences.mli @@ -1,15 +1,17 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: preferences.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) +type project_behavior = Ignore_args | Append_args | Subst_args +type inputenc = Elocale | Eutf8 | Emanual of string type pref = { + mutable cmd_coqtop : string option; mutable cmd_coqc : string; mutable cmd_make : string; mutable cmd_coqmakefile : string; @@ -22,18 +24,19 @@ type pref = mutable auto_save_delay : int; mutable auto_save_name : string * string; - mutable encoding_use_locale : bool; - mutable encoding_use_utf8 : bool; - mutable encoding_manual : string; + mutable read_project : project_behavior; + mutable project_file_name : string; + + mutable encoding : inputenc; mutable automatic_tactics : string list; mutable cmd_print : string; - mutable modifier_for_navigation : Gdk.Tags.modifier list; - mutable modifier_for_templates : Gdk.Tags.modifier list; - mutable modifier_for_tactics : Gdk.Tags.modifier list; - mutable modifier_for_display : Gdk.Tags.modifier list; - mutable modifiers_valid : Gdk.Tags.modifier list; + mutable modifier_for_navigation : string; + mutable modifier_for_templates : string; + mutable modifier_for_tactics : string; + mutable modifier_for_display : string; + mutable modifiers_valid : string; mutable cmd_browse : string; mutable cmd_editor : string; @@ -54,9 +57,12 @@ type pref = *) mutable auto_complete : bool; mutable stop_before : bool; - mutable lax_syntax : bool; mutable vertical_tabs : bool; mutable opposite_tabs : bool; + + mutable background_color : string; + mutable processing_color : string; + mutable processed_color : string; } val save_pref : unit -> unit @@ -66,9 +72,11 @@ val current : pref ref val configure : ?apply:(unit -> unit) -> unit -> unit -val change_font : ( Pango.font_description -> unit) ref -val show_toolbar : (bool -> unit) ref -val auto_complete : (bool -> unit) ref -val resize_window : (unit -> unit) ref +(* Hooks *) +val refresh_font_hook : (unit -> unit) ref +val refresh_background_color_hook : (unit -> unit) ref +val refresh_toolbar_hook : (unit -> unit) ref +val resize_window_hook : (unit -> unit) ref +val refresh_tabs_hook : (unit -> unit) ref val use_default_doc_url : string diff --git a/ide/project_file.ml4 b/ide/project_file.ml4 new file mode 100644 index 00000000..aa1189ce --- /dev/null +++ b/ide/project_file.ml4 @@ -0,0 +1,190 @@ +type target = + | ML of string (* ML file : foo.ml -> (ML "foo.ml") *) + | MLI of string (* MLI file : foo.mli -> (MLI "foo.mli") *) + | ML4 of string (* ML4 file : foo.ml4 -> (ML4 "foo.ml4") *) + | MLLIB of string (* MLLIB file : foo.mllib -> (MLLIB "foo.mllib") *) + | MLPACK of string (* MLLIB file : foo.mlpack -> (MLLIB "foo.mlpack") *) + | V of string (* V file : foo.v -> (V "foo") *) + | Arg of string + | Special of string * string * string (* file, dependencies, command *) + | Subdir of string + | Def of string * string (* X=foo -> Def ("X","foo") *) + | Include of string + | RInclude of string * string (* -R physicalpath logicalpath *) + +type install = + | NoInstall + | TraditionalInstall + | UserInstall + | UnspecInstall + +exception Parsing_error +let rec parse_string = parser + | [< '' ' | '\n' | '\t' >] -> "" + | [< 'c; s >] -> (String.make 1 c)^(parse_string s) + | [< >] -> "" +and parse_string2 = parser + | [< ''"' >] -> "" + | [< 'c; s >] -> (String.make 1 c)^(parse_string2 s) +and parse_skip_comment = parser + | [< ''\n'; s >] -> s + | [< 'c; s >] -> parse_skip_comment s + | [< >] -> [< >] +and parse_args = parser + | [< '' ' | '\n' | '\t'; s >] -> parse_args s + | [< ''#'; s >] -> parse_args (parse_skip_comment s) + | [< ''"'; str = parse_string2; s >] -> ("" ^ str) :: parse_args s + | [< 'c; str = parse_string; s >] -> ((String.make 1 c) ^ str) :: (parse_args s) + | [< >] -> [] + + +let parse f = + let c = open_in f in + let res = parse_args (Stream.of_channel c) in + close_in c; + res + +let rec process_cmd_line orig_dir ((project_file,makefile,install,opt) as opts) l = function + | [] -> opts,List.rev l + | ("-h"|"--help") :: _ -> + raise Parsing_error + | ("-no-opt"|"-byte") :: r -> + process_cmd_line orig_dir (project_file,makefile,install,false) l r + | ("-full"|"-opt") :: r -> + process_cmd_line orig_dir (project_file,makefile,install,true) l r + | "-impredicative-set" :: r -> + Minilib.safe_prerr_endline "Please now use \"-arg -impredicative-set\" instead of \"-impredicative-set\" alone to be more uniform."; + process_cmd_line orig_dir opts (Arg "-impredicative-set" :: l) r + | "-no-install" :: r -> + Minilib.safe_prerr_endline "Option -no-install is deprecated. Use \"-install none\" instead"; + process_cmd_line orig_dir (project_file,makefile,NoInstall,opt) l r + | "-install" :: d :: r -> + if install <> UnspecInstall then Minilib.safe_prerr_endline "Warning: -install sets more than once."; + let install = + match d with + | "user" -> UserInstall + | "none" -> NoInstall + | "global" -> TraditionalInstall + | _ -> Minilib.safe_prerr_endline (String.concat "" ["Warning: invalid option '"; d; "' passed to -install."]); + install + in + process_cmd_line orig_dir (project_file,makefile,install,opt) l r + | "-custom" :: com :: dependencies :: file :: r -> + process_cmd_line orig_dir opts (Special (file,dependencies,com) :: l) r + | "-I" :: d :: r -> + process_cmd_line orig_dir opts ((Include (Minilib.correct_path d orig_dir)) :: l) r + | "-R" :: p :: lp :: r -> + process_cmd_line orig_dir opts (RInclude (Minilib.correct_path p orig_dir,lp) :: l) r + | ("-I"|"-custom") :: _ -> + raise Parsing_error + | "-f" :: file :: r -> + let file = Minilib.remove_path_dot (Minilib.correct_path file orig_dir) in + let () = match project_file with + | None -> () + | Some _ -> Minilib.safe_prerr_endline + "Warning: Several features will not work with multiple project files." + in + let (opts',l') = process_cmd_line (Filename.dirname file) (Some file,makefile,install,opt) l (parse file) in + process_cmd_line orig_dir opts' l' r + | ["-f"] -> + raise Parsing_error + | "-o" :: file :: r -> + begin try + let _ = String.index file '/' in + raise Parsing_error + with Not_found -> + let () = match makefile with + |None -> () + |Some f -> + Minilib.safe_prerr_endline ("Warning: Only one output file is genererated. "^f^" will not be.") + in process_cmd_line orig_dir (project_file,Some file,install,opt) l r + end + | v :: "=" :: def :: r -> + process_cmd_line orig_dir opts (Def (v,def) :: l) r + | "-arg" :: a :: r -> + process_cmd_line orig_dir opts (Arg a :: l) r + | f :: r -> + let f = Minilib.correct_path f orig_dir in + process_cmd_line orig_dir opts (( + if Filename.check_suffix f ".v" then V f + else if (Filename.check_suffix f ".ml") then ML f + else if (Filename.check_suffix f ".ml4") then ML4 f + else if (Filename.check_suffix f ".mli") then MLI f + else if (Filename.check_suffix f ".mllib") then MLLIB f + else if (Filename.check_suffix f ".mlpack") then MLPACK f + else Subdir f) :: l) r + +let rec post_canonize f = + if Filename.basename f = Filename.current_dir_name + then let dir = Filename.dirname f in + if dir = Filename.current_dir_name then f else post_canonize dir + else f + +(* Return: ((v,(mli,ml4,ml,mllib,mlpack),special,subdir),(i_inc,r_inc),(args,defs)) *) +let split_arguments = + let rec aux = function + | V n :: r -> + let (v,m,o,s),i,d = aux r in ((Minilib.remove_path_dot n::v,m,o,s),i,d) + | ML n :: r -> + let (v,(mli,ml4,ml,mllib,mlpack),o,s),i,d = aux r in + ((v,(mli,ml4,Minilib.remove_path_dot n::ml,mllib,mlpack),o,s),i,d) + | MLI n :: r -> + let (v,(mli,ml4,ml,mllib,mlpack),o,s),i,d = aux r in + ((v,(Minilib.remove_path_dot n::mli,ml4,ml,mllib,mlpack),o,s),i,d) + | ML4 n :: r -> + let (v,(mli,ml4,ml,mllib,mlpack),o,s),i,d = aux r in + ((v,(mli,Minilib.remove_path_dot n::ml4,ml,mllib,mlpack),o,s),i,d) + | MLLIB n :: r -> + let (v,(mli,ml4,ml,mllib,mlpack),o,s),i,d = aux r in + ((v,(mli,ml4,ml,Minilib.remove_path_dot n::mllib,mlpack),o,s),i,d) + | MLPACK n :: r -> + let (v,(mli,ml4,ml,mllib,mlpack),o,s),i,d = aux r in + ((v,(mli,ml4,ml,mllib,Minilib.remove_path_dot n::mlpack),o,s),i,d) + | Special (n,dep,c) :: r -> + let (v,m,o,s),i,d = aux r in ((v,m,(n,dep,c)::o,s),i,d) + | Subdir n :: r -> + let (v,m,o,s),i,d = aux r in ((v,m,o,n::s),i,d) + | Include p :: r -> + let t,(i,r),d = aux r in (t,((Minilib.remove_path_dot (post_canonize p), + Minilib.canonical_path_name p)::i,r),d) + | RInclude (p,l) :: r -> + let t,(i,r),d = aux r in (t,(i,(Minilib.remove_path_dot (post_canonize p),l, + Minilib.canonical_path_name p)::r),d) + | Def (v,def) :: r -> + let t,i,(args,defs) = aux r in (t,i,(args,(v,def)::defs)) + | Arg a :: r -> + let t,i,(args,defs) = aux r in (t,i,(a::args,defs)) + | [] -> ([],([],[],[],[],[]),[],[]),([],[]),([],[]) + in aux + +let read_project_file f = + split_arguments + (snd (process_cmd_line (Filename.dirname f) (Some f, None, NoInstall, true) [] (parse f))) + +let args_from_project file project_files default_name = + let is_f = Minilib.same_file file in + let contains_file dir = + List.exists (fun x -> is_f (Minilib.correct_path x dir)) + in + let build_cmd_line i_inc r_inc args = + List.fold_right (fun (_,i) o -> "-I" :: i :: o) i_inc + (List.fold_right (fun (_,l,p) o -> "-R" :: p :: l :: o) r_inc + (List.fold_right (fun a o -> parse_args (Stream.of_string a) @ o) args [])) + in try + let (_,(_,(i_inc,r_inc),(args,_))) = + List.find (fun (dir,((v_files,_,_,_),_,_)) -> + contains_file dir v_files) project_files in + build_cmd_line i_inc r_inc args + with Not_found -> + let rec find_project_file dir = try + let ((v_files,_,_,_),(i_inc,r_inc),(args,_)) = + read_project_file (Filename.concat dir default_name) in + if contains_file dir v_files + then build_cmd_line i_inc r_inc args + else let newdir = Filename.dirname dir in + Minilib.safe_prerr_endline newdir; + if dir = newdir then [] else find_project_file newdir + with Sys_error s -> + let newdir = Filename.dirname dir in + if dir = newdir then [] else find_project_file newdir + in find_project_file (Filename.dirname file) diff --git a/ide/tags.ml b/ide/tags.ml index aacac46e..7b67944b 100644 --- a/ide/tags.ml +++ b/ide/tags.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id$ *) - let make_tag (tt:GText.tag_table) ~name prop = let new_tag = GText.tag ~name () in @@ -15,6 +13,9 @@ let make_tag (tt:GText.tag_table) ~name prop = tt#add new_tag#as_tag; new_tag +let processed_color = ref "light green" +let processing_color = ref "light blue" + module Script = struct let table = GText.tag_table () @@ -25,19 +26,19 @@ struct let comment = make_tag table ~name:"comment" [`FOREGROUND "brown"] let reserved = make_tag table ~name:"reserved" [`FOREGROUND "dark red"] let error = make_tag table ~name:"error" [`UNDERLINE `DOUBLE ; `FOREGROUND "red"] - let to_process = make_tag table ~name:"to_process" [`BACKGROUND "light blue" ;`EDITABLE false] - let processed = make_tag table ~name:"processed" [`BACKGROUND "light green" ;`EDITABLE false] + let to_process = make_tag table ~name:"to_process" [`BACKGROUND !processing_color ;`EDITABLE false] + let processed = make_tag table ~name:"processed" [`BACKGROUND !processed_color;`EDITABLE false] let unjustified = make_tag table ~name:"unjustified" [`UNDERLINE `SINGLE; `FOREGROUND "red"; `BACKGROUND "gold";`EDITABLE false] let found = make_tag table ~name:"found" [`BACKGROUND "blue"; `FOREGROUND "white"] let hidden = make_tag table ~name:"hidden" [`INVISIBLE true; `EDITABLE false] let folded = make_tag table ~name:"locked" [`EDITABLE false; `BACKGROUND "light grey"] let paren = make_tag table ~name:"paren" [`BACKGROUND "purple"] - let lax_end = make_tag table ~name:"sentence_end" [] + let sentence = make_tag table ~name:"sentence" [] end module Proof = struct let table = GText.tag_table () - let highlight = make_tag table ~name:"highlight" [`BACKGROUND "light green"] + let highlight = make_tag table ~name:"highlight" [`BACKGROUND !processed_color] let hypothesis = make_tag table ~name:"hypothesis" [] let goal = make_tag table ~name:"goal" [] end @@ -47,3 +48,27 @@ struct let error = make_tag table ~name:"error" [`FOREGROUND "red"] end +let string_of_color clr = + let r = Gdk.Color.red clr in + let g = Gdk.Color.green clr in + let b = Gdk.Color.blue clr in + Printf.sprintf "#%04X%04X%04X" r g b + +let color_of_string s = + let colormap = Gdk.Color.get_system_colormap () in + Gdk.Color.alloc ~colormap (`NAME s) + +let get_processed_color () = color_of_string !processed_color + +let set_processed_color clr = + let s = string_of_color clr in + processed_color := s; + Script.processed#set_property (`BACKGROUND s); + Proof.highlight#set_property (`BACKGROUND s) + +let get_processing_color () = color_of_string !processing_color + +let set_processing_color clr = + let s = string_of_color clr in + processing_color := s; + Script.to_process#set_property (`BACKGROUND s) diff --git a/ide/tags.mli b/ide/tags.mli new file mode 100644 index 00000000..36f18a2f --- /dev/null +++ b/ide/tags.mli @@ -0,0 +1,50 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +module Script : +sig + val table : GText.tag_table + val kwd : GText.tag + val qed : GText.tag + val decl : GText.tag + val proof_decl : GText.tag + val comment : GText.tag + val reserved : GText.tag + val error : GText.tag + val to_process : GText.tag + val processed : GText.tag + val unjustified : GText.tag + val found : GText.tag + val hidden : GText.tag + val folded : GText.tag + val paren : GText.tag + val sentence : GText.tag +end + +module Proof : +sig + val table : GText.tag_table + val highlight : GText.tag + val hypothesis : GText.tag + val goal : GText.tag +end + +module Message : +sig + val table : GText.tag_table + val error : GText.tag +end + +val string_of_color : Gdk.color -> string +val color_of_string : string -> Gdk.color + +val get_processed_color : unit -> Gdk.color +val set_processed_color : Gdk.color -> unit + +val get_processing_color : unit -> Gdk.color +val set_processing_color : Gdk.color -> unit diff --git a/ide/typed_notebook.ml b/ide/typed_notebook.ml index 3dd2279f..60c89eb1 100644 --- a/ide/typed_notebook.ml +++ b/ide/typed_notebook.ml @@ -1,68 +1,67 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: coqide.ml 11952 2009-03-02 15:29:08Z vgross $ *) - -class ['a] typed_notebook default_build nb = +class ['a] typed_notebook make_page kill_page nb = object(self) inherit GPack.notebook nb as super val mutable term_list = [] - method append_term ?(build=default_build) (term:'a) = - let tab_label,menu_label,page = build term in + method append_term (term:'a) = + let tab_label,menu_label,page = make_page term in (* XXX - Temporary hack to compile with archaic lablgtk *) ignore (super#append_page ?tab_label ?menu_label page); let real_pos = super#page_num page in - let lower,higher = Util.list_split_at real_pos term_list in + let lower,higher = Minilib.list_chop real_pos term_list in term_list <- lower@[term]@higher; real_pos (* XXX - Temporary hack to compile with archaic lablgtk method insert_term ?(build=default_build) ?pos (term:'a) = let tab_label,menu_label,page = build term in let real_pos = super#insert_page ?tab_label ?menu_label ?pos page in - let lower,higher = Util.list_split_at real_pos term_list in + let lower,higher = Minilib.list_chop real_pos term_list in term_list <- lower@[term]@higher; real_pos *) - method prepend_term ?(build=default_build) (term:'a) = - let tab_label,menu_label,page = build term in + method prepend_term (term:'a) = + let tab_label,menu_label,page = make_page term in (* XXX - Temporary hack to compile with archaic lablgtk *) ignore (super#prepend_page ?tab_label ?menu_label page); let real_pos = super#page_num page in - let lower,higher = Util.list_split_at real_pos term_list in + let lower,higher = Minilib.list_chop real_pos term_list in term_list <- lower@[term]@higher; real_pos - method set_term ?(build=default_build) (term:'a) = - let tab_label,menu_label,page = build term in + method set_term (term:'a) = + let tab_label,menu_label,page = make_page term in let real_pos = super#current_page in - term_list <- Util.list_map_i (fun i x -> if i = real_pos then term else x) 0 term_list; + term_list <- Minilib.list_map_i (fun i x -> if i = real_pos then term else x) 0 term_list; super#set_page ?tab_label ?menu_label page - method remove_page index = - term_list <- Util.list_filter_i (fun i x -> i <> index) term_list; - super#remove_page index - method get_nth_term i = List.nth term_list i method term_num p = - Util.list_index0 p term_list + Minilib.list_index0 p term_list method pages = term_list - method current_term = List.nth term_list super#current_page + method remove_page index = + term_list <- Minilib.list_filter_i (fun i x -> if i = index then kill_page x; i <> index) term_list; + super#remove_page index + + method current_term = + List.nth term_list super#current_page end -let create build = +let create make kill = GtkPack.Notebook.make_params [] ~cont:(GContainer.pack_container ~create:(fun pl -> let nb = GtkPack.Notebook.create pl in - (new typed_notebook build nb))) + (new typed_notebook make kill nb))) diff --git a/ide/uim/coqide-custom.scm b/ide/uim/coqide-custom.scm deleted file mode 100644 index 622f5063..00000000 --- a/ide/uim/coqide-custom.scm +++ /dev/null @@ -1,99 +0,0 @@ -;;; coqide-custom.scm -- customization variables for coqide.scm -;;; -;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/ -;;; -;;; All rights reserved. -;;; -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: -;;; 1. Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. -;;; 2. Redistributions in binary form must reproduce the above copyright -;;; notice, this list of conditions and the following disclaimer in the -;;; documentation and/or other materials provided with the distribution. -;;; 3. Neither the name of authors nor the names of its contributors -;;; may be used to endorse or promote products derived from this software -;;; without specific prior written permission. -;;; -;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND -;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE -;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -;;; SUCH DAMAGE. -;;;; - -(require "i18n.scm") - -(define coqide-im-name-label (N_ "CoqIDE")) -(define coqide-im-short-desc (N_ "Emacs-style Latin characters input")) -(define coqide-im-long-desc (N_ "An input method for entering Latin letters used in European languages with the key translations adopted in Emacs.")) - -(define-custom-group 'coqide - coqide-im-name-label - coqide-im-short-desc) - -(define-custom-group 'coqide-properties - (N_ "Properties") - (N_ "long description will be here.")) - -(define-custom 'coqide-rules 'coqide-rules-latin-ltx - '(coqide coqide-properties) - (list 'choice - (list 'coqide-rules-latin-ltx - (N_ "TeX") - (N_ "long description will be here."))) - (N_ "Latin characters keyboard layout") - (N_ "long description will be here.")) - -(custom-add-hook 'coqide-rules - 'custom-set-hooks - (lambda () - (map (lambda (lc) - (let ((new-rkc (rk-context-new - (symbol-value coqide-rules) #f #f))) - (coqide-context-flush lc) - (coqide-update-preedit lc) - (coqide-context-set-rkc! lc new-rkc))) - coqide-context-list))) - -;; For VI users. -(define-custom 'coqide-esc-turns-off? #f - '(coqide coqide-properties) - '(boolean) - (N_ "ESC turns off composition mode (for vi users)") - (N_ "long description will be here.")) - - -(define-custom-group 'coqide-keys - (N_ "CoqIDE key bindings") - (N_ "long description will be here.")) - -(define-custom 'coqide-on-key '("<Control>\\") - '(coqide coqide-keys) - '(key) - (N_ "CoqIDE on") - (N_ "long description will be here")) - -(define-custom 'coqide-off-key '("<Control>\\") - '(coqide coqide-keys) - '(key) - (N_ "CoqIDE off") - (N_ "long description will be here")) - -(define-custom 'coqide-backspace-key '(generic-backspace-key) - '(coqide coqide-keys) - '(key) - (N_ "CoqIDE backspace") - (N_ "long description will be here")) - -;; Local Variables: -;; mode: scheme -;; coding: utf-8 -;; End: diff --git a/ide/uim/coqide-rules.scm b/ide/uim/coqide-rules.scm deleted file mode 100644 index af25b613..00000000 --- a/ide/uim/coqide-rules.scm +++ /dev/null @@ -1,1142 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; v ; The Coq Proof Assistant / The Coq Development Team ;; -;; <O___,, ; INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 ;; -;; \VV/ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; // ; This file is distributed under the terms of the ;; -;; ; GNU Lesser General Public License Version 2.1 ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; coqide-rules.scm -- key sequence tables for coqide.scm - -;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/ -;; -;; All rights reserved. - -;; The translation tables in this file were derived from -;; the emacs-lisp source files latin-pre.el, latin-post.el, latin-alt.el -;; included in GNU Emacs. The following is the original copyright notice -;; therein, with the name GNU Emacs replaced by "this program". - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 -;; Free Software Foundation, Inc. -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 -;; National Institute of Advanced Industrial Science and Technology (AIST) -;; Registration Number H14PRO021 - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Key translation maps were originally copied from iso-acc.el. -;; latin-1-prefix: extra special characters added, adapted from the vim -;; digraphs (from J.H.M.Dassen <jdassen@wi.leidenuniv.nl>) -;; by R.F. Smith <rsmith@xs4all.nl> -;; -;; polish-slash: -;; Author: Włodek Bzyl <matwb@univ.gda.pl> -;; Maintainer: Włodek Bzyl <matwb@univ.gda.pl> -;; -;; latin-[89]-prefix: Dave Love <fx@gnu.org> - -(define coqide-rules-latin-ltx '( -((("!" "`")) ("¡")) -((("\\" "p" "o" "u" "n" "d" "s")) ("£")) -((("\\" "S")) ("§")) -((("\\" "\"" "{" "}")) ("¨")) -((("\\" "c" "o" "p" "y" "r" "i" "g" "h" "t")) ("©")) -((("$" "^" "a" "$")) ("ª")) -((("\\" "=" "{" "}")) ("¯")) -((("$" "\\" "p" "m" "$")) ("±")) -((("\\" "p" "m")) ("±")) -((("$" "^" "2" "$")) ("²")) -((("$" "^" "3" "$")) ("³")) -((("\\" "'" "{" "}")) ("´")) -((("\\" "P")) ("¶")) -((("$" "\\" "c" "d" "o" "t" "$")) ("·")) -((("\\" "c" "d" "o" "t")) ("·")) -((("\\" "c" "{" "}")) ("¸")) -((("$" "^" "1" "$")) ("¹")) -((("$" "^" "o" "$")) ("º")) -((("?" "`")) ("¿")) -((("\\" "`" "{" "A" "}")) ("À")) -((("\\" "`" "A")) ("À")) -((("\\" "'" "{" "A" "}")) ("Á")) -((("\\" "'" "A")) ("Á")) -((("\\" "^" "{" "A" "}")) ("Â")) -((("\\" "^" "A")) ("Â")) -((("\\" "~" "{" "A" "}")) ("Ã")) -((("\\" "~" "A")) ("Ã")) -((("\\" "\"" "{" "A" "}")) ("Ä")) -((("\\" "\"" "A")) ("Ä")) -((("\\" "k" "{" "A" "}")) ("Ą")) -((("\\" "A" "A")) ("Å")) -((("\\" "A" "E")) ("Æ")) -((("\\" "c" "{" "C" "}")) ("Ç")) -((("\\" "c" "C")) ("Ç")) -((("\\" "`" "{" "E" "}")) ("È")) -((("\\" "`" "E")) ("È")) -((("\\" "'" "{" "E" "}")) ("É")) -((("\\" "'" "E")) ("É")) -((("\\" "^" "{" "E" "}")) ("Ê")) -((("\\" "^" "E")) ("Ê")) -((("\\" "\"" "{" "E" "}")) ("Ë")) -((("\\" "\"" "E")) ("Ë")) -((("\\" "k" "{" "E" "}")) ("Ę")) -((("\\" "`" "{" "I" "}")) ("Ì")) -((("\\" "`" "I")) ("Ì")) -((("\\" "'" "{" "I" "}")) ("Í")) -((("\\" "'" "I")) ("Í")) -((("\\" "^" "{" "I" "}")) ("Î")) -((("\\" "^" "I")) ("Î")) -((("\\" "\"" "{" "I" "}")) ("Ï")) -((("\\" "\"" "I")) ("Ï")) -((("\\" "k" "{" "I" "}")) ("Į")) -((("\\" "~" "{" "N" "}")) ("Ñ")) -((("\\" "~" "N")) ("Ñ")) -((("\\" "`" "{" "O" "}")) ("Ò")) -((("\\" "`" "O")) ("Ò")) -((("\\" "'" "{" "O" "}")) ("Ó")) -((("\\" "'" "O")) ("Ó")) -((("\\" "^" "{" "O" "}")) ("Ô")) -((("\\" "^" "O")) ("Ô")) -((("\\" "~" "{" "O" "}")) ("Õ")) -((("\\" "~" "O")) ("Õ")) -((("\\" "\"" "{" "O" "}")) ("Ö")) -((("\\" "\"" "O")) ("Ö")) -((("\\" "k" "{" "O" "}")) ("Ǫ")) -((("$" "\\" "t" "i" "m" "e" "s" "$")) ("×")) -((("\\" "t" "i" "m" "e" "s")) ("×")) -((("\\" "O")) ("Ø")) -((("\\" "`" "{" "U" "}")) ("Ù")) -((("\\" "`" "U")) ("Ù")) -((("\\" "'" "{" "U" "}")) ("Ú")) -((("\\" "'" "U")) ("Ú")) -((("\\" "^" "{" "U" "}")) ("Û")) -((("\\" "^" "U")) ("Û")) -((("\\" "\"" "{" "U" "}")) ("Ü")) -((("\\" "\"" "U")) ("Ü")) -((("\\" "k" "{" "U" "}")) ("Ų")) -((("\\" "'" "{" "Y" "}")) ("Ý")) -((("\\" "'" "Y")) ("Ý")) -((("\\" "s" "s")) ("ß")) -((("\\" "`" "{" "a" "}")) ("à")) -((("\\" "`" "a")) ("à")) -((("\\" "'" "{" "a" "}")) ("á")) -((("\\" "'" "a")) ("á")) -((("\\" "^" "{" "a" "}")) ("â")) -((("\\" "^" "a")) ("â")) -((("\\" "~" "{" "a" "}")) ("ã")) -((("\\" "~" "a")) ("ã")) -((("\\" "\"" "{" "a" "}")) ("ä")) -((("\\" "\"" "a")) ("ä")) -((("\\" "k" "{" "a" "}")) ("ą")) -((("\\" "a" "a")) ("å")) -((("\\" "a" "e")) ("æ")) -((("\\" "c" "{" "c" "}")) ("ç")) -((("\\" "c" "c")) ("ç")) -((("\\" "`" "{" "e" "}")) ("è")) -((("\\" "`" "e")) ("è")) -((("\\" "'" "{" "e" "}")) ("é")) -((("\\" "'" "e")) ("é")) -((("\\" "^" "{" "e" "}")) ("ê")) -((("\\" "^" "e")) ("ê")) -((("\\" "\"" "{" "e" "}")) ("ë")) -((("\\" "\"" "e")) ("ë")) -((("\\" "k" "{" "e" "}")) ("ę")) -((("\\" "`" "{" "\\" "i" "}")) ("ì")) -((("\\" "`" "i")) ("ì")) -((("\\" "'" "{" "\\" "i" "}")) ("í")) -((("\\" "'" "i")) ("í")) -((("\\" "^" "{" "\\" "i" "}")) ("î")) -((("\\" "^" "i")) ("î")) -((("\\" "\"" "{" "\\" "i" "}")) ("ï")) -((("\\" "\"" "i")) ("ï")) -((("\\" "k" "{" "i" "}")) ("į")) -((("\\" "~" "{" "n" "}")) ("ñ")) -((("\\" "~" "n")) ("ñ")) -((("\\" "`" "{" "o" "}")) ("ò")) -((("\\" "`" "o")) ("ò")) -((("\\" "'" "{" "o" "}")) ("ó")) -((("\\" "'" "o")) ("ó")) -((("\\" "^" "{" "o" "}")) ("ô")) -((("\\" "^" "o")) ("ô")) -((("\\" "~" "{" "o" "}")) ("õ")) -((("\\" "~" "o")) ("õ")) -((("\\" "\"" "{" "o" "}")) ("ö")) -((("\\" "\"" "o")) ("ö")) -((("\\" "k" "{" "o" "}")) ("ǫ")) -((("$" "\\" "d" "i" "v" "$")) ("÷")) -((("\\" "d" "i" "v")) ("÷")) -((("\\" "o")) ("ø")) -((("\\" "`" "{" "u" "}")) ("ù")) -((("\\" "`" "u")) ("ù")) -((("\\" "'" "{" "u" "}")) ("ú")) -((("\\" "'" "u")) ("ú")) -((("\\" "^" "{" "u" "}")) ("û")) -((("\\" "^" "u")) ("û")) -((("\\" "\"" "{" "u" "}")) ("ü")) -((("\\" "\"" "u")) ("ü")) -((("\\" "k" "{" "u" "}")) ("ų")) -((("\\" "'" "{" "y" "}")) ("ý")) -((("\\" "'" "y")) ("ý")) -((("\\" "\"" "{" "y" "}")) ("ÿ")) -((("\\" "\"" "y")) ("ÿ")) -((("\\" "=" "{" "A" "}")) ("Ā")) -((("\\" "=" "A")) ("Ā")) -((("\\" "=" "{" "a" "}")) ("ā")) -((("\\" "=" "a")) ("ā")) -((("\\" "u" "{" "A" "}")) ("Ă")) -((("\\" "u" "A")) ("Ă")) -((("\\" "u" "{" "a" "}")) ("ă")) -((("\\" "u" "a")) ("ă")) -((("\\" "'" "{" "C" "}")) ("Ć")) -((("\\" "'" "C")) ("Ć")) -((("\\" "'" "{" "c" "}")) ("ć")) -((("\\" "'" "c")) ("ć")) -((("\\" "^" "{" "C" "}")) ("Ĉ")) -((("\\" "^" "C")) ("Ĉ")) -((("\\" "^" "{" "c" "}")) ("ĉ")) -((("\\" "^" "c")) ("ĉ")) -((("\\" "." "{" "C" "}")) ("Ċ")) -((("\\" "." "C")) ("Ċ")) -((("\\" "." "{" "c" "}")) ("ċ")) -((("\\" "." "c")) ("ċ")) -((("\\" "v" "{" "C" "}")) ("Č")) -((("\\" "v" "C")) ("Č")) -((("\\" "v" "{" "c" "}")) ("č")) -((("\\" "v" "c")) ("č")) -((("\\" "v" "{" "D" "}")) ("Ď")) -((("\\" "v" "D")) ("Ď")) -((("\\" "v" "{" "d" "}")) ("ď")) -((("\\" "v" "d")) ("ď")) -((("\\" "=" "{" "E" "}")) ("Ē")) -((("\\" "=" "E")) ("Ē")) -((("\\" "=" "{" "e" "}")) ("ē")) -((("\\" "=" "e")) ("ē")) -((("\\" "u" "{" "E" "}")) ("Ĕ")) -((("\\" "u" "E")) ("Ĕ")) -((("\\" "u" "{" "e" "}")) ("ĕ")) -((("\\" "u" "e")) ("ĕ")) -((("\\" "." "{" "E" "}")) ("Ė")) -((("\\" "." "E")) ("Ė")) -((("\\" "e" "{" "e" "}")) ("ė")) -((("\\" "e" "e")) ("ė")) -((("\\" "v" "{" "E" "}")) ("Ě")) -((("\\" "v" "E")) ("Ě")) -((("\\" "v" "{" "e" "}")) ("ě")) -((("\\" "v" "e")) ("ě")) -((("\\" "^" "{" "G" "}")) ("Ĝ")) -((("\\" "^" "G")) ("Ĝ")) -((("\\" "^" "{" "g" "}")) ("ĝ")) -((("\\" "^" "g")) ("ĝ")) -((("\\" "u" "{" "G" "}")) ("Ğ")) -((("\\" "u" "G")) ("Ğ")) -((("\\" "u" "{" "g" "}")) ("ğ")) -((("\\" "u" "g")) ("ğ")) -((("\\" "." "{" "G" "}")) ("Ġ")) -((("\\" "." "G")) ("Ġ")) -((("\\" "." "{" "g" "}")) ("ġ")) -((("\\" "." "g")) ("ġ")) -((("\\" "c" "{" "G" "}")) ("Ģ")) -((("\\" "c" "G")) ("Ģ")) -((("\\" "c" "{" "g" "}")) ("ģ")) -((("\\" "c" "g")) ("ģ")) -((("\\" "^" "{" "H" "}")) ("Ĥ")) -((("\\" "^" "H")) ("Ĥ")) -((("\\" "^" "{" "h" "}")) ("ĥ")) -((("\\" "^" "h")) ("ĥ")) -((("\\" "~" "{" "I" "}")) ("Ĩ")) -((("\\" "~" "I")) ("Ĩ")) -((("\\" "~" "{" "\\" "i" "}")) ("ĩ")) -((("\\" "~" "i")) ("ĩ")) -((("\\" "=" "{" "I" "}")) ("Ī")) -((("\\" "=" "I")) ("Ī")) -((("\\" "=" "{" "\\" "i" "}")) ("ī")) -((("\\" "=" "i")) ("ī")) -((("\\" "u" "{" "I" "}")) ("Ĭ")) -((("\\" "u" "I")) ("Ĭ")) -((("\\" "u" "{" "\\" "i" "}")) ("ĭ")) -((("\\" "u" "i")) ("ĭ")) -((("\\" "." "{" "I" "}")) ("İ")) -((("\\" "." "I")) ("İ")) -((("\\" "i")) ("ı")) -((("\\" "^" "{" "J" "}")) ("Ĵ")) -((("\\" "^" "J")) ("Ĵ")) -((("\\" "^" "{" "\\" "j" "}")) ("ĵ")) -((("\\" "^" "j")) ("ĵ")) -((("\\" "c" "{" "K" "}")) ("Ķ")) -((("\\" "c" "K")) ("Ķ")) -((("\\" "c" "{" "k" "}")) ("ķ")) -((("\\" "c" "k")) ("ķ")) -((("\\" "'" "{" "L" "}")) ("Ĺ")) -((("\\" "'" "L")) ("Ĺ")) -((("\\" "'" "{" "l" "}")) ("ĺ")) -((("\\" "'" "l")) ("ĺ")) -((("\\" "c" "{" "L" "}")) ("Ļ")) -((("\\" "c" "L")) ("Ļ")) -((("\\" "c" "{" "l" "}")) ("ļ")) -((("\\" "c" "l")) ("ļ")) -((("\\" "L")) ("Ł")) -((("\\" "l")) ("ł")) -((("\\" "'" "{" "N" "}")) ("Ń")) -((("\\" "'" "N")) ("Ń")) -((("\\" "'" "{" "n" "}")) ("ń")) -((("\\" "'" "n")) ("ń")) -((("\\" "c" "{" "N" "}")) ("Ņ")) -((("\\" "c" "N")) ("Ņ")) -((("\\" "c" "{" "n" "}")) ("ņ")) -((("\\" "c" "n")) ("ņ")) -((("\\" "v" "{" "N" "}")) ("Ň")) -((("\\" "v" "N")) ("Ň")) -((("\\" "v" "{" "n" "}")) ("ň")) -((("\\" "v" "n")) ("ň")) -((("\\" "=" "{" "O" "}")) ("Ō")) -((("\\" "=" "O")) ("Ō")) -((("\\" "=" "{" "o" "}")) ("ō")) -((("\\" "=" "o")) ("ō")) -((("\\" "u" "{" "O" "}")) ("Ŏ")) -((("\\" "u" "O")) ("Ŏ")) -((("\\" "u" "{" "o" "}")) ("ŏ")) -((("\\" "u" "o")) ("ŏ")) -((("\\" "H" "{" "O" "}")) ("Ő")) -((("\\" "H" "O")) ("Ő")) -((("\\" "U" "{" "o" "}")) ("ő")) -((("\\" "U" "o")) ("ő")) -((("\\" "O" "E")) ("Œ")) -((("\\" "o" "e")) ("œ")) -((("\\" "'" "{" "R" "}")) ("Ŕ")) -((("\\" "'" "R")) ("Ŕ")) -((("\\" "'" "{" "r" "}")) ("ŕ")) -((("\\" "'" "r")) ("ŕ")) -((("\\" "c" "{" "R" "}")) ("Ŗ")) -((("\\" "c" "R")) ("Ŗ")) -((("\\" "c" "{" "r" "}")) ("ŗ")) -((("\\" "c" "r")) ("ŗ")) -((("\\" "v" "{" "R" "}")) ("Ř")) -((("\\" "v" "R")) ("Ř")) -((("\\" "v" "{" "r" "}")) ("ř")) -((("\\" "v" "r")) ("ř")) -((("\\" "'" "{" "S" "}")) ("Ś")) -((("\\" "'" "S")) ("Ś")) -((("\\" "'" "{" "s" "}")) ("ś")) -((("\\" "'" "s")) ("ś")) -((("\\" "^" "{" "S" "}")) ("Ŝ")) -((("\\" "^" "S")) ("Ŝ")) -((("\\" "^" "{" "s" "}")) ("ŝ")) -((("\\" "^" "s")) ("ŝ")) -((("\\" "c" "{" "S" "}")) ("Ş")) -((("\\" "c" "S")) ("Ş")) -((("\\" "c" "{" "s" "}")) ("ş")) -((("\\" "c" "s")) ("ş")) -((("\\" "v" "{" "S" "}")) ("Š")) -((("\\" "v" "S")) ("Š")) -((("\\" "v" "{" "s" "}")) ("š")) -((("\\" "v" "s")) ("š")) -((("\\" "c" "{" "T" "}")) ("Ţ")) -((("\\" "c" "T")) ("Ţ")) -((("\\" "c" "{" "t" "}")) ("ţ")) -((("\\" "c" "t")) ("ţ")) -((("\\" "v" "{" "T" "}")) ("Ť")) -((("\\" "v" "T")) ("Ť")) -((("\\" "v" "{" "t" "}")) ("ť")) -((("\\" "v" "t")) ("ť")) -((("\\" "~" "{" "U" "}")) ("Ũ")) -((("\\" "~" "U")) ("Ũ")) -((("\\" "~" "{" "u" "}")) ("ũ")) -((("\\" "~" "u")) ("ũ")) -((("\\" "=" "{" "U" "}")) ("Ū")) -((("\\" "=" "U")) ("Ū")) -((("\\" "=" "{" "u" "}")) ("ū")) -((("\\" "=" "u")) ("ū")) -((("\\" "u" "{" "U" "}")) ("Ŭ")) -((("\\" "u" "U")) ("Ŭ")) -((("\\" "u" "{" "u" "}")) ("ŭ")) -((("\\" "u" "u")) ("ŭ")) -((("\\" "H" "{" "U" "}")) ("Ű")) -((("\\" "H" "U")) ("Ű")) -((("\\" "H" "{" "u" "}")) ("ű")) -((("\\" "H" "u")) ("ű")) -((("\\" "^" "{" "W" "}")) ("Ŵ")) -((("\\" "^" "W")) ("Ŵ")) -((("\\" "^" "{" "w" "}")) ("ŵ")) -((("\\" "^" "w")) ("ŵ")) -((("\\" "^" "{" "Y" "}")) ("Ŷ")) -((("\\" "^" "Y")) ("Ŷ")) -((("\\" "^" "{" "y" "}")) ("ŷ")) -((("\\" "^" "y")) ("ŷ")) -((("\\" "\"" "{" "Y" "}")) ("Ÿ")) -((("\\" "\"" "Y")) ("Ÿ")) -((("\\" "'" "{" "Z" "}")) ("Ź")) -((("\\" "'" "Z")) ("Ź")) -((("\\" "'" "{" "z" "}")) ("ź")) -((("\\" "'" "z")) ("ź")) -((("\\" "." "{" "Z" "}")) ("Ż")) -((("\\" "." "Z")) ("Ż")) -((("\\" "." "{" "z" "}")) ("ż")) -((("\\" "." "z")) ("ż")) -((("\\" "v" "{" "Z" "}")) ("Ž")) -((("\\" "v" "Z")) ("Ž")) -((("\\" "v" "{" "z" "}")) ("ž")) -((("\\" "v" "z")) ("ž")) -((("\\" "v" "{" "A" "}")) ("Ǎ")) -((("\\" "v" "A")) ("Ǎ")) -((("\\" "v" "{" "a" "}")) ("ǎ")) -((("\\" "v" "a")) ("ǎ")) -((("\\" "v" "{" "I" "}")) ("Ǐ")) -((("\\" "v" "I")) ("Ǐ")) -((("\\" "v" "{" "\\" "i" "}")) ("ǐ")) -((("\\" "v" "i")) ("ǐ")) -((("\\" "v" "{" "O" "}")) ("Ǒ")) -((("\\" "v" "O")) ("Ǒ")) -((("\\" "v" "{" "o" "}")) ("ǒ")) -((("\\" "v" "o")) ("ǒ")) -((("\\" "v" "{" "U" "}")) ("Ǔ")) -((("\\" "v" "U")) ("Ǔ")) -((("\\" "v" "{" "u" "}")) ("ǔ")) -((("\\" "v" "u")) ("ǔ")) -((("\\" "=" "{" "\\" "A" "E" "}")) ("Ǣ")) -((("\\" "=" "\\" "A" "E")) ("Ǣ")) -((("\\" "=" "{" "\\" "a" "e" "}")) ("ǣ")) -((("\\" "=" "\\" "a" "e")) ("ǣ")) -((("\\" "v" "{" "G" "}")) ("Ǧ")) -((("\\" "v" "G")) ("Ǧ")) -((("\\" "v" "{" "g" "}")) ("ǧ")) -((("\\" "v" "g")) ("ǧ")) -((("\\" "v" "{" "K" "}")) ("Ǩ")) -((("\\" "v" "K")) ("Ǩ")) -((("\\" "v" "{" "k" "}")) ("ǩ")) -((("\\" "v" "k")) ("ǩ")) -((("\\" "v" "{" "\\" "j" "}")) ("ǰ")) -((("\\" "v" "j")) ("ǰ")) -((("\\" "'" "{" "G" "}")) ("Ǵ")) -((("\\" "'" "G")) ("Ǵ")) -((("\\" "'" "{" "g" "}")) ("ǵ")) -((("\\" "'" "g")) ("ǵ")) -((("\\" "`" "{" "N" "}")) ("Ǹ")) -((("\\" "`" "N")) ("Ǹ")) -((("\\" "`" "{" "n" "}")) ("ǹ")) -((("\\" "`" "n")) ("ǹ")) -((("\\" "'" "{" "\\" "A" "E" "}")) ("Ǽ")) -((("\\" "'" "\\" "A" "E")) ("Ǽ")) -((("\\" "'" "{" "\\" "a" "e" "}")) ("ǽ")) -((("\\" "'" "\\" "a" "e")) ("ǽ")) -((("\\" "'" "{" "\\" "O" "}")) ("Ǿ")) -((("\\" "'" "\\" "O")) ("Ǿ")) -((("\\" "'" "{" "\\" "o" "}")) ("ǿ")) -((("\\" "'" "\\" "o")) ("ǿ")) -((("\\" "v" "{" "H" "}")) ("Ȟ")) -((("\\" "v" "H")) ("Ȟ")) -((("\\" "v" "{" "h" "}")) ("ȟ")) -((("\\" "v" "h")) ("ȟ")) -((("\\" "." "{" "A" "}")) ("Ȧ")) -((("\\" "." "A")) ("Ȧ")) -((("\\" "." "{" "a" "}")) ("ȧ")) -((("\\" "." "a")) ("ȧ")) -((("\\" "c" "{" "E" "}")) ("Ȩ")) -((("\\" "c" "E")) ("Ȩ")) -((("\\" "c" "{" "e" "}")) ("ȩ")) -((("\\" "c" "e")) ("ȩ")) -((("\\" "." "{" "O" "}")) ("Ȯ")) -((("\\" "." "O")) ("Ȯ")) -((("\\" "." "{" "o" "}")) ("ȯ")) -((("\\" "." "o")) ("ȯ")) -((("\\" "=" "{" "Y" "}")) ("Ȳ")) -((("\\" "=" "Y")) ("Ȳ")) -((("\\" "=" "{" "y" "}")) ("ȳ")) -((("\\" "=" "y")) ("ȳ")) -((("\\" "v" "{" "}")) ("ˇ")) -((("\\" "u" "{" "}")) ("˘")) -((("\\" "." "{" "}")) ("˙")) -((("\\" "~" "{" "}")) ("˜")) -((("\\" "H" "{" "}")) ("˝")) -((("\\" "'")) ("́")) -((("\\" "'" "K")) ("Ḱ")) -((("\\" "'" "M")) ("Ḿ")) -((("\\" "'" "P")) ("Ṕ")) -((("\\" "'" "W")) ("Ẃ")) -((("\\" "'" "k")) ("ḱ")) -((("\\" "'" "m")) ("ḿ")) -((("\\" "'" "p")) ("ṕ")) -((("\\" "'" "w")) ("ẃ")) -((("\\" ",")) (" ")) -((("\\" ".")) ("̇")) -((("\\" "." "B")) ("Ḃ")) -((("\\" "." "D")) ("Ḋ")) -((("\\" "." "F")) ("Ḟ")) -((("\\" "." "H")) ("Ḣ")) -((("\\" "." "M")) ("Ṁ")) -((("\\" "." "N")) ("Ṅ")) -((("\\" "." "P")) ("Ṗ")) -((("\\" "." "R")) ("Ṙ")) -((("\\" "." "S")) ("Ṡ")) -((("\\" "." "T")) ("Ṫ")) -((("\\" "." "W")) ("Ẇ")) -((("\\" "." "X")) ("Ẋ")) -((("\\" "." "Y")) ("Ẏ")) -((("\\" "." "b")) ("ḃ")) -((("\\" "." "d")) ("ḋ")) -((("\\" "." "e")) ("ė")) -((("\\" "." "f")) ("ḟ")) -((("\\" "." "h")) ("ḣ")) -((("\\" "." "m")) ("ṁ")) -((("\\" "." "n")) ("ṅ")) -((("\\" "." "p")) ("ṗ")) -((("\\" "." "r")) ("ṙ")) -((("\\" "." "s")) ("ṡ")) -((("\\" "." "t")) ("ṫ")) -((("\\" "." "w")) ("ẇ")) -((("\\" "." "x")) ("ẋ")) -((("\\" "." "y")) ("ẏ")) -((("\\" "/")) ("")) -((("\\" ":")) (" ")) -((("\\" ";")) (" ")) -((("\\" "=")) ("̄")) -((("\\" "=" "G")) ("Ḡ")) -((("\\" "=" "g")) ("ḡ")) -((("^" "(")) ("⁽")) -((("^" ")")) ("⁾")) -((("^" "+")) ("⁺")) -((("^" "-")) ("⁻")) -((("^" "0")) ("⁰")) -((("^" "1")) ("¹")) -((("^" "2")) ("²")) -((("^" "3")) ("³")) -((("^" "4")) ("⁴")) -((("^" "5")) ("⁵")) -((("^" "6")) ("⁶")) -((("^" "7")) ("⁷")) -((("^" "8")) ("⁸")) -((("^" "9")) ("⁹")) -((("^" "=")) ("⁼")) -((("^" "\\" "g" "a" "m" "m" "a")) ("ˠ")) -((("^" "h")) ("ʰ")) -((("^" "j")) ("ʲ")) -((("^" "l")) ("ˡ")) -((("^" "n")) ("ⁿ")) -((("^" "o")) ("º")) -((("^" "r")) ("ʳ")) -((("^" "s")) ("ˢ")) -((("^" "w")) ("ʷ")) -((("^" "x")) ("ˣ")) -((("^" "y")) ("ʸ")) -((("^" "{" "S" "M" "}")) ("℠")) -((("^" "{" "T" "E" "L" "}")) ("℡")) -((("^" "{" "T" "M" "}")) ("™")) -((("_" "(")) ("₍")) -((("_" ")")) ("₎")) -((("_" "+")) ("₊")) -((("_" "-")) ("₋")) -((("_" "0")) ("₀")) -((("_" "1")) ("₁")) -((("_" "2")) ("₂")) -((("_" "3")) ("₃")) -((("_" "4")) ("₄")) -((("_" "5")) ("₅")) -((("_" "6")) ("₆")) -((("_" "7")) ("₇")) -((("_" "8")) ("₈")) -((("_" "9")) ("₉")) -((("_" "=")) ("₌")) -((("\\" "~")) ("̃")) -((("\\" "~" "E")) ("Ẽ")) -((("\\" "~" "V")) ("Ṽ")) -((("\\" "~" "Y")) ("Ỹ")) -((("\\" "~" "e")) ("ẽ")) -((("\\" "~" "v")) ("ṽ")) -((("\\" "~" "y")) ("ỹ")) -((("\\" "\"")) ("̈")) -((("\\" "\"" "H")) ("Ḧ")) -((("\\" "\"" "W")) ("Ẅ")) -((("\\" "\"" "X")) ("Ẍ")) -((("\\" "\"" "h")) ("ḧ")) -((("\\" "\"" "t")) ("ẗ")) -((("\\" "\"" "w")) ("ẅ")) -((("\\" "\"" "x")) ("ẍ")) -((("\\" "^")) ("̂")) -((("\\" "^" "Z")) ("Ẑ")) -((("\\" "^" "z")) ("ẑ")) -((("\\" "`")) ("̀")) -((("\\" "`" "W")) ("Ẁ")) -((("\\" "`" "Y")) ("Ỳ")) -((("\\" "`" "w")) ("ẁ")) -((("\\" "`" "y")) ("ỳ")) -((("\\" "b")) ("̱")) -((("\\" "c")) ("̧")) -((("\\" "c" "{" "D" "}")) ("Ḑ")) -((("\\" "c" "{" "H" "}")) ("Ḩ")) -((("\\" "c" "{" "d" "}")) ("ḑ")) -((("\\" "c" "{" "h" "}")) ("ḩ")) -((("\\" "d")) ("̣")) -((("\\" "d" "{" "A" "}")) ("Ạ")) -((("\\" "d" "{" "B" "}")) ("Ḅ")) -((("\\" "d" "{" "D" "}")) ("Ḍ")) -((("\\" "d" "{" "E" "}")) ("Ẹ")) -((("\\" "d" "{" "H" "}")) ("Ḥ")) -((("\\" "d" "{" "I" "}")) ("Ị")) -((("\\" "d" "{" "K" "}")) ("Ḳ")) -((("\\" "d" "{" "L" "}")) ("Ḷ")) -((("\\" "d" "{" "M" "}")) ("Ṃ")) -((("\\" "d" "{" "N" "}")) ("Ṇ")) -((("\\" "d" "{" "O" "}")) ("Ọ")) -((("\\" "d" "{" "R" "}")) ("Ṛ")) -((("\\" "d" "{" "S" "}")) ("Ṣ")) -((("\\" "d" "{" "T" "}")) ("Ṭ")) -((("\\" "d" "{" "U" "}")) ("Ụ")) -((("\\" "d" "{" "V" "}")) ("Ṿ")) -((("\\" "d" "{" "W" "}")) ("Ẉ")) -((("\\" "d" "{" "Y" "}")) ("Ỵ")) -((("\\" "d" "{" "Z" "}")) ("Ẓ")) -((("\\" "d" "{" "a" "}")) ("ạ")) -((("\\" "d" "{" "b" "}")) ("ḅ")) -((("\\" "d" "{" "d" "}")) ("ḍ")) -((("\\" "d" "{" "e" "}")) ("ẹ")) -((("\\" "d" "{" "h" "}")) ("ḥ")) -((("\\" "d" "{" "i" "}")) ("ị")) -((("\\" "d" "{" "k" "}")) ("ḳ")) -((("\\" "d" "{" "l" "}")) ("ḷ")) -((("\\" "d" "{" "m" "}")) ("ṃ")) -((("\\" "d" "{" "n" "}")) ("ṇ")) -((("\\" "d" "{" "o" "}")) ("ọ")) -((("\\" "d" "{" "r" "}")) ("ṛ")) -((("\\" "d" "{" "s" "}")) ("ṣ")) -((("\\" "d" "{" "t" "}")) ("ṭ")) -((("\\" "d" "{" "u" "}")) ("ụ")) -((("\\" "d" "{" "v" "}")) ("ṿ")) -((("\\" "d" "{" "w" "}")) ("ẉ")) -((("\\" "d" "{" "y" "}")) ("ỵ")) -((("\\" "d" "{" "z" "}")) ("ẓ")) -((("\\" "r" "q")) ("’")) -((("\\" "u")) ("̆")) -((("\\" "v")) ("̌")) -((("\\" "v" "{" "L" "}")) ("Ľ")) -((("\\" "v" "{" "i" "}")) ("ǐ")) -((("\\" "v" "{" "j" "}")) ("ǰ")) -((("\\" "v" "{" "l" "}")) ("ľ")) -((("\\" "y" "e" "n")) ("¥")) -((("\\" "B" "o" "x")) ("□")) -((("\\" "B" "u" "m" "p" "e" "q")) ("≎")) -((("\\" "C" "a" "p")) ("⋒")) -((("\\" "C" "u" "p")) ("⋓")) -((("\\" "D" "e" "l" "t" "a")) ("Δ")) -((("\\" "D" "i" "a" "m" "o" "n" "d")) ("◇")) -((("\\" "D" "o" "w" "n" "a" "r" "r" "o" "w")) ("⇓")) -((("\\" "G" "a" "m" "m" "a")) ("Γ")) -((("\\" "H")) ("̋")) -((("\\" "H" "{" "o" "}")) ("ő")) -((("\\" "I" "m")) ("ℑ")) -((("\\" "J" "o" "i" "n")) ("⋈")) -((("\\" "L" "a" "m" "b" "d" "a")) ("Λ")) -((("\\" "L" "e" "f" "t" "a" "r" "r" "o" "w")) ("⇐")) -((("\\" "L" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇔")) -((("\\" "L" "l")) ("⋘")) -((("\\" "L" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("⇚")) -((("\\" "L" "o" "n" "g" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("⇐")) -((("\\" "L" "o" "n" "g" "l" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇔")) -((("\\" "L" "o" "n" "g" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇒")) -((("\\" "L" "s" "h")) ("↰")) -((("\\" "O" "m" "e" "g" "a")) ("Ω")) -((("\\" "P" "h" "i")) ("Φ")) -((("\\" "P" "i")) ("Π")) -((("\\" "P" "s" "i")) ("Ψ")) -((("\\" "R" "e")) ("ℜ")) -((("\\" "R" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇒")) -((("\\" "R" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇛")) -((("\\" "R" "s" "h")) ("↱")) -((("\\" "S" "i" "g" "m" "a")) ("Σ")) -((("\\" "S" "u" "b" "s" "e" "t")) ("⋐")) -((("\\" "S" "u" "p" "s" "e" "t")) ("⋑")) -((("\\" "T" "h" "e" "t" "a")) ("Θ")) -((("\\" "U" "p" "a" "r" "r" "o" "w")) ("⇑")) -((("\\" "U" "p" "d" "o" "w" "n" "a" "r" "r" "o" "w")) ("⇕")) -((("\\" "U" "p" "s" "i" "l" "o" "n")) ("Υ")) -((("\\" "V" "d" "a" "s" "h")) ("⊩")) -((("\\" "V" "e" "r" "t")) ("‖")) -((("\\" "V" "v" "d" "a" "s" "h")) ("⊪")) -((("\\" "X" "i")) ("Ξ")) -((("\\" "a" "l" "e" "p" "h")) ("א")) -((("\\" "a" "l" "p" "h" "a")) ("α")) -((("\\" "a" "m" "a" "l" "g")) ("∐")) -((("\\" "a" "n" "g" "l" "e")) ("∠")) -((("\\" "a" "p" "p" "r" "o" "x")) ("≈")) -((("\\" "a" "p" "p" "r" "o" "x" "e" "q")) ("≊")) -((("\\" "a" "s" "t")) ("∗")) -((("\\" "a" "s" "y" "m" "p")) ("≍")) -((("\\" "b" "a" "c" "k" "c" "o" "n" "g")) ("≌")) -((("\\" "b" "a" "c" "k" "e" "p" "s" "i" "l" "o" "n")) ("∍")) -((("\\" "b" "a" "c" "k" "p" "r" "i" "m" "e")) ("‵")) -((("\\" "b" "a" "c" "k" "s" "i" "m")) ("∽")) -((("\\" "b" "a" "c" "k" "s" "i" "m" "e" "q")) ("⋍")) -((("\\" "b" "a" "c" "k" "s" "l" "a" "s" "h")) ("\\")) -((("\\" "b" "a" "r" "w" "e" "d" "g" "e")) ("⊼")) -((("\\" "b" "e" "c" "a" "u" "s" "e")) ("∵")) -((("\\" "b" "e" "t" "a")) ("β")) -((("\\" "b" "e" "t" "h")) ("ב")) -((("\\" "b" "e" "t" "w" "e" "e" "n")) ("≬")) -((("\\" "b" "i" "g" "c" "a" "p")) ("⋂")) -((("\\" "b" "i" "g" "c" "i" "r" "c")) ("◯")) -((("\\" "b" "i" "g" "c" "u" "p")) ("⋃")) -((("\\" "b" "i" "g" "s" "t" "a" "r")) ("★")) -((("\\" "b" "i" "g" "t" "r" "i" "a" "n" "g" "l" "e" "d" "o" "w" "n")) ("▽")) -((("\\" "b" "i" "g" "t" "r" "i" "a" "n" "g" "l" "e" "u" "p")) ("△")) -((("\\" "b" "i" "g" "v" "e" "e")) ("⋁")) -((("\\" "b" "i" "g" "w" "e" "d" "g" "e")) ("⋀")) -((("\\" "b" "l" "a" "c" "k" "l" "o" "z" "e" "n" "g" "e")) ("✦")) -((("\\" "b" "l" "a" "c" "k" "s" "q" "u" "a" "r" "e")) ("▪")) -((("\\" "b" "l" "a" "c" "k" "t" "r" "i" "a" "n" "g" "l" "e")) ("▴")) -((("\\" "b" "l" "a" "c" "k" "t" "r" "i" "a" "n" "g" "l" "e" "d" "o" "w" "n")) ("▾")) -((("\\" "b" "l" "a" "c" "k" "t" "r" "i" "a" "n" "g" "l" "e" "l" "e" "f" "t")) ("◂")) -((("\\" "b" "l" "a" "c" "k" "t" "r" "i" "a" "n" "g" "l" "e" "r" "i" "g" "h" "t")) ("▸")) -((("\\" "b" "o" "t")) ("⊥")) -((("\\" "b" "o" "w" "t" "i" "e")) ("⋈")) -((("\\" "b" "o" "x" "m" "i" "n" "u" "s")) ("⊟")) -((("\\" "b" "o" "x" "p" "l" "u" "s")) ("⊞")) -((("\\" "b" "o" "x" "t" "i" "m" "e" "s")) ("⊠")) -((("\\" "b" "u" "l" "l" "e" "t")) ("•")) -((("\\" "b" "u" "m" "p" "e" "q")) ("≏")) -((("\\" "c" "a" "p")) ("∩")) -((("\\" "c" "d" "o" "t" "s")) ("⋯")) -((("\\" "c" "e" "n" "t" "e" "r" "d" "o" "t")) ("·")) -((("\\" "c" "h" "e" "c" "k" "m" "a" "r" "k")) ("✓")) -((("\\" "c" "h" "i")) ("χ")) -((("\\" "c" "i" "r" "c")) ("○")) -((("\\" "c" "i" "r" "c" "e" "q")) ("≗")) -((("\\" "c" "i" "r" "c" "l" "e" "a" "r" "r" "o" "w" "l" "e" "f" "t")) ("↺")) -((("\\" "c" "i" "r" "c" "l" "e" "a" "r" "r" "o" "w" "r" "i" "g" "h" "t")) ("↻")) -((("\\" "c" "i" "r" "c" "l" "e" "d" "R")) ("®")) -((("\\" "c" "i" "r" "c" "l" "e" "d" "S")) ("Ⓢ")) -((("\\" "c" "i" "r" "c" "l" "e" "d" "a" "s" "t")) ("⊛")) -((("\\" "c" "i" "r" "c" "l" "e" "d" "c" "i" "r" "c")) ("⊚")) -((("\\" "c" "i" "r" "c" "l" "e" "d" "d" "a" "s" "h")) ("⊝")) -((("\\" "c" "l" "u" "b" "s" "u" "i" "t")) ("♣")) -((("\\" "c" "o" "l" "o" "n")) (":")) -((("\\" "c" "o" "l" "o" "n" "e" "q")) ("≔")) -((("\\" "c" "o" "m" "p" "l" "e" "m" "e" "n" "t")) ("∁")) -((("\\" "c" "o" "n" "g")) ("≅")) -((("\\" "c" "o" "p" "r" "o" "d")) ("∐")) -((("\\" "c" "u" "p")) ("∪")) -((("\\" "c" "u" "r" "l" "y" "e" "q" "p" "r" "e" "c")) ("⋞")) -((("\\" "c" "u" "r" "l" "y" "e" "q" "s" "u" "c" "c")) ("⋟")) -((("\\" "c" "u" "r" "l" "y" "p" "r" "e" "c" "e" "q")) ("≼")) -((("\\" "c" "u" "r" "l" "y" "v" "e" "e")) ("⋎")) -((("\\" "c" "u" "r" "l" "y" "w" "e" "d" "g" "e")) ("⋏")) -((("\\" "c" "u" "r" "v" "e" "a" "r" "r" "o" "w" "l" "e" "f" "t")) ("↶")) -((("\\" "c" "u" "r" "v" "e" "a" "r" "r" "o" "w" "r" "i" "g" "h" "t")) ("↷")) -((("\\" "d" "a" "g")) ("†")) -((("\\" "d" "a" "g" "g" "e" "r")) ("†")) -((("\\" "d" "a" "l" "e" "t" "h")) ("ד")) -((("\\" "d" "a" "s" "h" "v")) ("⊣")) -((("\\" "d" "d" "a" "g")) ("‡")) -((("\\" "d" "d" "a" "g" "g" "e" "r")) ("‡")) -((("\\" "d" "d" "o" "t" "s")) ("⋱")) -((("\\" "d" "e" "l" "t" "a")) ("δ")) -((("\\" "d" "i" "a" "m" "o" "n" "d")) ("⋄")) -((("\\" "d" "i" "a" "m" "o" "n" "d" "s" "u" "i" "t")) ("♢")) -((("\\" "d" "i" "g" "a" "m" "m" "a")) ("Ϝ")) -((("\\" "d" "i" "v" "i" "d" "e" "o" "n" "t" "i" "m" "e" "s")) ("⋇")) -((("\\" "d" "o" "t" "e" "q")) ("≐")) -((("\\" "d" "o" "t" "e" "q" "d" "o" "t")) ("≑")) -((("\\" "d" "o" "t" "p" "l" "u" "s")) ("∔")) -((("\\" "d" "o" "t" "s" "q" "u" "a" "r" "e")) ("⊡")) -((("\\" "d" "o" "w" "n" "a" "r" "r" "o" "w")) ("↓")) -((("\\" "d" "o" "w" "n" "d" "o" "w" "n" "a" "r" "r" "o" "w" "s")) ("⇊")) -((("\\" "d" "o" "w" "n" "l" "e" "f" "t" "h" "a" "r" "p" "o" "o" "n")) ("⇃")) -((("\\" "d" "o" "w" "n" "r" "i" "g" "h" "t" "h" "a" "r" "p" "o" "o" "n")) ("⇂")) -((("\\" "e" "l" "l")) ("ℓ")) -((("\\" "e" "m" "p" "t" "y" "s" "e" "t")) ("∅")) -((("\\" "e" "p" "s" "i" "l" "o" "n")) ("ε")) -((("\\" "e" "q" "c" "i" "r" "c")) ("≖")) -((("\\" "e" "q" "c" "o" "l" "o" "n")) ("≕")) -((("\\" "e" "q" "s" "l" "a" "n" "t" "g" "t" "r")) ("⋝")) -((("\\" "e" "q" "s" "l" "a" "n" "t" "l" "e" "s" "s")) ("⋜")) -((("\\" "e" "q" "u" "i" "v")) ("≡")) -((("\\" "e" "t" "a")) ("η")) -((("\\" "e" "u" "r" "o")) ("€")) -((("\\" "e" "x" "i" "s" "t" "s")) ("∃")) -((("\\" "f" "a" "l" "l" "i" "n" "g" "d" "o" "t" "s" "e" "q")) ("≒")) -((("\\" "f" "l" "a" "t")) ("♭")) -((("\\" "f" "o" "r" "a" "l" "l")) ("∀")) -((("\\" "f" "r" "a" "c" "1")) ("⅟")) -((("\\" "f" "r" "a" "c" "1" "2")) ("½")) -((("\\" "f" "r" "a" "c" "1" "3")) ("⅓")) -((("\\" "f" "r" "a" "c" "1" "4")) ("¼")) -((("\\" "f" "r" "a" "c" "1" "5")) ("⅕")) -((("\\" "f" "r" "a" "c" "1" "6")) ("⅙")) -((("\\" "f" "r" "a" "c" "1" "8")) ("⅛")) -((("\\" "f" "r" "a" "c" "2" "3")) ("⅔")) -((("\\" "f" "r" "a" "c" "2" "5")) ("⅖")) -((("\\" "f" "r" "a" "c" "3" "4")) ("¾")) -((("\\" "f" "r" "a" "c" "3" "5")) ("⅗")) -((("\\" "f" "r" "a" "c" "3" "8")) ("⅜")) -((("\\" "f" "r" "a" "c" "4" "5")) ("⅘")) -((("\\" "f" "r" "a" "c" "5" "6")) ("⅚")) -((("\\" "f" "r" "a" "c" "5" "8")) ("⅝")) -((("\\" "f" "r" "a" "c" "7" "8")) ("⅞")) -((("\\" "f" "r" "o" "w" "n")) ("⌢")) -((("\\" "g" "a" "m" "m" "a")) ("γ")) -((("\\" "g" "e")) ("≥")) -((("\\" "g" "e" "q")) ("≥")) -((("\\" "g" "e" "q" "q")) ("≧")) -((("\\" "g" "e" "q" "s" "l" "a" "n" "t")) ("≥")) -((("\\" "g" "e" "t" "s")) ("←")) -((("\\" "g" "g")) ("≫")) -((("\\" "g" "g" "g")) ("⋙")) -((("\\" "g" "i" "m" "e" "l")) ("ג")) -((("\\" "g" "n" "a" "p" "p" "r" "o" "x")) ("⋧")) -((("\\" "g" "n" "e" "q")) ("≩")) -((("\\" "g" "n" "e" "q" "q")) ("≩")) -((("\\" "g" "n" "s" "i" "m")) ("⋧")) -((("\\" "g" "t" "r" "a" "p" "p" "r" "o" "x")) ("≳")) -((("\\" "g" "t" "r" "d" "o" "t")) ("⋗")) -((("\\" "g" "t" "r" "e" "q" "l" "e" "s" "s")) ("⋛")) -((("\\" "g" "t" "r" "e" "q" "q" "l" "e" "s" "s")) ("⋛")) -((("\\" "g" "t" "r" "l" "e" "s" "s")) ("≷")) -((("\\" "g" "t" "r" "s" "i" "m")) ("≳")) -((("\\" "g" "v" "e" "r" "t" "n" "e" "q" "q")) ("≩")) -((("\\" "h" "b" "a" "r")) ("ℏ")) -((("\\" "h" "e" "a" "r" "t" "s" "u" "i" "t")) ("♥")) -((("\\" "h" "o" "o" "k" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("↩")) -((("\\" "h" "o" "o" "k" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("↪")) -((("\\" "i" "f" "f")) ("⇔")) -((("\\" "i" "m" "a" "t" "h")) ("ı")) -((("\\" "i" "n")) ("∈")) -((("\\" "i" "n" "f" "t" "y")) ("∞")) -((("\\" "i" "n" "t")) ("∫")) -((("\\" "i" "n" "t" "e" "r" "c" "a" "l")) ("⊺")) -((("\\" "i" "o" "t" "a")) ("ι")) -((("\\" "k" "a" "p" "p" "a")) ("κ")) -((("\\" "l" "a" "m" "b" "d" "a")) ("λ")) -((("\\" "l" "a" "n" "g" "l" "e")) ("〈")) -((("\\" "l" "b" "r" "a" "c" "e")) ("{")) -((("\\" "l" "b" "r" "a" "c" "k")) ("[")) -((("\\" "l" "c" "e" "i" "l")) ("⌈")) -((("\\" "l" "d" "o" "t" "s")) ("…")) -((("\\" "l" "e")) ("≤")) -((("\\" "l" "e" "a" "d" "s" "t" "o")) ("↝")) -((("\\" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("←")) -((("\\" "l" "e" "f" "t" "a" "r" "r" "o" "w" "t" "a" "i" "l")) ("↢")) -((("\\" "l" "e" "f" "t" "h" "a" "r" "p" "o" "o" "n" "d" "o" "w" "n")) ("↽")) -((("\\" "l" "e" "f" "t" "h" "a" "r" "p" "o" "o" "n" "u" "p")) ("↼")) -((("\\" "l" "e" "f" "t" "l" "e" "f" "t" "a" "r" "r" "o" "w" "s")) ("⇇")) -((("\\" "l" "e" "f" "t" "p" "a" "r" "e" "n" "g" "t" "r")) ("〈")) -((("\\" "l" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("↔")) -((("\\" "l" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w" "s")) ("⇆")) -((("\\" "l" "e" "f" "t" "r" "i" "g" "h" "t" "h" "a" "r" "p" "o" "o" "n" "s")) ("⇋")) -((("\\" "l" "e" "f" "t" "r" "i" "g" "h" "t" "s" "q" "u" "i" "g" "a" "r" "r" "o" "w")) ("↭")) -((("\\" "l" "e" "f" "t" "t" "h" "r" "e" "e" "t" "i" "m" "e" "s")) ("⋋")) -((("\\" "l" "e" "q")) ("≤")) -((("\\" "l" "e" "q" "q")) ("≦")) -((("\\" "l" "e" "q" "s" "l" "a" "n" "t")) ("≤")) -((("\\" "l" "e" "s" "s" "a" "p" "p" "r" "o" "x")) ("≲")) -((("\\" "l" "e" "s" "s" "d" "o" "t")) ("⋖")) -((("\\" "l" "e" "s" "s" "e" "q" "g" "t" "r")) ("⋚")) -((("\\" "l" "e" "s" "s" "e" "q" "q" "g" "t" "r")) ("⋚")) -((("\\" "l" "e" "s" "s" "g" "t" "r")) ("≶")) -((("\\" "l" "e" "s" "s" "s" "i" "m")) ("≲")) -((("\\" "l" "f" "l" "o" "o" "r")) ("⌊")) -((("\\" "l" "h" "d")) ("◁")) -((("\\" "r" "h" "d")) ("▷")) -((("\\" "l" "l")) ("≪")) -((("\\" "l" "l" "c" "o" "r" "n" "e" "r")) ("⌞")) -((("\\" "l" "n" "a" "p" "p" "r" "o" "x")) ("⋦")) -((("\\" "l" "n" "e" "q")) ("≨")) -((("\\" "l" "n" "e" "q" "q")) ("≨")) -((("\\" "l" "n" "s" "i" "m")) ("⋦")) -((("\\" "l" "o" "n" "g" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("←")) -((("\\" "l" "o" "n" "g" "l" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("↔")) -((("\\" "l" "o" "n" "g" "m" "a" "p" "s" "t" "o")) ("↦")) -((("\\" "l" "o" "n" "g" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("→")) -((("\\" "l" "o" "o" "p" "a" "r" "r" "o" "w" "l" "e" "f" "t")) ("↫")) -((("\\" "l" "o" "o" "p" "a" "r" "r" "o" "w" "r" "i" "g" "h" "t")) ("↬")) -((("\\" "l" "o" "z" "e" "n" "g" "e")) ("✧")) -((("\\" "l" "q")) ("‘")) -((("\\" "l" "r" "c" "o" "r" "n" "e" "r")) ("⌟")) -((("\\" "l" "t" "i" "m" "e" "s")) ("⋉")) -((("\\" "l" "v" "e" "r" "t" "n" "e" "q" "q")) ("≨")) -((("\\" "m" "a" "l" "t" "e" "s" "e")) ("✠")) -((("\\" "m" "a" "p" "s" "t" "o")) ("↦")) -((("\\" "m" "e" "a" "s" "u" "r" "e" "d" "a" "n" "g" "l" "e")) ("∡")) -((("\\" "m" "h" "o")) ("℧")) -((("\\" "m" "i" "d")) ("∣")) -((("\\" "m" "o" "d" "e" "l" "s")) ("⊧")) -((("\\" "m" "p")) ("∓")) -((("\\" "m" "u" "l" "t" "i" "m" "a" "p")) ("⊸")) -((("\\" "n" "L" "e" "f" "t" "a" "r" "r" "o" "w")) ("⇍")) -((("\\" "n" "L" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇎")) -((("\\" "n" "R" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("⇏")) -((("\\" "n" "V" "D" "a" "s" "h")) ("⊯")) -((("\\" "n" "V" "d" "a" "s" "h")) ("⊮")) -((("\\" "n" "a" "b" "l" "a")) ("∇")) -((("\\" "n" "a" "p" "p" "r" "o" "x")) ("≉")) -((("\\" "n" "a" "t" "u" "r" "a" "l")) ("♮")) -((("\\" "n" "c" "o" "n" "g")) ("≇")) -((("\\" "n" "e")) ("≠")) -((("\\" "n" "e" "a" "r" "r" "o" "w")) ("↗")) -((("\\" "n" "e" "g")) ("¬")) -((("\\" "n" "e" "q")) ("≠")) -((("\\" "n" "e" "q" "u" "i" "v")) ("≢")) -((("\\" "n" "e" "w" "l" "i" "n" "e")) ("
")) -((("\\" "n" "e" "x" "i" "s" "t" "s")) ("∄")) -((("\\" "n" "g" "e" "q")) ("≱")) -((("\\" "n" "g" "e" "q" "q")) ("≱")) -((("\\" "n" "g" "e" "q" "s" "l" "a" "n" "t")) ("≱")) -((("\\" "n" "g" "t" "r")) ("≯")) -((("\\" "n" "i")) ("∋")) -((("\\" "n" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("↚")) -((("\\" "n" "l" "e" "f" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("↮")) -((("\\" "n" "l" "e" "q")) ("≰")) -((("\\" "n" "l" "e" "q" "q")) ("≰")) -((("\\" "n" "l" "e" "q" "s" "l" "a" "n" "t")) ("≰")) -((("\\" "n" "l" "e" "s" "s")) ("≮")) -((("\\" "n" "m" "i" "d")) ("∤")) -((("\\" "n" "o" "t")) ("̸")) -((("\\" "n" "o" "t" "i" "n")) ("∉")) -((("\\" "n" "p" "a" "r" "a" "l" "l" "e" "l")) ("∦")) -((("\\" "n" "p" "r" "e" "c")) ("⊀")) -((("\\" "n" "p" "r" "e" "c" "e" "q")) ("⋠")) -((("\\" "n" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("↛")) -((("\\" "n" "s" "h" "o" "r" "t" "m" "i" "d")) ("∤")) -((("\\" "n" "s" "h" "o" "r" "t" "p" "a" "r" "a" "l" "l" "e" "l")) ("∦")) -((("\\" "n" "s" "i" "m")) ("≁")) -((("\\" "n" "s" "i" "m" "e" "q")) ("≄")) -((("\\" "n" "s" "u" "b" "s" "e" "t")) ("⊄")) -((("\\" "n" "s" "u" "b" "s" "e" "t" "e" "q")) ("⊈")) -((("\\" "n" "s" "u" "b" "s" "e" "t" "e" "q" "q")) ("⊈")) -((("\\" "n" "s" "u" "c" "c")) ("⊁")) -((("\\" "n" "s" "u" "c" "c" "e" "q")) ("⋡")) -((("\\" "n" "s" "u" "p" "s" "e" "t")) ("⊅")) -((("\\" "n" "s" "u" "p" "s" "e" "t" "e" "q")) ("⊉")) -((("\\" "n" "s" "u" "p" "s" "e" "t" "e" "q" "q")) ("⊉")) -((("\\" "n" "t" "r" "i" "a" "n" "g" "l" "e" "l" "e" "f" "t")) ("⋪")) -((("\\" "n" "t" "r" "i" "a" "n" "g" "l" "e" "l" "e" "f" "t" "e" "q")) ("⋬")) -((("\\" "n" "t" "r" "i" "a" "n" "g" "l" "e" "r" "i" "g" "h" "t")) ("⋫")) -((("\\" "n" "t" "r" "i" "a" "n" "g" "l" "e" "r" "i" "g" "h" "t" "e" "q")) ("⋭")) -((("\\" "n" "u")) ("ν")) -((("\\" "n" "v" "D" "a" "s" "h")) ("⊭")) -((("\\" "n" "v" "d" "a" "s" "h")) ("⊬")) -((("\\" "n" "w" "a" "r" "r" "o" "w")) ("↖")) -((("\\" "o" "d" "o" "t")) ("⊙")) -((("\\" "o" "i" "n" "t")) ("∮")) -((("\\" "o" "m" "e" "g" "a")) ("ω")) -((("\\" "o" "m" "i" "n" "u" "s")) ("⊖")) -((("\\" "o" "p" "l" "u" "s")) ("⊕")) -((("\\" "o" "s" "l" "a" "s" "h")) ("⊘")) -((("\\" "o" "t" "i" "m" "e" "s")) ("⊗")) -((("\\" "p" "a" "r")) ("
")) -((("\\" "p" "a" "r" "a" "l" "l" "e" "l")) ("∥")) -((("\\" "p" "a" "r" "t" "i" "a" "l")) ("∂")) -((("\\" "p" "e" "r" "p")) ("⊥")) -((("\\" "p" "h" "i")) ("φ")) -((("\\" "p" "i")) ("π")) -((("\\" "p" "i" "t" "c" "h" "f" "o" "r" "k")) ("⋔")) -((("\\" "p" "r" "e" "c")) ("≺")) -((("\\" "p" "r" "e" "c" "a" "p" "p" "r" "o" "x")) ("≾")) -((("\\" "p" "r" "e" "c" "e" "q")) ("≼")) -((("\\" "p" "r" "e" "c" "n" "a" "p" "p" "r" "o" "x")) ("⋨")) -((("\\" "p" "r" "e" "c" "n" "s" "i" "m")) ("⋨")) -((("\\" "p" "r" "e" "c" "s" "i" "m")) ("≾")) -((("\\" "p" "r" "i" "m" "e")) ("′")) -((("\\" "p" "r" "o" "d")) ("∏")) -((("\\" "p" "r" "o" "p" "t" "o")) ("∝")) -((("\\" "p" "s" "i")) ("ψ")) -((("\\" "q" "e" "d")) ("∎")) -((("\\" "q" "u" "a" "d")) (" ")) -((("\\" "r" "a" "n" "g" "l" "e")) ("〉")) -((("\\" "r" "b" "r" "a" "c" "e")) ("}")) -((("\\" "r" "b" "r" "a" "c" "k")) ("]")) -((("\\" "r" "c" "e" "i" "l")) ("⌉")) -((("\\" "r" "f" "l" "o" "o" "r")) ("⌋")) -((("\\" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("→")) -((("\\" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w" "t" "a" "i" "l")) ("↣")) -((("\\" "r" "i" "g" "h" "t" "h" "a" "r" "p" "o" "o" "n" "d" "o" "w" "n")) ("⇁")) -((("\\" "r" "i" "g" "h" "t" "h" "a" "r" "p" "o" "o" "n" "u" "p")) ("⇀")) -((("\\" "r" "i" "g" "h" "t" "l" "e" "f" "t" "a" "r" "r" "o" "w" "s")) ("⇄")) -((("\\" "r" "i" "g" "h" "t" "l" "e" "f" "t" "h" "a" "r" "p" "o" "o" "n" "s")) ("⇌")) -((("\\" "r" "i" "g" "h" "t" "p" "a" "r" "e" "n" "g" "t" "r")) ("〉")) -((("\\" "r" "i" "g" "h" "t" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w" "s")) ("⇉")) -((("\\" "r" "i" "g" "h" "t" "t" "h" "r" "e" "e" "t" "i" "m" "e" "s")) ("⋌")) -((("\\" "r" "i" "s" "i" "n" "g" "d" "o" "t" "s" "e" "q")) ("≓")) -((("\\" "r" "t" "i" "m" "e" "s")) ("⋊")) -((("\\" "s" "b" "s")) ("﹨")) -((("\\" "s" "e" "a" "r" "r" "o" "w")) ("↘")) -((("\\" "s" "e" "t" "m" "i" "n" "u" "s")) ("∖")) -((("\\" "s" "h" "a" "r" "p")) ("♯")) -((("\\" "s" "h" "o" "r" "t" "m" "i" "d")) ("∣")) -((("\\" "s" "h" "o" "r" "t" "p" "a" "r" "a" "l" "l" "e" "l")) ("∥")) -((("\\" "s" "i" "g" "m" "a")) ("σ")) -((("\\" "s" "i" "m")) ("∼")) -((("\\" "s" "i" "m" "e" "q")) ("≃")) -((("\\" "s" "m" "a" "l" "l" "a" "m" "a" "l" "g")) ("∐")) -((("\\" "s" "m" "a" "l" "l" "s" "e" "t" "m" "i" "n" "u" "s")) ("∖")) -((("\\" "s" "m" "a" "l" "l" "s" "m" "i" "l" "e")) ("⌣")) -((("\\" "s" "m" "i" "l" "e")) ("⌣")) -((("\\" "s" "p" "a" "d" "e" "s" "u" "i" "t")) ("♠")) -((("\\" "s" "p" "h" "e" "r" "i" "c" "a" "l" "a" "n" "g" "l" "e")) ("∢")) -((("\\" "s" "q" "c" "a" "p")) ("⊓")) -((("\\" "s" "q" "c" "u" "p")) ("⊔")) -((("\\" "s" "q" "s" "u" "b" "s" "e" "t")) ("⊏")) -((("\\" "s" "q" "s" "u" "b" "s" "e" "t" "e" "q")) ("⊑")) -((("\\" "s" "q" "s" "u" "p" "s" "e" "t")) ("⊐")) -((("\\" "s" "q" "s" "u" "p" "s" "e" "t" "e" "q")) ("⊒")) -((("\\" "s" "q" "u" "a" "r" "e")) ("□")) -((("\\" "s" "q" "u" "i" "g" "a" "r" "r" "o" "w" "r" "i" "g" "h" "t")) ("⇝")) -((("\\" "s" "t" "a" "r")) ("⋆")) -((("\\" "s" "t" "r" "a" "i" "g" "h" "t" "p" "h" "i")) ("φ")) -((("\\" "s" "u" "b" "s" "e" "t")) ("⊂")) -((("\\" "s" "u" "b" "s" "e" "t" "e" "q")) ("⊆")) -((("\\" "s" "u" "b" "s" "e" "t" "e" "q" "q")) ("⊆")) -((("\\" "s" "u" "b" "s" "e" "t" "n" "e" "q")) ("⊊")) -((("\\" "s" "u" "b" "s" "e" "t" "n" "e" "q" "q")) ("⊊")) -((("\\" "s" "u" "c" "c")) ("≻")) -((("\\" "s" "u" "c" "c" "a" "p" "p" "r" "o" "x")) ("≿")) -((("\\" "s" "u" "c" "c" "c" "u" "r" "l" "y" "e" "q")) ("≽")) -((("\\" "s" "u" "c" "c" "e" "q")) ("≽")) -((("\\" "s" "u" "c" "c" "n" "a" "p" "p" "r" "o" "x")) ("⋩")) -((("\\" "s" "u" "c" "c" "n" "s" "i" "m")) ("⋩")) -((("\\" "s" "u" "c" "c" "s" "i" "m")) ("≿")) -((("\\" "s" "u" "m")) ("∑")) -((("\\" "s" "u" "p" "s" "e" "t")) ("⊃")) -((("\\" "s" "u" "p" "s" "e" "t" "e" "q")) ("⊇")) -((("\\" "s" "u" "p" "s" "e" "t" "e" "q" "q")) ("⊇")) -((("\\" "s" "u" "p" "s" "e" "t" "n" "e" "q")) ("⊋")) -((("\\" "s" "u" "p" "s" "e" "t" "n" "e" "q" "q")) ("⊋")) -((("\\" "s" "u" "r" "d")) ("√")) -((("\\" "s" "w" "a" "r" "r" "o" "w")) ("↙")) -((("\\" "t" "a" "u")) ("τ")) -((("\\" "t" "h" "e" "r" "e" "f" "o" "r" "e")) ("∴")) -((("\\" "t" "h" "e" "t" "a")) ("θ")) -((("\\" "t" "h" "i" "c" "k" "a" "p" "p" "r" "o" "x")) ("≈")) -((("\\" "t" "h" "i" "c" "k" "s" "i" "m")) ("∼")) -((("\\" "t" "o")) ("→")) -((("\\" "t" "o" "p")) ("⊤")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e")) ("▵")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e" "d" "o" "w" "n")) ("▿")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e" "l" "e" "f" "t")) ("◃")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e" "l" "e" "f" "t" "e" "q")) ("⊴")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e" "q")) ("≜")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e" "r" "i" "g" "h" "t")) ("▹")) -((("\\" "t" "r" "i" "a" "n" "g" "l" "e" "r" "i" "g" "h" "t" "e" "q")) ("⊵")) -((("\\" "t" "w" "o" "h" "e" "a" "d" "l" "e" "f" "t" "a" "r" "r" "o" "w")) ("↞")) -((("\\" "t" "w" "o" "h" "e" "a" "d" "r" "i" "g" "h" "t" "a" "r" "r" "o" "w")) ("↠")) -((("\\" "u" "l" "c" "o" "r" "n" "e" "r")) ("⌜")) -((("\\" "u" "p" "a" "r" "r" "o" "w")) ("↑")) -((("\\" "u" "p" "d" "o" "w" "n" "a" "r" "r" "o" "w")) ("↕")) -((("\\" "u" "p" "l" "e" "f" "t" "h" "a" "r" "p" "o" "o" "n")) ("↿")) -((("\\" "u" "p" "l" "u" "s")) ("⊎")) -((("\\" "u" "p" "r" "i" "g" "h" "t" "h" "a" "r" "p" "o" "o" "n")) ("↾")) -((("\\" "u" "p" "s" "i" "l" "o" "n")) ("υ")) -((("\\" "u" "p" "u" "p" "a" "r" "r" "o" "w" "s")) ("⇈")) -((("\\" "u" "r" "c" "o" "r" "n" "e" "r")) ("⌝")) -((("\\" "u" "{" "i" "}")) ("ĭ")) -((("\\" "v" "D" "a" "s" "h")) ("⊨")) -((("\\" "v" "a" "r" "k" "a" "p" "p" "a")) ("ϰ")) -((("\\" "v" "a" "r" "p" "h" "i")) ("ϕ")) -((("\\" "v" "a" "r" "p" "i")) ("ϖ")) -((("\\" "v" "a" "r" "p" "r" "i" "m" "e")) ("′")) -((("\\" "v" "a" "r" "p" "r" "o" "p" "t" "o")) ("∝")) -((("\\" "v" "a" "r" "r" "h" "o")) ("ϱ")) -((("\\" "v" "a" "r" "s" "i" "g" "m" "a")) ("ς")) -((("\\" "v" "a" "r" "t" "h" "e" "t" "a")) ("ϑ")) -((("\\" "v" "a" "r" "t" "r" "i" "a" "n" "g" "l" "e" "l" "e" "f" "t")) ("⊲")) -((("\\" "v" "a" "r" "t" "r" "i" "a" "n" "g" "l" "e" "r" "i" "g" "h" "t")) ("⊳")) -((("\\" "v" "d" "a" "s" "h")) ("⊢")) -((("\\" "v" "d" "o" "t" "s")) ("⋮")) -((("\\" "v" "e" "e")) ("∨")) -((("\\" "v" "e" "e" "b" "a" "r")) ("⊻")) -((("\\" "v" "e" "r" "t")) ("|")) -((("\\" "w" "e" "d" "g" "e")) ("∧")) -((("\\" "w" "p")) ("℘")) -((("\\" "w" "r")) ("≀")) -((("\\" "x" "i")) ("ξ")) -((("\\" "z" "e" "t" "a")) ("ζ")) -((("\\" "B" "b" "b" "{" "N" "}")) ("ℕ")) -((("\\" "B" "b" "b" "{" "P" "}")) ("ℙ")) -((("\\" "B" "b" "b" "{" "R" "}")) ("ℝ")) -((("\\" "B" "b" "b" "{" "Z" "}")) ("ℤ")) -((("-" "-")) ("–")) -((("-" "-" "-")) ("—")) -((("\\" " ")) (" ")) -((("\\" "\\")) ("\\")) -((("\\" "m" "u")) ("μ")) -((("\\" "r" "h" "o")) ("ρ")) -((("\\" "m" "a" "t" "h" "s" "c" "r" "{" "I" "}")) ("ℐ")) -((("\\" "S" "m" "i" "l" "e" "y")) ("☺")) -((("\\" "b" "l" "a" "c" "k" "s" "m" "i" "l" "e" "y")) ("☻")) -((("\\" "F" "r" "o" "w" "n" "y")) ("☹")) -((("\\" "L" "e" "t" "t" "e" "r")) ("✉")) -((("\\" "p" "e" "r" "m" "i" "l")) ("‰")) -((("\\" "r" "e" "g" "i" "s" "t" "e" "r" "e" "d")) ("®")) -((("\\" "c" "u" "r" "r" "e" "n" "c" "y")) ("¤")) -((("\\" "d" "h")) ("ð")) -((("\\" "D" "H")) ("Ð")) -((("\\" "t" "h")) ("þ")) -((("\\" "T" "H")) ("Þ")) -((("\\" "m" "i" "c" "r" "o")) ("µ")) -((("\\" "l" "n" "o" "t")) ("¬")) -((("\\" "o" "r" "d" "f" "e" "m" "i" "n" "i" "n" "e")) ("ª")) -((("\\" "o" "r" "d" "m" "a" "s" "c" "u" "l" "i" "n" "e")) ("º")) -((("\\" "l" "a" "m" "b" "d" "a" "b" "a" "r")) ("ƛ")) -((("\\" "c" "e" "l" "s" "i" "u" "s")) ("℃")) -((("\\" "l" "d" "q")) ("“")) -((("\\" "r" "d" "q")) ("”")) -((("\\" "m" "i" "n" "u" "s")) ("−")) -((("\\" "d" "e" "f" "s")) ("≙")) -((("\\" "l" "l" "b" "r" "a" "c" "k" "e" "t")) ("〚")) -((("\\" "r" "r" "b" "r" "a" "c" "k" "e" "t")) ("〛")) -((("\\" "l" "d" "a" "t" "a")) ("《")) -((("\\" "r" "d" "a" "t" "a")) ("》")) -((("\\" "g" "l" "q")) ("‚")) -((("\\" "g" "r" "q")) ("‘")) -((("\\" "g" "l" "q" "q")) ("„")) -((("\\" "\"" "`")) ("„")) -((("\\" "g" "r" "q" "q")) ("“")) -((("\\" "\"" "'")) ("“")) -((("\\" "f" "l" "q")) ("‹")) -((("\\" "f" "r" "q")) ("›")) -((("\\" "f" "l" "q" "q")) ("«")) -((("\\" "\"" "<")) ("«")) -((("\\" "f" "r" "q" "q")) ("»")) -((("\\" "\"" ">")) ("»")) -((("\\" "-")) ("")) -((("\\" "t" "e" "x" "t" "m" "u")) ("µ")) -((("\\" "t" "e" "x" "t" "f" "r" "a" "c" "t" "i" "o" "n" "s" "o" "l" "i" "d" "u" "s")) ("⁄")) -((("\\" "t" "e" "x" "t" "b" "i" "g" "c" "i" "r" "c" "l" "e")) ("⃝")) -((("\\" "t" "e" "x" "t" "m" "u" "s" "i" "c" "a" "l" "n" "o" "t" "e")) ("♪")) -((("\\" "t" "e" "x" "t" "d" "i" "e" "d")) ("✝")) -((("\\" "t" "e" "x" "t" "c" "o" "l" "o" "n" "m" "o" "n" "e" "t" "a" "r" "y")) ("₡")) -((("\\" "t" "e" "x" "t" "w" "o" "n")) ("₩")) -((("\\" "t" "e" "x" "t" "n" "a" "i" "r" "a")) ("₦")) -((("\\" "t" "e" "x" "t" "p" "e" "s" "o")) ("₱")) -((("\\" "t" "e" "x" "t" "l" "i" "r" "a")) ("₤")) -((("\\" "t" "e" "x" "t" "r" "e" "c" "i" "p" "e")) ("℞")) -((("\\" "t" "e" "x" "t" "i" "n" "t" "e" "r" "r" "o" "b" "a" "n" "g")) ("‽")) -((("\\" "t" "e" "x" "t" "p" "e" "r" "t" "e" "n" "t" "h" "o" "u" "s" "a" "n" "d")) ("‱")) -((("\\" "t" "e" "x" "t" "b" "a" "h" "t")) ("฿")) -((("\\" "t" "e" "x" "t" "n" "u" "m" "e" "r" "o")) ("№")) -((("\\" "t" "e" "x" "t" "d" "i" "s" "c" "o" "u" "n" "t")) ("⁒")) -((("\\" "t" "e" "x" "t" "e" "s" "t" "i" "m" "a" "t" "e" "d")) ("℮")) -((("\\" "t" "e" "x" "t" "o" "p" "e" "n" "b" "u" "l" "l" "e" "t")) ("◦")) -((("\\" "t" "e" "x" "t" "l" "q" "u" "i" "l" "l")) ("⁅")) -((("\\" "t" "e" "x" "t" "r" "q" "u" "i" "l" "l")) ("⁆")) -((("\\" "t" "e" "x" "t" "c" "i" "r" "c" "l" "e" "d" "P")) ("℗")) -((("\\" "t" "e" "x" "t" "r" "e" "f" "e" "r" "e" "n" "c" "e" "m" "a" "r" "k")) ("※")) -)) - -;; Local Variables: -;; mode: scheme -;; coding: utf-8 -;; End: diff --git a/ide/uim/coqide.scm b/ide/uim/coqide.scm deleted file mode 100644 index 62355ac2..00000000 --- a/ide/uim/coqide.scm +++ /dev/null @@ -1,277 +0,0 @@ -;;; coqide.scm -- Emacs-style Latin characters translation -;;; -;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/ -;;; -;;; All rights reserved. -;;; -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: -;;; 1. Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. -;;; 2. Redistributions in binary form must reproduce the above copyright -;;; notice, this list of conditions and the following disclaimer in the -;;; documentation and/or other materials provided with the distribution. -;;; 3. Neither the name of authors nor the names of its contributors -;;; may be used to endorse or promote products derived from this software -;;; without specific prior written permission. -;;; -;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND -;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE -;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -;;; SUCH DAMAGE. -;;;; - -;; This input method implements character composition rules for the -;; Latin letters used in European languages. The rules, defined in -;; the file coqide-rules.scm, have been adapted from GNU Emacs 22. - -(require "util.scm") -(require "rk.scm") -(require "coqide-rules.scm") -(require-custom "generic-key-custom.scm") -(require-custom "coqide-custom.scm") - -(define coqide-context-rec-spec - (append - context-rec-spec - '((on #f) - (rkc #f) - (show-cands #f)))) -(define-record 'coqide-context coqide-context-rec-spec) -(define coqide-context-new-internal coqide-context-new) - -(define (coqide-context-new id im) - (let ((lc (coqide-context-new-internal id im)) - (rkc (rk-context-new (symbol-value coqide-rules) #f #f))) - (coqide-context-set-widgets! lc coqide-widgets) - (coqide-context-set-rkc! lc rkc) - lc)) - -(define (coqide-current-translation lc) - (let ((rkc (coqide-context-rkc lc))) - (or (rk-peek-terminal-match rkc) - (and (not (null? (rk-context-seq rkc))) - (list (rk-pending rkc)))))) - -(define (coqide-current-string lc) - (let ((trans (coqide-current-translation lc))) - (if trans (car trans) ""))) - -(define (coqide-context-clear lc) - (rk-flush (coqide-context-rkc lc))) - -(define (coqide-context-flush lc) - (let ((str (coqide-current-string lc))) - (if (not (equal? str "")) (im-commit lc str)) - (coqide-context-clear lc))) - -(define (coqide-open-candidates-window lc height) - (if (coqide-context-show-cands lc) - (im-deactivate-candidate-selector lc)) - (im-activate-candidate-selector lc height height) - (im-select-candidate lc 0) - (coqide-context-set-show-cands! lc #t)) - -(define (coqide-close-candidates-window lc) - (if (coqide-context-show-cands lc) - (im-deactivate-candidate-selector lc)) - (coqide-context-set-show-cands! lc #f)) - -(define (coqide-update-preedit lc) - (if (coqide-context-on lc) - (let ((trans (coqide-current-translation lc)) - (ltrans 0)) - (im-clear-preedit lc) - (if trans - (begin (im-pushback-preedit lc - preedit-underline - (car trans)) - (set! ltrans (length trans)))) - (im-pushback-preedit lc - preedit-cursor - "") - (im-update-preedit lc) - (if (> ltrans 1) - (coqide-open-candidates-window lc ltrans) - (coqide-close-candidates-window lc))))) - -(define (coqide-prepare-activation lc) - (coqide-context-flush lc) - (coqide-update-preedit lc)) - -(register-action 'action_coqide_off - (lambda (lc) - (list - 'off - "a" - (N_ "CoqIDE mode off") - (N_ "CoqIDE composition off"))) - (lambda (lc) - (not (coqide-context-on lc))) - (lambda (lc) - (coqide-prepare-activation lc) - (coqide-context-set-on! lc #f))) - -(register-action 'action_coqide_on - (lambda (lc) - (list - 'on - "à" - (N_ "CoqIDE mode on") - (N_ "CoqIDE composition on"))) - (lambda (lc) - (coqide-context-on lc)) - (lambda (lc) - (coqide-prepare-activation lc) - (coqide-context-set-on! lc #t))) - -(define coqide-input-mode-actions - '(action_coqide_off action_coqide_on)) - -(define coqide-widgets '(widget_coqide_input_mode)) - -(define default-widget_coqide_input_mode 'action_coqide_on) - -(register-widget 'widget_coqide_input_mode - (activity-indicator-new coqide-input-mode-actions) - (actions-new coqide-input-mode-actions)) - -(define coqide-context-list '()) - -(define (coqide-init-handler id im arg) - (let ((lc (coqide-context-new id im))) - (set! coqide-context-list (cons lc coqide-context-list)) - lc)) - -(define (coqide-release-handler lc) - (let ((rkc (coqide-context-rkc lc))) - (set! coqide-context-list - ;; (delete lc coqide-context-list eq?) does not work - (remove (lambda (c) (eq? (coqide-context-rkc c) rkc)) - coqide-context-list)))) - -(define coqide-control-key? - (let ((shift-or-no-modifier? (make-key-predicate '("<Shift>" "")))) - (lambda (key key-state) - (not (shift-or-no-modifier? -1 key-state))))) - -(define (coqide-proc-on-state lc key key-state) - (let ((rkc (coqide-context-rkc lc)) - (cur-trans (coqide-current-translation lc))) - (cond - - ((or (coqide-off-key? key key-state) - (and coqide-esc-turns-off? (eq? key 'escape))) - (coqide-context-flush lc) - (if (eq? key 'escape) - (im-commit-raw lc)) - (coqide-context-set-on! lc #f) - (coqide-close-candidates-window lc) - (im-clear-preedit lc) - (im-update-preedit lc)) - - ((coqide-backspace-key? key key-state) - (if (not (rk-backspace rkc)) - (im-commit-raw lc))) - - ((coqide-control-key? key key-state) - (coqide-context-flush lc) - (im-commit-raw lc)) - - ((and (ichar-numeric? key) - (coqide-context-show-cands lc) - (let ((idx (- (numeric-ichar->integer key) 1))) - (if (= idx -1) (set! idx 9)) - (and (>= idx 0) (< idx (length cur-trans)) - (begin - (im-commit lc (nth idx cur-trans)) - (coqide-context-clear lc) - #t))))) - - (else - (let* ((key-str (if (symbol? key) - (symbol->string key) - (charcode->string key))) - (cur-seq (rk-context-seq rkc)) - (res (rk-push-key! rkc key-str)) - (new-seq (rk-context-seq rkc)) - (new-trans (coqide-current-translation lc))) - (if (equal? new-seq (cons key-str cur-seq)) - (if (not (or (rk-partial? rkc) (> (length new-trans) 1))) - (begin (im-commit lc (car (rk-peek-terminal-match rkc))) - (coqide-context-clear lc))) - (begin (if (not (null? cur-seq)) (im-commit lc (car cur-trans))) - (if (null? new-seq) (im-commit-raw lc))))))))) - -(define (coqide-proc-off-state lc key key-state) - (if (coqide-on-key? key key-state) - (coqide-context-set-on! lc #t) - (im-commit-raw lc))) - -(define (coqide-key-press-handler lc key key-state) - (if (coqide-context-on lc) - (coqide-proc-on-state lc key key-state) - (coqide-proc-off-state lc key key-state)) - (coqide-update-preedit lc)) - -(define (coqide-key-release-handler lc key key-state) - (if (or (ichar-control? key) - (not (coqide-context-on lc))) - ;; don't discard key release event for apps - (im-commit-raw lc))) - -(define (coqide-reset-handler lc) - (coqide-context-clear lc)) - -(define (coqide-get-candidate-handler lc idx accel-enum-hint) - (let* ((candidates (coqide-current-translation lc)) - (candidate (nth idx candidates))) - (list candidate (digit->string (+ idx 1)) ""))) - -;; Emacs does nothing on focus-out -;; TODO: this should be configurable -(define (coqide-focus-out-handler lc) - #f) - -(define (coqide-place-handler lc) - (coqide-update-preedit lc)) - -(define (coqide-displace-handler lc) - (coqide-context-flush lc) - (coqide-update-preedit lc)) - -(register-im - 'coqide - "" - "UTF-8" - coqide-im-name-label - coqide-im-short-desc - #f - coqide-init-handler - coqide-release-handler - context-mode-handler - coqide-key-press-handler - coqide-key-release-handler - coqide-reset-handler - coqide-get-candidate-handler - #f - context-prop-activate-handler - #f - #f - coqide-focus-out-handler - coqide-place-handler - coqide-displace-handler -) - -;; Local Variables: -;; mode: scheme -;; coding: utf-8 -;; End: diff --git a/ide/undo.ml b/ide/undo.ml index 55d0f288..0951ab5e 100644 --- a/ide/undo.ml +++ b/ide/undo.ml @@ -1,15 +1,13 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: undo.ml 14641 2011-11-06 11:59:10Z herbelin $ *) - -open GText open Ideutils +open GText type action = | Insert of string * int * int (* content*pos*length *) | Delete of string * int * int (* content*pos*length *) diff --git a/ide/undo_lablgtk_ge212.mli b/ide/undo_lablgtk_ge212.mli index 1326a486..95168b17 100644 --- a/ide/undo_lablgtk_ge212.mli +++ b/ide/undo_lablgtk_ge212.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: undo_lablgtk_ge26.mli 7580 2005-11-18 17:09:10Z herbelin $ i*) - (* An undoable view class *) class undoable_view : ([> Gtk.text_view] as 'a) Gtk.obj -> diff --git a/ide/undo_lablgtk_ge26.mli b/ide/undo_lablgtk_ge26.mli index 698b34c5..4b471395 100644 --- a/ide/undo_lablgtk_ge26.mli +++ b/ide/undo_lablgtk_ge26.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: undo_lablgtk_ge26.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) - (* An undoable view class *) class undoable_view : [> Gtk.text_view] Gtk.obj -> diff --git a/ide/undo_lablgtk_lt26.mli b/ide/undo_lablgtk_lt26.mli index e99d3141..df76ee5e 100644 --- a/ide/undo_lablgtk_lt26.mli +++ b/ide/undo_lablgtk_lt26.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: undo_lablgtk_lt26.mli 14641 2011-11-06 11:59:10Z herbelin $ i*) - (* An undoable view class *) class undoable_view : Gtk.text_view Gtk.obj -> diff --git a/ide/utf8_convert.mll b/ide/utf8_convert.mll index ce0c4836..f27f96a6 100644 --- a/ide/utf8_convert.mll +++ b/ide/utf8_convert.mll @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: utf8_convert.mll 14641 2011-11-06 11:59:10Z herbelin $ *) - { open Lexing let b = Buffer.create 127 diff --git a/ide/utils/config_file.ml b/ide/utils/config_file.ml index d972639f..921d3d9c 100644 --- a/ide/utils/config_file.ml +++ b/ide/utils/config_file.ml @@ -23,8 +23,6 @@ (* *) (*********************************************************************************) -(* $Id: config_file.ml 10348 2007-12-06 17:36:14Z aspiwack $ *) - (* TODO *) (* section comments *) (* better obsoletes: no "{}", line cuts *) diff --git a/ide/utils/configwin.ml b/ide/utils/configwin.ml index 05bf54eb..4606ef29 100644 --- a/ide/utils/configwin.ml +++ b/ide/utils/configwin.ml @@ -27,8 +27,8 @@ type parameter_kind = Configwin_types.parameter_kind type configuration_structure = Configwin_types.configuration_structure = - Section of string * parameter_kind list - | Section_list of string * configuration_structure list + Section of string * GtkStock.id option * parameter_kind list + | Section_list of string * GtkStock.id option * configuration_structure list type return_button = Configwin_types.return_button = @@ -60,9 +60,9 @@ let html = Configwin_ihm.html let edit ?(apply=(fun () -> ())) - title ?(width=400) ?(height=400) + title ?width ?height conf_struct_list = - Configwin_ihm.edit ~with_apply: true ~apply title ~width ~height conf_struct_list + Configwin_ihm.edit ~with_apply: true ~apply title ?width ?height conf_struct_list let get = Configwin_ihm.edit ~with_apply: false ~apply: (fun () -> ()) diff --git a/ide/utils/configwin.mli b/ide/utils/configwin.mli index bbfb7a04..c5fbf39a 100644 --- a/ide/utils/configwin.mli +++ b/ide/utils/configwin.mli @@ -32,10 +32,10 @@ type parameter_kind;; (** This type represents the structure of the configuration window. *) type configuration_structure = - | Section of string * parameter_kind list - (** label of the section, parameters *) - | Section_list of string * configuration_structure list - (** label of the section, list of the sub sections *) + | Section of string * GtkStock.id option * parameter_kind list + (** label of the section, icon, parameters *) + | Section_list of string * GtkStock.id option * configuration_structure list + (** label of the section, icon, list of the sub sections *) ;; (** To indicate what button pushed the user when the window is closed. *) diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml index 3833acfa..7dbd0452 100644 --- a/ide/utils/configwin_ihm.ml +++ b/ide/utils/configwin_ihm.ml @@ -29,6 +29,12 @@ open Configwin_types module O = Config_file +class type widget = + object + method box : GObj.widget + method apply : unit -> unit + end + let file_html_config = Filename.concat Configwin_messages.home ".configwin_html" let debug = false @@ -320,17 +326,17 @@ class ['a] list_selection_box in let _ = dbg "list_selection_box: connecting wb_add" in (* connect the functions to the buttons *) - ignore (wb_add#connect#clicked f_add); + ignore (wb_add#connect#clicked ~callback:f_add); let _ = dbg "list_selection_box: connecting wb_remove" in - ignore (wb_remove#connect#clicked f_remove); + ignore (wb_remove#connect#clicked ~callback:f_remove); let _ = dbg "list_selection_box: connecting wb_up" in - ignore (wb_up#connect#clicked (fun () -> self#up_selected)); + ignore (wb_up#connect#clicked ~callback:(fun () -> self#up_selected)); ( match f_edit_opt with None -> () | Some f -> let _ = dbg "list_selection_box: connecting wb_edit" in - ignore (wb_edit#connect#clicked (fun () -> self#edit_selected f)) + ignore (wb_edit#connect#clicked ~callback:(fun () -> self#edit_selected f)) ); (* connect the selection and deselection of items in the clist *) let f_select ~row ~column ~event = @@ -350,9 +356,9 @@ class ['a] list_selection_box in (* connect the select and deselect events *) let _ = dbg "list_selection_box: connecting select_row" in - ignore(wlist#connect#select_row f_select); + ignore(wlist#connect#select_row ~callback:f_select); let _ = dbg "list_selection_box: connecting unselect_row" in - ignore(wlist#connect#unselect_row f_unselect); + ignore(wlist#connect#unselect_row ~callback:f_unselect); (* initialize the clist with the listref *) self#update !listref @@ -393,38 +399,50 @@ class string_param_box param (tt:GData.tooltips) = (** This class is used to build a box for a combo parameter.*) class combo_param_box param (tt:GData.tooltips) = - let _ = dbg "combo_param_box" in - let hbox = GPack.hbox () in - let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in - let _wl = GMisc.label ~text: param.combo_label ~packing: wev#add () in - let wc = GEdit.combo - ~popdown_strings: param.combo_choices - ~value_in_list: (not param.combo_new_allowed) - (* ~allow_empty: param.combo_blank_allowed *) - ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2) - () - in - let _ = - match param.combo_help with - None -> () - | Some help -> - tt#set_tip ~text: help ~privat: help wev#coerce - in - let _ = wc#entry#set_editable param.combo_editable in - let _ = wc#entry#set_text param.combo_value in - - object (self) - (** This method returns the main box ready to be packed. *) - method box = hbox#coerce + let _ = dbg "combo_param_box" in + let hbox = GPack.hbox () in + let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in + let _wl = GMisc.label ~text: param.combo_label ~packing: wev#add () in + let _ = + match param.combo_help with + None -> () + | Some help -> + tt#set_tip ~text: help ~privat: help wev#coerce + in + let get_value = if not param.combo_new_allowed then + let wc = GEdit.combo_box_text + ~strings: param.combo_choices + ?active:(let rec aux i = function + |[] -> None + |h::_ when h = param.combo_value -> Some i + |_::t -> aux (succ i) t + in aux 0 param.combo_choices) + ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2) + () + in + fun () -> match GEdit.text_combo_get_active wc with |None -> "" |Some s -> s + else + let (wc,_) = GEdit.combo_box_entry_text + ~strings: param.combo_choices + ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2) + () + in + let _ = wc#entry#set_editable param.combo_editable in + let _ = wc#entry#set_text param.combo_value in + fun () -> wc#entry#text + in +object (self) + (** This method returns the main box ready to be packed. *) + method box = hbox#coerce (** This method applies the new value of the parameter. *) - method apply = - let new_value = wc#entry#text in + method apply = + let new_value = get_value () in if new_value <> param.combo_value then let _ = param.combo_f_apply new_value in - param.combo_value <- new_value + param.combo_value <- new_value else () - end ;; +end ;; (** Class used to pack a custom box. *) class custom_param_box param (tt:GData.tooltips) = @@ -488,9 +506,9 @@ class color_param_box param (tt:GData.tooltips) = in let wb_ok = dialog#ok_button in let wb_cancel = dialog#cancel_button in - let _ = dialog#connect#destroy GMain.Main.quit in + let _ = dialog#connect#destroy ~callback:GMain.Main.quit in let _ = wb_ok#connect#clicked - (fun () -> + ~callback:(fun () -> (* let color = dialog#colorsel#color in let r = (Gdk.Color.red color) in let g = (Gdk.Color.green color)in @@ -505,11 +523,11 @@ class color_param_box param (tt:GData.tooltips) = dialog#destroy () ) in - let _ = wb_cancel#connect#clicked dialog#destroy in + let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in GMain.Main.main () in let _ = - if param.color_editable then ignore (wb#connect#clicked f_sel) + if param.color_editable then ignore (wb#connect#clicked ~callback:f_sel) in object (self) @@ -525,7 +543,7 @@ class color_param_box param (tt:GData.tooltips) = () initializer - ignore (we#connect#changed (fun () -> set_color we#text)); + ignore (we#connect#changed ~callback:(fun () -> set_color we#text)); end ;; @@ -573,19 +591,19 @@ class font_param_box param (tt:GData.tooltips) = dialog#selection#set_font_name !v; let wb_ok = dialog#ok_button in let wb_cancel = dialog#cancel_button in - let _ = dialog#connect#destroy GMain.Main.quit in + let _ = dialog#connect#destroy ~callback:GMain.Main.quit in let _ = wb_ok#connect#clicked - (fun () -> + ~callback:(fun () -> let font = dialog#selection#font_name in we#set_text font ; set_entry_font (Some font); dialog#destroy () ) in - let _ = wb_cancel#connect#clicked dialog#destroy in + let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in GMain.Main.main () in - let _ = if param.font_editable then ignore (wb#connect#clicked f_sel) in + let _ = if param.font_editable then ignore (wb#connect#clicked ~callback:f_sel) in object (self) (** This method returns the main box ready to be packed. *) @@ -730,7 +748,7 @@ class filename_param_box param (tt:GData.tooltips) = in let _ = if param.string_editable then - let _ = wb#connect#clicked f_click in + let _ = wb#connect#clicked ~callback:f_click in () else () @@ -782,7 +800,7 @@ class hotkey_param_box param (tt:GData.tooltips) = in let _ = if param.hk_editable then - ignore (we#event#connect#key_press capture) + ignore (we#event#connect#key_press ~callback:capture) else () in @@ -811,7 +829,7 @@ class modifiers_param_box param = ~active:(List.mem modifier param.md_value) ~packing:(hbox#pack ~expand:false) () in ignore (but#connect#toggled - (fun _ -> if but#active then value := modifier::!value + ~callback:(fun _ -> if but#active then value := modifier::!value else value := List.filter ((<>) modifier) !value))) param.md_allow in @@ -867,7 +885,7 @@ class date_param_box param (tt:GData.tooltips) = in let _ = if param.date_editable then - let _ = wb#connect#clicked f_click in + let _ = wb#connect#clicked ~callback:f_click in () else () @@ -910,106 +928,179 @@ class ['a] list_param_box (param : 'a list_param) (tt:GData.tooltips) = param.list_value <- !listref end ;; -(** This class is used to build a box from a configuration structure - and adds the page to the given notebook. *) -class configuration_box (tt:GData.tooltips) conf_struct (notebook : GPack.notebook) = - (* we build different widgets, according to the conf_struct parameter *) - let main_box = GPack.vbox () in - let (label, child_boxes) = +(** This class creates a configuration box from a configuration structure *) +class configuration_box (tt : GData.tooltips) conf_struct = + + let main_box = GPack.hbox () in + + let columns = new GTree.column_list in + let icon_col = columns#add GtkStock.conv in + let label_col = columns#add Gobject.Data.string in + let box_col = columns#add Gobject.Data.caml in + let () = columns#lock () in + + let pane = GPack.paned `HORIZONTAL ~packing:main_box#add () in + + (* Tree view part *) + let scroll = GBin.scrolled_window ~hpolicy:`NEVER ~packing:pane#pack1 () in + let tree = GTree.tree_store columns in + let view = GTree.view ~model:tree ~headers_visible:false ~packing:scroll#add_with_viewport () in + let selection = view#selection in + let _ = selection#set_mode `SINGLE in + + let menu_box = GPack.vbox ~packing:pane#pack2 () in + + let renderer = (GTree.cell_renderer_pixbuf [], ["stock-id", icon_col]) in + let col = GTree.view_column ~renderer () in + let _ = view#append_column col in + + let renderer = (GTree.cell_renderer_text [], ["text", label_col]) in + let col = GTree.view_column ~renderer () in + let _ = view#append_column col in + + let make_param (main_box : #GPack.box) = function + | String_param p -> + let box = new string_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Combo_param p -> + let box = new combo_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Text_param p -> + let box = new text_param_box p tt in + let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in + box + | Bool_param p -> + let box = new bool_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Filename_param p -> + let box = new filename_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | List_param f -> + let box = f tt in + let _ = main_box#pack ~expand: true ~padding: 2 box#box in + box + | Custom_param p -> + let box = new custom_param_box p tt in + let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in + box + | Color_param p -> + let box = new color_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Font_param p -> + let box = new font_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Date_param p -> + let box = new date_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Hotkey_param p -> + let box = new hotkey_param_box p tt in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Modifiers_param p -> + let box = new modifiers_param_box p in + let _ = main_box#pack ~expand: false ~padding: 2 box#box in + box + | Html_param p -> + let box = new html_param_box p tt in + let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in + box + in + + let set_icon iter = function + | None -> () + | Some icon -> tree#set iter icon_col icon + in + + (* Populate the tree *) + + let rec make_tree iter conf_struct = + (* box is not shown at first *) + let box = GPack.vbox ~packing:(menu_box#pack ~expand:true) ~show:false () in + let new_iter = match iter with + | None -> tree#append () + | Some parent -> tree#append ~parent () + in match conf_struct with - Section (label, param_list) -> - let f parameter = - match parameter with - String_param p -> - let box = new string_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Combo_param p -> - let box = new combo_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Text_param p -> - let box = new text_param_box p tt in - let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in - box - | Bool_param p -> - let box = new bool_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Filename_param p -> - let box = new filename_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | List_param f -> - let box = f tt in - let _ = main_box#pack ~expand: true ~padding: 2 box#box in - box - | Custom_param p -> - let box = new custom_param_box p tt in - let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in - box - | Color_param p -> - let box = new color_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Font_param p -> - let box = new font_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Date_param p -> - let box = new date_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Hotkey_param p -> - let box = new hotkey_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Modifiers_param p -> - let box = new modifiers_param_box p in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Html_param p -> - let box = new html_param_box p tt in - let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in - box - in - let list_children_boxes = List.map f param_list in - - (label, list_children_boxes) - - | Section_list (label, struct_list) -> - let wnote = GPack.notebook - (*homogeneous_tabs: true*) - ~scrollable: true - ~show_tabs: true - ~tab_border: 3 - ~packing: (main_box#pack ~expand: true) - () - in - (* we create all the children boxes *) - let f structure = - let new_box = new configuration_box tt structure wnote in - new_box - in - let list_child_boxes = List.map f struct_list in - (label, list_child_boxes) + | Section (label, icon, param_list) -> + let params = List.map (make_param box) param_list in + let widget = + object + method box = box#coerce + method apply () = List.iter (fun param -> param#apply) params + end + in + let () = tree#set new_iter label_col label in + let () = set_icon new_iter icon in + let () = tree#set new_iter box_col widget in + () + | Section_list (label, icon, struct_list) -> + let widget = + object + (* Section_list does not contain any effect widget, so we do not have to + apply anything. *) + method apply () = () + method box = box#coerce + end + in + let () = tree#set new_iter label_col label in + let () = set_icon new_iter icon in + let () = tree#set new_iter box_col widget in + List.iter (make_tree (Some new_iter)) struct_list + in + + let () = List.iter (make_tree None) conf_struct in + (* Dealing with signals *) + + let current_prop : widget option ref = ref None in + + let select_iter iter = + let () = match !current_prop with + | None -> () + | Some box -> box#box#misc#hide () + in + let box = tree#get ~row:iter ~column:box_col in + let () = box#box#misc#show () in + current_prop := Some box in - let page_label = GMisc.label ~text: label () in - let _ = notebook#append_page - ~tab_label: page_label#coerce - main_box#coerce + + let when_selected () = + let rows = selection#get_selected_rows in + match rows with + | [] -> () + | row :: _ -> + let iter = tree#get_iter row in + select_iter iter in - object (self) - (** This method returns the main box ready to be packed. *) - method box = main_box#coerce - (** This method make the new values of the paramters applied, recursively in - all boxes.*) + (* Focus on a box when selected *) + + let _ = selection#connect#changed ~callback:when_selected in + + let _ = match tree#get_iter_first with + | None -> () + | Some iter -> select_iter iter + in + + object + + method box = main_box + method apply = - List.iter (fun box -> box#apply) child_boxes + let foreach _ iter = + let widget = tree#get ~row:iter ~column:box_col in + widget#apply(); false + in + tree#foreach foreach + end -;; (** Create a vbox with the list of given configuration structure list, and the given list of buttons (defined by their label and callback). @@ -1017,24 +1108,12 @@ class configuration_box (tt:GData.tooltips) conf_struct (notebook : GPack.notebo of each parameter is called. *) let tabbed_box conf_struct_list buttons tooltips = - let vbox = GPack.vbox () in - let wnote = GPack.notebook - (*homogeneous_tabs: true*) - ~scrollable: true - ~show_tabs: true - ~tab_border: 3 - ~packing: (vbox#pack ~expand: true) - () + let param_box = + new configuration_box tooltips conf_struct_list in - let list_param_box = - List.map - (fun conf_struct -> new configuration_box tooltips conf_struct wnote) - conf_struct_list - in - let f_apply () = - List.iter (fun param_box -> param_box#apply) list_param_box ; + let f_apply () = param_box#apply in - let hbox_buttons = GPack.hbox ~packing: (vbox#pack ~expand: false ~padding: 4) () in + let hbox_buttons = GPack.hbox ~packing: (param_box#box#pack ~expand: false ~padding: 4) () in let rec iter_buttons ?(grab=false) = function [] -> () @@ -1051,62 +1130,49 @@ let tabbed_box conf_struct_list buttons tooltips = in iter_buttons ~grab: true buttons; - vbox + param_box#box (** This function takes a configuration structure list and creates a window to configure the various parameters. *) let edit ?(with_apply=true) ?(apply=(fun () -> ())) - title ?(width=400) ?(height=400) - conf_struct_list = + title ?width ?height + conf_struct = let dialog = GWindow.dialog ~position:`CENTER ~modal: true ~title: title - ~height ~width + ?height ?width () in let tooltips = GData.tooltips () in - let wnote = GPack.notebook - (*homogeneous_tabs: true*) - ~scrollable: true - ~show_tabs: true - ~tab_border: 3 - ~packing: (dialog#vbox#pack ~expand: true) - () - in - let list_param_box = - List.map - (fun conf_struct -> new configuration_box tooltips conf_struct wnote) - conf_struct_list - in - if with_apply then - dialog#add_button Configwin_messages.mApply `APPLY; + let config_box = new configuration_box tooltips conf_struct in - dialog#add_button Configwin_messages.mOk `OK; - dialog#add_button Configwin_messages.mCancel `CANCEL; + let _ = dialog#vbox#add config_box#box#coerce in - let f_apply () = - List.iter (fun param_box -> param_box#apply) list_param_box ; - apply () - in - let destroy () = - tooltips#destroy () ; - dialog#destroy (); - in - let rec iter rep = - try - match dialog#run () with - | `APPLY -> f_apply (); iter Return_apply - | `OK -> f_apply (); destroy (); Return_ok - | _ -> destroy (); rep - with - Failure s -> - GToolbox.message_box "Error" s; iter rep - | e -> - GToolbox.message_box "Error" (Printexc.to_string e); iter rep - in - iter Return_cancel + if with_apply then + dialog#add_button Configwin_messages.mApply `APPLY; + + dialog#add_button Configwin_messages.mOk `OK; + dialog#add_button Configwin_messages.mCancel `CANCEL; + + let destroy () = + tooltips#destroy () ; + dialog#destroy (); + in + let rec iter rep = + try + match dialog#run () with + | `APPLY -> config_box#apply; iter Return_apply + | `OK -> config_box#apply; destroy (); Return_ok + | _ -> destroy (); rep + with + Failure s -> + GToolbox.message_box ~title:"Error" s; iter rep + | e -> + GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep + in + iter Return_cancel (** Create a vbox with the list of given parameters. *) let box param_list tt = @@ -1205,9 +1271,9 @@ let simple_edit ?(with_apply=true) | _ -> destroy (); rep with Failure s -> - GToolbox.message_box "Error" s; iter rep + GToolbox.message_box ~title:"Error" s; iter rep | e -> - GToolbox.message_box "Error" (Printexc.to_string e); iter rep + GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep in iter Return_cancel diff --git a/ide/utils/configwin_messages.ml b/ide/utils/configwin_messages.ml index 26f5b61b..de292431 100644 --- a/ide/utils/configwin_messages.ml +++ b/ide/utils/configwin_messages.ml @@ -30,7 +30,7 @@ let version = "1.2";; let html_config = "Configwin bindings configurator for html parameters" -let home = System.home +let home = Minilib.home let mCapture = "Capture";; let mType_key = "Type key" ;; diff --git a/ide/utils/configwin_types.ml b/ide/utils/configwin_types.ml index 90d5756b..5e2b1e7c 100644 --- a/ide/utils/configwin_types.ml +++ b/ide/utils/configwin_types.ml @@ -263,8 +263,8 @@ type parameter_kind = (** This type represents the structure of the configuration window. *) type configuration_structure = - | Section of string * parameter_kind list (** label of the section, parameters *) - | Section_list of string * configuration_structure list (** label of the section, list of the sub sections *) + | Section of string * GtkStock.id option * parameter_kind list (** label of the section, icon, parameters *) + | Section_list of string * GtkStock.id option * configuration_structure list (** label of the section, list of the sub sections *) ;; (** To indicate what button was pushed by the user when the window is closed. *) diff --git a/ide/utils/okey.ml b/ide/utils/okey.ml index 57939266..905c3485 100644 --- a/ide/utils/okey.ml +++ b/ide/utils/okey.ml @@ -47,6 +47,10 @@ let int_of_modifier = function | `BUTTON3 -> 1024 | `BUTTON4 -> 2048 | `BUTTON5 -> 4096 + | `HYPER -> 1 lsl 22 + | `META -> 1 lsl 20 + | `RELEASE -> 1 lsl 30 + | `SUPER -> 1 lsl 21 let print_modifier l = List.iter @@ -65,7 +69,11 @@ let print_modifier l = | `BUTTON2 -> "B2" | `BUTTON3 -> "B3" | `BUTTON4 -> "B4" - | `BUTTON5 -> "B5") + | `BUTTON5 -> "B5" + | `HYPER -> "HYPER" + | `META -> "META" + | `RELEASE -> "" + | `SUPER -> "SUPER") m)^" ") ) l; |