[Unison-hackers] [unison-svn] r391 - in trunk/src: . system uimacnew uimacnew09
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Tue Jan 5 04:33:18 EST 2010
Author: vouillon
Date: 2010-01-05 04:33:18 -0500 (Tue, 05 Jan 2010)
New Revision: 391
Modified:
trunk/src/Makefile.OCaml
trunk/src/RECENTNEWS
trunk/src/copy.ml
trunk/src/mkProjectInfo.ml
trunk/src/pixmaps.ml
trunk/src/props.ml
trunk/src/remote.ml
trunk/src/system/system_win.ml
trunk/src/system/system_win_stubs.c
trunk/src/uigtk2.ml
trunk/src/uimacnew/ReconItem.m
trunk/src/uimacnew09/ReconItem.m
Log:
* GTK UI:
- revert to the previous action pixmaps
- made the progress bar slightly larger
* MacOS GUI:
- use darker grey arrows (patch contributed by Eric Y. Kow)
* Make STATIC=true kind of work again (though it is not possible to
make completely statically linked binaries with the glibc library)
* Windows: added support for long UNC paths
* Do not keep many files simultaneously opened anymore when the rsync
algorithm is in use
* IPV6: properly deal with Unix errors, so that Unison correctly fall
backs to IPV4 if the kernel does not support IPV6
Modified: trunk/src/Makefile.OCaml
===================================================================
--- trunk/src/Makefile.OCaml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/Makefile.OCaml 2010-01-05 09:33:18 UTC (rev 391)
@@ -292,7 +292,7 @@
### Static build setup
ifeq ($(STATIC), true)
- STATICLIBS+=-cclib -static
+ CFLAGS+=-cclib -static
endif
####################################################################
@@ -409,7 +409,7 @@
$(NAME)$(EXEC_EXT): $(CAMLOBJS) $(COBJS)
@echo Linking $@
- $(CAMLC) -verbose $(CAMLFLAGS) -o $@ $(CFLAGS) $(CAMLLIBS) $(CLIBS) $^
+ $(CAMLC) -verbose $(CAMLFLAGS) -o $@ $(CFLAGS) $(CAMLLIBS) $^ $(CLIBS)
# Unfortunately -output-obj does not put .o files into the output, only .cmx
# files, so we have to use $(LD) to take care of COBJS.
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/RECENTNEWS 2010-01-05 09:33:18 UTC (rev 391)
@@ -1,5 +1,21 @@
CHANGES FROM VERSION 2.38.0
+* GTK UI:
+ - revert to the previous action pixmaps
+ - made the progress bar slightly larger
+* MacOS GUI:
+ - use darker grey arrows (patch contributed by Eric Y. Kow)
+* Make STATIC=true kind of work again (though it is not possible to
+ make completely statically linked binaries with the glibc library)
+* Windows: added support for long UNC paths
+* Do not keep many files simultaneously opened anymore when the rsync
+ algorithm is in use
+* IPV6: properly deal with Unix errors, so that Unison correctly fall
+ backs to IPV4 if the kernel does not support IPV6
+
+-------------------------------
+CHANGES FROM VERSION 2.38.0
+
* Incorporated new version of OSX GUI with numerous improvements and
bugfixes by Markus Gross. (Not compiling yet on my machine, though.)
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/copy.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -408,6 +408,16 @@
| Some fd ->
fd
+(* Lazy opening of the reference file (for rsync algorithm) *)
+let referenceFd fspath path kind infd =
+ match !infd with
+ None ->
+ let fd = openFileIn fspath path kind in
+ infd := Some fd;
+ fd
+ | Some fd ->
+ fd
+
let rsyncReg = Lwt_util.make_region (40 * 1024)
let rsyncThrottle useRsync srcFileSize destFileSize f =
if not useRsync then f () else
@@ -417,8 +427,9 @@
let transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
fileKind srcFileSize id =
- (* We delay the opening of the file so that there are not too many
- temporary files remaining after a crash *)
+ (* We delay the opening of the files so that there are not too many
+ temporary files remaining after a crash, and that they are not
+ too many files simultaneously opened. *)
let outfd = ref None in
let infd = ref None in
let showProgress count =
@@ -446,24 +457,25 @@
Util.convertUnixErrorsToTransient
"preprocessing file"
(fun () ->
- let ifd = openFileIn fspathTo realPathTo fileKind in
+ let ifd = referenceFd fspathTo realPathTo fileKind infd in
let (bi, blockSize) =
protect
(fun () -> Transfer.Rsync.rsyncPreprocess
ifd srcFileSize destFileSize)
(fun () -> close_in_noerr ifd)
in
- infd := Some ifd;
+ close_all infd outfd;
(Some bi,
(* Rsync decompressor *)
fun ti ->
+ let ifd = referenceFd fspathTo realPathTo fileKind infd in
let fd =
destinationFd
fspathTo pathTo fileKind srcFileSize outfd id in
let eof =
Transfer.Rsync.rsyncDecompress blockSize ifd fd showProgress ti
in
- if eof then begin close_out fd; outfd := None end))
+ if eof then close_all infd outfd))
else
(None,
(* Simple generic decompressor *)
@@ -471,7 +483,7 @@
let fd =
destinationFd fspathTo pathTo fileKind srcFileSize outfd id in
let eof = Transfer.receive fd showProgress ti in
- if eof then begin close_out fd; outfd := None end)
+ if eof then close_all infd outfd)
in
let file_id = Remote.newMsgId () in
Lwt.catch
@@ -483,6 +495,7 @@
decompressor :=
Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
close_all infd outfd;
+ (* JV: FIX: the file descriptors are already closed... *)
Lwt.return ())
(fun e ->
decompressor :=
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/mkProjectInfo.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -89,3 +89,4 @@
+
Modified: trunk/src/pixmaps.ml
===================================================================
--- trunk/src/pixmaps.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/pixmaps.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -18,147 +18,140 @@
let copyAB color = [|
(* width height num_colors chars_per_pixel *)
-" 28 14 3 1";
+" 28 14 2 1";
(* colors *)
". c None";
"# c #" ^ color;
-" c #ffffff";
(* pixels *)
"............................";
"............................";
-"..................... ......";
-".................... # .....";
-"................... ### ...";
-". #### .";
-" ########################## ";
-" ########################## ";
-". #### .";
-"................... ### ...";
-".................... # .....";
-"..................... ......";
"............................";
+"......................#.....";
+".....................###....";
+"......................####..";
+"..##########################";
+"..##########################";
+"......................####..";
+".....................###....";
+"......................#.....";
+"............................";
+"............................";
"............................"
|]
let copyBA color = [|
(* width height num_colors chars_per_pixel *)
-" 28 14 3 1";
+" 28 14 2 1";
(* colors *)
". c None";
"# c #" ^ color;
-" c #ffffff";
(* pixels *)
"............................";
"............................";
-"...... .....................";
-"..... # ....................";
-"... ### ...................";
-". #### .";
-" ########################## ";
-" ########################## ";
-". #### .";
-"... ### ...................";
-"..... # ....................";
-"...... .....................";
"............................";
+".....#......................";
+"....###.....................";
+"..####......................";
+"##########################..";
+"##########################..";
+"..####......................";
+"....###.....................";
+".....#......................";
+"............................";
+"............................";
"............................"
|]
let mergeLogo color = [|
(* width height num_colors chars_per_pixel *)
-" 28 14 3 1";
+" 28 14 2 1";
(* colors *)
". c None";
"# c #" ^ color;
-" c #ffffff";
(* pixels *)
"............................";
-"......... ...... .........";
-"........ ## .... ## ........";
-"........ ### .. ### ........";
-"........ #### #### ........";
-"........ ## #### ## ........";
-"........ ## ## ## ........";
-"........ ## . . ## ........";
-"........ ## .... ## ........";
-"........ ## .... ## ........";
-"........ ## .... ## ........";
-"........ ## .... ## ........";
-"......... ...... .........";
+"............................";
+".........##......##.........";
+".........###....###.........";
+".........####..####.........";
+".........##.####.##.........";
+".........##..##..##.........";
+".........##......##.........";
+".........##......##.........";
+".........##......##.........";
+".........##......##.........";
+".........##......##.........";
+"............................";
"............................"
|]
let ignore color = [|
(* width height num_colors chars_per_pixel *)
-" 20 14 3 1";
+" 20 14 2 1";
(* colors *)
" c None";
"* c #" ^ color;
-". c #ffffff";
(* pixels *)
-" ..... ";
-" .*****. ";
-" .**...**. ";
-" .**. .**. ";
-" .. .**. ";
-" .**. ";
-" .**. ";
-" .**. ";
-" .**. ";
-" .. ";
-" .. ";
-" .**. ";
-" .**. ";
-" .. "
+" ";
+" ***** ";
+" ** ** ";
+" ** ** ";
+" ** ";
+" ** ";
+" ** ";
+" ** ";
+" ** ";
+" ";
+" ";
+" ** ";
+" ** ";
+" "
|]
let success = [|
(* width height num_colors chars_per_pixel *)
-" 20 14 3 1";
+" 20 14 2 1";
(* colors *)
" c None";
"* c #00dd00";
-". c #ffffff";
(* pixels *)
+" ";
" ";
-" ... ";
-" ..***. ";
-" .******. ";
-" .*****.*. ";
-" ... .****.. . ";
-" .***. .***. ";
-" .***.**.. ";
-" .******. ";
-" ..***. ";
-" .**. ";
-" .**. ";
-" .*. ";
-" . "
+" *** ";
+" ****** ";
+" ***** * ";
+" **** ";
+" *** *** ";
+" *** ** ";
+" ****** ";
+" *** ";
+" ** ";
+" ** ";
+" * ";
+" "
|]
let failure = [|
(* width height num_colors chars_per_pixel *)
-" 20 15 3 1";
+" 20 14 2 1";
(* colors *)
" c None";
"* c #ff0000";
-". c #ffffff";
(* pixels *)
-" . .. ";
-" .*. .**. ";
-" .***. .***. ";
-" .**. .***. ";
-" .**..**. ";
-" .*****. ";
-" .****. ";
-" .***. ";
-" .*****. ";
-" .**.**. ";
-" .**. .**. ";
-" .**. .***. ";
-" .***. .**. ";
-" .***. .. ";
-" ... "
+" * * ";
+" *** ** ";
+" *** *** ";
+" ** ** ";
+" ** ** ";
+" ***** ";
+" **** ";
+" *** ";
+" ***** ";
+" ** ** ";
+" ** ** ";
+" ** *** ";
+" *** ** ";
+" *** "
|]
Modified: trunk/src/props.ml
===================================================================
--- trunk/src/props.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/props.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -489,7 +489,7 @@
let toString t = Util.time2string (extract t)
let syncedPartsToString t = match t with
- Synced _ -> toString t
+ Synced _ -> Format.sprintf "%s (%f)" (toString t) (extract t)
| NotSynced _ -> ""
(* FIX: Probably there should be a check here that prevents us from ever *)
Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/remote.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -901,7 +901,7 @@
Lwt_util.run_in_region streamReg 1
(fun () -> sender (fun v -> client conn id v)))
(fun v -> ping conn id >>= fun () -> Lwt.return v)
- (fun e -> ping conn id >>= fun () -> Lwt.fail e)
+ (fun e -> ping conn id >>= fun () -> Lwt.fail e)
end
let commandAvailable =
@@ -991,29 +991,88 @@
let targetHostEntry = Unix.gethostbyname host in
targetHostEntry.Unix.h_addr_list.(0)
+let rec findFirst f l =
+ match l with
+ [] -> None
+ | x :: r -> match f x with
+ None -> findFirst f r
+ | Some _ as v -> v
+
+let buildSocket host port kind =
+ let attemptCreation ai =
+ try
+ let socket =
+ Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype ai.Unix.ai_protocol
+ in
+ try
+ begin match kind with
+ `Connect ->
+ (* Connect to the remote host *)
+ Unix.connect socket ai.Unix.ai_addr
+ | `Bind ->
+ (* Allow reuse of local addresses for bind *)
+ Unix.setsockopt socket Unix.SO_REUSEADDR true;
+ (* Bind the socket to portnum on the local host *)
+ Unix.bind socket ai.Unix.ai_addr;
+ (* Start listening, allow up to 1 pending request *)
+ Unix.listen socket 1
+ end;
+ Some socket
+ with Unix.Unix_error _ as e ->
+ Unix.close socket;
+ raise e
+ with Unix.Unix_error (error, _, _) ->
+ begin match error with
+ Unix.EAFNOSUPPORT | Unix.EPROTONOSUPPORT | Unix.EINVAL ->
+ ()
+ | _ ->
+ let msg =
+ match kind with
+ `Connect ->
+ Printf.sprintf "Can't connect to server (%s:%s): %s"
+ host port (Unix.error_message error)
+ | `Bind ->
+ Printf.sprintf
+ "Can't bind socket to port %s at address [%s]: %s\n"
+ port
+ (match ai.Unix.ai_addr with
+ Unix.ADDR_INET (addr, _) -> Unix.string_of_inet_addr addr
+ | _ -> assert false)
+ (Unix.error_message error)
+ in
+ Util.warn msg
+ end;
+ None
+ in
+ let options =
+ match kind with
+ `Connect -> [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ]
+ | `Bind -> [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ; Unix.AI_PASSIVE ]
+ in
+ match
+ findFirst attemptCreation (Unix.getaddrinfo host port options)
+ with
+ Some socket ->
+ socket
+ | None ->
+ let msg =
+ match kind with
+ `Connect ->
+ Printf.sprintf
+ "Can't find the IP address of the server (%s:%s)" host port
+ | `Bind ->
+ if host = "" then
+ Printf.sprintf "Can't bind socket to port %s" port
+ else
+ Printf.sprintf "Can't bind socket to port %s on host %s"
+ port host
+ in
+ raise (Util.Fatal msg)
+
let buildSocketConnection host port =
Util.convertUnixErrorsToFatal "canonizeRoot" (fun () ->
- let rec loop = function
- [] ->
- raise (Util.Fatal
- (Printf.sprintf
- "Can't find the IP address of the server (%s:%s)" host
- port))
- | ai::r ->
- (* create a socket to talk to the remote host *)
- let socket = Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype ai.Unix.ai_protocol in
- begin try
- Unix.connect socket ai.Unix.ai_addr;
- initConnection socket socket
- with
- Unix.Unix_error (error, _, reason) ->
- (if error != Unix.EAFNOSUPPORT then
- Util.warn
- (Printf.sprintf
- "Can't connect to server (%s:%s): %s" host port reason);
- loop r)
- end
- in loop (Unix.getaddrinfo host port [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ]))
+ let socket = buildSocket host port `Connect in
+ initConnection socket socket)
let buildShellConnection shell host userOpt portOpt rootName termInteract =
let remoteCmd =
@@ -1359,38 +1418,7 @@
let host = match hostOpt with
Some host -> host
| None -> "" in
- let rec loop = function
- [] -> raise (Util.Fatal
- (if host = "" then
- Printf.sprintf "Can't bind socket to port %s" port
- else
- Printf.sprintf "Can't bind socket to port %s on host %s" port host))
- | ai::r ->
- (* Open a socket to listen for queries *)
- let socket = Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype
- ai.Unix.ai_protocol in
- begin try
- (* Allow reuse of local addresses for bind *)
- Unix.setsockopt socket Unix.SO_REUSEADDR true;
- (* Bind the socket to portnum on the local host *)
- Unix.bind socket ai.Unix.ai_addr;
- (* Start listening, allow up to 1 pending request *)
- Unix.listen socket 1;
- socket
- with
- Unix.Unix_error (error, _, reason) ->
- (if error != Unix.EAFNOSUPPORT then
- Util.msg
- "Can't bind socket to port %s at address [%s]: %s\n"
- port
- (match ai.Unix.ai_addr with
- Unix.ADDR_INET (addr, _) -> Unix.string_of_inet_addr addr
- | _ -> assert false)
- (Unix.error_message error);
- loop r)
- end in
- let listening = loop (Unix.getaddrinfo host port [ Unix.AI_SOCKTYPE
- Unix.SOCK_STREAM ; Unix.AI_PASSIVE ]) in
+ let listening = buildSocket host port `Bind in
Util.msg "server started\n";
while
(* Accept a connection *)
Modified: trunk/src/system/system_win.ml
===================================================================
--- trunk/src/system/system_win.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/system/system_win.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -41,11 +41,12 @@
done;
f
let winRootRx = Rx.rx "[a-zA-Z]:[/\\].*"
-let winUncRx = Rx.rx "//[^/]+/[^/]+/.*"
-(* FIX: we could also handle UNC paths *)
+let winUncRx = Rx.rx "[/\\][/\\][^/\\]+[/\\][^/\\]+[/\\].*"
let extendedPath f =
if Rx.match_string winRootRx f then
fixPath ("\\\\?\\" ^ f)
+ else if Rx.match_string winUncRx f then
+ fixPath ("\\\\?\\UNC" ^ String.sub f 1 (String.length f - 1))
else
f
Modified: trunk/src/system/system_win_stubs.c
===================================================================
--- trunk/src/system/system_win_stubs.c 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/system/system_win_stubs.c 2010-01-05 09:33:18 UTC (rev 391)
@@ -281,6 +281,10 @@
v = caml_alloc (12, 0);
Store_field (v, 0, Val_int (info.dwVolumeSerialNumber));
+
+ // Apparently, we cannot trust the inode number to be stable when
+ // nFileIndexHigh is 0.
+ if (info.nFileIndexHigh == 0) info.nFileIndexLow = 0;
/* The ocaml code truncates inode numbers to 31 bits. We hash the
low and high parts in order to lose as little information as
possible. */
Modified: trunk/src/uigtk2.ml
===================================================================
--- trunk/src/uigtk2.ml 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/uigtk2.ml 2010-01-05 09:33:18 UTC (rev 391)
@@ -108,10 +108,13 @@
Gdk.Cursor.create_from_pixmap
(bitmap :> Gdk.pixmap) ~mask:bitmap ~fg:color ~bg:color ~x:2 ~y:2)
-let make_busy w = Gdk.Window.set_cursor w#misc#window (Lazy.force leftPtrWatch)
+let make_busy w =
+ if Util.osType <> `Win32 then
+ Gdk.Window.set_cursor w#misc#window (Lazy.force leftPtrWatch)
let make_interactive w =
- (* HACK: setting the cursor to NULL restore the default cursor *)
- Gdk.Window.set_cursor w#misc#window (Obj.magic Gpointer.boxed_null)
+ if Util.osType <> `Win32 then
+ (* HACK: setting the cursor to NULL restore the default cursor *)
+ Gdk.Window.set_cursor w#misc#window (Obj.magic Gpointer.boxed_null)
(*********************************************************************
UI state variables
@@ -1467,8 +1470,8 @@
let fastcheck = isLocal >> not >> (fun b -> b || Util.osType = `Win32) in
(* Unicode mode can be problematic when the source machine is under
Windows and the remote machine is not, as Unison may have already
- been used using the legacy Latin 1 encoding. Cygwin (stable)
- also does not handle Unicode at the moment. *)
+ been used using the legacy Latin 1 encoding. Cygwin also did not
+ handle Unicode before version 1.7. *)
let vb = GPack.vbox ~spacing:6 ~packing:(options#pack ~expand:false) () in
let askUnicode =
isLocal >> not >> fun b -> (b || Util.isCygwin) && Util.osType = `Win32 in
@@ -1505,11 +1508,18 @@
let unicode =
React.lift2 (||) (askUnicode >> not) (GtkReact.toggle_button unicodeButton)
in
+ let p =
+ assistant#append_page
+ ~title:"Specific Options" ~complete:true
+ ~page_type:`CONTENT
+ options#as_widget
+ in
ignore
- (assistant#append_page
- ~title:"Specific Options" ~complete:true
- ~page_type:`CONTENT
- options#as_widget);
+ (assistant#connect#prepare (fun () ->
+ if assistant#current_page = p &&
+ not (Util.osType <> `Win32 || React.state askUnicode)
+ then
+ assistant#set_current_page (p + 1)));
let conclusion =
GMisc.label
@@ -2954,7 +2964,7 @@
let progressBar =
GRange.progress_bar ~packing:(statusHBox#pack ~expand:false) () in
- progressBar#misc#set_size_chars ~height:1 ~width:25 ();
+ progressBar#misc#set_size_chars ~height:1 ~width:28 ();
progressBar#set_pulse_step 0.02;
let progressBarPulse = ref false in
Modified: trunk/src/uimacnew/ReconItem.m
===================================================================
--- trunk/src/uimacnew/ReconItem.m 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/uimacnew/ReconItem.m 2010-01-05 09:33:18 UTC (rev 391)
@@ -824,8 +824,7 @@
{
if (!_parentImages) {
_parentImages = [[NSMutableDictionary alloc] init];
- _veryLightGreyColor = [[NSColor colorWithCalibratedRed:0.9 green:0.9 blue:0.9 alpha:1.0] retain];
- // [NSColor lightGrayColor]
+ _veryLightGreyColor = [[NSColor colorWithCalibratedRed:0.7 green:0.7 blue:0.7 alpha:1.0] retain];
}
NSImage *baseImage = [super direction];
NSImage *parentImage = [_parentImages objectForKey:baseImage];
Modified: trunk/src/uimacnew09/ReconItem.m
===================================================================
--- trunk/src/uimacnew09/ReconItem.m 2009-12-04 01:30:20 UTC (rev 390)
+++ trunk/src/uimacnew09/ReconItem.m 2010-01-05 09:33:18 UTC (rev 391)
@@ -824,8 +824,7 @@
{
if (!_parentImages) {
_parentImages = [[NSMutableDictionary alloc] init];
- _veryLightGreyColor = [[NSColor colorWithCalibratedRed:0.9 green:0.9 blue:0.9 alpha:1.0] retain];
- // [NSColor lightGrayColor]
+ _veryLightGreyColor = [[NSColor colorWithCalibratedRed:0.7 green:0.7 blue:0.7 alpha:1.0] retain];
}
NSImage *baseImage = [super direction];
NSImage *parentImage = [_parentImages objectForKey:baseImage];
More information about the Unison-hackers
mailing list