[Unison-hackers] [unison-svn] r402 - in trunk/src: . ubase
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Fri Jan 15 10:28:25 EST 2010
Author: vouillon
Date: 2010-01-15 10:28:23 -0500 (Fri, 15 Jan 2010)
New Revision: 402
Modified:
trunk/src/RECENTNEWS
trunk/src/copy.ml
trunk/src/external.ml
trunk/src/external.mli
trunk/src/fileinfo.ml
trunk/src/files.ml
trunk/src/globals.ml
trunk/src/globals.mli
trunk/src/mkProjectInfo.ml
trunk/src/path.ml
trunk/src/props.ml
trunk/src/recon.ml
trunk/src/remote.ml
trunk/src/ubase/prefs.ml
trunk/src/ubase/prefs.mli
trunk/src/ubase/util.ml
trunk/src/uicommon.ml
trunk/src/uigtk2.ml
trunk/src/uimacbridge.ml
trunk/src/uimacbridgenew.ml
trunk/src/update.ml
Log:
* New preferences "noupdate=root", "nodeletion=root", "nocreation=root"
that prevent Unison from performing files updates, deletions or
creations on the given root.
* GTK UI: do not reload the preference file before a new update
detection if it is unchanged
* Limit the number of simultaneous external copy program
("copymax" preference)
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/RECENTNEWS 2010-01-15 15:28:23 UTC (rev 402)
@@ -1,5 +1,16 @@
CHANGES FROM VERSION 2.39.4
+* New preferences "noupdate=root", "nodeletion=root", "nocreation=root"
+ that prevent Unison from performing files updates, deletions or
+ creations on the given root.
+* GTK UI: do not reload the preference file before a new update
+ detection if it is unchanged
+* Limit the number of simultaneous external copy program
+ ("copymax" preference)
+
+-------------------------------
+CHANGES FROM VERSION 2.39.4
+
* GTK UI:
- take into account the "height" preference again
- the internal list of selected reconciler item was not always in
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/copy.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -693,6 +693,12 @@
^ "added if the value of {\\tt copyprog} contains the string "
^ "{\\tt rsync}.")
+let copymax =
+ Prefs.createInt "copymax" ~local:true 1
+ "!maximum number of simultaneous copyprog transfers"
+ ("A number indicating how many instances of the external copying utility \
+ Unison is allowed to run simultaneously (default to 1).")
+
let formatConnectionInfo root =
match root with
Common.Local, _ -> ""
@@ -762,6 +768,8 @@
Remote.registerRootCmdWithConnection
"finishExternalTransfer" finishExternalTransferLocal
+let copyprogReg = Lwt_util.make_region 1
+
let transferFileUsingExternalCopyprog
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id useExistingTarget =
@@ -791,7 +799,9 @@
^ (Uutil.quotes fromSpec) ^ " "
^ (Uutil.quotes toSpec) in
Trace.log (Printf.sprintf "%s\n" cmd);
- let _,log = External.runExternalProgram cmd in
+ Lwt_util.resize_region copyprogReg (Prefs.read copymax);
+ Lwt_util.run_in_region copyprogReg 1
+ (fun () -> External.runExternalProgram cmd) >>= fun (_, log) ->
debug (fun() ->
let l = Util.trimWhitespace log in
Util.msg "transferFileUsingExternalCopyprog %s: returned...\n%s%s"
Modified: trunk/src/external.ml
===================================================================
--- trunk/src/external.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/external.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -74,8 +74,8 @@
"\n\n" ^ Util.process_status_to_string returnValue
else
"") in
- (returnValue,mergeResultLog)
- end else Lwt_unix.run (
+ Lwt.return (returnValue,mergeResultLog)
+ end else
let (out, ipt, err) as desc = System.open_process_full cmd in
let out = Lwt_unix.intern_in_channel out in
let err = Lwt_unix.intern_in_channel err in
@@ -94,4 +94,4 @@
then ""
else "\n\n" ^ Util.process_status_to_string returnValue)))
(* Stop typechechecker from complaining about non-exhaustive pattern above *)
- | _ -> assert false))
+ | _ -> assert false)
Modified: trunk/src/external.mli
===================================================================
--- trunk/src/external.mli 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/external.mli 2010-01-15 15:28:23 UTC (rev 402)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/external.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
-val runExternalProgram : string -> Unix.process_status * string
+val runExternalProgram : string -> (Unix.process_status * string) Lwt.t
val readChannelTillEof : in_channel -> string
Modified: trunk/src/fileinfo.ml
===================================================================
--- trunk/src/fileinfo.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/fileinfo.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -150,14 +150,13 @@
let ignoreInodeNumbers =
Prefs.createBool "ignoreinodenumbers" false
- "!Use creation times for detecting updates"
+ "!ignore inode number changes when detecting updates"
("When set to true, this preference makes Unison not take advantage \
- of inode numbers during fast update detection even when running \
- on a Unix system. This switch should be used with care, as it \
+ of inode numbers during fast update detection. \
+ This switch should be used with care, as it \
is less safe than the standard update detection method, but it \
can be useful for synchronizing VFAT filesystems (which do not \
- support inode numbers) mounted on Unix systems. \
- The {\\tt fastcheck} option should also be set to true.")
+ support inode numbers) mounted on Unix systems.")
let _ = Prefs.alias ignoreInodeNumbers "pretendwin"
let stamp info =
Modified: trunk/src/files.ml
===================================================================
--- trunk/src/files.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/files.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -580,7 +580,7 @@
let diffCmd =
Prefs.createString "diff" "diff -u CURRENT2 CURRENT1"
- "!command for showing differences between files"
+ "!set command for showing differences between files"
("This preference can be used to control the name and command-line "
^ "arguments of the system "
^ "utility used to generate displays of file differences. The default "
@@ -873,7 +873,8 @@
(Fspath.quotes (Fspath.concat workingDirForMerge newarch)) in
Trace.log (Printf.sprintf "Merge command: %s\n" cmd);
- let returnValue, mergeResultLog = External.runExternalProgram cmd in
+ let returnValue, mergeResultLog =
+ Lwt_unix.run (External.runExternalProgram cmd) in
Trace.log (Printf.sprintf "Merge result (%s):\n%s\n"
(showStatus returnValue) mergeResultLog);
Modified: trunk/src/globals.ml
===================================================================
--- trunk/src/globals.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/globals.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -40,14 +40,13 @@
^ "that, if Unison is invoked later with a slightly different name "
^ "for the same root, it will be able to locate the correct archives.")
-let setRawRoots l =
- Prefs.set rawroots l
+let setRawRoots l = Prefs.set rawroots (Safelist.rev l)
-let rawRoots () = Prefs.read rawroots
+let rawRoots () = Safelist.rev (Prefs.read rawroots)
-let rootsInitialName () =
+let rawRootPair () =
match rawRoots () with
- [r2; r1] -> (r1, r2)
+ [r1; r2] -> (r1, r2)
| _ -> assert false
let theroots = ref []
@@ -67,7 +66,7 @@
cont >>= (fun l ->
return (r' :: l))))
roots (return []) >>= (fun roots' ->
- theroots := Safelist.rev roots';
+ theroots := roots';
return ())
(* Alternate interface, should replace old interface eventually *)
@@ -76,8 +75,8 @@
let roots = rawRoots () in
theroots :=
Safelist.map Remote.canonize ((Safelist.map Clroot.parseRoot) roots);
- theroots := Safelist.rev !theroots (* Not sure why this is needed... *)
-
+ theroots := !theroots
+
let roots () =
match !theroots with
[root1;root2] -> (root1,root2)
Modified: trunk/src/globals.mli
===================================================================
--- trunk/src/globals.mli 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/globals.mli 2010-01-15 15:28:23 UTC (rev 402)
@@ -8,6 +8,7 @@
(* line *)
val rawRoots : unit -> string list
val setRawRoots : string list -> unit
+val rawRootPair : unit -> string * string
(* Parse and canonize roots from their raw names *)
val installRoots : (string -> string -> string) option -> unit Lwt.t
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/mkProjectInfo.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -102,3 +102,4 @@
+
Modified: trunk/src/path.ml
===================================================================
--- trunk/src/path.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/path.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -195,7 +195,7 @@
let equal (p1 : local) (p2 : local) = p1 = p2
(* Pref controlling whether symlinks are followed. *)
-let followPred = Pred.create "follow"
+let followPred = Pred.create ~advanced:true "follow"
("Including the preference \\texttt{-follow \\ARG{pathspec}} causes Unison to \
treat symbolic links matching \\ARG{pathspec} as `invisible' and \
behave as if the object pointed to by the link had appeared literally \
Modified: trunk/src/props.ml
===================================================================
--- trunk/src/props.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/props.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -188,7 +188,7 @@
let dontChmod =
Prefs.createBool "dontchmod"
false
- "!When set, never use the chmod system call"
+ "!when set, never use the chmod system call"
( "By default, Unison uses the 'chmod' system call to set the permission bits"
^ " of files after it has copied them. But in some circumstances (and under "
^ " some operating systems), the chmod call always fails. Setting this "
@@ -544,7 +544,7 @@
let cmd = "/usr/local/bin/sudo -u root /usr/bin/touch -m -a -t "
^ tstr ^ " " ^ Fspath.quotes abspath in
Util.msg "Running external program to set utimes:\n %s\n" cmd;
- let (r,_) = External.runExternalProgram cmd in
+ let (r,_) = Lwt_unix.run (External.runExternalProgram cmd) in
if r<>(Unix.WEXITED 0) then raise (Util.Transient "External time-setting command failed")
end else
Fs.utimes abspath v v)
Modified: trunk/src/recon.ml
===================================================================
--- trunk/src/recon.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/recon.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -68,9 +68,7 @@
if root="older" then `Older
else if root="newer" then `Newer
else
- let roots = Safelist.rev (Globals.rawRoots()) in
- let r1 = Safelist.nth roots 0 in
- let r2 = Safelist.nth roots 1 in
+ let (r1, r2) = Globals.rawRootPair () in
debug (fun() ->
Printf.eprintf "root2direction called to choose %s from %s and %s\n"
root r1 r2);
@@ -82,7 +80,7 @@
let forceRoot: string Prefs.t =
Prefs.createString "force" ""
- "force changes from this replica to the other"
+ "!force changes from this replica to the other"
("Including the preference \\texttt{-force \\ARG{root}} causes Unison to "
^ "resolve all differences (even non-conflicting changes) in favor of "
^ "\\ARG{root}. "
@@ -114,7 +112,7 @@
let preferRoot: string Prefs.t =
Prefs.createString "prefer" ""
- "choose this replica's version for conflicting changes"
+ "!choose this replica's version for conflicting changes"
("Including the preference \\texttt{-prefer \\ARG{root}} causes Unison always to "
^ "resolve conflicts in favor of \\ARG{root}, rather than asking for "
^ "guidance from the user. (The syntax of \\ARG{root} is the same as "
@@ -158,6 +156,71 @@
else
("",`Prefer)
+let actionKind fromRc toRc =
+ let fromTyp = fromRc.typ in
+ let toTyp = toRc.typ in
+ if fromTyp = toTyp then `UPDATE else
+ if toTyp = `ABSENT then `CREATION else
+ `DELETION
+
+type prefs = { noDeletion : bool; noUpdate: bool; noCreation : bool }
+
+let shouldCancel rc1 rc2 prefs =
+ match actionKind rc1 rc2 with
+ `UPDATE -> prefs.noUpdate
+ | `DELETION -> prefs.noUpdate || prefs.noDeletion
+ | `CREATION -> prefs.noCreation
+
+let filterRi prefs1 prefs2 ri =
+ match ri.replicas with
+ Problem _ ->
+ ()
+ | Different diff ->
+ if
+ match diff.direction with
+ Replica1ToReplica2 -> shouldCancel diff.rc1 diff.rc2 prefs2
+ | Replica2ToReplica1 -> shouldCancel diff.rc2 diff.rc1 prefs1
+ | Conflict | Merge -> false
+ then
+ diff.direction <- Conflict
+
+let noDeletion =
+ Prefs.createStringList "nodeletion" ~local:true
+ "prevent file deletions on one replica"
+ ("Including the preference \\texttt{-nodeletion \\ARG{root}} prevents \
+ Unison from performing any file deletion on root \\ARG{root}.\n\
+ This preference can be included twice, once for each root, if you \
+ want to prevent any creation.")
+
+let noUpdate =
+ Prefs.createStringList "noupdate" ~local:true
+ "prevent file updates and deletions on one replica"
+ ("Including the preference \\texttt{-noupdate \\ARG{root}} prevents \
+ Unison from performing any file update or deletion on root \
+ \\ARG{root}.\n\
+ This preference can be included twice, once for each root, if you \
+ want to prevent any update.")
+
+let noCreation =
+ Prefs.createStringList "nocreation" ~local:true
+ "prevent file creations on one replica"
+ ("Including the preference \\texttt{-nocreation \\ARG{root}} prevents \
+ Unison from performing any file creation on root \\ARG{root}.\n\
+ This preference can be included twice, once for each root, if you \
+ want to prevent any creation.")
+
+let filterRis ris =
+ let (root1, root2) = Globals.rawRootPair () in
+ let getPref root pref = List.mem root (Prefs.read pref) in
+ let getPrefs root =
+ { noDeletion = getPref root noDeletion;
+ noUpdate = getPref root noUpdate;
+ noCreation = getPref root noCreation }
+ in
+ let prefs1 = getPrefs root1 in
+ let prefs2 = getPrefs root2 in
+ Safelist.iter (fun ri -> filterRi prefs1 prefs2 ri) ris
+
(* Use the current values of the '-prefer <ROOT>' and '-force <ROOT>' *)
(* preferences to override the reconciler's choices *)
let overrideReconcilerChoices ris =
@@ -171,13 +234,12 @@
if rootp<>"" then begin
let dir = root2direction rootp in
setDirection ri dir forcep
- end) ris
+ end) ris;
+ filterRis ris
(* Look up the preferred root and verify that it is OK (this is called at *)
(* the beginning of the run, so that we don't have to wait to hear about *)
(* errors *)
-(* This should also check for the partial version, but this needs a way to *)
-(* extract the associated values from a Pred.t *)
let checkThatPreferredRootIsValid () =
let test_root predname = function
| "" -> ()
@@ -190,7 +252,23 @@
let (root,pred) = lookupPreferredRoot() in
if root<>"" then test_root (match pred with `Force -> "force" | `Prefer -> "prefer") root;
Safelist.iter (test_root "forcepartial") (Pred.extern_associated_strings forceRootPartial);
- Safelist.iter (test_root "preferpartial") (Pred.extern_associated_strings preferRootPartial)
+ Safelist.iter (test_root "preferpartial") (Pred.extern_associated_strings preferRootPartial);
+ let checkPref pref prefName =
+ try
+ let root =
+ List.find (fun r -> not (List.mem r (Globals.rawRoots ())))
+ (Prefs.read pref)
+ in
+ let (r1, r2) = Globals.rawRootPair () in
+ raise (Util.Fatal (Printf.sprintf
+ "%s (given as argument to '%s' preference)\n\
+ is not one of the current roots:\n %s\n %s" root prefName r1 r2))
+ with Not_found ->
+ ()
+ in
+ checkPref noDeletion "nodeletion";
+ checkPref noUpdate "noupdate";
+ checkPref noCreation "nocreation"
(* ------------------------------------------------------------------------- *)
(* Main Reconciliation stuff *)
Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/remote.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -94,7 +94,8 @@
Unix.Unix_error(Unix.ECONNRESET, _, _)
| Unix.Unix_error(Unix.EPIPE, _, _)
(* Windows may also return the following errors... *)
- | Unix.Unix_error(Unix.EINVAL, _, _) ->
+ | Unix.Unix_error(Unix.EINVAL, _, _)
+ | Unix.Unix_error(Unix.EUNKNOWNERR (-64), _, _) ->
(* Client has closed its end of the connection *)
lostConnection ()
| _ ->
Modified: trunk/src/ubase/prefs.ml
===================================================================
--- trunk/src/ubase/prefs.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/ubase/prefs.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -16,6 +16,7 @@
(* ------------------------------------------------------------------------- *)
let profileName = ref None
+let profileFiles = ref []
let profilePathname n =
let f = Util.fileInUnisonDir n in
@@ -27,6 +28,18 @@
None -> raise (Util.Transient("No preference file has been specified"))
| Some(n) -> profilePathname n
+let profileUnchanged () =
+ List.for_all
+ (fun (path, info) ->
+ try
+ let newInfo = System.stat path in
+ newInfo.Unix.LargeFile.st_kind = Unix.S_REG &&
+ info.Unix.LargeFile.st_mtime = newInfo.Unix.LargeFile.st_mtime &&
+ info.Unix.LargeFile.st_size = newInfo.Unix.LargeFile.st_size
+ with Unix.Unix_error _ ->
+ false)
+ !profileFiles
+
(* ------------------------------------------------------------------------- *)
(* When preferences change, we need to dump them out to the file we loaded *)
@@ -46,8 +59,9 @@
let addresetter f = resetters := f :: !resetters
-let resetToDefaults () = Safelist.iter (fun f -> f()) !resetters
-
+let resetToDefaults () =
+ Safelist.iter (fun f -> f()) !resetters; profileFiles := []
+
(* ------------------------------------------------------------------------- *)
(* When the server starts up, we need to ship it the current state of all *)
@@ -322,9 +336,13 @@
in the same order as in the file. *)
let rec readAFile filename : (string * int * string * string) list =
let chan =
- try System.open_in_bin (profilePathname filename)
- with Sys_error _ ->
- raise(Util.Fatal(Printf.sprintf "Preference file %s not found" filename)) in
+ try
+ let path = profilePathname filename in
+ profileFiles := (path, System.stat path) :: !profileFiles;
+ System.open_in_bin path
+ with Unix.Unix_error _ | 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
Modified: trunk/src/ubase/prefs.mli
===================================================================
--- trunk/src/ubase/prefs.mli 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/ubase/prefs.mli 2010-01-15 15:28:23 UTC (rev 402)
@@ -104,6 +104,9 @@
(* Calculate the full pathname of a preference file *)
val profilePathname : string -> System.fspath
+(* Check whether the profile file is unchanged *)
+val profileUnchanged : unit -> bool
+
(* Add a new preference to the file on disk (the result is a diagnostic *)
(* message that can be displayed to the user to verify where the new pref *)
(* went) *)
Modified: trunk/src/ubase/util.ml
===================================================================
--- trunk/src/ubase/util.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/ubase/util.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -125,7 +125,11 @@
Unix.Unix_error(err,fnname,param) ->
let s = "Error in " ^ m ^ ":\n"
^ (Unix.error_message err)
- ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in
+ ^ " [" ^ fnname ^ "(" ^ param ^ ")]%s" ^
+ (match err with
+ Unix.EUNKNOWNERR n -> Format.sprintf " (code %d)" n
+ | _ -> "")
+ in
debug "exn"
(fun() -> msg "Converting a Unix error to %s:\n%s\n" kindStr s);
reraise s
Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/uicommon.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -313,6 +313,15 @@
Sys.Break -> "Terminated!"
| Util.Fatal(s) -> Printf.sprintf "Fatal error: %s" s
| Util.Transient(s) -> Printf.sprintf "Error: %s" s
+ | Unix.Unix_error (err, fun_name, arg) ->
+ Printf.sprintf "Uncaught unix error: %s failed%s: %s%s"
+ fun_name
+ (if String.length arg > 0 then Format.sprintf " on \"%s\"" arg else "")
+ (Unix.error_message err)
+ (match err with
+ Unix.EUNKNOWNERR n -> Format.sprintf " (code %d)" n
+ | _ -> "")
+ | Invalid_argument s -> Printf.sprintf "Invalid argument: %s" s
| other -> Printf.sprintf "Uncaught exception %s" (Printexc.to_string other)
(* precondition: uc = File (Updates(_, ..) on both sides *)
@@ -464,7 +473,7 @@
let r2 = match getSecondRoot() with None -> exit 0 | Some r -> r in
(* Remember them for this run, ordering them so that the first
will come out on the left in the UI *)
- Globals.setRawRoots [r2;r1];
+ Globals.setRawRoots [r1; r2];
(* Save them in the current profile *)
ignore (Prefs.add "root" r1);
ignore (Prefs.add "root" r2)
@@ -477,14 +486,14 @@
let firstTime = ref(true)
(* Roots given on the command line *)
-let rawRoots = ref []
+let cmdLineRawRoots = ref []
(* BCP: WARNING: Some of the code from here is duplicated in uimacbridge...! *)
let initPrefs ~profileName ~displayWaitMessage ~getFirstRoot ~getSecondRoot
~termInteract =
(* Restore prefs to their default values, if necessary *)
if not !firstTime then Prefs.resetToDefaults();
- Globals.setRawRoots !rawRoots;
+ Globals.setRawRoots !cmdLineRawRoots;
(* Tell the preferences module the name of the profile *)
Prefs.profileName := Some(profileName);
@@ -644,9 +653,9 @@
match Util.StringMap.find "rest" args with
[] -> ()
| [profile] -> clprofile := Some profile
- | [root1;root2] -> rawRoots := [root1;root2]
- | [root1;root2;profile] ->
- rawRoots := [root1;root2];
+ | [root2;root1] -> cmdLineRawRoots := [root1;root2]
+ | [root2;root1;profile] ->
+ cmdLineRawRoots := [root1;root2];
clprofile := Some profile
| _ ->
(reportError(Printf.sprintf
@@ -664,7 +673,7 @@
(match !clprofile with
None -> Util.msg "No profile given on command line"
| Some s -> Printf.eprintf "Profile '%s' given on command line" s);
- (match !rawRoots with
+ (match !cmdLineRawRoots with
[] -> Util.msg "No roots given on command line"
| [root1;root2] ->
Printf.eprintf "Roots '%s' and '%s' given on command line"
@@ -674,7 +683,7 @@
let profileName =
begin match !clprofile with
None ->
- let clroots_given = !rawRoots <> [] in
+ let clroots_given = !cmdLineRawRoots <> [] in
let n =
if not(clroots_given) then begin
(* Ask the user to choose a profile or create a new one. *)
Modified: trunk/src/uigtk2.ml
===================================================================
--- trunk/src/uigtk2.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/uigtk2.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -3768,9 +3768,14 @@
in
let reloadProfile () =
- match !Prefs.profileName with
- None -> ()
- | Some(n) -> clearMainWindow (); loadProfile n true in
+ let n =
+ match !Prefs.profileName with
+ None -> assert false
+ | Some n -> n
+ in
+ clearMainWindow ();
+ if not (Prefs.profileUnchanged ()) then loadProfile n true
+ in
let detectCmd () =
getLock detectUpdatesAndReconcile;
@@ -4026,7 +4031,7 @@
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Older `Prefer))
- "Resolve conflicts in favor of least recently modified");
+ "Resolve Conflicts in Favor of Least Recently Modified");
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
Modified: trunk/src/uimacbridge.ml
===================================================================
--- trunk/src/uimacbridge.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/uimacbridge.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -79,8 +79,8 @@
match Util.StringMap.find "rest" args with
[] -> ()
| [profile] -> clprofile := Some profile
- | [root1;root2] -> Globals.setRawRoots [root1;root2]
- | [root1;root2;profile] ->
+ | [root2;root1] -> Globals.setRawRoots [root1;root2]
+ | [root2;root1;profile] ->
Globals.setRawRoots [root1;root2];
clprofile := Some profile
| _ ->
Modified: trunk/src/uimacbridgenew.ml
===================================================================
--- trunk/src/uimacbridgenew.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/uimacbridgenew.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -150,8 +150,8 @@
match Util.StringMap.find "rest" args with
[] -> ()
| [profile] -> clprofile := Some profile
- | [root1;root2] -> Globals.setRawRoots [root1;root2]
- | [root1;root2;profile] ->
+ | [root2;root1] -> Globals.setRawRoots [root1;root2]
+ | [root2;root1;profile] ->
Globals.setRawRoots [root1;root2];
clprofile := Some profile
| _ ->
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2010-01-15 08:29:26 UTC (rev 401)
+++ trunk/src/update.ml 2010-01-15 15:28:23 UTC (rev 402)
@@ -524,9 +524,11 @@
&&
Props.same_time oldInfo.Fileinfo.desc newInfo.Fileinfo.desc
&&
+ Props.length oldInfo.Fileinfo.desc = Props.length newInfo.Fileinfo.desc
+ &&
match Fileinfo.stamp oldInfo, Fileinfo.stamp newInfo with
Fileinfo.InodeStamp in1, Fileinfo.InodeStamp in2 -> in1 = in2
- | Fileinfo.CtimeStamp t1, Fileinfo.CtimeStamp t2 -> t1 = t2
+ | Fileinfo.CtimeStamp _, Fileinfo.CtimeStamp _ -> true
| _ -> false
let archiveUnchanged fspath newInfo =
@@ -1042,10 +1044,8 @@
this switch under Windows most of the time and occasionally \
run Unison once with {\\tt fastcheck} set to \
\\verb|false|, if you are \
- worried that Unison may have overlooked an update. The default \
- value of the preference is \\verb|auto|, which causes Unison to \
- use fast checking on Unix replicas (where it is safe) and slow \
- checking on Windows replicas. For backward compatibility, \
+ worried that Unison may have overlooked an update. \
+ For backward compatibility, \
\\verb|yes|, \\verb|no|, and \\verb|default| can be used in place \
of \\verb|true|, \\verb|false|, and \\verb|auto|. See \
\\sectionref{fastcheck}{Fast Checking} for more information.")
@@ -1055,7 +1055,7 @@
|| (Prefs.read fastcheck = `Default (*&& Util.osType = `Unix*))
let immutable = Pred.create "immutable" ~advanced:true
- ("This preference specifies paths for directories whose \
+ ("This preference specifies paths for directories whose \
immediate children are all immutable files --- i.e., once a file has been \
created, its contents never changes. When scanning for updates, \
Unison does not check whether these files have been modified; \
@@ -1063,13 +1063,13 @@
directories).")
let immutablenot = Pred.create "immutablenot" ~advanced:true
- ("This preference overrides {\\tt immutable}.")
+ ("This preference overrides {\\tt immutable}.")
type scanInfo =
- { fastCheck : bool;
- dirFastCheck : bool;
- dirStamp : Props.dirChangedStamp;
- showStatus : bool }
+ { fastCheck : bool;
+ dirFastCheck : bool;
+ dirStamp : Props.dirChangedStamp;
+ showStatus : bool }
(** Status display **)
@@ -1085,26 +1085,26 @@
the status display message -- thus effectively serializing the client
and server! *)
let showStatusAddLength scanInfo info =
- let len1 = Props.length info.Fileinfo.desc in
- let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in
+ let len1 = Props.length info.Fileinfo.desc in
+ let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in
if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then
fileLength := bigFileLength
else
fileLength :=
min bigFileLength
- (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2)
+ (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2)
let showStatus scanInfo path =
- fileLength := !fileLength + smallFileLength;
- if !fileLength >= bigFileLength then begin
- fileLength := 0;
- let t = Unix.gettimeofday () in
+ fileLength := !fileLength + smallFileLength;
+ if !fileLength >= bigFileLength then begin
+ fileLength := 0;
+ let t = Unix.gettimeofday () in
if t -. !t0 > 0.05 then begin
if scanInfo.showStatus then
Uutil.showUpdateStatus (Path.toString path);
t0 := t
end
- end
+ end
let showStatusDir path = ()
@@ -1114,11 +1114,11 @@
they are scanned -- but this seems worse: it prints far too much stuff.
So I'm going to revert to the old version. *)
(*
-let showStatus path = ()
-let showStatusAddLength info = ()
-let showStatusDir path =
+ let showStatus path = ()
+ let showStatusAddLength info = ()
+ let showStatusDir path =
if not !Trace.runningasserver then begin
- Trace.statusDetail ("scanning... " ^ Path.toString path);
+ Trace.statusDetail ("scanning... " ^ Path.toString path);
end
*)
More information about the Unison-hackers
mailing list