[Unison-hackers] [unison-svn] r379 - in branches/2.32/src: . ubase
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Tue Jul 21 09:06:29 EDT 2009
Author: vouillon
Date: 2009-07-21 09:06:29 -0400 (Tue, 21 Jul 2009)
New Revision: 379
Modified:
branches/2.32/src/RECENTNEWS
branches/2.32/src/mkProjectInfo.ml
branches/2.32/src/os.ml
branches/2.32/src/ubase/prefs.ml
branches/2.32/src/ubase/trace.ml
branches/2.32/src/ubase/util.ml
branches/2.32/src/ubase/util.mli
branches/2.32/src/uicommon.ml
branches/2.32/src/uigtk2.ml
branches/2.32/src/uitext.ml
Log:
* GTK UI: Unison now take into account the arguments given (including
roots if they are given this way) on the command line when rescanning.
* Truncate temporary filename to remain under system limits.
* Fix include directive failure when the line ends by CRLF
(the CR was not removed)
* Ignore errors when writing to the log file
* Do not print the "Connected" message when the preference "silent" is set.
* Print a warning when running "unison -ui graphic" with a text-only
build of Unison
Modified: branches/2.32/src/RECENTNEWS
===================================================================
--- branches/2.32/src/RECENTNEWS 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/RECENTNEWS 2009-07-21 13:06:29 UTC (rev 379)
@@ -1,3 +1,16 @@
+CHANGES FROM VERSION 2.32.52
+
+* GTK UI: Unison now take into account the arguments given (including
+ roots if they are given this way) on the command line when rescanning.
+* Truncate temporary filename to remain under system limits.
+* Fix include directive failure when the line ends by CRLF
+ (the CR was not removed)
+* Ignore errors when writing to the log file
+* Do not print the "Connected" message when the preference "silent" is set.
+* Print a warning when running "unison -ui graphic" with a text-only
+ build of Unison
+
+-------------------------------
CHANGES FROM VERSION 2.32.44
* Describe recent changes in changelog
Modified: branches/2.32/src/mkProjectInfo.ml
===================================================================
--- branches/2.32/src/mkProjectInfo.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/mkProjectInfo.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -119,3 +119,4 @@
+
Modified: branches/2.32/src/os.ml
===================================================================
--- branches/2.32/src/os.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/os.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -334,6 +334,14 @@
(* TEMPORARY FILES *)
(*****************************************************************************)
+(* Truncate a filename to at most [l] bytes, making sure of not
+ truncating an UTF-8 character *)
+let rec truncate_filename s l =
+ if l >= 0 && Char.code s.[l] land 0xC0 = 0x80 then
+ truncate_filename s (l - 1)
+ else
+ String.sub s 0 l
+
(* Generates an unused fspath for a temporary file. *)
let genTempPath fresh fspath path prefix suffix =
let rec f i =
@@ -341,9 +349,19 @@
if i=0 then suffix
else Printf.sprintf "..%03d.%s" i suffix in
let tempPath =
- Path.addPrefixToFinalName
- (Path.addSuffixToFinalName path s)
- prefix
+ match Path.deconstructRev path with
+ None ->
+ assert false
+ | Some (name, parentPath) ->
+ let name = Name.toString name in
+ let len = String.length name in
+ let maxlen = 64 in
+ let name =
+ if len <= maxlen then name else
+ (truncate_filename name maxlen ^
+ Digest.to_hex (Digest.string name))
+ in
+ Path.child parentPath (Name.fromString (prefix ^ name ^ s))
in
if fresh && exists fspath tempPath then f (i + 1) else tempPath
in f 0
Modified: branches/2.32/src/ubase/prefs.ml
===================================================================
--- branches/2.32/src/ubase/prefs.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/ubase/prefs.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -276,6 +276,7 @@
match lines with
[] -> res
| theLine :: rest ->
+ let theLine = Util.removeTrailingCR theLine in
let l = Util.trimWhitespace theLine in
if l = "" || l.[0]='#' then
loop rest (lineNum+1) res
Modified: branches/2.32/src/ubase/trace.ml
===================================================================
--- branches/2.32/src/ubase/trace.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/ubase/trace.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -151,8 +151,10 @@
| `FormatStdout -> Format.printf "%s " s);
if Prefs.read logging then begin
let ch = getLogch() in
- output_string ch s;
- flush ch
+ begin try
+ output_string ch s;
+ flush ch
+ with Sys_error _ -> () end
end
(* ---------------------------------------------------------------------- *)
Modified: branches/2.32/src/ubase/util.ml
===================================================================
--- branches/2.32/src/ubase/util.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/ubase/util.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -387,6 +387,11 @@
let concatmap sep f l =
String.concat sep (Safelist.map f l)
+let removeTrailingCR s =
+ let l = String.length s in
+ if l = 0 || s.[l - 1] <> '\r' then s else
+ String.sub s 0 (l - 1)
+
let rec trimWhitespace s =
let l = String.length s in
if l=0 then s
Modified: branches/2.32/src/ubase/util.mli
===================================================================
--- branches/2.32/src/ubase/util.mli 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/ubase/util.mli 2009-07-21 13:06:29 UTC (rev 379)
@@ -53,6 +53,7 @@
val replacesubstring : string -> string -> string -> string (* IN,FROM,TO *)
val replacesubstrings : string -> (string * string) list -> string
val concatmap : string -> ('a -> string) -> 'a list -> string
+val removeTrailingCR : string -> string
val trimWhitespace : string -> string
val splitIntoWords : string -> char -> string list
val splitIntoWordsByString : string -> string -> string list
Modified: branches/2.32/src/uicommon.ml
===================================================================
--- branches/2.32/src/uicommon.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/uicommon.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -472,11 +472,15 @@
we ignore the command line *)
let firstTime = ref(true)
+(* Roots given on the command line *)
+let rawRoots = 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;
(* Tell the preferences module the name of the profile *)
Prefs.profileName := Some(profileName);
@@ -505,7 +509,8 @@
end;
(* Parse the command line. This will override settings from the profile. *)
- if !firstTime then begin
+ (* JV (6/09): always reparse the command line *)
+ if true (*!firstTime*) then begin
debug (fun() -> Util.msg "about to parse command line");
Prefs.parseCmdLine usageMsg;
end;
@@ -633,9 +638,9 @@
match Util.StringMap.find "rest" args with
[] -> ()
| [profile] -> clprofile := Some profile
- | [root1;root2] -> Globals.setRawRoots [root1;root2]
+ | [root1;root2] -> rawRoots := [root1;root2]
| [root1;root2;profile] ->
- Globals.setRawRoots [root1;root2];
+ rawRoots := [root1;root2];
clprofile := Some profile
| _ ->
(reportError(Printf.sprintf
@@ -653,7 +658,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 Globals.rawRoots() with
+ (match !rawRoots with
[] -> Util.msg "No roots given on command line"
| [root1;root2] ->
Printf.eprintf "Roots '%s' and '%s' given on command line"
@@ -665,7 +670,7 @@
None ->
let dirString = Fspath.toString Os.unisonDir in
let profiles_exist = (Files.ls dirString "*.prf")<>[] in
- let clroots_given = (Globals.rawRoots() <> []) in
+ let clroots_given = !rawRoots <> [] in
let n =
if profiles_exist && not(clroots_given) then begin
(* Unison has been used before: at least one profile exists.
Modified: branches/2.32/src/uigtk2.ml
===================================================================
--- branches/2.32/src/uigtk2.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/uigtk2.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -2019,6 +2019,19 @@
(*********************************************************************
Restart button
*********************************************************************)
+ let loadProfile p =
+ debug (fun()-> Util.msg "Loading profile %s..." p);
+ Uicommon.initPrefs p displayWaitMessage getFirstRoot getSecondRoot
+ termInteract;
+ displayNewProfileLabel p;
+ setMainWindowColumnHeaders()
+ in
+
+ let reloadProfile () =
+ match !Prefs.profileName with
+ None -> ()
+ | Some(n) -> loadProfile n in
+
let detectCmdName = "Restart" in
let detectCmd () =
getLock detectUpdatesAndReconcile;
@@ -2031,7 +2044,7 @@
(actionBar#insert_button ~text:detectCmdName
~icon:((GMisc.image ~stock:`REFRESH ())#coerce)
~tooltip:"Check for updates"
- ~callback: detectCmd ());
+ ~callback: (fun () -> reloadProfile(); detectCmd ()) ());
(*********************************************************************
Buttons for <--, M, -->, Skip
@@ -2274,19 +2287,6 @@
Synchronization menu
*********************************************************************)
- let loadProfile p =
- debug (fun()-> Util.msg "Loading profile %s..." p);
- Uicommon.initPrefs p displayWaitMessage getFirstRoot getSecondRoot
- termInteract;
- displayNewProfileLabel p;
- setMainWindowColumnHeaders()
- in
-
- let reloadProfile () =
- match !Prefs.profileName with
- None -> ()
- | Some(n) -> loadProfile n in
-
grAdd grGo
(fileMenu#add_image_item ~key:GdkKeysyms._g
~image:(GMisc.image ~stock:`EXECUTE ~icon_size:`MENU () :> GObj.widget)
Modified: branches/2.32/src/uitext.ml
===================================================================
--- branches/2.32/src/uitext.ml 2009-07-19 20:07:54 UTC (rev 378)
+++ branches/2.32/src/uitext.ml 2009-07-21 13:06:29 UTC (rev 379)
@@ -738,14 +738,17 @@
synchronizeUntilDone ()
end
-let start _ =
+let start interface =
+ if interface <> Uicommon.Text then
+ Util.msg "This Unison binary only provides the text GUI...\n";
begin try
(* Just to make sure something is there... *)
setWarnPrinterForInitialization();
Uicommon.uiInit
(fun s -> Util.msg "%s\n%s\n" Uicommon.shortUsageMsg s; exit 1)
(fun s -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1)
- (fun () -> if not (Prefs.read silent)
+ (fun () -> if Prefs.read silent then Prefs.set Trace.terse true;
+ if not (Prefs.read silent)
then Util.msg "%s\n" (Uicommon.contactingServerMsg()))
(fun () -> Some "default")
(fun () -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1)
More information about the Unison-hackers
mailing list