Imported Upstream version 8.4pl2dfsgupstream/8.4pl2dfsg

4 files changed, 50 insertions, 54 deletions

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:"<Ctrl>," ~stock:`PREFERENCES;
+	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";
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);
 }