From 499a11a45b5711d4eaabe84a80f0ad3ae539d500 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Wed, 8 May 2013 17:47:10 +0200 Subject: Imported Upstream version 8.4pl2dfsg --- ide/coqide.ml | 7 +++++-- ide/coqide_main.ml4 | 52 +++++++++++++++++++++------------------------------ ide/gtk_parsing.ml | 1 + ide/ide_win32_stubs.c | 44 ++++++++++++++++++++++--------------------- 4 files changed, 50 insertions(+), 54 deletions(-) (limited to 'ide') diff --git a/ide/coqide.ml b/ide/coqide.ml index 07de4daf..94be8318 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -212,6 +212,9 @@ let ignore_break () = 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 @@ -902,7 +905,7 @@ object(self) if stop#compare start > 0 && is_sentence_end stop#backward_char then Some (start,stop) else None - with Not_found -> None + with StartError -> None method complete_at_offset (offset:int) = prerr_endline ("Completion at offset : " ^ string_of_int offset); @@ -2449,7 +2452,7 @@ let main files = try configure ~apply:update_notebook_pos () with _ -> flash_info "Cannot save preferences" end; - reset_revert_timer ()) ~accel:"," ~stock:`PREFERENCES; + reset_revert_timer ()) ~accel:"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"; diff --git a/ide/coqide_main.ml4 b/ide/coqide_main.ml4 index ebcecc17..aaede465 100644 --- a/ide/coqide_main.ml4 +++ b/ide/coqide_main.ml4 @@ -38,6 +38,11 @@ let catch_gtk_messages () = 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). *) @@ -46,47 +51,32 @@ let set_win32_path () = (Filename.dirname Sys.executable_name ^ ";" ^ (try Sys.getenv "PATH" with _ -> "")) -(* On win32, since coqide is now console-free, we re-route stdout/stderr - to avoid Sys_error if someone writes to them. We write to a pipe which - is never read (by default) or to a temp log file (when in debug mode). -*) - -let reroute_stdout_stderr () = - (* We anticipate a bit the argument parsing and look for -debug *) - let debug = List.mem "-debug" (Array.to_list Sys.argv) in - Ideutils.debug := debug; - let out_descr = - if debug then - let (name,chan) = Filename.open_temp_file "coqide_" ".log" in - Coqide.logfile := Some name; - Unix.descr_of_out_channel chan - else - snd (Unix.pipe ()) - in +(* 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. *) -(* Since [win32_interrupt] involves some hack about the process console, - only one should run at the same time, we simply skip execution of - [win32_interrupt] if another instance is already running *) - -let ctrl_c_mtx = Mutex.create () - -let ctrl_c_protect f i = - if not (Mutex.try_lock ctrl_c_mtx) then () - else try f i; Mutex.unlock ctrl_c_mtx with _ -> Mutex.unlock ctrl_c_mtx - IFDEF WIN32 THEN external win32_kill : int -> unit = "win32_kill" -external win32_interrupt : int -> unit = "win32_interrupt" +external win32_interrupt_all : unit -> unit = "win32_interrupt_all" +external win32_hide_console : unit -> unit = "win32_hide_console" + let () = - Coq.killer := win32_kill; - Coq.interrupter := ctrl_c_protect win32_interrupt; set_win32_path (); - reroute_stdout_stderr () + 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 diff --git a/ide/gtk_parsing.ml b/ide/gtk_parsing.ml index 67f7e649..47096e6f 100644 --- a/ide/gtk_parsing.ml +++ b/ide/gtk_parsing.ml @@ -6,6 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) +open Ideutils let underscore = Glib.Utf8.to_unichar "_" ~pos:(ref 0) let arobase = Glib.Utf8.to_unichar "@" ~pos:(ref 0) diff --git a/ide/ide_win32_stubs.c b/ide/ide_win32_stubs.c index c09bf37d..c170b1a9 100644 --- a/ide/ide_win32_stubs.c +++ b/ide/ide_win32_stubs.c @@ -19,31 +19,33 @@ CAMLprim value win32_kill(value pseudopid) { CAMLreturn(Val_unit); } - /* Win32 emulation of a kill -2 (SIGINT) */ -/* This code rely of the fact that coqide is now without initial console. - Otherwise, no console creation in win32unix/createprocess.c, hence - the same console for coqide and all coqtop, and everybody will be - signaled at the same time by the code below. */ +/* 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); +} -/* Moreover, AttachConsole exists only since WinXP, and GetProcessId - since WinXP SP1. For avoiding the GetProcessId, we could adapt code - from win32unix/createprocess.c to make it return both the pid and the - handle. For avoiding the AttachConsole, I don't know, maybe having - an intermediate process between coqide and coqtop ? */ +/* Get rid of the nasty console window (only if we created it) */ -CAMLprim value win32_interrupt(value pseudopid) { - CAMLparam1(pseudopid); - HANDLE h; +CAMLprim value win32_hide_console (value unit) { + CAMLparam1(unit); DWORD pid; - FreeConsole(); /* Normally unnecessary, just to be sure... */ - h = (HANDLE)(Long_val(pseudopid)); - pid = GetProcessId(h); - AttachConsole(pid); - /* We want to survive the Ctrl-C that will also concerns us */ - SetConsoleCtrlHandler(NULL,TRUE); /* NULL + TRUE means ignore */ - GenerateConsoleCtrlEvent(CTRL_C_EVENT,0); /* signal our co-console */ - FreeConsole(); + HWND hw = GetConsoleWindow(); + if (hw != NULL) { + GetWindowThreadProcessId(hw, &pid); + if (pid == GetCurrentProcessId()) + ShowWindow(hw, SW_HIDE); + } CAMLreturn(Val_unit); } -- cgit v1.2.3