[Unison-hackers] [unison-svn] r396 - in trunk/src: . ubase
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Thu Jan 7 14:16:05 EST 2010
Author: vouillon
Date: 2010-01-07 14:16:05 -0500 (Thu, 07 Jan 2010)
New Revision: 396
Modified:
trunk/src/.depend
trunk/src/RECENTNEWS
trunk/src/abort.ml
trunk/src/case.ml
trunk/src/case.mli
trunk/src/copy.ml
trunk/src/fileinfo.ml
trunk/src/mkProjectInfo.ml
trunk/src/osx.ml
trunk/src/ubase/prefs.ml
trunk/src/ubase/prefs.mli
trunk/src/uicommon.ml
trunk/src/uicommon.mli
trunk/src/uigtk2.ml
trunk/src/update.ml
Log:
* Bumped version number: incompatible protocol changes
* Resume copy of partially transferred files.
* Unicode mode is now the default when one of the hosts is under
Windows or MacOS. This may make upgrades a bit more painful (the
archives cannot be reused), but this is a much saner default.
* Fastcheck is now the default under Windows. People mostly use NTFS
nowadays and the Unicode API provides an equivalent to inode numbers
for this filesystem.
* Unison now fails if in unicode case-insensitive mode but the archive
mode is not known (this means that we are upgrading from an older
version which did not support this mode)
* Changed the type of trivalued preferences (true/false/default) to an
enumerated type
* Removed the "reusewindows" preference, which was not used anymore.
* GTK UI: do not reposition the file list on focus change
Modified: trunk/src/.depend
===================================================================
--- trunk/src/.depend 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/.depend 2010-01-07 19:16:05 UTC (rev 396)
@@ -13,7 +13,8 @@
lwt/lwt.cmi common.cmi
fileutil.cmi:
fingerprint.cmi: uutil.cmi path.cmi fspath.cmi
-fpcache.cmi:
+fpcache.cmi: system.cmi props.cmi path.cmi osx.cmi os.cmi fspath.cmi \
+ fileinfo.cmi
fs.cmi: system/system_intf.cmo fspath.cmi
fspath.cmi: system.cmi path.cmi name.cmi
globals.cmi: ubase/prefs.cmi pred.cmi path.cmi lwt/lwt.cmi common.cmi
@@ -63,13 +64,13 @@
copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi transfer.cmi \
ubase/trace.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi \
path.cmi osx.cmi os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi \
- fspath.cmi fs.cmi fileinfo.cmi external.cmi common.cmi clroot.cmi \
- bytearray.cmi abort.cmi copy.cmi
+ fspath.cmi fs.cmi fpcache.cmi fingerprint.cmi fileinfo.cmi external.cmi \
+ common.cmi clroot.cmi bytearray.cmi abort.cmi copy.cmi
copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx transfer.cmx \
ubase/trace.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx \
path.cmx osx.cmx os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx \
- fspath.cmx fs.cmx fileinfo.cmx external.cmx common.cmx clroot.cmx \
- bytearray.cmx abort.cmx copy.cmi
+ fspath.cmx fs.cmx fpcache.cmx fingerprint.cmx fileinfo.cmx external.cmx \
+ common.cmx clroot.cmx bytearray.cmx abort.cmx copy.cmi
external.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi lwt/lwt_util.cmi \
lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi
external.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx lwt/lwt_util.cmx \
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/RECENTNEWS 2010-01-07 19:16:05 UTC (rev 396)
@@ -1,3 +1,23 @@
+CHANGES FROM VERSION 2.39.0
+
+* Bumped version number: incompatible protocol changes
+
+* Resume copy of partially transferred files.
+* Unicode mode is now the default when one of the hosts is under
+ Windows or MacOS. This may make upgrades a bit more painful (the
+ archives cannot be reused), but this is a much saner default.
+* Fastcheck is now the default under Windows. People mostly use NTFS
+ nowadays and the Unicode API provides an equivalent to inode numbers
+ for this filesystem.
+* Unison now fails if in unicode case-insensitive mode but the archive
+ mode is not known (this means that we are upgrading from an older
+ version which did not support this mode)
+* Changed the type of trivalued preferences (true/false/default) to an
+ enumerated type
+* Removed the "reusewindows" preference, which was not used anymore.
+* GTK UI: do not reposition the file list on focus change
+
+-------------------------------
CHANGES FROM VERSION 2.38.5
* Fix the fingerprint cache so that it works also with multiple paths
Modified: trunk/src/abort.ml
===================================================================
--- trunk/src/abort.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/abort.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -25,7 +25,7 @@
"This preference controls after how many errors Unison aborts a \
directory transfer. Setting it to a large number allows Unison \
to transfer most of a directory even when some files fail to be \
- copied. The default is 1. If the preference is set to high, \
+ copied. The default is 1. If the preference is set too high, \
Unison may take a long time to abort in case of repeated \
failures (for instance, when the disk is full)."
Modified: trunk/src/case.ml
===================================================================
--- trunk/src/case.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/case.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -51,10 +51,10 @@
"*Pseudo-preference for internal use only" ""
(* Whether we default to Unicode encoding on OSX and Windows *)
-let defaultToUnicode = false
+let defaultToUnicode = true
let useUnicode b =
- let pref = Prefs.readBoolWithDefault unicode in
+ let pref = Prefs.read unicode in
pref = `True ||
(defaultToUnicode && pref = `Default && b)
@@ -66,8 +66,8 @@
(* server with the rest of the prefs. *)
let init b =
Prefs.set someHostIsInsensitive
- (Prefs.readBoolWithDefault caseInsensitiveMode = `True ||
- (Prefs.readBoolWithDefault caseInsensitiveMode = `Default && b));
+ (Prefs.read caseInsensitiveMode = `True ||
+ (Prefs.read caseInsensitiveMode = `Default && b));
Prefs.set unicodeEncoding (useUnicode b)
(****)
Modified: trunk/src/case.mli
===================================================================
--- trunk/src/case.mli 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/case.mli 2010-01-07 19:16:05 UTC (rev 396)
@@ -4,7 +4,7 @@
val unicodeEncoding : bool Prefs.t
val useUnicodeAPI : unit -> bool
-type mode
+type mode = Sensitive | Insensitive | UnicodeInsensitive
val ops : unit ->
< mode : mode; modeDesc : string; (* Current mode *)
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/copy.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -117,6 +117,44 @@
let fp' = Os.fingerprint fspathTo pathTo info in
fp' = fp)
+(* We slice the files in 1GB chunks because that's the limit for
+ Fingerprint.subfile on 32 bit architectures *)
+let fingerprintLimit = Uutil.Filesize.ofInt64 1072693248L
+
+let rec fingerprintPrefix fspath path offset len accu =
+ if len = Uutil.Filesize.zero then accu else begin
+ let l = min len fingerprintLimit in
+ let fp = Fingerprint.subfile (Fspath.concat fspath path) offset l in
+ fingerprintPrefix fspath path
+ (Int64.add offset (Uutil.Filesize.toInt64 l)) (Uutil.Filesize.sub len l)
+ (fp :: accu)
+ end
+
+let fingerprintPrefixRemotely =
+ Remote.registerServerCmd
+ "fingerprintSubfile"
+ (fun _ (fspath, path, len) ->
+ Lwt.return (fingerprintPrefix fspath path 0L len []))
+
+let appendThreshold = Uutil.Filesize.ofInt (1024 * 1024)
+
+let validFilePrefix connFrom fspathFrom pathFrom fspathTo pathTo info desc =
+ let len = Props.length info.Fileinfo.desc in
+ if
+ info.Fileinfo.typ = `FILE &&
+ len >= appendThreshold && len < Props.length desc
+ then begin
+ Lwt.try_bind
+ (fun () ->
+ fingerprintPrefixRemotely connFrom (fspathFrom, pathFrom, len))
+ (fun fpFrom ->
+ let fpTo = fingerprintPrefix fspathTo pathTo 0L len [] in
+ Lwt.return (if fpFrom = fpTo then Some len else None))
+ (fun _ ->
+ Lwt.return None)
+ end else
+ Lwt.return None
+
type transferStatus =
Success of Fileinfo.t
| Failure of string
@@ -163,8 +201,14 @@
let openFileIn fspath path kind =
match kind with
- `DATA -> Fs.open_in_bin (Fspath.concat fspath path)
- | `RESS -> Osx.openRessIn fspath path
+ `DATA ->
+ Fs.open_in_bin (Fspath.concat fspath path)
+ | `DATA_APPEND len ->
+ let ch = Fs.open_in_bin (Fspath.concat fspath path) in
+ LargeFile.seek_in ch (Uutil.Filesize.toInt64 len);
+ ch
+ | `RESS ->
+ Osx.openRessIn fspath path
let openFileOut fspath path kind len =
match kind with
@@ -189,6 +233,13 @@
in
Unix.out_channel_of_descr fd
end
+ | `DATA_APPEND len ->
+ let fullpath = Fspath.concat fspath path in
+ let perm = 0o600 in
+ let ch = Fs.open_out_gen [Open_wronly; Open_binary] perm fullpath in
+ Fs.chmod fullpath perm;
+ LargeFile.seek_out ch (Uutil.Filesize.toInt64 len);
+ ch
| `RESS ->
Osx.openRessOut fspath path len
@@ -336,6 +387,11 @@
"processTransferInstruction" marshalTransferInstruction
processTransferInstruction
+let showPrefixProgress id kind =
+ match kind with
+ `DATA_APPEND len -> Uutil.showProgress id len "r"
+ | _ -> ()
+
let compress conn
(biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) =
Lwt.catch
@@ -344,10 +400,11 @@
(fun processTransferInstructionRemotely ->
(* We abort the file transfer on error if it has not
already started *)
- if fileKind = `DATA then Abort.check id;
+ if fileKind <> `RESS then Abort.check id;
let infd = openFileIn fspathFrom pathFrom fileKind in
lwt_protect
(fun () ->
+ showPrefixProgress id fileKind;
let showProgress count =
Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in
let compr =
@@ -401,8 +458,9 @@
None ->
(* We abort the file transfer on error if it has not
already started *)
- if kind = `DATA then Abort.check id;
+ if kind <> `RESS then Abort.check id;
let fd = openFileOut fspath path kind len in
+ showPrefixProgress id kind;
outfd := Some fd;
fd
| Some fd ->
@@ -441,7 +499,7 @@
Uutil.Filesize.zero
| `Update (destFileDataSize, destFileRessSize) ->
match fileKind with
- `DATA -> destFileDataSize
+ `DATA | `DATA_APPEND _ -> destFileDataSize
| `RESS -> destFileRessSize
in
let useRsync =
@@ -522,16 +580,27 @@
let reallyTransferFile
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
- update desc fp ress id =
+ update desc fp ress id tempInfo =
debug (fun() -> Util.msg "reallyTransferFile(%s,%s) -> (%s,%s,%s,%s)\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathFrom)
(Fspath.toDebugString fspathTo) (Path.toString pathTo)
(Path.toString realPathTo) (Props.toString desc));
- removeOldTempFile fspathTo pathTo;
+ validFilePrefix connFrom fspathFrom pathFrom fspathTo pathTo tempInfo desc
+ >>= fun prefixLen ->
+ begin match prefixLen with
+ None ->
+ removeOldTempFile fspathTo pathTo
+ | Some len ->
+ debug
+ (fun() ->
+ Util.msg "Keeping %s bytes previously transferred for file %s\n"
+ (Uutil.Filesize.toString len) (Path.toString pathFrom))
+ end;
(* Data fork *)
transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
- `DATA (Props.length desc) id >>= fun () ->
+ (match prefixLen with None -> `DATA | Some l -> `DATA_APPEND l)
+ (Props.length desc) id >>= fun () ->
transferRessourceForkAndSetFileinfo
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id
@@ -703,8 +772,8 @@
else
Prefs.read copyprog
in
- let extraquotes = Prefs.readBoolWithDefault copyquoterem = `True
- || ( Prefs.readBoolWithDefault copyquoterem = `Default
+ let extraquotes = Prefs.read copyquoterem = `True
+ || ( Prefs.read copyquoterem = `Default
&& Util.findsubstring "rsync" prog <> None) in
let addquotes root s =
match root with
@@ -738,7 +807,8 @@
let transferFileLocal connFrom
(fspathFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) =
- let (info, isTransferred) = fileIsTransferred fspathTo pathTo desc fp ress in
+ let (tempInfo, isTransferred) =
+ fileIsTransferred fspathTo pathTo desc fp ress in
if isTransferred then begin
(* File is already fully transferred (from some interrupted
previous transfer). *)
@@ -752,7 +822,7 @@
Uutil.showProgress id len "alr";
setFileinfo fspathTo pathTo realPathTo update desc;
Xferhint.insertEntry fspathTo pathTo fp;
- Lwt.return (`DONE (Success info, Some msg))
+ Lwt.return (`DONE (Success tempInfo, Some msg))
end else
registerFileTransfer pathTo fp
(fun () ->
@@ -769,7 +839,7 @@
else begin
reallyTransferFile
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
- update desc fp ress id >>= fun status ->
+ update desc fp ress id tempInfo >>= fun status ->
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (status, None))
end)
Modified: trunk/src/fileinfo.ml
===================================================================
--- trunk/src/fileinfo.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/fileinfo.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -36,8 +36,8 @@
let init b =
Prefs.set symlinksAllowed
- (Prefs.readBoolWithDefault allowSymlinks = `True ||
- (Prefs.readBoolWithDefault allowSymlinks = `Default && not b))
+ (Prefs.read allowSymlinks = `True ||
+ (Prefs.read allowSymlinks = `Default && not b))
type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ]
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/mkProjectInfo.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -5,8 +5,8 @@
let projectName = "unison"
let majorVersion = 2
-let minorVersion = 38
-let pointVersionOrigin = 388 (* Revision that corresponds to point version 0 *)
+let minorVersion = 39
+let pointVersionOrigin = 396 (* Revision that corresponds to point version 0 *)
(* Documentation:
This is a program to construct a version of the form Major.Minor.Point,
@@ -65,7 +65,7 @@
Str.matched_group 1 str;;
let extract_int re str = int_of_string (extract_str re str);;
-let revisionString = "$Rev: 393$";;
+let revisionString = "$Rev: 396$";;
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:
@@ -87,5 +87,3 @@
Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion pointVersion;;
Printf.printf "NAME=%s\n" projectName;;
-
-
Modified: trunk/src/osx.ml
===================================================================
--- trunk/src/osx.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/osx.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -45,8 +45,8 @@
let init b =
Prefs.set rsrc
- (Prefs.readBoolWithDefault rsrcSync = `True ||
- (Prefs.readBoolWithDefault rsrcSync = `Default && b))
+ (Prefs.read rsrcSync = `True ||
+ (Prefs.read rsrcSync = `Default && b))
(****)
Modified: trunk/src/ubase/prefs.ml
===================================================================
--- trunk/src/ubase/prefs.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/ubase/prefs.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -197,8 +197,7 @@
(fun cell -> Uarg.String (fun s -> set cell (s::(fst !cell))))
let createBoolWithDefault name ?(local=false) doc fulldoc =
- createPrefInternal name `BOOLDEF local "default" doc fulldoc
-(*
+ createPrefInternal name `BOOLDEF local `Default doc fulldoc
(fun v -> [match v with
`True -> "true"
| `False -> "false"
@@ -213,15 +212,7 @@
| _ -> `False
in
set cell v))
-*)
- (fun v -> [v]) (fun cell -> Uarg.String (fun s -> set cell s))
-let readBoolWithDefault p =
- match read p with
- "yes" | "true" -> `True
- | "default" | "auto" -> `Default
- | _ -> `False
-
(*****************************************************************************)
(* Command-line parsing *)
(*****************************************************************************)
Modified: trunk/src/ubase/prefs.mli
===================================================================
--- trunk/src/ubase/prefs.mli 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/ubase/prefs.mli 2010-01-07 19:16:05 UTC (rev 396)
@@ -4,8 +4,6 @@
type 'a t
val read : 'a t -> 'a
-(*FIX: remove this function and change the type of the preferences instead*)
-val readBoolWithDefault : string t -> [ `Default | `False | `True ]
val set : 'a t -> 'a -> unit
val name : 'a t -> string list
@@ -57,7 +55,7 @@
-> ?local:bool (* whether it is local to the client *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
- -> string t
+ -> [`True|`False|`Default] t
(* -> new preference value *)
exception IllegalValue of string
Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/uicommon.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -55,19 +55,6 @@
("Used to set the height (in lines) of the main window in the graphical "
^ "user interface.")
-(*FIX: remove this option... *)
-let reuseToplevelWindows =
- Prefs.createBool "reusewindows" false
- "*reuse top-level windows instead of making new ones" ""
-(* Not sure if this should actually be made available to users...
- ("When true, causes the graphical interface to re-use top-level windows "
- ^ "(e.g., the small window that says ``Connecting...'') rather than "
- ^ "destroying them and creating fresh ones. ")
-*)
-(* For convenience: *)
-let _ = Prefs.alias reuseToplevelWindows "rw"
-
-
let expert =
Prefs.createBool "expert" false
"*Enable some developers-only functionality in the UI" ""
Modified: trunk/src/uicommon.mli
===================================================================
--- trunk/src/uicommon.mli 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/uicommon.mli 2010-01-07 19:16:05 UTC (rev 396)
@@ -19,9 +19,6 @@
(* User preference: How tall to make the main window in the GTK ui *)
val mainWindowHeight : int Prefs.t
-(* User preference: Should we reuse top-level windows as much as possible? *)
-val reuseToplevelWindows : bool Prefs.t
-
(* User preference: Expert mode *)
val expert : bool Prefs.t
Modified: trunk/src/uigtk2.ml
===================================================================
--- trunk/src/uigtk2.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/uigtk2.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -1467,14 +1467,16 @@
modification time. Nowadays, FAT is rarely used on working
partitions. In most cases, we should be in Unicode mode.
Thus, it seems sensible to always enable fastcheck. *)
+(*
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 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
+ let askUnicode = React.const false in
+(* isLocal >> not >> fun b -> (b || Util.isCygwin) && Util.osType = `Win32 in*)
GtkReact.show vb askUnicode;
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
@@ -1505,9 +1507,11 @@
ignore
(GButton.radio_button ~label:"_Latin 1" ~use_mnemonic:true
~group:unicodeButton#group ~packing:(hb#add) ());
+(*
let unicode =
React.lift2 (||) (askUnicode >> not) (GtkReact.toggle_button unicodeButton)
in
+*)
let p =
assistant#append_page
~title:"Specific Options" ~complete:true
@@ -1560,12 +1564,15 @@
Printf.fprintf ch "root = %s\n" (Clroot.clroot2string secondRoot);
if React.state compress && React.state kind = `SSH then
Printf.fprintf ch "sshargs = -C\n";
+(*
if React.state fastcheck then
Printf.fprintf ch "fastcheck = true\n";
if React.state unicode then
Printf.fprintf ch "unicode = true\n";
+*)
if React.state fat then begin
Printf.fprintf ch "ignorecase = true\n";
+ Printf.fprintf ch "unicode = true\n";
Printf.fprintf ch "ignoreinodenumbers = true\n";
Printf.fprintf ch "links = false\n";
Printf.fprintf ch "perms = 0o200\n"
@@ -2467,8 +2474,10 @@
GButton.button ~stock:`EDIT ~packing:(vb#pack ~expand:false) () in
ignore (editButton#connect#clicked
~callback:(fun () -> match React.state selInfo with
- None -> ()
- | Some ((p, _), _) -> editProfile t p));
+ None ->
+ ()
+ | Some ((p, _), _) ->
+ editProfile t p; fillLst (Some p)));
GtkReact.set_sensitive editButton hasSel;
let deleteProfile () =
match React.state selInfo with
@@ -2994,12 +3003,14 @@
let delayUpdates = ref false in
let hasFocus = ref false in
- let select i =
+ let select i scroll =
if !hasFocus then begin
(* If we have the focus, we move the focus row directely *)
- let r = mainWindow#rows in
- let p = if r < 2 then 0. else (float i +. 0.5) /. float (r - 1) in
- mainWindow#scroll_vertical `JUMP (min p 1.);
+ if scroll then begin
+ let r = mainWindow#rows in
+ let p = if r < 2 then 0. else (float i +. 0.5) /. float (r - 1) in
+ mainWindow#scroll_vertical `JUMP (min p 1.)
+ end;
if IntSet.is_empty !current then mainWindow#select i 0
end else begin
(* If we don't have the focus, we just move the selection.
@@ -3010,7 +3021,7 @@
mainWindow#unselect_all ();
mainWindow#select i 0;
delayUpdates := false;
- makeRowVisible i;
+ if scroll then makeRowVisible i;
updateDetails ()
end
in
@@ -3021,7 +3032,7 @@
otherwise the focus row is not drawn correctly. *)
ignore (GMain.Idle.add (fun () ->
begin match currentRow () with
- Some i -> select i
+ Some i -> select i false
| None -> ()
end;
false));
@@ -3046,7 +3057,7 @@
match !theState.(i).ri.replicas with
Different {direction = dir}
when not (Prefs.read Uicommon.auto) || dir = Conflict ->
- select i
+ select i true
| _ ->
loop (i + 1) in
loop start in
@@ -3149,7 +3160,7 @@
(match savedCurrent with None->"None" | Some(i) -> string_of_int i));
begin match savedCurrent with
None -> selectSomethingIfPossible ()
- | Some idx -> select idx
+ | Some idx -> select idx true
end;
mainWindow#thaw ();
updateDetails (); (* Do we need this line? *)
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2010-01-07 17:52:04 UTC (rev 395)
+++ trunk/src/update.ml 2010-01-07 19:16:05 UTC (rev 396)
@@ -276,37 +276,44 @@
System.file_exists (Os.fileInUnisonDir name)))
let checkArchiveCaseSensitivity l =
+ let error curMode archMode =
+ (* We cannot compute the archive name locally as it
+ currently depends on the os type *)
+ Globals.allRootsMap
+ (fun r -> archiveNameOnRoot r MainArch) >>= fun names ->
+ let l =
+ List.map
+ (fun (name, host, _) ->
+ Format.sprintf " archive %s on host %s" name host)
+ names
+ in
+ Lwt.fail
+ (Util.Fatal
+ (String.concat "\n"
+ ("Warning: incompatible case sensitivity settings." ::
+ Format.sprintf "Unison is currently in %s mode," curMode ::
+ Format.sprintf
+ "while the archives were created in %s mode." archMode ::
+ "You should either change Unison's setup or delete " ::
+ "the following archives from the .unison directories:" ::
+ l @
+ ["Then, try again."])))
+ in
match l with
- Some (_, magic) :: _ ->
+ Some (_, magic) :: _ when magic <> "" ->
begin try
let archMode = String.sub magic 0 (String.index magic '\000') in
let curMode = (Case.ops ())#modeDesc in
- if curMode <> archMode then begin
- (* We cannot compute the archive name locally as it
- currently depends on the os type *)
- Globals.allRootsMap
- (fun r -> archiveNameOnRoot r MainArch) >>= fun names ->
- let l =
- List.map
- (fun (name, host, _) ->
- Format.sprintf " archive %s on host %s" name host)
- names
- in
- Lwt.fail
- (Util.Fatal
- (String.concat "\n"
- ("Warning: incompatible case sensitivity settings." ::
- Format.sprintf "Unison is currently in %s mode," curMode ::
- Format.sprintf
- "while the archives assume %s mode." archMode ::
- "You should either change Unison's setup " ::
- "or delete the following archives:" ::
- l @
- ["Then, try again."])))
+ if curMode <> archMode then
+ error curMode archMode
+ else
+ Lwt.return ()
+ with Not_found ->
+ if (Case.ops ())#mode = Case.UnicodeInsensitive then begin
+ let curMode = (Case.ops ())#modeDesc in
+ error curMode "some non-Unicode"
end else
Lwt.return ()
- with Not_found ->
- Lwt.return ()
end
| _ ->
Lwt.return ()
@@ -1026,8 +1033,8 @@
\\sectionref{fastcheck}{Fast Checking} for more information.")
let useFastChecking () =
- Prefs.readBoolWithDefault fastcheck = `True
- || (Prefs.readBoolWithDefault fastcheck = `Default && Util.osType = `Unix)
+ Prefs.read fastcheck = `True
+ || (Prefs.read fastcheck = `Default (*&& Util.osType = `Unix*))
let immutable = Pred.create "immutable" ~advanced:true
("This preference specifies paths for directories whose \
More information about the Unison-hackers
mailing list