[Unison-hackers] [unison-svn] r388 - in trunk/src: . ubase

vouillon@seas.upenn.edu vouillon at seas.upenn.edu
Tue Aug 18 09:14:35 EDT 2009


Author: vouillon
Date: 2009-08-18 09:14:35 -0400 (Tue, 18 Aug 2009)
New Revision: 388

Modified:
   trunk/src/RECENTNEWS
   trunk/src/case.ml
   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/update.ml
Log:
* Fixed incompatible protocol change introduced in last commit
  (the type of some preferences was changed)


Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/RECENTNEWS	2009-08-18 13:14:35 UTC (rev 388)
@@ -1,3 +1,9 @@
+CHANGES FROM VERSION 2.37.11
+
+* Fixed incompatible protocol change introduced in last commit
+  (the type of some preferences was changed)
+
+-------------------------------
 CHANGES FROM VERSION 2.37.10
 
 * GTK UI:

Modified: trunk/src/case.ml
===================================================================
--- trunk/src/case.ml	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/case.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -54,7 +54,7 @@
 let defaultToUnicode = false
 
 let useUnicode b =
-  let pref = Prefs.read unicode in
+  let pref = Prefs.readBoolWithDefault 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.read caseInsensitiveMode = `True ||
-     (Prefs.read caseInsensitiveMode = `Default && b));
+    (Prefs.readBoolWithDefault caseInsensitiveMode = `True ||
+     (Prefs.readBoolWithDefault caseInsensitiveMode = `Default && b));
   Prefs.set unicodeEncoding (useUnicode b)
 
 (****)

Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/copy.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -690,8 +690,8 @@
     else
       Prefs.read copyprog
   in
-  let extraquotes = Prefs.read copyquoterem = `True
-                 || (  Prefs.read copyquoterem = `Default
+  let extraquotes = Prefs.readBoolWithDefault copyquoterem = `True
+                 || (  Prefs.readBoolWithDefault copyquoterem = `Default
                     && Util.findsubstring "rsync" prog <> None) in
   let addquotes root s =
     match root with

Modified: trunk/src/fileinfo.ml
===================================================================
--- trunk/src/fileinfo.ml	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/fileinfo.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -36,8 +36,8 @@
 
 let init b =
   Prefs.set symlinksAllowed
-    (Prefs.read allowSymlinks = `True ||
-     (Prefs.read allowSymlinks = `Default && not b))
+    (Prefs.readBoolWithDefault allowSymlinks = `True ||
+     (Prefs.readBoolWithDefault allowSymlinks = `Default && not b))
 
 type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ]
 

Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/mkProjectInfo.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -65,7 +65,7 @@
   Str.matched_group 1 str;;
 let extract_int re str = int_of_string (extract_str re str);;
 
-let revisionString = "$Rev: 387$";;
+let revisionString = "$Rev: 388$";;
 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,20 +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	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/osx.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -45,8 +45,8 @@
 
 let init b =
   Prefs.set rsrc
-    (Prefs.read rsrcSync = `True ||
-     (Prefs.read rsrcSync = `Default && b))
+    (Prefs.readBoolWithDefault rsrcSync = `True ||
+     (Prefs.readBoolWithDefault rsrcSync = `Default && b))
 
 (****)
 

Modified: trunk/src/ubase/prefs.ml
===================================================================
--- trunk/src/ubase/prefs.ml	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/ubase/prefs.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -197,7 +197,8 @@
     (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"
@@ -212,7 +213,15 @@
               | _                  -> `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	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/ubase/prefs.mli	2009-08-18 13:14:35 UTC (rev 388)
@@ -3,7 +3,9 @@
 
 type 'a t
 
-val read : 'a t -> 'a  
+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
 
@@ -55,7 +57,7 @@
      -> ?local:bool             (* whether it is local to the client *)
      -> string              (* documentation string *)
      -> string              (* full (tex) documentation string *)
-     -> [`True|`False|`Default] t
+     -> string t
                             (*   -> new preference value *)
 
 exception IllegalValue of string

Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml	2009-08-11 13:16:56 UTC (rev 387)
+++ trunk/src/update.ml	2009-08-18 13:14:35 UTC (rev 388)
@@ -1003,8 +1003,8 @@
        \\sectionref{fastcheck}{Fast Checking} for more information.")
 
 let useFastChecking () =
-      Prefs.read fastcheck = `True
-   || (Prefs.read fastcheck = `Default && Util.osType = `Unix)
+      Prefs.readBoolWithDefault fastcheck = `True
+   || (Prefs.readBoolWithDefault 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