[Unison-hackers] [unison-svn] r382 - in trunk/src: . system ubase
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Thu Jul 30 12:58:35 EDT 2009
Author: vouillon
Date: 2009-07-30 12:58:35 -0400 (Thu, 30 Jul 2009)
New Revision: 382
Modified:
trunk/src/RECENTNEWS
trunk/src/mkProjectInfo.ml
trunk/src/system/system_generic.ml
trunk/src/system/system_intf.ml
trunk/src/system/system_win.ml
trunk/src/system/system_win_stubs.c
trunk/src/ubase/prefs.ml
trunk/src/uitext.ml
trunk/src/unicode.ml
trunk/src/update.ml
Log:
* Windows text UI: now put the console into UTF-8 output mode. This
is the right thing to do when in Unicode mode, and is no worse than
what we had previously otherwise (the console use some esoteric
encoding by default). This only works when using a Unicode font
instead of the default raster font.
* Windows text UI: put the terminal into raw mode
* Incorrect paths ("path" directive) now result in an error update
item rather than a fatal error.
* Ignore any BOM (byte-order mark) character at the beginning of
profile files (this character is produced by many tools under
Windows)
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/RECENTNEWS 2009-07-30 16:58:35 UTC (rev 382)
@@ -1,3 +1,18 @@
+CHANGES FROM VERSION 2.37.5
+
+* Windows text UI: now put the console into UTF-8 output mode. This
+ is the right thing to do when in Unicode mode, and is no worse than
+ what we had previously otherwise (the console use some esoteric
+ encoding by default). This only works when using a Unicode font
+ instead of the default raster font.
+* Windows text UI: put the terminal into raw mode
+* Incorrect paths ("path" directive) now result in an error update
+ item rather than a fatal error.
+* Ignore any BOM (byte-order mark) character at the beginning of
+ profile files (this character is produced by many tools under
+ Windows)
+
+-------------------------------
CHANGES FROM VERSION 2.37.1
* Disabled the new directory fast check optimization under Windows, as
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/mkProjectInfo.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -65,7 +65,7 @@
Str.matched_group 1 str;;
let extract_int re str = int_of_string (extract_str re str);;
-let revisionString = "$Rev: 378$";;
+let revisionString = "$Rev: 382$";;
let pointVersion = if String.length revisionString > 5
then Scanf.sscanf revisionString "$Rev: %d " (fun x -> x) - pointVersionOrigin
else (* Determining the pointVersionOrigin in bzr is kind of tricky:
@@ -98,3 +98,4 @@
+
Modified: trunk/src/system/system_generic.ml
===================================================================
--- trunk/src/system/system_generic.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/system/system_generic.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -87,3 +87,23 @@
(* Note that Cygwin provides some kind of inode numbers, but we only
have access to the lower 32 bits on 32bit systems... *)
let hasInodeNumbers () = isNotWindows
+
+(****)
+
+type terminalStateFunctions =
+ { defaultTerminal : unit -> unit; rawTerminal : unit -> unit;
+ startReading : unit -> unit; stopReading : unit -> unit }
+
+let terminalStateFunctions () =
+ let oldState = Unix.tcgetattr Unix.stdin in
+ { defaultTerminal =
+ (fun () -> Unix.tcsetattr Unix.stdin Unix.TCSANOW oldState);
+ rawTerminal =
+ (fun () ->
+ let newState =
+ { oldState with Unix.c_icanon = false; Unix.c_echo = false;
+ Unix.c_vmin = 1 }
+ in
+ Unix.tcsetattr Unix.stdin Unix.TCSANOW newState);
+ startReading = (fun () -> ());
+ stopReading = (fun () -> ()) }
Modified: trunk/src/system/system_intf.ml
===================================================================
--- trunk/src/system/system_intf.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/system/system_intf.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -85,4 +85,9 @@
val close_process_full :
in_channel * out_channel * in_channel -> Unix.process_status
+type terminalStateFunctions =
+ { defaultTerminal : unit -> unit; rawTerminal : unit -> unit;
+ startReading : unit -> unit; stopReading : unit -> unit }
+val terminalStateFunctions : unit -> terminalStateFunctions
+
end
Modified: trunk/src/system/system_win.ml
===================================================================
--- trunk/src/system/system_win.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/system/system_win.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -287,4 +287,33 @@
let canSetTime f = true
(* We provide some kind of inode numbers *)
+(* However, these inode numbers are not usable on FAT filesystems, as
+ renaming a file "b" over a file "a" does not change the inode
+ number of "a". *)
let hasInodeNumbers () = true
+
+(****)
+
+external getConsoleMode : unit -> int = "win_get_console_mode"
+external setConsoleMode : int -> unit = "win_set_console_mode"
+external getConsoleOutputCP : unit -> int = "win_get_console_output_cp"
+external setConsoleOutputCP : int -> unit = "win_set_console_output_cp"
+
+type terminalStateFunctions =
+ { defaultTerminal : unit -> unit; rawTerminal : unit -> unit;
+ startReading : unit -> unit; stopReading : unit -> unit }
+
+let terminalStateFunctions () =
+ let oldstate = getConsoleMode () in
+ let oldcp = getConsoleOutputCP () in
+ (* Ctrl-C does not interrupt a call to ReadFile when
+ ENABLE_LINE_INPUT is not set, so we handle Ctr-C
+ as a character when reading from the console.
+ We still want Ctrl-C to generate an exception when not reading
+ from the console in order to be able to interrupt Unison at any
+ time. *)
+ { defaultTerminal = (fun () -> setConsoleMode oldstate;
+ setConsoleOutputCP oldcp);
+ rawTerminal = (fun () -> setConsoleMode 0x19; setConsoleOutputCP 65001);
+ startReading = (fun () -> setConsoleMode 0x18);
+ stopReading = (fun () -> setConsoleMode 0x19) }
Modified: trunk/src/system/system_win_stubs.c
===================================================================
--- trunk/src/system/system_win_stubs.c 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/system/system_win_stubs.c 2009-07-30 16:58:35 UTC (rev 382)
@@ -511,3 +511,64 @@
return w_create_process_native(argv[0], argv[1], argv[2],
argv[3], argv[4], argv[5]);
}
+
+/****/
+
+static HANDLE conin = INVALID_HANDLE_VALUE;
+
+static void init_conin ()
+{
+ if (conin == INVALID_HANDLE_VALUE) {
+ conin = CreateFile ("CONIN$", GENERIC_READ | GENERIC_WRITE,
+ FILE_SHARE_READ | FILE_SHARE_WRITE, NULL,
+ OPEN_EXISTING, 0, 0);
+ if (conin == INVALID_HANDLE_VALUE) {
+ win32_maperr (GetLastError ());
+ uerror("init_conin", Nothing);
+ }
+ }
+}
+
+CAMLprim value win_get_console_mode (value unit)
+{
+ DWORD mode;
+ BOOL res;
+
+ init_conin ();
+
+ res = GetConsoleMode (conin, &mode);
+ if (res == 0) {
+ win32_maperr (GetLastError ());
+ uerror("get_console_mode", Nothing);
+ }
+
+ return (Val_int (mode));
+}
+
+CAMLprim value win_set_console_mode (value mode)
+{
+ BOOL res;
+
+ init_conin ();
+
+ res = SetConsoleMode (conin, Int_val(mode));
+ if (res == 0) {
+ win32_maperr (GetLastError ());
+ uerror("set_console_mode", Nothing);
+ }
+ return (Val_unit);
+}
+
+CAMLprim value win_get_console_output_cp (value unit) {
+ return (Val_int (GetConsoleOutputCP ()));
+}
+
+CAMLprim value win_set_console_output_cp (value cp) {
+ BOOL res;
+ res = SetConsoleOutputCP (Int_val (cp));
+ if (res == 0) {
+ win32_maperr (GetLastError ());
+ uerror("set_console_cp", Nothing);
+ }
+ return (Val_unit);
+}
Modified: trunk/src/ubase/prefs.ml
===================================================================
--- trunk/src/ubase/prefs.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/ubase/prefs.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -271,10 +271,20 @@
try System.open_in_bin (profilePathname filename)
with Sys_error _ ->
raise(Util.Fatal(Printf.sprintf "Preference file %s not found" filename)) in
+ let bom = "\xef\xbb\xbf" in (* BOM: UTF-8 byte-order mark *)
let rec loop lines =
match (try Some(input_line chan) with End_of_file -> None) with
None -> close_in chan; parseLines filename lines
- | Some(theLine) -> loop (theLine::lines) in
+ | Some(theLine) ->
+ let theLine =
+ (* A lot of Windows tools start a UTF-8 encoded file by a
+ byte-order mark. We skip it. *)
+ if lines = [] && Util.startswith theLine bom then
+ String.sub theLine 3 (String.length theLine - 3)
+ else
+ theLine
+ in
+ loop (theLine::lines) in
loop []
(* Takes a list of strings in reverse order and yields a list of "parsed lines"
Modified: trunk/src/uitext.ml
===================================================================
--- trunk/src/uitext.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/uitext.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -25,12 +25,7 @@
let dumbtty =
Prefs.createBool "dumbtty"
- (match Util.osType with
- `Unix ->
- (try (System.getenv "EMACS" <> "") with
- Not_found -> false)
- | _ ->
- true)
+ (try System.getenv "EMACS" <> "" with Not_found -> false)
"!do not change terminal settings in text UI"
("When set to \\verb|true|, this flag makes the text mode user "
^ "interface avoid trying to change any of the terminal settings. "
@@ -54,42 +49,41 @@
let cbreakMode = ref None
+(* FIX: this may also work with Cygwin, but someone needs to try it... *)
+let supportSignals = Util.osType = `Unix (*|| Util.isCygwin*)
+
let rawTerminal () =
match !cbreakMode with
- None -> ()
- | Some state ->
- let newstate =
- { state with Unix.c_icanon = false; Unix.c_echo = false;
- Unix.c_vmin = 1 }
- in
- Unix.tcsetattr Unix.stdin Unix.TCSANOW newstate
+ None -> ()
+ | Some funs -> funs.System.rawTerminal ()
let defaultTerminal () =
match !cbreakMode with
- None -> ()
- | Some state ->
- Unix.tcsetattr Unix.stdin Unix.TCSANOW state
-
+ None -> ()
+ | Some funs -> funs.System.defaultTerminal ()
+
let restoreTerminal() =
- if Util.osType = `Unix && not (Prefs.read dumbtty) then
+ if supportSignals && not (Prefs.read dumbtty) then
Sys.set_signal Sys.sigcont Sys.Signal_default;
defaultTerminal ();
cbreakMode := None
let setupTerminal() =
- if Util.osType = `Unix && not (Prefs.read dumbtty) then
+ if not (Prefs.read dumbtty) then
try
- cbreakMode := Some (Unix.tcgetattr Unix.stdin);
+ cbreakMode := Some (System.terminalStateFunctions ());
let suspend _ =
defaultTerminal ();
Sys.set_signal Sys.sigtstp Sys.Signal_default;
Unix.kill (Unix.getpid ()) Sys.sigtstp
in
let resume _ =
- Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend);
+ if supportSignals then
+ Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend);
rawTerminal ()
in
- Sys.set_signal Sys.sigcont (Sys.Signal_handle resume);
+ if supportSignals then
+ Sys.set_signal Sys.sigcont (Sys.Signal_handle resume);
resume ()
with Unix.Unix_error _ ->
restoreTerminal ()
@@ -109,14 +103,27 @@
if not (Prefs.read Globals.batch) then alwaysDisplay message
let getInput () =
- if !cbreakMode = None then
- let l = input_line stdin in
- if l="" then "" else String.sub l 0 1
- else
- let c = input_char stdin in
- let c = if c='\n' then "" else String.make 1 c in
- display c;
- c
+ match !cbreakMode with
+ None ->
+ let l = input_line stdin in
+ if l="" then "" else String.sub l 0 1
+ | Some funs ->
+ let input_char () =
+ (* We cannot used buffered I/Os under Windows, as character
+ '\r' is not passed through (probably due to the code that
+ turns \r\n into \n) *)
+ let s = String.create 1 in
+ let n = Unix.read Unix.stdin s 0 1 in
+ if n = 0 then raise End_of_file;
+ if s.[0] = '\003' then raise Sys.Break;
+ s.[0]
+ in
+ funs.System.startReading ();
+ let c = input_char () in
+ funs.System.stopReading ();
+ let c = if c='\n' || c = '\r' then "" else String.make 1 c in
+ display c;
+ c
let newLine () =
if !cbreakMode <> None then display "\n"
Modified: trunk/src/unicode.ml
===================================================================
--- trunk/src/unicode.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/unicode.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -934,7 +934,11 @@
try
let s' = norm s 0 l s' 0 in order s'; s'
with Invalid ->
- s
+ (* We need a comparison function which is coherent (transitive)
+ also with non-unicode strings. The optimization below assumes
+ a case-insensitive comparison on ASCII characters, thus we
+ translate the string to lowercase *)
+ String.lowercase s
(****)
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2009-07-29 14:34:18 UTC (rev 381)
+++ trunk/src/update.ml 2009-07-30 16:58:35 UTC (rev 382)
@@ -1598,24 +1598,30 @@
in
match status with
| `BadEnc ->
- raise (Util.Transient
- (Format.sprintf
- "The filename %s in path %s is not encoded in Unicode"
- (Name.toString name) (Path.toString fullpath)))
+ let error =
+ Format.sprintf
+ "The filename %s in path %s is not encoded in Unicode"
+ (Name.toString name) (Path.toString fullpath)
+ in
+ (archive, Error error, translatePathLocal fspath fullpath, [])
| `BadName ->
- raise (Util.Transient
- (Format.sprintf
- "The filename %s in path %s is not allowed under Windows"
- (Name.toString name) (Path.toString fullpath)))
+ let error =
+ Format.sprintf
+ "The filename %s in path %s is not allowed under Windows"
+ (Name.toString name) (Path.toString fullpath)
+ in
+ (archive, Error error, translatePathLocal fspath fullpath, [])
| `Dup ->
- raise (Util.Transient
- (Format.sprintf
- "The path %s is ambiguous at filename %s (i.e., the name \
- of this path is the same, modulo capitalization, as \
- another path in a case-sensitive filesystem, and you are \
- synchronizing this filesystem with a case-insensitive \
- filesystem."
- (Path.toString fullpath) (Name.toString name)))
+ let error =
+ Format.sprintf
+ "The path %s is ambiguous at filename %s (i.e., the name \
+ of this path is the same, modulo capitalization, as \
+ another path in a case-sensitive filesystem, and you are \
+ synchronizing this filesystem with a case-insensitive \
+ filesystem."
+ (Path.toString fullpath) (Name.toString name)
+ in
+ (archive, Error error, translatePathLocal fspath fullpath, [])
| `Ok ->
match archive with
ArchiveDir (desc, children) ->
More information about the Unison-hackers
mailing list