summaryrefslogtreecommitdiff
path: root/ide
diff options
context:
space:
mode:
Diffstat (limited to 'ide')
-rw-r--r--ide/FAQ24
-rw-r--r--ide/command_windows.ml58
-rw-r--r--ide/command_windows.mli14
-rw-r--r--ide/config_lexer.mll39
-rw-r--r--ide/config_parser.mly43
-rw-r--r--ide/coq.ml953
-rw-r--r--ide/coq.mli106
-rw-r--r--ide/coq_commands.ml9
-rw-r--r--ide/coq_lex.mll223
-rw-r--r--ide/coq_tactics.ml131
-rw-r--r--ide/coq_tactics.mli12
-rw-r--r--ide/coqide-gtk2rc (renamed from ide/.coqide-gtk2rc)14
-rw-r--r--ide/coqide.ml5201
-rw-r--r--ide/coqide.mli38
-rw-r--r--ide/coqide_main.ml4135
-rw-r--r--ide/coqide_ui.ml155
-rw-r--r--ide/gtk_parsing.ml17
-rw-r--r--ide/highlight.mll215
-rw-r--r--ide/ide.mllib5
-rw-r--r--ide/ide_win32_stubs.c51
-rw-r--r--ide/ideproof.ml147
-rw-r--r--ide/ideutils.ml242
-rw-r--r--ide/ideutils.mli32
-rw-r--r--ide/mac_default_accel_map376
-rw-r--r--ide/minilib.ml186
-rw-r--r--ide/minilib.mli44
-rw-r--r--ide/preferences.ml437
-rw-r--r--ide/preferences.mli38
-rw-r--r--ide/project_file.ml4190
-rw-r--r--ide/tags.ml39
-rw-r--r--ide/tags.mli50
-rw-r--r--ide/typed_notebook.ml43
-rw-r--r--ide/uim/coqide-custom.scm99
-rw-r--r--ide/uim/coqide-rules.scm1142
-rw-r--r--ide/uim/coqide.scm277
-rw-r--r--ide/undo.ml6
-rw-r--r--ide/undo_lablgtk_ge212.mli4
-rw-r--r--ide/undo_lablgtk_ge26.mli4
-rw-r--r--ide/undo_lablgtk_lt26.mli4
-rw-r--r--ide/utf8_convert.mll4
-rw-r--r--ide/utils/config_file.ml2
-rw-r--r--ide/utils/configwin.ml8
-rw-r--r--ide/utils/configwin.mli8
-rw-r--r--ide/utils/configwin_ihm.ml464
-rw-r--r--ide/utils/configwin_messages.ml2
-rw-r--r--ide/utils/configwin_types.ml4
-rw-r--r--ide/utils/okey.ml10
47 files changed, 5031 insertions, 6274 deletions
diff --git a/ide/FAQ b/ide/FAQ
index 2079ef6c..f07f229f 100644
--- a/ide/FAQ
+++ b/ide/FAQ
@@ -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 */ { [] }
-;
-
diff --git a/ide/coq.ml b/ide/coq.ml
index 1a5b9def..07f0ece8 100644
--- a/ide/coq.ml
+++ b/ide/coq.ml
@@ -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;