unison-2.40.102/ 0000755 0061316 0061316 00000000000 12050210657 013373 5 ustar bcpierce bcpierce unison-2.40.102/abort.ml 0000644 0061316 0061316 00000004156 11361646373 015056 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/abort.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
let debug = Trace.debug "abort"
(****)
let maxerrors =
Prefs.createInt "maxerrors" 1
"!maximum number of errors before a directory transfer is aborted"
"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 too high, \
Unison may take a long time to abort in case of repeated \
failures (for instance, when the disk is full)."
(****)
let files = Hashtbl.create 17
let abortAll = ref false
let errorCountCell id =
try
Hashtbl.find files id
with Not_found ->
let c = ref 0 in
Hashtbl.add files id c;
c
let errorCount id = !(errorCountCell id)
let bumpErrorCount id = incr (errorCountCell id)
(****)
let reset () = Hashtbl.clear files; abortAll := false
(****)
let file id =
debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id));
bumpErrorCount id
let all () = abortAll := true
(****)
let check id =
debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id));
if !abortAll || errorCount id >= Prefs.read maxerrors then begin
debug (fun() ->
Util.msg "Abort failure for line %s\n" (Uutil.File.toString id));
raise (Util.Transient "Aborted")
end
let testException e = e = Util.Transient "Aborted"
unison-2.40.102/uutil.ml 0000644 0061316 0061316 00000013021 12025627377 015101 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/uutil.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(*****************************************************************************)
(* Unison name and version *)
(*****************************************************************************)
let myName = ProjectInfo.myName
let myVersion = ProjectInfo.myVersion
let myMajorVersion = ProjectInfo.myMajorVersion
let myNameAndVersion = myName ^ " " ^ myVersion
(*****************************************************************************)
(* HASHING *)
(*****************************************************************************)
let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF
external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
let hash x = hash_param 10 100 x
(*****************************************************************************)
(* File sizes *)
(*****************************************************************************)
module type FILESIZE = sig
type t
val zero : t
val dummy : t
val add : t -> t -> t
val sub : t -> t -> t
val ofFloat : float -> t
val toFloat : t -> float
val toString : t -> string
val ofInt : int -> t
val ofInt64 : int64 -> t
val toInt : t -> int
val toInt64 : t -> int64
val fromStats : Unix.LargeFile.stats -> t
val hash : t -> int
val percentageOfTotalSize : t -> t -> float
end
module Filesize : FILESIZE = struct
type t = int64
let zero = 0L
let dummy = -1L
let add = Int64.add
let sub = Int64.sub
let ofFloat = Int64.of_float
let toFloat = Int64.to_float
let toString = Int64.to_string
let ofInt x = Int64.of_int x
let ofInt64 x = x
let toInt x = Int64.to_int x
let toInt64 x = x
let fromStats st = st.Unix.LargeFile.st_size
let hash x =
hash2 (Int64.to_int x) (Int64.to_int (Int64.shift_right_logical x 31))
let percentageOfTotalSize current total =
let total = toFloat total in
if total = 0. then 100.0 else
toFloat current *. 100.0 /. total
end
(*****************************************************************************)
(* File tranfer progress display *)
(*****************************************************************************)
module File =
struct
type t = int
let dummy = -1
let ofLine l = l
let toLine l = assert (l <> dummy); l
let toString l = if l=dummy then "" else string_of_int l
end
let progressPrinter = ref (fun _ _ _ -> ())
let setProgressPrinter p = progressPrinter := p
let showProgress i bytes ch =
if i <> File.dummy then !progressPrinter i bytes ch
let statusPrinter = ref None
let setUpdateStatusPrinter p = statusPrinter := p
let showUpdateStatus path =
match !statusPrinter with
Some f -> f path
| None -> Trace.statusDetail path
(*****************************************************************************)
(* Copy bytes from one file_desc to another *)
(*****************************************************************************)
let bufsize = 16384
let bufsizeFS = Filesize.ofInt bufsize
let buf = String.create bufsize
let readWrite source target notify =
let len = ref 0 in
let rec read () =
let n = input source buf 0 bufsize in
if n > 0 then begin
output target buf 0 n;
len := !len + n;
if !len > 100 * 1024 then begin
notify !len;
len := 0
end;
read ()
end else if !len > 0 then
notify !len
in
Util.convertUnixErrorsToTransient "readWrite" read
let readWriteBounded source target len notify =
let l = ref 0 in
let rec read len =
if len > Filesize.zero then begin
let n =
input source buf 0
(if len > bufsizeFS then bufsize else Filesize.toInt len)
in
if n > 0 then begin
let _ = output target buf 0 n in
l := !l + n;
if !l >= 100 * 1024 then begin
notify !l;
l := 0
end;
read (Filesize.sub len (Filesize.ofInt n))
end else if !l > 0 then
notify !l
end else if !l > 0 then
notify !l
in
Util.convertUnixErrorsToTransient "readWriteBounded" (fun () -> read len)
(*****************************************************************************)
(* ESCAPING SHELL PARAMETERS *)
(*****************************************************************************)
(* Using single quotes is simpler under Unix but they are not accepted
by the Windows shell. Double quotes without further quoting is
sufficient with Windows as filenames are not allowed to contain
double quotes. *)
let quotes s =
if Util.osType = `Win32 && not Util.isCygwin then
"\"" ^ s ^ "\""
else
"'" ^ Util.replacesubstring s "'" "'\\''" ^ "'"
unison-2.40.102/strings.mli 0000644 0061316 0061316 00000000246 11361646373 015605 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/strings.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
val docs : (string * (string * string)) list
unison-2.40.102/bytearray.ml 0000644 0061316 0061316 00000005202 11361646373 015742 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/bytearray.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Bigarray
type t = (char, int8_unsigned_elt, c_layout) Array1.t
let length = Bigarray.Array1.dim
let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l
(*
let unsafe_blit_from_string s i a j l =
for k = 0 to l - 1 do
a.{j + k} <- s.[i + k]
done
let unsafe_blit_to_string a i s j l =
for k = 0 to l - 1 do
s.[j + k] <- a.{i + k}
done
*)
external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit
= "ml_blit_string_to_bigarray" "noalloc"
external unsafe_blit_to_string : t -> int -> string -> int -> int -> unit
= "ml_blit_bigarray_to_string" "noalloc"
let to_string a =
let l = length a in
if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else
let s = String.create l in
unsafe_blit_to_string a 0 s 0 l;
s
let of_string s =
let l = String.length s in
let a = create l in
unsafe_blit_from_string s 0 a 0 l;
a
let sub a ofs len =
if
ofs < 0 || len < 0 || ofs > length a - len || len > Sys.max_string_length
then
invalid_arg "Bytearray.sub"
else begin
let s = String.create len in
unsafe_blit_to_string a ofs s 0 len;
s
end
let rec prefix_rec a i a' i' l =
l = 0 ||
(a.{i} = a'.{i'} && prefix_rec a (i + 1) a' (i' + 1) (l - 1))
let prefix a a' i =
let l = length a in
let l' = length a' in
i <= l' - l &&
prefix_rec a 0 a' i l
let blit_from_string s i a j l =
if l < 0 || i < 0 || i > String.length s - l
|| j < 0 || j > length a - l
then invalid_arg "Bytearray.blit_from_string"
else unsafe_blit_from_string s i a j l
let blit_to_string a i s j l =
if l < 0 || i < 0 || i > length a - l
|| j < 0 || j > String.length s - l
then invalid_arg "Bytearray.blit_to_string"
else unsafe_blit_to_string a i s j l
external marshal : 'a -> Marshal.extern_flags list -> t
= "ml_marshal_to_bigarray"
external unmarshal : t -> int -> 'a
= "ml_unmarshal_from_bigarray"
unison-2.40.102/linktext.ml 0000644 0061316 0061316 00000001427 11361646373 015607 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/linktext.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
module TopLevel = Main.Body(Uitext.Body)
unison-2.40.102/xferhint.mli 0000644 0061316 0061316 00000001431 11361646373 015740 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/xferhint.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* This module maintains a cache that can be used to map
an Os.fingerprint to a (Fspath.t * Path.t) naming a file that *may*
(if we are lucky) have this fingerprint. The cache is not guaranteed
to be reliable -- the things it returns are only hints, and must be
double-checked before they are used (to optimize file transfers). *)
val xferbycopying: bool Prefs.t
type handle
(* Suggest a file that's likely to have a given fingerprint *)
val lookup: Os.fullfingerprint -> (Fspath.t * Path.local * handle) option
(* Add a file *)
val insertEntry: Fspath.t -> Path.local -> Os.fullfingerprint -> unit
(* Delete an entry *)
val deleteEntry: handle -> unit
unison-2.40.102/INSTALL.win32 0000644 0061316 0061316 00000001106 11361646373 015377 0 ustar bcpierce bcpierce Installation notes to build Unison on Windows systems
We provide two options for building Unison on MS Windows. Both
options require the Cygwin layer to be able to use a few GNU tools as
well as the OCaml distribution version. The options differ in the C
compiler employed: MS Visual C++ (MSVC) vs Cygwin GNU C.
Tradeoff?
. Only the MSVC option can produce statically linked Unison executable.
. The Cygwin GNU C option requires only free software.
The files "INSTALL.win32-msvc" and "INSTALL.win32-cygwin-gnuc" describe
the building procedures for the respective options.
unison-2.40.102/tree.ml 0000644 0061316 0061316 00000006057 11361646373 014710 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/tree.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
type ('a, 'b) t =
Node of ('a * ('a, 'b) t) list * 'b option
| Leaf of 'b
type ('a, 'b) u =
{ anc: (('a, 'b) u * 'a) option;
node: 'b option;
children: ('a * ('a, 'b) t) list}
let start =
{anc = None; node = None; children = []}
let add t v =
{t with node = Some v}
let enter t n = {anc = Some (t, n); node = None; children = []}
let leave t =
match t with
{anc = Some (t, n); node = None; children = []} ->
t
| {anc = Some (t, n); node = Some v; children = []} ->
{t with children = (n, Leaf v) :: t.children}
| {anc = Some (t, n); node = v; children = l} ->
{t with children = (n, (Node (Safelist.rev l, v))) :: t.children}
| {anc = None} ->
invalid_arg "Tree.leave"
let finish t =
match t with
{anc = Some _} ->
invalid_arg "Tree.finish"
| {anc = None; node = Some v; children = []} ->
Leaf v
| {anc = None; node = v; children = l} ->
Node (Safelist.rev l, v)
let rec leave_all t =
if t.anc = None then t else leave_all (leave t)
let rec empty t =
{anc =
begin match t.anc with
Some (t', n) -> Some (empty t', n)
| None -> None
end;
node = None;
children = []}
let slice t =
(finish (leave_all t), empty t)
(****)
let is_empty t =
match t with
Node ([], None) -> true
| _ -> false
let rec map f g t =
match t with
Node (l, v) ->
Node (Safelist.map (fun (n, t') -> (f n, map f g t')) l,
match v with None -> None | Some v -> Some (g v))
| Leaf v ->
Leaf (g v)
let rec iteri t path pcons f =
match t with
Node (l, v) ->
begin match v with
Some v -> f path v
| None -> ()
end;
Safelist.iter (fun (n, t') -> iteri t' (pcons path n) pcons f) l
| Leaf v ->
f path v
let rec size_rec s t =
match t with
Node (l, v) ->
let s' = if v = None then s else s + 1 in
Safelist.fold_left (fun s (_, t') -> size_rec s t') s' l
| Leaf v ->
s + 1
let size t = size_rec 0 t
let rec flatten t path pcons result =
match t with
Leaf v ->
(path, v) :: result
| Node (l, v) ->
let rem =
Safelist.fold_right
(fun (name, t') rem ->
flatten t' (pcons path name) pcons rem)
l result
in
match v with
None -> rem
| Some v -> (path, v) :: rem
unison-2.40.102/fspath.mli 0000644 0061316 0061316 00000002422 12025627377 015400 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fspath.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Defines an abstract type of absolute filenames (fspaths) *)
type t
val child : t -> Name.t -> t
val concat : t -> Path.local -> t
val canonize : string option -> t
val toString : t -> string
val toPrintString : t -> string
val toDebugString : t -> string
val toSysPath : t -> System.fspath
(* If fspath+path refers to a (followed) symlink, then return the directory *)
(* of the symlink's target; otherwise return the parent dir of path. If *)
(* fspath+path is a root directory, raise Fatal. *)
val findWorkingDir : t -> Path.local -> (t * Path.local)
(* Return the least distinguishing suffixes of two fspaths, for displaying *)
(* in the user interface. *)
val differentSuffix: t -> t -> (string * string)
(* Return the AppleDouble filename; if root dir, raise Invalid_argument *)
val appleDouble : t -> t
(* Return the resource fork filename; if root dir, raise Invalid_argument *)
val rsrc : t -> t
(* Escaped fspath (to pass as shell parameter) *)
val quotes : t -> string
(* CASE-SENSITIVE comparison between fspaths *)
val compare : t -> t -> int
unison-2.40.102/path.ml 0000644 0061316 0061316 00000016031 12025627377 014677 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/path.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* Defines an abstract type of relative pathnames *)
type 'a path = string
type t = string
type local = string
let pathSeparatorChar = '/'
let pathSeparatorString = "/"
let concat p p' =
let l = String.length p in
if l = 0 then p' else
let l' = String.length p' in
if l' = 0 then p else
let p'' = String.create (l + l' + 1) in
String.blit p 0 p'' 0 l;
p''.[l] <- pathSeparatorChar;
String.blit p' 0 p'' (l + 1) l';
p''
let empty = ""
let isEmpty p = String.length p = 0
let length p =
let l = ref 0 in
for i = 0 to String.length p - 1 do
if p.[i] = pathSeparatorChar then incr l
done;
!l
(* Add a name to the end of a path *)
let rcons n path = concat (Name.toString n) path
let toStringList p = Str.split (Str.regexp pathSeparatorString) p
(* Give a left-to-right list of names in the path *)
let toNames p = Safelist.map Name.fromString (toStringList p)
let child path name = concat path (Name.toString name)
let parent path =
try
let i = String.rindex path pathSeparatorChar in
String.sub path 0 i
with Not_found ->
empty
let finalName path =
try
let i = String.rindex path pathSeparatorChar + 1 in
Some (Name.fromString (String.sub path i (String.length path - i)))
with Not_found ->
if isEmpty path then
None
else
Some (Name.fromString path)
(* pathDeconstruct : path -> (name * path) option *)
let deconstruct path =
try
let i = String.index path pathSeparatorChar in
Some (Name.fromString (String.sub path 0 i),
String.sub path (i + 1) (String.length path - i - 1))
with Not_found ->
if isEmpty path then
None
else
Some (Name.fromString path, empty)
let deconstructRev path =
try
let i = String.rindex path pathSeparatorChar in
Some (Name.fromString
(String.sub path (i + 1) (String.length path - i - 1)),
String.sub path 0 i)
with Not_found ->
if path = "" then
None
else
Some (Name.fromString path, empty)
let winAbspathRx = Rx.rx "([a-zA-Z]:)?(/|\\\\).*"
let unixAbspathRx = Rx.rx "/.*"
let is_absolute s =
if Util.osType=`Win32 then Rx.match_string winAbspathRx s
else Rx.match_string unixAbspathRx s
(* Function string2path: string -> path
THIS IS THE CRITICAL FUNCTION.
Problem: What to do on argument "" ?
What we do: we raise Invalid_argument.
Problem: double slash within the argument, e.g., "foo//bar".
What we do: we raise Invalid_argument.
Problem: What if string2path is applied to an absolute path? We
want to disallow this, but, relative is relative. E.g., on Unix it
makes sense to have a directory with subdirectory "c:". Then, it
makes sense to synchronize on the path "c:". But this will go
badly if the Unix system synchronizes with a Windows system.
What we do: we check whether a path is relative using local
conventions, and raise Invalid_argument if not. If we synchronize
with a system with other conventions, then problems must be caught
elsewhere. E.g., the system should refuse to create a directory
"c:" on a Windows machine.
Problem: spaces in the argument, e.g., " ". Still not sure what to
do here. Is it possible to create a file with this name in Unix or
Windows?
Problem: trailing slashes, e.g., "foo/bar/". Shells with
command-line completion may produce these routinely.
What we do: we remove them. Moreover, we remove as many as
necessary, e.g., "foo/bar///" becomes "foo/bar". This may be
counter to conventions of some shells/os's, where "foo/bar///"
might mean "/".
Examples:
loop "hello/there" -> ["hello"; "there"]
loop "/hello/there" -> [""; "hello"; "there"]
loop "" -> [""]
loop "/" -> [""; ""]
loop "//" -> [""; ""; ""]
loop "c:/" ->["c:"; ""]
loop "c:/foo" -> ["c:"; "foo"]
*)
let fromString str =
let str0 = str in
let str = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes str else str in
if is_absolute str then
raise (Util.Transient
(Printf.sprintf "The path '%s' is not a relative path" str));
let str = Fileutil.removeTrailingSlashes str in
if str = "" then empty else
let rec loop p str =
try
let pos = String.index str pathSeparatorChar in
let name1 = String.sub str 0 pos in
if name1 = ".." then
raise (Util.Transient
(Printf.sprintf
"Reference to parent directory '..' not allowed \
in path '%s'" str0));
let str_res =
String.sub str (pos + 1) (String.length str - pos - 1) in
if pos = 0 || name1 = "." then begin
loop p str_res
end else
loop (child p (Name.fromString name1)) str_res
with
Not_found ->
if str = ".." then
raise (Util.Transient
(Printf.sprintf
"Reference to parent directory '..' not allowed \
in path '%s'" str0));
if str = "." then p else child p (Name.fromString str)
| Invalid_argument _ ->
raise(Invalid_argument "Path.fromString") in
loop empty str
let toString path = path
let compare p1 p2 = (Case.ops())#compare p1 p2
let toDebugString path = String.concat " / " (toStringList path)
let addSuffixToFinalName path suffix = path ^ suffix
let addPrefixToFinalName path prefix =
try
let i = String.rindex path pathSeparatorChar + 1 in
let l = String.length path in
let l' = String.length prefix in
let p = String.create (l + l') in
String.blit path 0 p 0 i;
String.blit prefix 0 p i l';
String.blit path i p (i + l') (l - i);
p
with Not_found ->
assert (not (isEmpty path));
prefix ^ path
(* Pref controlling whether symlinks are followed. *)
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 \
at this position in the replica. See \
\\sectionref{symlinks}{Symbolic Links} for more details. \
The syntax of \\ARG{pathspec} is \
described in \\sectionref{pathspec}{Path Specification}.")
let followLink path =
(Util.osType = `Unix || Util.isCygwin)
&& Pred.test followPred (toString path)
let forceLocal p = p
let makeGlobal p = p
unison-2.40.102/bytearray_stubs.c 0000644 0061316 0061316 00000002271 11361646373 016777 0 ustar bcpierce bcpierce /* Unison file synchronizer: src/bytearray_stubs.c */
/* Copyright 1999-2009 (see COPYING for details) */
#include
#include "caml/intext.h"
#include "caml/bigarray.h"
CAMLprim value ml_marshal_to_bigarray(value v, value flags)
{
char *buf;
long len;
output_value_to_malloc(v, flags, &buf, &len);
return alloc_bigarray(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT | BIGARRAY_MANAGED,
1, buf, &len);
}
#define Array_data(a, i) (((char *) a->data) + Long_val(i))
CAMLprim value ml_unmarshal_from_bigarray(value b, value ofs)
{
struct caml_bigarray *b_arr = Bigarray_val(b);
return input_value_from_block (Array_data (b_arr, ofs),
b_arr->dim[0] - Long_val(ofs));
}
CAMLprim value ml_blit_string_to_bigarray
(value s, value i, value a, value j, value l)
{
char *src = String_val(s) + Int_val(i);
char *dest = Array_data(Bigarray_val(a), j);
memcpy(dest, src, Long_val(l));
return Val_unit;
}
CAMLprim value ml_blit_bigarray_to_string
(value a, value i, value s, value j, value l)
{
char *src = Array_data(Bigarray_val(a), i);
char *dest = String_val(s) + Long_val(j);
memcpy(dest, src, Long_val(l));
return Val_unit;
}
unison-2.40.102/uitext.mli 0000644 0061316 0061316 00000000222 11361646373 015430 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/uitext.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
module Body : Uicommon.UI
unison-2.40.102/sortri.mli 0000644 0061316 0061316 00000001474 11361646373 015442 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/sortri.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Sort a list of recon items according to the current setting of
various preferences (defined in sort.ml, and accessible from the
profile and via the functions below) *)
val sortReconItems : Common.reconItem list -> Common.reconItem list
(* The underlying comparison function for sortReconItems (in case we
want to use it to sort something else, like stateItems in the UI) *)
val compareReconItems : unit -> (Common.reconItem -> Common.reconItem -> int)
(* Set the global preferences so that future calls to sortReconItems
will sort in particular orders *)
val sortByName : unit -> unit
val sortBySize : unit -> unit
val sortNewFirst : unit -> unit
val restoreDefaultSettings : unit -> unit
unison-2.40.102/strings.ml 0000644 0061316 0061316 00000000045 12050210653 015411 0 ustar bcpierce bcpierce (* Dummy strings.ml *)
let docs = []
unison-2.40.102/common.ml 0000644 0061316 0061316 00000017530 11361646373 015237 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/common.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
type hostname = string
(* Canonized roots *)
type host =
Local
| Remote of hostname
type root = host * Fspath.t
type 'a oneperpath = ONEPERPATH of 'a list
(* ------------------------------------------------------------------------- *)
(* Printing *)
(* ------------------------------------------------------------------------- *)
let root2hostname root =
match root with
(Local, _) -> "local"
| (Remote host, _) -> host
let root2string root =
match root with
(Local, fspath) -> Fspath.toPrintString fspath
| (Remote host, fspath) -> "//"^host^"/"^(Fspath.toPrintString fspath)
(* ------------------------------------------------------------------------- *)
(* Root comparison *)
(* ------------------------------------------------------------------------- *)
let compareRoots x y =
match x,y with
(Local,fspath1), (Local,fspath2) ->
(* FIX: This is a path comparison, should it take case
sensitivity into account ? *)
Fspath.compare fspath1 fspath2
| (Local,_), (Remote _,_) -> -1
| (Remote _,_), (Local,_) -> 1
| (Remote host1, fspath1), (Remote host2, fspath2) ->
let result =
(* FIX: Should this ALWAYS be a case insensitive compare? *)
compare host1 host2 in
if result = 0 then
(* FIX: This is a path comparison, should it take case
sensitivity into account ? *)
Fspath.compare fspath1 fspath2
else
result
let sortRoots rootList = Safelist.sort compareRoots rootList
(* ---------------------------------------------------------------------- *)
type prevState =
Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp
| New
type contentschange =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp
type permchange = PropsSame | PropsUpdated
type updateItem =
NoUpdates (* Path not changed *)
| Updates (* Path changed in this replica *)
of updateContent (* - new state *)
* prevState (* - summary of old state *)
| Error (* Error while detecting updates *)
of string (* - description of error *)
and updateContent =
Absent (* Path refers to nothing *)
| File (* Path refers to an ordinary file *)
of Props.t (* - summary of current state *)
* contentschange (* - hint to transport agent *)
| Dir (* Path refers to a directory *)
of Props.t (* - summary of current state *)
* (Name.t * updateItem) list (* - children;
MUST KEEP SORTED for recon *)
* permchange (* - did permissions change? *)
* bool (* - is the directory now empty? *)
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)
(* ------------------------------------------------------------------------- *)
type status =
[ `Deleted
| `Modified
| `PropsChanged
| `Created
| `Unchanged ]
type replicaContent =
{ typ : Fileinfo.typ;
status : status;
desc : Props.t; (* Properties (for the UI) *)
ui : updateItem;
size : int * Uutil.Filesize.t; (* Number of items and size *)
props : Props.t list } (* Parent properties *)
type direction =
Conflict
| Merge
| Replica1ToReplica2
| Replica2ToReplica1
let direction2string = function
Conflict -> "conflict"
| Merge -> "merge"
| Replica1ToReplica2 -> "replica1 to replica2"
| Replica2ToReplica1 -> "replica2 to replica1"
type difference =
{ rc1 : replicaContent;
rc2 : replicaContent;
errors1 : string list;
errors2 : string list;
mutable direction : direction;
default_direction : direction }
type replicas =
Problem of string (* There was a problem during update detection *)
| Different of difference (* Replicas differ *)
type reconItem = {path1 : Path.t; path2 : Path.t; replicas : replicas}
let ucLength = function
File(desc,_) -> Props.length desc
| Dir(desc,_,_,_) -> Props.length desc
| _ -> Uutil.Filesize.zero
let uiLength = function
Updates(uc,_) -> ucLength uc
| _ -> Uutil.Filesize.zero
let riAction rc rc' =
match rc.status, rc'.status with
`Deleted, _ ->
`Delete
| (`Unchanged | `PropsChanged), (`Unchanged | `PropsChanged) ->
`SetProps
| _ ->
`Copy
let rcLength rc rc' =
if riAction rc rc' = `SetProps then
Uutil.Filesize.zero
else
snd rc.size
let riLength ri =
match ri.replicas with
Different {rc1 = {status= `Unchanged | `PropsChanged};
rc2 = {status= `Unchanged | `PropsChanged}} ->
Uutil.Filesize.zero (* No contents propagated *)
| Different {rc1 = rc1; rc2 = rc2; direction = dir} ->
begin match dir with
Replica1ToReplica2 -> rcLength rc1 rc2
| Replica2ToReplica1 -> rcLength rc2 rc1
| Conflict -> Uutil.Filesize.zero
| Merge -> Uutil.Filesize.zero (* underestimate :-*)
end
| _ ->
Uutil.Filesize.zero
let fileInfos ui1 ui2 =
match ui1, ui2 with
(Updates (File (desc1, ContentsUpdated (fp1, _, ress1)),
Previous (`FILE, desc2, fp2, ress2)),
NoUpdates)
| (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)),
Previous (`FILE, desc2, fp2, ress2)),
Updates (File (_, ContentsSame), _))
| (NoUpdates,
Updates (File (desc2, ContentsUpdated (fp2, _, ress2)),
Previous (`FILE, desc1, fp1, ress1)))
| (Updates (File (_, ContentsSame), _),
Updates (File (desc2, ContentsUpdated (fp2, _, ress2)),
Previous (`FILE, desc1, fp1, ress1)))
| (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), _),
Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), _)) ->
(desc1, fp1, ress1, desc2, fp2, ress2)
| _ ->
raise (Util.Transient "Can't diff")
let problematic ri =
match ri.replicas with
Problem _ -> true
| Different diff -> diff.direction = Conflict
let partiallyProblematic ri =
match ri.replicas with
Problem _ ->
true
| Different diff ->
diff.direction = Conflict || diff.errors1 <> [] || diff.errors2 <> []
let isDeletion ri =
match ri.replicas with
Different {rc1 = rc1; rc2 = rc2; direction = rDir} ->
(match rDir, rc1.typ, rc2.typ with
Replica1ToReplica2, `ABSENT, _ -> true
| Replica2ToReplica1, _, `ABSENT -> true
| _ -> false)
| _ -> false
let rcType rc = Fileinfo.type2string rc.typ
let riFileType ri =
match ri.replicas with
Different {rc1 = rc1; rc2 = rc2; default_direction = dir} ->
begin match dir with
Replica2ToReplica1 -> rcType rc2
| _ -> rcType rc1
end
| _ -> "nonexistent"
unison-2.40.102/ubase/ 0000755 0061316 0061316 00000000000 12050210657 014472 5 ustar bcpierce bcpierce unison-2.40.102/ubase/uarg.mli 0000644 0061316 0061316 00000011126 11361646373 016150 0 ustar bcpierce bcpierce (***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* Slightly modified version by BCP for Unison in 1999 and 2008 *)
(* Module [Uarg]: parsing of command line arguments *)
(* This module provides a general mechanism for extracting options and
arguments from the command line to the program.
*)
(* Syntax of command lines:
A keyword is a character string starting with a [-].
An option is a keyword alone or followed by an argument.
The types of keywords are: [Unit], [Set], [Clear], [String],
[Int], [Float], and [Rest]. [Unit], [Set] and [Clear] keywords take
no argument. [String], [Int], and [Float] keywords take the following
word on the command line as an argument. A [Rest] keyword takes the
remaining of the command line as (string) arguments.
Arguments not preceded by a keyword are called anonymous arguments.
*)
(* Examples ([cmd] is assumed to be the command name):
- [cmd -flag ](a unit option)
- [cmd -int 1 ](an int option with argument [1])
- [cmd -string foobar ](a string option with argument ["foobar"])
- [cmd -float 12.34 ](a float option with argument [12.34])
- [cmd a b c ](three anonymous arguments: ["a"], ["b"], and ["c"])
- [cmd a b -- c d ](two anonymous arguments and a rest option with
- [ ] two arguments)
*)
type spec =
| Unit of (unit -> unit) (* Call the function with unit argument *)
| Set of bool ref (* Set the reference to true *)
| Clear of bool ref (* Set the reference to false *)
| Bool of (bool -> unit) (* Pass true to the function *)
| String of (string -> unit) (* Call the function with a string argument *)
| Int of (int -> unit) (* Call the function with an int argument *)
| Float of (float -> unit) (* Call the function with a float argument *)
| Rest of (string -> unit) (* Stop interpreting keywords and call the
function with each remaining argument *)
(* The concrete type describing the behavior associated
with a keyword. *)
val parse : (string * spec * string) list -> (string -> unit) -> string -> unit
(*
[Uarg.parse speclist anonfun usage_msg] parses the command line.
[speclist] is a list of triples [(key, spec, doc)].
[key] is the option keyword, it must start with a ['-'] character.
[spec] gives the option type and the function to call when this option
is found on the command line.
[doc] is a one-line description of this option.
[anonfun] is called on anonymous arguments.
The functions in [spec] and [anonfun] are called in the same order
as their arguments appear on the command line.
If an error occurs, [Uarg.parse] exits the program, after printing
an error message as follows:
- The reason for the error: unknown option, invalid or missing argument, etc.
- [usage_msg]
- The list of options, each followed by the corresponding [doc] string.
For the user to be able to specify anonymous arguments starting with a
[-], include for example [("-", String anonfun, doc)] in [speclist].
By default, [parse] recognizes a unit option [-help], which will
display [usage_msg] and the list of options, and exit the program.
You can override this behaviour by specifying your own [-help]
option in [speclist].
*)
exception Bad of string
(*
Functions in [spec] or [anonfun] can raise [Uarg.Bad] with an error
message to reject invalid arguments.
*)
val usage: (string * spec * string) list -> string -> unit
(*
[Uarg.usage speclist usage_msg] prints an error message including
the list of valid options. This is the same message that
[Uarg.parse] prints in case of error.
[speclist] and [usage_msg] are the same as for [Uarg.parse].
*)
val current: int ref;;
(*
Position (in [Sys.argv]) of the argument being processed. You can
change this value, e.g. to force [Uarg.parse] to skip some arguments.
*)
unison-2.40.102/ubase/trace.mli 0000644 0061316 0061316 00000010123 11361646373 016304 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/trace.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* ---------------------------------------------------------------------- *)
(* Debugging support *)
(* Show a low-level debugging message. The first argument is the
name of the module from which the debugging message originates: this is
used to control which messages are printing (by looking at the value of
the 'debug' preference, a list of strings). The second argument is a
thunk that, if executed, should print the actual message to stderr. Note
that, since control of debugging depends on preferences, it is not possible
to see debugging output generated before the preferences have been
loaded. *)
val debug : string -> (unit->unit) -> unit
val debugmods : string list Prefs.t
(* Check whether a particular debugging flag is enabled *)
val enabled : string -> bool
(* Enable/disable a particular flag *)
val enable : string -> bool -> unit
(* When running in server mode, we use this ref to know to indicate this in
debugging messages *)
val runningasserver : bool ref
(* Tell the Trace module which local stream to use for tracing and
debugging messages *)
val redirect : [`Stdout | `Stderr | `FormatStdout] -> unit
(* ---------------------------------------------------------------------- *)
(* Tracing *)
(* The function used to display a message on the machine where the
user is going to see it. The default value just prints the string
on stderr. The graphical user interface should install an
appropriate function here when it starts. In the server process, this
variable's value is ignored. *)
val messageDisplayer : (string -> unit) ref
(* The function used to format a status message (with a major and a minor
part) into a string for display. Should be set by the user interface. *)
val statusFormatter : (string -> string -> string) ref
(* The internal type of messages (it is exposed because it appears in the
types of the following) *)
type msg
(* The internal routine used for formatting a message to be displayed
locally. It calls !messageDisplayer to do the actual work. *)
val displayMessageLocally : msg -> unit
(* This can be set to function that should be used to get messages to
the machine where the user can see it, if we are running on some
other machine. (On the client machine, this variable's value is None.
On the server, it should be set to something that moves the message
across the network and then calls displayMessageLocally on the
client.) *)
val messageForwarder : (msg -> unit) option ref
(* Allow outside access to the logging preference, so that the main program
can turn it off by default *)
val logging : bool Prefs.t
(* ---------------------------------------------------------------------- *)
(* Messages *)
(* Suppress all message printing *)
val terse
: bool Prefs.t
(* Show a string to the user. *)
val message : string -> unit
(* Show a change of "top-level" status (what phase we're in) *)
val status : string -> unit
(* Show a change of "detail" status (what file we're working on) *)
val statusMinor : string -> unit
(* Show a change of "detail" status unless we want to avoid generating
too much output (e.g. because we're using the text ui) *)
val statusDetail : string -> unit
(* Write a message just to the log file (no extra '\n' will be added: include
one explicitly if you want one) *)
val log : string -> unit
(* Like 'log', but only send message to log file if -terse preference is set *)
val logverbose : string -> unit
(* When set to true (default), log messages will also be printed to stderr *)
val sendLogMsgsToStderr : bool ref
(* ---------------------------------------------------------------------- *)
(* Timers (for performance measurements during development) *)
type timer
(* Create a new timer, print a description, and start it ticking *)
val startTimer : string -> timer
(* Create a new timer without printing a description *)
val startTimerQuietly : string -> timer
(* Display the current time on a timer (and its description) *)
val showTimer : timer -> unit
unison-2.40.102/ubase/Makefile 0000644 0061316 0061316 00000002564 11361646373 016155 0 ustar bcpierce bcpierce NAME = ubase
OBJECTS = \
safelist.cmo uprintf.cmo util.cmo uarg.cmo prefs.cmo trace.cmo rx.cmo \
myMap.cmo
OCAMLC = ocamlfind ocamlc -g
OCAMLOPT = ocamlfind ocamlopt
OCAMLDEP = ocamldep
XOBJECTS = $(OBJECTS:cmo=cmx)
ARCHIVE = $(NAME).cma
XARCHIVE = $(NAME).cmxa
REQUIRES =
PREDICATES =
all: $(ARCHIVE)
opt: $(XARCHIVE)
$(ARCHIVE): $(OBJECTS)
$(OCAMLC) -a -o $(ARCHIVE) -package "$(REQUIRES)" -linkpkg \
-predicates "$(PREDICATES)" $(OBJECTS)
$(XARCHIVE): $(XOBJECTS)
$(OCAMLOPT) -a -o $(XARCHIVE) -package "$(REQUIRES)" -linkpkg \
-predicates "$(PREDICATES)" $(XOBJECTS)
.SUFFIXES: .cmo .cmi .cmx .ml .mli
.ml.cmo:
$(OCAMLC) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \
-c $<
.mli.cmi:
$(OCAMLC) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \
-c $<
.ml.cmx:
$(OCAMLOPT) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \
-c $<
depend: *.ml *.mli
$(OCAMLDEP) *.ml *.mli > depend
include depend
install: all
{ test ! -f $(XARCHIVE) || extra="$(XARCHIVE) "`basename $(XARCHIVE) .cmxa`.a; }; \
ocamlfind install $(NAME) *.mli *.cmi $(ARCHIVE) META $$extra
uninstall:
ocamlfind remove $(NAME)
clean::
rm -f *.cmi *.cmo *.cmx *.cma *.cmxa *.a *.o *~ *.bak
# Used by BCP to update Harmony's copy of these files from Unison's
update:
cp $(HOME)/current/unison/trunk/src/ubase/{*.ml,*.mli,Makefile} . unison-2.40.102/ubase/rx.mli 0000644 0061316 0061316 00000004326 11361646373 015647 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/rx.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
type t
(* Posix regular expression *)
val rx : string -> t
(* File globbing *)
val glob : string -> t
val glob' : bool -> string -> t
(* Same, but allows to choose whether dots at the beginning of a
file name need to be explicitly matched (true) or not (false) *)
val globx : string -> t
val globx' : bool -> string -> t
(* These two functions also recognize the pattern {...} *)
(* String expression (literal match) *)
val str : string -> t
(* Operations on regular expressions *)
val alt : t list -> t (* Alternative *)
val seq : t list -> t (* Sequence *)
val empty : t (* Match nothing *)
val epsilon : t (* Empty word *)
val rep : t -> int -> int option -> t (* Repeated matches *)
val rep0 : t -> t (* 0 or more matches *)
val rep1 : t -> t (* 1 or more matches *)
val opt : t -> t (* 0 or 1 matches *)
val bol : t (* Beginning of line *)
val eol : t (* End of line *)
val any : t (* Any character *)
val notnl : t (* Any character but a newline *)
val set : string -> t (* Any character of the string *)
val inter : t list -> t (* All subexpressions must match *)
val diff : t -> t -> t (* The first expression matches
but not the second *)
val case_insensitive : t -> t (* Case insensitive matching *)
(* Test whether a regular expression matches a string *)
val match_string : t -> string -> bool
(* Test whether a regular expression matches a substring of the given
string *)
val match_substring : t -> string -> bool
(* Test whether a regular expression matches some characters of a
string starting at a given position. Return the length of
the matched prefix. *)
val match_prefix : t -> string -> int -> int option
(* Errors that can be raised during the parsing of Posix regular
expressions *)
exception Parse_error
exception Not_supported
unison-2.40.102/ubase/uprintf.mli 0000644 0061316 0061316 00000010275 11361646373 016705 0 ustar bcpierce bcpierce (***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License. *)
(* *)
(***********************************************************************)
(* Modified for Unison *)
(* Module [Printf]: formatting printing functions *)
val fprintf: out_channel -> (unit->unit) -> ('a, out_channel, unit) format -> 'a
(* [fprintf outchan doafter format arg1 ... argN] formats the arguments
[arg1] to [argN] according to the format string [format],
outputs the resulting string on the channel [outchan], and then
executes the thunk [doafter].
The format is a character string which contains two types of
objects: plain characters, which are simply copied to the
output channel, and conversion specifications, each of which
causes conversion and printing of one argument.
Conversion specifications consist in the [%] character, followed
by optional flags and field widths, followed by one conversion
character. The conversion characters and their meanings are:
- [d] or [i]: convert an integer argument to signed decimal
- [u]: convert an integer argument to unsigned decimal
- [x]: convert an integer argument to unsigned hexadecimal,
using lowercase letters.
- [X]: convert an integer argument to unsigned hexadecimal,
using uppercase letters.
- [o]: convert an integer argument to unsigned octal.
- [s]: insert a string argument
- [c]: insert a character argument
- [f]: convert a floating-point argument to decimal notation,
in the style [dddd.ddd]
- [e] or [E]: convert a floating-point argument to decimal notation,
in the style [d.ddd e+-dd] (mantissa and exponent)
- [g] or [G]: convert a floating-point argument to decimal notation,
in style [f] or [e], [E] (whichever is more compact)
- [b]: convert a boolean argument to the string [true] or [false]
- [a]: user-defined printer. Takes two arguments and apply the first
one to [outchan] (the current output channel) and to the second
argument. The first argument must therefore have type
[out_channel -> 'b -> unit] and the second ['b].
The output produced by the function is therefore inserted
in the output of [fprintf] at the current point.
- [t]: same as [%a], but takes only one argument (with type
[out_channel -> unit]) and apply it to [outchan].
- [%]: take no argument and output one [%] character.
- Refer to the C library [printf] function for the meaning of
flags and field width specifiers.
Warning: if too few arguments are provided,
for instance because the [printf] function is partially
applied, the format is immediately printed up to
the conversion of the first missing argument; printing
will then resume when the missing arguments are provided.
For example, [List.iter (printf "x=%d y=%d " 1) [2;3]]
prints [x=1 y=2 3] instead of the expected
[x=1 y=2 x=1 y=3]. To get the expected behavior, do
[List.iter (fun y -> printf "x=%d y=%d " 1 y) [2;3]]. *)
val printf: (unit->unit) -> ('a, out_channel, unit) format -> 'a
(* Same as [fprintf], but output on [stdout]. *)
val eprintf: (unit->unit) -> ('a, out_channel, unit) format -> 'a
(* Same as [fprintf], but output on [stderr]. *)
unison-2.40.102/ubase/uarg.ml 0000644 0061316 0061316 00000007130 11361646373 015777 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/uarg.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* by Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* Slightly modified by BCP, July 1999 *)
type spec =
| Unit of (unit -> unit) (* Call the function with unit argument *)
| Set of bool ref (* Set the reference to true *)
| Clear of bool ref (* Set the reference to false *)
| Bool of (bool -> unit) (* Pass true to the function *)
| String of (string -> unit) (* Call the function with a string argument *)
| Int of (int -> unit) (* Call the function with an int argument *)
| Float of (float -> unit) (* Call the function with a float argument *)
| Rest of (string -> unit) (* Stop interpreting keywords and call the
function with each remaining argument *)
exception Bad of string
type error =
| Unknown of string
| Wrong of string * string * string (* option, actual, expected *)
| Missing of string
| Message of string
open Printf
let rec assoc3 x l =
match l with
| [] -> raise Not_found
| (y1, y2, y3)::t when y1 = x -> y2
| _::t -> assoc3 x t
;;
let usage speclist errmsg =
printf "%s\n" errmsg;
Safelist.iter
(function (key, _, doc) ->
if String.length doc > 0 && doc.[0] <> '*'
then printf " %s %s\n" key doc)
(Safelist.rev speclist)
;;
let current = ref 0;;
let parse speclist anonfun errmsg =
let argv = System.argv () in
let initpos = !current in
let stop error =
let progname =
if initpos < Array.length argv then argv.(initpos) else "(?)" in
begin match error with
| Unknown s when s = "-help" -> ()
| Unknown s ->
eprintf "%s: unknown option `%s'.\n" progname s
| Missing s ->
eprintf "%s: option `%s' needs an argument.\n" progname s
| Wrong (opt, arg, expected) ->
eprintf "%s: wrong argument `%s'; option `%s' expects %s.\n"
progname arg opt expected
| Message s ->
eprintf "%s: %s.\n" progname s
end;
usage speclist errmsg;
exit 2;
in
let l = Array.length argv in
incr current;
while !current < l do
let ss = argv.(!current) in
if String.length ss >= 1 & String.get ss 0 = '-' then begin
let args = Util.splitIntoWords ss '=' in
let s = Safelist.nth args 0 in
let arg conv mesg =
match args with
[_] ->
if !current + 1 >= l then stop (Missing s) else
let a = argv.(!current+1) in
incr current;
(try conv a with Failure _ -> stop (Wrong (s, a, mesg)))
| [_;a] -> (try conv a with Failure _ -> stop (Wrong (s, a, mesg)))
| _ -> stop (Message (sprintf "Garbled argument %s" s)) in
let action =
try assoc3 s speclist
with Not_found -> stop (Unknown s)
in
begin try
match action with
| Unit f -> f ();
| Set r -> r := true;
| Clear r -> r := false;
| Bool f ->
begin match args with
[_] -> f true
| _ -> f (arg bool_of_string "a boolean")
end
| String f -> f (arg (fun s-> s) "")
| Int f -> f (arg int_of_string "an integer")
| Float f -> f (arg float_of_string "a float")
| Rest f ->
while !current < l-1 do
f argv.(!current+1);
incr current;
done;
with Bad m -> stop (Message m);
end;
incr current;
end else begin
(try anonfun ss with Bad m -> stop (Message m));
incr current;
end;
done;
;;
unison-2.40.102/ubase/trace.ml 0000644 0061316 0061316 00000020572 11361646373 016144 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/trace.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* ---------------------------------------------------------------------- *)
(* Choosing where messages go *)
type trace_printer_choices = [`Stdout | `Stderr | `FormatStdout]
let traceprinter = ref (`Stderr : trace_printer_choices)
let redirect x = (traceprinter := x)
(* ---------------------------------------------------------------------- *)
(* Debugging messages *)
let debugmods =
Prefs.createStringList "debug"
"!debug module xxx ('all' -> everything, 'verbose' -> more)"
("This preference is used to make Unison print various sorts of "
^ "information about what it is doing internally on the standard "
^ "error stream. It can be used many times, each time with the name "
^ "of a module for which debugging information should be printed. "
^ "Possible arguments for \\verb|debug| can be found "
^ "by looking for calls to \\verb|Util.debug| in the "
^ "sources (using, e.g., \\verb|grep|). "
^ "Setting \\verb|-debug all| causes information from {\\em all} "
^ "modules to be printed (this mode of usage is the first one to try, "
^ "if you are trying to understand something that Unison seems to be "
^ "doing wrong); \\verb|-debug verbose| turns on some additional "
^ "debugging output from some modules (e.g., it will show exactly "
^ "what bytes are being sent across the network).")
let debugtimes =
Prefs.createBool "debugtimes"
false "*annotate debugging messages with timestamps" ""
let runningasserver = ref false
let debugging() = (Prefs.read debugmods) <> []
let enabled modname =
let m = Prefs.read debugmods in
let en =
m <> [] && ( (* tracing labeled "" is enabled if anything is *)
(modname = "")
|| (* '-debug verbose' enables everything *)
(Safelist.mem "verbose" m)
|| (* '-debug all+' likewise *)
(Safelist.mem "all+" m)
|| (* '-debug all' enables all tracing not marked + *)
(Safelist.mem "all" m && not (Util.endswith modname "+"))
|| (* '-debug m' enables m and '-debug m+' enables m+ *)
(Safelist.mem modname m)
|| (* '-debug m+' also enables m *)
(Safelist.mem (modname ^ "+") m)
) in
en
let enable modname onoff =
let m = Prefs.read debugmods in
let m' = if onoff then (modname::m) else (Safelist.remove modname m) in
Prefs.set debugmods m'
let debug modname thunk =
if enabled modname then begin
let s = if !runningasserver then "server: " else "" in
let time =
if Prefs.read debugtimes then
let tm = Util.localtime (Util.time()) in
Printf.sprintf "%02d:%02d:%02d"
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
else "" in
if time<>"" || s<>"" || modname<>"" then begin
let time = if time="" || (s=""&&modname="") then time else time^": " in
match !traceprinter with
| `Stdout -> Printf.printf "[%s%s%s] " time s modname
| `Stderr -> Printf.eprintf "[%s%s%s] " time s modname
| `FormatStdout -> Format.printf "[%s%s%s] " time s modname
end;
thunk();
flush stderr
end
(* We set the debugPrinter variable in the Util module so that other modules
lower down in the module dependency graph (so that they can't just
import Trace) can also print debugging messages. *)
let _ = Util.debugPrinter := Some(debug)
(* ---------------------------------------------------------------------- *)
(* Logging *)
let logging =
Prefs.createBool "log" true
"!record actions in logfile"
"When this flag is set, Unison will log all changes to the filesystems
on a file."
let logfile =
Prefs.createFspath "logfile"
(Util.fileInHomeDir "unison.log")
"!logfile name"
"By default, logging messages will be appended to the file
\\verb|unison.log| in your HOME directory. Set this preference if
you prefer another file."
let logch = ref None
let rec getLogch() =
Util.convertUnixErrorsToFatal "getLogch" (fun() ->
match !logch with
None ->
let file = Prefs.read logfile in
let ch =
System.open_out_gen [Open_wronly; Open_creat; Open_append] 0o600 file in
logch := Some (ch, file);
ch
| Some(ch, file) ->
if Prefs.read logfile = file then ch else begin
close_out ch;
logch := None; getLogch ()
end)
let sendLogMsgsToStderr = ref true
let writeLog s =
if !sendLogMsgsToStderr then begin
match !traceprinter with
| `Stdout -> Printf.printf "%s" s
| `Stderr -> Util.msg "%s" s
| `FormatStdout -> Format.printf "%s " s
end else debug "" (fun() ->
match !traceprinter with
| `Stdout -> Printf.printf "%s" s
| `Stderr -> Util.msg "%s" s
| `FormatStdout -> Format.printf "%s " s);
if Prefs.read logging then begin
let ch = getLogch() in
begin try
output_string ch s;
flush ch
with Sys_error _ -> () end
end
(* ---------------------------------------------------------------------- *)
(* Formatting and displaying messages *)
let terse =
Prefs.createBool "terse" false "suppress status messages"
("When this preference is set to {\\tt true}, the user "
^ "interface will not print status messages.")
type msgtype = Msg | StatusMajor | StatusMinor | Log
type msg = msgtype * string
let defaultMessageDisplayer s =
if not (Prefs.read terse) then begin
let show() = if s<>"" then Util.msg "%s\n" s in
if enabled "" then debug "" show
else if not !runningasserver then show()
end
let messageDisplayer = ref defaultMessageDisplayer
let defaultStatusFormatter s1 s2 = s1 ^ " " ^ s2
let statusFormatter = ref defaultStatusFormatter
let statusMsgMajor = ref ""
let statusMsgMinor = ref ""
let displayMessageLocally (mt,s) =
let display = !messageDisplayer in
let displayStatus() =
display (!statusFormatter !statusMsgMajor !statusMsgMinor) in
match mt with
Msg -> display s
| StatusMajor -> statusMsgMajor := s; statusMsgMinor := ""; displayStatus()
| StatusMinor -> statusMsgMinor := s; displayStatus()
| Log -> writeLog s
let messageForwarder = ref None
let displayMessage m =
match !messageForwarder with
None -> displayMessageLocally m
| Some(f) -> f m
(* ---------------------------------------------------------------------- *)
(* Convenience functions for displaying various kinds of messages *)
let message s = displayMessage (Msg, s)
let status s =
displayMessage (StatusMajor, s)
let statusMinor s = displayMessage (StatusMinor, s)
let statusDetail s =
let ss = if not !runningasserver then s else (Util.padto 30 s) ^ " [server]" in
displayMessage (StatusMinor, ss)
let log s = displayMessage (Log, s)
let logverbose s =
let temp = !sendLogMsgsToStderr in
sendLogMsgsToStderr := !sendLogMsgsToStderr && not (Prefs.read terse);
displayMessage (Log, s);
sendLogMsgsToStderr := temp
(* ---------------------------------------------------------------------- *)
(* Timing *)
let printTimers =
Prefs.createBool "timers" false
"*print timing information" ""
type timer = string * float
let gettime () = Unix.gettimeofday()
let startTimer desc =
if Prefs.read(printTimers) then
(message (desc ^ "..."); (desc, gettime()))
else
(desc,0.0)
let startTimerQuietly desc =
if Prefs.read(printTimers) then
(desc, gettime())
else
(desc,0.0)
let showTimer (desc, t1) =
(* Showing timer values from the server process does not work at the moment:
it confuses the RPC mechanism *)
if not !runningasserver then
if Prefs.read(printTimers) then
let t2 = gettime() in
message (Printf.sprintf "%s (%.2f seconds)" desc (t2 -. t1))
unison-2.40.102/ubase/myMap.mli 0000644 0061316 0061316 00000012460 11361646373 016277 0 ustar bcpierce bcpierce (*
This file is taken from the Objective Caml standard library.
Some functions has been added to suite Unison needs.
*)
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(** Association tables over ordered types.
This module implements applicative association tables, also known as
finite maps or dictionaries, given a total ordering function
over the keys.
All operations over maps are purely applicative (no side-effects).
The implementation uses balanced binary trees, and therefore searching
and insertion take time logarithmic in the size of the map.
*)
module type OrderedType =
sig
type t
(** The type of the map keys. *)
val compare : t -> t -> int
(** A total ordering function over the keys.
This is a two-argument function [f] such that
[f e1 e2] is zero if the keys [e1] and [e2] are equal,
[f e1 e2] is strictly negative if [e1] is smaller than [e2],
and [f e1 e2] is strictly positive if [e1] is greater than [e2].
Example: a suitable ordering function is the generic structural
comparison function {!Pervasives.compare}. *)
end
(** Input signature of the functor {!Map.Make}. *)
module type S =
sig
type key
(** The type of the map keys. *)
type (+'a) t
(** The type of maps from type [key] to type ['a]. *)
val empty: 'a t
(** The empty map. *)
val is_empty: 'a t -> bool
(** Test whether a map is empty or not. *)
val add: key -> 'a -> 'a t -> 'a t
(** [add x y m] returns a map containing the same bindings as
[m], plus a binding of [x] to [y]. If [x] was already bound
in [m], its previous binding disappears. *)
val find: key -> 'a t -> 'a
(** [find x m] returns the current binding of [x] in [m],
or raises [Not_found] if no such binding exists. *)
val findi: key -> 'a t -> key * 'a
(** [find x m] returns the current binding of [x] in [m],
or raises [Not_found] if no such binding exists. *)
val remove: key -> 'a t -> 'a t
(** [remove x m] returns a map containing the same bindings as
[m], except for [x] which is unbound in the returned map. *)
val mem: key -> 'a t -> bool
(** [mem x m] returns [true] if [m] contains a binding for [x],
and [false] otherwise. *)
val iter: (key -> 'a -> unit) -> 'a t -> unit
(** [iter f m] applies [f] to all bindings in map [m].
[f] receives the key as first argument, and the associated value
as second argument. The bindings are passed to [f] in increasing
order with respect to the ordering over the type of the keys.
Only current bindings are presented to [f]:
bindings hidden by more recent bindings are not passed to [f]. *)
val map: ('a -> 'b) -> 'a t -> 'b t
(** [map f m] returns a map with same domain as [m], where the
associated value [a] of all bindings of [m] has been
replaced by the result of the application of [f] to [a].
The bindings are passed to [f] in increasing order
with respect to the ordering over the type of the keys. *)
val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
(** Same as {!Map.S.map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
val mapii: (key -> 'a -> key * 'b) -> 'a t -> 'b t
(** Same as {!Map.S.map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
where [k1 ... kN] are the keys of all bindings in [m]
(in increasing order), and [d1 ... dN] are the associated data. *)
val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Total ordering between maps. The first argument is a total ordering
used to compare data associated with equal keys in the two maps. *)
val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
equal, that is, contain equal keys and associate them with
equal data. [cmp] is the equality predicate used to compare
the data associated with the keys. *)
val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid of key * key]
end
(** Output signature of the functor {!Map.Make}. *)
module Make (Ord : OrderedType) : S with type key = Ord.t
(** Functor building an implementation of the map structure
given a totally ordered type. *)
unison-2.40.102/ubase/rx.ml 0000644 0061316 0061316 00000056126 11361646373 015503 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/rx.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(*
Inspired by some code and algorithms from Mark William Hopkins
(regexp.tar.gz, available in the comp.compilers file archive)
*)
(*
Missing POSIX features
----------------------
- Collating sequences
*)
type v =
Cst of int list
| Alt of u list
| Seq of u list
| Rep of u * int * int option
| Bol | Eol
| Int of u list
| Dif of u * u
and u = { desc : v; hash : int }
(****)
let hash x =
match x with
Cst l -> List.fold_left (fun h i -> h + 757 * i) 0 l
| Alt l -> 199 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l
| Seq l -> 821 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l
| Rep (y, i, Some j) -> 197 * y.hash + 137 * i + j
| Rep (y, i, None) -> 197 * y.hash + 137 * i + 552556457
| Bol -> 165160782
| Eol -> 152410806
| Int l -> 71 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l
| Dif (y, z) -> 379 * y.hash + 563 * z.hash
let make x = {desc = x; hash = hash x}
let epsilon = make (Seq [])
let empty = make (Alt [])
(**** Printing ****)
open Format
let print_list sep print l =
match l with
[] -> ()
| v::r -> print v; List.iter (fun v -> sep (); print v) r
let rec print n t =
match t.desc with
Cst l ->
open_box 1; print_string "[";
print_list print_space print_int l;
print_string "]"; close_box ()
| Alt tl ->
if n > 0 then begin open_box 1; print_string "(" end;
print_list (fun () -> print_string "|"; print_cut ()) (print 1) tl;
if n > 0 then begin print_string ")"; close_box () end
| Seq tl ->
if n > 1 then begin open_box 1; print_string "(" end;
print_list (fun () -> print_cut ()) (print 2) tl;
if n > 1 then begin print_string ")"; close_box () end
| Rep (t, 0, None) ->
print 2 t; print_string "*"
| Rep (t, i, None) ->
print 2 t; print_string "{"; print_int i; print_string ",}"
| Rep (t, i, Some j) ->
print 2 t;
print_string "{"; print_int i; print_string ",";
print_int j; print_string "}"
| _ -> assert false
(**** Constructors for regular expressions *)
let seq2 x y =
match x.desc, y.desc with
Alt [], _ | _, Alt [] -> empty
| Seq [], s -> y
| r, Seq [] -> x
| Seq r, Seq s -> make (Seq (r @ s))
| Seq r, _ -> make (Seq (r @ [y]))
| _, Seq s -> make (Seq (x :: s))
| r, s -> make (Seq [x; y])
let seq l = List.fold_right seq2 l epsilon
let seq' l = match l with [] -> epsilon | [x] -> x | _ -> make (Seq l)
let rec alt_merge r s =
match r, s with
[], _ -> s
| _, [] -> r
| {desc = Seq (x::m)} :: s, {desc = Seq (y::n)} :: r when x = y ->
alt_merge (seq2 x (alt2 (seq' m) (seq' n))::s) r
| x :: r', y :: s' ->
let c = compare x y in
if c = 0 then x :: alt_merge r' s'
else if c < 0 then x :: alt_merge r' s
else (* if c > 0 then *) y :: alt_merge r s'
and alt2 x y =
let c = compare x y in
if c = 0 then x else
match x.desc, y.desc with
Alt [], _ -> y
| _, Alt [] -> x
| Alt r, Alt s -> make (Alt (alt_merge r s))
| Alt [r], _ when r = y -> y
| _, Alt [s] when x = s -> x
| Alt r, _ -> make (Alt (alt_merge r [y]))
| _, Alt s -> make (Alt (alt_merge [x] s))
| Seq (r::m), Seq (s::n) when r = s -> seq2 r (alt2 (seq' m) (seq' n))
| _, _ -> make (if c < 0 then Alt [x; y] else Alt [y; x])
let alt l = List.fold_right alt2 l empty
let rep x i j =
match x.desc with
Alt [] when i > 0 -> empty
| Alt [] | Seq [] -> epsilon
| _ ->
match i, j with
_, Some 0 -> epsilon
| 0, Some 1 -> alt2 epsilon x
| 1, Some 1 -> x
| _ -> make (Rep (x, i, j))
let rec int2 x y =
let c = compare x y in
if c = 0 then x else
match x.desc, y.desc with
Int [], _ -> y
| _, Int [] -> x
| Int r, Int s -> make (Int (alt_merge r s))
| Int [r], _ when r = y -> y
| _, Int [s] when s = x -> x
| Int r, _ -> make (Int (alt_merge r [y]))
| _, Int s -> make (Int (alt_merge [x] s))
| _, _ -> make (if c < 0 then Int [x; y] else Int [y; x])
let int l = List.fold_right int2 l empty
let cst c = Cst [Char.code c]
let rec dif x y =
if x = y then empty else
match x.desc, y.desc with
Dif (x1, y1), _ -> dif x1 (alt2 y1 y)
| Alt [], _ -> empty
| _, Alt [] -> x
| _ -> make (Dif (x, y))
(**** Computation of the next states of an automata ****)
type pos = Pos_bol | Pos_other
let never = 0
let always = (-1)
let when_eol = 2
let combine top bot op f l =
let rec combine v l =
match l with
[] -> v
| a::r ->
let c = f a in
if c = bot then c else combine (op v c) r
in
combine top l
module ReTbl =
Hashtbl.Make
(struct
type t = u
let equal x y = x.hash = y.hash && x = y
let hash x = x.hash
end)
let h = ReTbl.create 101
let rec contains_epsilon pos x =
try ReTbl.find h x with Not_found ->
let res =
match x.desc with
Cst _ -> never
| Alt l -> combine never always (lor) (contains_epsilon pos) l
| Seq l -> combine always never (land) (contains_epsilon pos) l
| Rep (_, 0, _) -> always
| Rep (y, _, _) -> contains_epsilon pos y
| Bol -> if pos = Pos_bol then always else never
| Eol -> when_eol
| Int l -> combine always never (land) (contains_epsilon pos) l
| Dif (y, z) -> contains_epsilon pos y land
(lnot (contains_epsilon pos z))
in
ReTbl.add h x res; res
module DiffTbl =
Hashtbl.Make
(struct
type t = int * u
let equal ((c : int), x) (d, y) = c = d && x.hash = y.hash && x = y
let hash (c, x) = x.hash + 11 * c
end)
let diff_cache = DiffTbl.create 101
let rec delta_seq nl pos c l =
match l with
[] ->
empty
| x::r ->
let rdx = seq2 (delta nl pos c x) (seq' r) in
let eps = contains_epsilon pos x in
if eps land always = always then
alt2 rdx (delta_seq nl pos c r)
else if eps land when_eol = when_eol && c = nl then
alt2 rdx (delta_seq nl pos c r)
else
rdx
and delta nl pos c x =
let p = (c, x) in
try DiffTbl.find diff_cache p with Not_found ->
let res =
match x.desc with
Cst l -> if List.mem c l then epsilon else empty
| Alt l -> alt (List.map (delta nl pos c) l)
| Seq l -> delta_seq nl pos c l
| Rep (y, 0, None) -> seq2 (delta nl pos c y) x
| Rep (y, i, None) -> seq2 (delta nl pos c y) (rep y (i - 1) None)
| Rep (y, 0, Some j) -> seq2 (delta nl pos c y) (rep y 0 (Some (j - 1)))
| Rep (y, i, Some j) -> seq2 (delta nl pos c y) (rep y (i - 1) (Some (j-1)))
| Eol | Bol -> empty
| Int l -> int (List.map (delta nl pos c) l)
| Dif (y, z) -> dif (delta nl pos c y) (delta nl pos c z)
in
DiffTbl.add diff_cache p res;
res
(**** String matching ****)
type state =
{ mutable valid : bool;
mutable next : state array;
pos : pos;
final : bool;
desc : u }
type rx =
{ initial : state;
categ : int array;
ncat : int;
states : state ReTbl.t }
let unknown =
{ valid = false; next = [||]; desc = empty ; pos = Pos_bol; final = false }
let mk_state ncat pos desc =
{ valid = desc <> empty;
next = Array.make ncat unknown;
pos = pos;
desc = desc;
final = contains_epsilon pos desc <> 0 }
let find_state states ncat pos desc =
try
ReTbl.find states desc
with Not_found ->
let st = mk_state ncat pos desc in
ReTbl.add states desc st;
st
let rec validate s i l rx cat st c =
let nl = cat.(Char.code '\n') in
let desc = delta nl st.pos c st.desc in
st.next.(c) <-
find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc;
loop s i l rx cat st
and loop s i l rx cat st =
let rec loop i st =
let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in
let st' = Array.unsafe_get st.next c in
if st'.valid then begin
let i = i + 1 in
if i < l then
loop i st'
else
st'.final
end else if st' != unknown then
false
else
validate s i l rx cat st c
in
loop i st
let match_str rx s =
let l = String.length s in
if l = 0 then rx.initial.final else
loop s 0 l rx rx.categ rx.initial
(* Combining the final and valid fields may make things slightly faster
(one less memory access) *)
let rec validate_pref s i l l0 rx cat st c =
let nl = cat.(Char.code '\n') in
let desc = delta nl st.pos c st.desc in
st.next.(c) <-
find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc;
loop_pref s i l l0 rx cat st
and loop_pref s i l l0 rx cat st =
let rec loop i l0 st =
let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in
let st' = Array.unsafe_get st.next c in
if st'.valid then begin
let i = i + 1 in
let l0 = if st'.final then i else l0 in
if i < l then
loop i l0 st'
else
l0
end else if st' != unknown then
l0
else
validate_pref s i l l0 rx cat st c
in
loop i l0 st
let match_pref rx s p =
let l = String.length s in
if p < 0 || p > l then invalid_arg "Rx.rep";
let l0 = if rx.initial.final then p else -1 in
let l0 =
if l = p then l0 else
loop_pref s p l l0 rx rx.categ rx.initial
in
if l0 >= 0 then Some (l0 - p) else None
let mk_rx init categ ncat =
let states = ReTbl.create 97 in
{ initial = find_state states ncat Pos_bol init;
categ = categ;
ncat = ncat;
states = states }
(**** Character sets ****)
let rec cunion l l' =
match l, l' with
_, [] -> l
| [], _ -> l'
| (c1, c2)::r, (c1', c2')::r' ->
if c2 + 1 < c1' then
(c1, c2)::cunion r l'
else if c2' + 1 < c1 then
(c1', c2')::cunion l r'
else if c2 < c2' then
cunion r ((min c1 c1', c2')::r')
else
cunion ((min c1 c1', c2)::r) r'
let rec cinter l l' =
match l, l' with
_, [] -> []
| [], _ -> []
| (c1, c2)::r, (c1', c2')::r' ->
if c2 < c1' then
cinter r l'
else if c2' < c1 then
cinter l r'
else if c2 < c2' then
(max c1 c1', c2)::cinter r l'
else
(max c1 c1', c2')::cinter l r'
let rec cnegate mi ma l =
match l with
[] ->
if mi <= ma then [(mi, ma)] else []
| (c1, c2)::r when ma < c1 ->
if mi <= ma then [(mi, ma)] else []
| (c1, c2)::r when mi < c1 ->
(mi, c1 - 1) :: cnegate c1 ma l
| (c1, c2)::r (* when c1 <= mi *) ->
cnegate (max mi (c2 + 1)) ma r
let csingle c = let i = Char.code c in [i, i]
let cadd c l = cunion (csingle c) l
let cseq c c' =
let i = Char.code c in let i' = Char.code c' in
if i <= i' then [i, i'] else [i', i]
let rec ctrans o l =
match l with
[] -> []
| (c1, c2) :: r ->
if c2 + o < 0 || c1 + o > 255 then
ctrans o r
else
(c1 + o, c2 + o) :: ctrans o r
let cany = [0, 255]
type cset = (int * int) list
(**** Compilation of a regular expression ****)
type regexp =
Set of cset
| Sequence of regexp list
| Alternative of regexp list
| Repeat of regexp * int * int option
| Beg_of_line | End_of_line
| Intersection of regexp list
| Difference of regexp * regexp
let rec split s cm =
match s with
[] -> ()
| (i, j)::r -> cm.(i) <- true; cm.(j + 1) <- true; split r cm
let rec colorize c regexp =
let rec colorize regexp =
match regexp with
Set s -> split s c
| Sequence l -> List.iter colorize l
| Alternative l -> List.iter colorize l
| Repeat (r, _, _) -> colorize r
| Beg_of_line | End_of_line -> split (csingle '\n') c
| Intersection l -> List.iter colorize l
| Difference (s, t) -> colorize s; colorize t
in
colorize regexp
let make_cmap () = Array.make 257 false
let flatten_cmap cm =
let c = Array.make 256 0 in
let v = ref 0 in
for i = 1 to 255 do
if cm.(i) then incr v;
c.(i) <- !v
done;
(c, !v + 1)
let rec interval i j = if i > j then [] else i :: interval (i + 1) j
let rec cset_hash_rec l =
match l with
[] -> 0
| (i, j)::r -> i + 13 * j + 257 * cset_hash_rec r
let cset_hash l = (cset_hash_rec l) land 0x3FFFFFFF
module CSetMap =
Map.Make
(struct
type t = int * (int * int) list
let compare (i, u) (j, v) =
let c = compare i j in if c <> 0 then c else compare u v
end)
let trans_set cache cm s =
match s with
[i, j] when i = j ->
[cm.(i)]
| _ ->
let v = (cset_hash_rec s, s) in
try
CSetMap.find v !cache
with Not_found ->
let l =
List.fold_right (fun (i, j) l -> cunion [cm.(i), cm.(j)] l) s []
in
let res =
List.flatten (List.map (fun (i, j) -> interval i j) l)
in
cache := CSetMap.add v res !cache;
res
let rec trans_seq cache c r rem =
match r with
Sequence l -> List.fold_right (trans_seq cache c) l rem
| _ -> seq2 (translate cache c r) rem
and translate cache c r =
match r with
Set s -> make (Cst (trans_set cache c s))
| Alternative l -> alt (List.map (translate cache c) l)
| Sequence l -> trans_seq cache c r epsilon
| Repeat (r', i, j) -> rep (translate cache c r') i j
| Beg_of_line -> make Bol
| End_of_line -> make Eol
| Intersection l -> int (List.map (translate cache c) l)
| Difference (r', r'') -> dif (translate cache c r') (translate cache c r'')
let compile regexp =
let c = make_cmap () in
colorize c regexp;
let (cat, ncat) = flatten_cmap c in
let r = translate (ref (CSetMap.empty)) cat regexp in
mk_rx r cat ncat
(**** Regexp type ****)
type t = {def : regexp; mutable comp: rx option; mutable comp': rx option}
let force r =
match r.comp with
Some r' -> r'
| None -> let r' = compile r.def in r.comp <- Some r'; r'
let anything = Repeat (Set [0, 255], 0, None)
let force' r =
match r.comp' with
Some r' -> r'
| None ->
let r1 = Sequence [anything; r.def; anything] in
let r' = compile r1 in r.comp' <- Some r'; r'
let wrap r = {def = r; comp = None; comp' = None}
let def r = r.def
let alt rl = wrap (Alternative (List.map def rl))
let seq rl = wrap (Sequence (List.map def rl))
let empty = alt []
let epsilon = seq []
let rep r i j =
if i < 0 then invalid_arg "Rx.rep";
begin match j with Some j when j < i -> invalid_arg "Rx.rep" | _ -> () end;
wrap (Repeat (def r, i, j))
let rep0 r = rep r 0 None
let rep1 r = rep r 1 None
let opt r = alt [epsilon; r]
let bol = wrap Beg_of_line
let eol = wrap End_of_line
let any = wrap (Set [0, 255])
let notnl = wrap (Set (cnegate 0 255 (csingle '\n')))
let inter rl = wrap (Intersection (List.map def rl))
let diff r r' = wrap (Difference (def r, def r'))
let set str =
let s = ref [] in
for i = 0 to String.length str - 1 do
s := cunion (csingle str.[i]) !s
done;
wrap (Set !s)
let str s =
let l = ref [] in
for i = String.length s - 1 downto 0 do
l := Set (csingle s.[i]) :: !l
done;
wrap (Sequence !l)
let match_string t s = match_str (force t) s
let match_substring t s = match_str (force' t) s
let match_prefix t s p = match_pref (force t) s p
let uppercase =
cunion (cseq 'A' 'Z') (cunion (cseq '\192' '\214') (cseq '\216' '\222'))
let lowercase = ctrans 32 uppercase
let rec case_insens r =
match r with
Set s ->
Set (cunion s (cunion (ctrans 32 (cinter s uppercase))
(ctrans (-32) (cinter s lowercase))))
| Sequence l ->
Sequence (List.map case_insens l)
| Alternative l ->
Alternative (List.map case_insens l)
| Repeat (r, i, j) ->
Repeat (case_insens r, i, j)
| Beg_of_line | End_of_line ->
r
| Intersection l ->
Intersection (List.map case_insens l)
| Difference (r, r') ->
Difference (case_insens r, case_insens r')
let case_insensitive r =
wrap (case_insens (def r))
(**** Parser ****)
exception Parse_error
exception Not_supported
let parse s =
let i = ref 0 in
let l = String.length s in
let eos () = !i = l in
let test c = not (eos ()) && s.[!i] = c in
let accept c = let r = test c in if r then incr i; r in
let get () = let r = s.[!i] in incr i; r in
let unget () = decr i in
let rec regexp () = regexp' (branch ())
and regexp' left =
if accept '|' then regexp' (Alternative [left; branch ()]) else left
and branch () = branch' (piece ())
and branch' left =
if eos () || test '|' || test ')' then left
else branch' (Sequence [left; piece ()])
and piece () =
let r = atom () in
if accept '*' then Repeat (r, 0, None) else
if accept '+' then Repeat (r, 1, None) else
if accept '?' then Alternative [Sequence []; r] else
if accept '{' then
match integer () with
Some i ->
let j = if accept ',' then integer () else Some i in
if not (accept '}') then raise Parse_error;
begin match j with
Some j when j < i -> raise Parse_error | _ -> ()
end;
Repeat (r, i, j)
| None ->
unget (); r
else
r
and atom () =
if accept '.' then Set cany else
if accept '(' then begin
let r = regexp () in
if not (accept ')') then raise Parse_error;
r
end else
if accept '^' then Beg_of_line else
if accept '$' then End_of_line else
if accept '[' then begin
if accept '^' then
Set (cnegate 0 255 (bracket []))
else
Set (bracket [])
end else
if accept '\\' then begin
if eos () then raise Parse_error;
match get () with
'|' | '(' | ')' | '*' | '+' | '?'
| '[' | '.' | '^' | '$' | '{' | '\\' as c -> Set (csingle c)
| _ -> raise Parse_error
end else begin
if eos () then raise Parse_error;
match get () with
'*' | '+' | '?' | '{' | '\\' -> raise Parse_error
| c -> Set (csingle c)
end
and integer () =
if eos () then None else
match get () with
'0'..'9' as d -> integer' (Char.code d - Char.code '0')
| _ -> unget (); None
and integer' i =
if eos () then Some i else
match get () with
'0'..'9' as d ->
let i' = 10 * i + (Char.code d - Char.code '0') in
if i' < i then raise Parse_error;
integer' i'
| _ ->
unget (); Some i
and bracket s =
if s <> [] && accept ']' then s else begin
let c = char () in
if accept '-' then begin
if accept ']' then (cadd c (cadd '-' s)) else begin
let c' = char () in
bracket (cunion (cseq c c') s)
end
end else
bracket (cadd c s)
end
and char () =
if eos () then raise Parse_error;
let c = get () in
if c = '[' then begin
if accept '=' || accept ':' then raise Not_supported;
if accept '.' then begin
if eos () then raise Parse_error;
let c = get () in
if not (accept '.') then raise Not_supported;
if not (accept ']') then raise Parse_error;
c
end else
c
end else
c
in
let res = regexp () in
if not (eos ()) then raise Parse_error;
res
let rx s = wrap (parse s)
(**** File globbing ****)
let gany = cnegate 0 255 (csingle '/')
let notdot = cnegate 0 255 (cunion (csingle '.') (csingle '/'))
let dot = csingle '.'
type loc = Beg | BegAny | Mid
let beg_start =
Alternative [Sequence []; Sequence [Set notdot; Repeat (Set gany, 0, None)]]
let beg_start' =
Sequence [Set notdot; Repeat (Set gany, 0, None)]
let glob_parse init s =
let i = ref 0 in
let l = String.length s in
let eos () = !i = l in
let test c = not (eos ()) && s.[!i] = c in
let accept c = let r = test c in if r then incr i; r in
let get () = let r = s.[!i] in incr i; r in
(* let unget () = decr i in *)
let rec expr () = expr' init (Sequence [])
and expr' beg left =
if eos () then
match beg with
Mid | Beg -> left
| BegAny -> Sequence [left; beg_start]
else
let (piec, beg) = piece beg in expr' beg (Sequence [left; piec])
and piece beg =
if accept '*' then begin
if beg <> Mid then
(Sequence [], BegAny)
else
(Repeat (Set gany, 0, None), Mid)
end else if accept '?' then
(begin match beg with
Beg -> Set notdot
| BegAny -> Sequence [Set notdot; Repeat (Set gany, 0, None)]
| Mid -> Set gany
end,
Mid)
else if accept '[' then begin
(* let mask = if beg <> Mid then notdot else gany in *)
let set =
if accept '^' || accept '!' then
cnegate 0 255 (bracket [])
else
bracket []
in
(begin match beg with
Beg -> Set (cinter notdot set)
| BegAny -> Alternative [Sequence [beg_start; Set (cinter notdot set)];
Sequence [beg_start'; Set (cinter dot set)]]
| Mid -> Set (cinter gany set)
end,
Mid)
end else
let c = char () in
((if beg <> BegAny then
Set (csingle c)
else if c = '.' then
Sequence [beg_start'; Set (csingle c)]
else
Sequence [beg_start; Set (csingle c)]),
if c = '/' then init else Mid)
and bracket s =
if s <> [] && accept ']' then s else begin
let c = char () in
if accept '-' then begin
if accept ']' then (cadd c (cadd '-' s)) else begin
let c' = char () in
bracket (cunion (cseq c c') s)
end
end else
bracket (cadd c s)
end
and char () =
ignore (accept '\\');
if eos () then raise Parse_error;
get ()
in
let res = expr () in
res
let rec mul l l' =
List.flatten (List.map (fun s -> List.map (fun s' -> s ^ s') l') l)
let explode str =
let l = String.length str in
let rec expl inner s i acc beg =
if i >= l then begin
if inner then raise Parse_error;
(mul beg [String.sub str s (i - s)], i)
end else
match str.[i] with
'\\' -> expl inner s (i + 2) acc beg
| '{' ->
let (t, i') = expl true (i + 1) (i + 1) [] [""] in
expl inner i' i' acc
(mul beg (mul [String.sub str s (i - s)] t))
| ',' when inner ->
expl inner (i + 1) (i + 1)
(mul beg [String.sub str s (i - s)] @ acc) [""]
| '}' when inner ->
(mul beg [String.sub str s (i - s)] @ acc, i + 1)
| _ ->
expl inner s (i + 1) acc beg
in
List.rev (fst (expl false 0 0 [] [""]))
let glob' nodot s = wrap (glob_parse (if nodot then Beg else Mid) s)
let glob s = glob' true s
let globx' nodot s = alt (List.map (glob' nodot) (explode s))
let globx s = globx' true s
unison-2.40.102/ubase/depend 0000644 0061316 0061316 00000001410 11361646373 015664 0 ustar bcpierce bcpierce myMap.cmo: myMap.cmi
myMap.cmx: myMap.cmi
prefs.cmo: util.cmi uarg.cmi safelist.cmi prefs.cmi
prefs.cmx: util.cmx uarg.cmx safelist.cmx prefs.cmi
proplist.cmo: util.cmi proplist.cmi
proplist.cmx: util.cmx proplist.cmi
rx.cmo: rx.cmi
rx.cmx: rx.cmi
safelist.cmo: safelist.cmi
safelist.cmx: safelist.cmi
trace.cmo: util.cmi safelist.cmi prefs.cmi trace.cmi
trace.cmx: util.cmx safelist.cmx prefs.cmx trace.cmi
uarg.cmo: util.cmi safelist.cmi uarg.cmi
uarg.cmx: util.cmx safelist.cmx uarg.cmi
uprintf.cmo: uprintf.cmi
uprintf.cmx: uprintf.cmi
util.cmo: uprintf.cmi safelist.cmi util.cmi
util.cmx: uprintf.cmx safelist.cmx util.cmi
myMap.cmi:
prefs.cmi: util.cmi
proplist.cmi:
rx.cmi:
safelist.cmi:
trace.cmi: prefs.cmi
uarg.cmi:
uprintf.cmi:
util.cmi:
unison-2.40.102/ubase/prefs.mli 0000644 0061316 0061316 00000015170 11361646373 016334 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/prefs.mli *)
(* $I3: Copyright 1999-2002 (see COPYING for details) $ *)
type 'a t
val read : 'a t -> 'a
val set : 'a t -> 'a -> unit
val name : 'a t -> string list
val overrideDefault : 'a t -> 'a -> unit
val readDefault : 'a t -> 'a
(* Convenient functions for registering simple kinds of preferences. Note *)
(* that createStringPref creates a preference that can only be set once, *)
(* while createStringListPref creates a reference to a list of strings that *)
(* accumulates a list of values. *)
val createBool :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> bool (* initial value *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> bool t (* -> new preference value *)
val createInt :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> int (* initial value *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> int t (* -> new preference value *)
val createString :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> string (* initial value *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> string t (* -> new preference value *)
val createFspath :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> System.fspath (* initial value *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> System.fspath t (* -> new preference value *)
val createStringList :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> string list t (* -> new preference value *)
val createBoolWithDefault :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> [`True|`False|`Default] t
(* -> new preference value *)
exception IllegalValue of string
(* A more general creation function that allows arbitrary functions for *)
(* interning and printing values. The interning function should raise *)
(* IllegalValue if it is passed a string it cannot deal with. *)
val create :
string (* preference name *)
-> ?local:bool (* whether it is local to the client *)
-> 'a (* initial value *)
-> string (* documentation string *)
-> string (* full (tex) documentation string *)
-> ('a->string->'a) (* interning function for preference values
(1st arg is old value of preference) *)
-> ('a -> string list) (* printing function for preference values *)
-> 'a t (* -> new preference value *)
(* Create an alternate name for a preference (the new name will not appear *)
(* in usage messages or generated documentation) *)
val alias : 'a t (* existing preference *)
-> string (* new name *)
-> unit
(* Reset all preferences to their initial values *)
val resetToDefaults : unit -> unit
(* ------------------------------------------------------------------------- *)
(* Parse command-line arguments, exiting program if there are any problems. *)
(* If a StringList preference named "rest" has been registered, then any *)
(* anonymous arguments on the command line will be added to its value. *)
val parseCmdLine :
string (* Usage message *)
-> unit
(* Make a preliminary scan without setting any preferences *)
val scanCmdLine : string -> (string list) Util.StringMap.t
val printUsage : string -> unit
(* ---------------------------------------------------------------------- *)
(* The name of the preferences file (if any), not including the .prf *)
val profileName : string option ref
(* 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) *)
val add : string -> string -> string
(* Add a comment line to the preferences file on disk *)
val addComment : string -> unit
(* Scan a given preferences file and return a list of tuples of the form *)
(* (fileName, lineno, name, value), without changing any of the preferences *)
val readAFile : string -> (string * int * string * string) list
(* Parse the preferences file, raising Fatal if there are any problems *)
val loadTheFile : unit -> unit
(* Parse the given strings as if they were part of the preferences file *)
val loadStrings : string list -> unit
(* ------------------------------------------------------------------------- *)
type dumpedPrefs
(* Dump current values of all preferences into a value that can be
marshalled and sent over the network or stored in a file for fast
retrieval *)
val dump : unit -> dumpedPrefs
(* Load new values of all preferences from a string created by dump *)
val load : dumpedPrefs -> unit
(* ------------------------------------------------------------------------- *)
type typ =
[`BOOL | `INT | `STRING | `STRING_LIST | `BOOLDEF | `CUSTOM | `UNKNOWN]
val canonicalName : string -> string
val typ : string -> typ
val documentation : string -> string * string * bool
val list : unit -> string list
(* ------------------------------------------------------------------------- *)
val printFullDocs : unit -> unit
val dumpPrefsToStderr : unit -> unit
unison-2.40.102/ubase/uprintf.ml 0000644 0061316 0061316 00000007066 11361646373 016540 0 ustar bcpierce bcpierce (***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License. *)
(* *)
(***********************************************************************)
external caml_format_int: string -> int -> string = "caml_format_int"
external caml_format_float: string -> float -> string = "caml_format_float"
let fprintf outchan doafter format =
let format = (Obj.magic format : string) in
let rec doprn i =
if i >= String.length format then
(doafter(); Obj.magic ())
else begin
let c = String.unsafe_get format i in
if c <> '%' then begin
output_char outchan c;
doprn (succ i)
end else begin
let j = skip_args (succ i) in
match String.unsafe_get format j with
'%' ->
output_char outchan '%';
doprn (succ j)
| 's' ->
Obj.magic(fun s ->
if j <= i+1 then
output_string outchan s
else begin
let p =
try
int_of_string (String.sub format (i+1) (j-i-1))
with Failure _ ->
invalid_arg "fprintf: bad %s format" in
if p > 0 && String.length s < p then begin
output_string outchan
(String.make (p - String.length s) ' ');
output_string outchan s
end else if p < 0 && String.length s < -p then begin
output_string outchan s;
output_string outchan
(String.make (-p - String.length s) ' ')
end else
output_string outchan s
end;
doprn (succ j))
| 'c' ->
Obj.magic(fun c ->
output_char outchan c;
doprn (succ j))
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
Obj.magic(fun n ->
output_string outchan
(caml_format_int (String.sub format i (j-i+1)) n);
doprn (succ j))
| 'f' | 'e' | 'E' | 'g' | 'G' ->
Obj.magic(fun f ->
output_string outchan
(caml_format_float (String.sub format i (j-i+1)) f);
doprn (succ j))
| 'b' ->
Obj.magic(fun b ->
output_string outchan (string_of_bool b);
doprn (succ j))
| 'a' ->
Obj.magic(fun printer arg ->
printer outchan arg;
doprn(succ j))
| 't' ->
Obj.magic(fun printer ->
printer outchan;
doprn(succ j))
| c ->
invalid_arg ("fprintf: unknown format")
end
end
and skip_args j =
match String.unsafe_get format j with
'0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
| c -> j
in doprn 0
let printf doafter fmt = fprintf stdout doafter fmt
and eprintf doafter fmt = fprintf stderr doafter fmt
unison-2.40.102/ubase/util.mli 0000644 0061316 0061316 00000010520 11361646373 016164 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/util.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Miscellaneous utility functions and datatypes *)
(* ---------------------------------------------------------------------- *)
(* Exceptions *)
exception Fatal of string
exception Transient of string
val encodeException : string -> [`Transient | `Fatal] -> exn -> 'a
val convertUnixErrorsToTransient : string -> (unit -> 'a) -> 'a
val convertUnixErrorsToFatal : string -> (unit -> 'a) -> 'a
val ignoreTransientErrors : (unit -> unit) -> unit
(* [unwindProtect e1 e2] executes e1, catching the above two exceptions and
executing e2 (passing it the exception packet, so that it can log a
message or whatever) before re-raising them *)
val unwindProtect : (unit -> 'a) -> (exn -> unit) -> 'a
(* [finalize e1 e2] executes e1 and then e2. If e1 raises either of the
above two exceptions e2 is still executed and the exception is reraised *)
val finalize : (unit -> 'a) -> (unit -> unit) -> 'a
(* For data structures that need to record when operations have succeeded or
failed *)
type confirmation =
Succeeded
| Failed of string
val printException : exn -> string
val process_status_to_string : Unix.process_status -> string
(* ---------------------------------------------------------------------- *)
(* Strings *)
(* Case insensitive comparison *)
val nocase_cmp : string -> string -> int
val nocase_eq : string -> string -> bool
(* Ready-build set and map implementations *)
module StringSet : Set.S with type elt = string
module StringMap : Map.S with type key = string
val stringSetFromList : string list -> StringSet.t
(* String manipulation *)
val truncateString : string -> int -> string
val startswith : string -> string -> bool
val endswith : string -> string -> bool
val findsubstring : string -> string -> int option
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
val padto : int -> string -> string
(* ---------------------------------------------------------------------- *)
(* Miscellaneous *)
(* Architecture *)
val osType : [`Unix | `Win32]
val isCygwin: bool (* osType will be `Win32 in this case *)
(* Options *)
val extractValueFromOption : 'a option -> 'a
val option2string: ('a -> string) -> ('a option -> string)
(* Miscellaneous *)
val time2string : float -> string
val percentageOfTotal :
int -> (* current value *)
int -> (* total value *)
int (* percentage of total *)
val monthname : int -> string
val percent2string : float -> string
val fileInHomeDir : string -> System.fspath
(* Just like the versions in the Unix module, but raising Transient
instead of Unix_error *)
val localtime : float -> Unix.tm
val time : unit -> float
(* Global debugging printer (it's exposed as a ref so that modules loaded
before Trace can use it; the ref will always be set to Some(Trace.debug)) *)
val debugPrinter : ((string -> (unit->unit) -> unit) option) ref
(* A synonym for Trace.debug *)
val debug : string -> (unit->unit) -> unit
(* The UI must supply a function to warn the user *)
val warnPrinter : (string -> unit) option ref
val warn : string -> unit
(* Someone should supply a function here that will convert a simple filename
to a filename in the unison directory *)
val supplyFileInUnisonDirFn : (string -> System.fspath) -> unit
(* Use it like this: *)
val fileInUnisonDir : string -> System.fspath
(* Printing and formatting functions *)
val format : ('a, Format.formatter, unit) format -> 'a
(** Format some text on the current formatting channel.
This is the only formatting function that should be called anywhere in the program! *)
val flush : unit -> unit
val format_to_string : (unit -> unit) -> string
(** [format_to_string f] runs [f] in a context where the Format functions are redirected to
a string, which it returns. *)
(* Format and print messages on the standard error stream, being careful to
flush the stream after each one *)
val msg : ('a, out_channel, unit) format -> 'a
(* Set the info line *)
val set_infos : string -> unit
unison-2.40.102/ubase/proplist.mli 0000644 0061316 0061316 00000000437 11361646373 017071 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/proplist.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
type 'a key
type t
val register : string -> 'a key
val empty : t
val mem : 'a key -> t -> bool
val find : 'a key -> t -> 'a
val add : 'a key -> 'a -> t -> t
unison-2.40.102/ubase/myMap.ml 0000644 0061316 0061316 00000020212 11361646373 016120 0 ustar bcpierce bcpierce (*
This file is taken from the Objective Caml standard library.
Some functions have been added to suite Unison needs.
*)
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
module type OrderedType =
sig
type t
val compare: t -> t -> int
end
module type S =
sig
type key
type +'a t
val empty: 'a t
val is_empty: 'a t -> bool
val add: key -> 'a -> 'a t -> 'a t
val find: key -> 'a t -> 'a
val findi: key -> 'a t -> key * 'a
val remove: key -> 'a t -> 'a t
val mem: key -> 'a t -> bool
val iter: (key -> 'a -> unit) -> 'a t -> unit
val map: ('a -> 'b) -> 'a t -> 'b t
val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
val mapii: (key -> 'a -> key * 'b) -> 'a t -> 'b t
val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid of key * key]
end
module Make(Ord: OrderedType) = struct
type key = Ord.t
type 'a t =
Empty
| Node of 'a t * key * 'a * 'a t * int
let height = function
Empty -> 0
| Node(_,_,_,_,h) -> h
let create l x d r =
let hl = height l and hr = height r in
Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
let bal l x d r =
let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
if hl > hr + 2 then begin
match l with
Empty -> invalid_arg "Map.bal"
| Node(ll, lv, ld, lr, _) ->
if height ll >= height lr then
create ll lv ld (create lr x d r)
else begin
match lr with
Empty -> invalid_arg "Map.bal"
| Node(lrl, lrv, lrd, lrr, _)->
create (create ll lv ld lrl) lrv lrd (create lrr x d r)
end
end else if hr > hl + 2 then begin
match r with
Empty -> invalid_arg "Map.bal"
| Node(rl, rv, rd, rr, _) ->
if height rr >= height rl then
create (create l x d rl) rv rd rr
else begin
match rl with
Empty -> invalid_arg "Map.bal"
| Node(rll, rlv, rld, rlr, _) ->
create (create l x d rll) rlv rld (create rlr rv rd rr)
end
end else
Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
let empty = Empty
let is_empty = function Empty -> true | _ -> false
let rec add x data = function
Empty ->
Node(Empty, x, data, Empty, 1)
| Node(l, v, d, r, h) ->
let c = Ord.compare x v in
if c = 0 then
Node(l, x, data, r, h)
else if c < 0 then
bal (add x data l) v d r
else
bal l v d (add x data r)
let rec find x = function
Empty ->
raise Not_found
| Node(l, v, d, r, _) ->
let c = Ord.compare x v in
if c = 0 then d
else find x (if c < 0 then l else r)
let rec findi x = function
Empty ->
raise Not_found
| Node(l, v, d, r, _) ->
let c = Ord.compare x v in
if c = 0 then (v, d)
else findi x (if c < 0 then l else r)
let rec mem x = function
Empty ->
false
| Node(l, v, d, r, _) ->
let c = Ord.compare x v in
c = 0 || mem x (if c < 0 then l else r)
let rec min_binding = function
Empty -> raise Not_found
| Node(Empty, x, d, r, _) -> (x, d)
| Node(l, x, d, r, _) -> min_binding l
let rec remove_min_binding = function
Empty -> invalid_arg "Map.remove_min_elt"
| Node(Empty, x, d, r, _) -> r
| Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
let merge t1 t2 =
match (t1, t2) with
(Empty, t) -> t
| (t, Empty) -> t
| (_, _) ->
let (x, d) = min_binding t2 in
bal t1 x d (remove_min_binding t2)
let rec remove x = function
Empty ->
Empty
| Node(l, v, d, r, h) ->
let c = Ord.compare x v in
if c = 0 then
merge l r
else if c < 0 then
bal (remove x l) v d r
else
bal l v d (remove x r)
let rec iter f = function
Empty -> ()
| Node(l, v, d, r, _) ->
iter f l; f v d; iter f r
let rec map f = function
Empty -> Empty
| Node(l, v, d, r, h) ->
let l' = map f l in
let d' = f d in
let r' = map f r in
Node(l', v, d', r', h)
let rec mapi f = function
Empty -> Empty
| Node(l, v, d, r, h) ->
let l' = mapi f l in
let d' = f v d in
let r' = mapi f r in
Node(l', v, d', r', h)
let rec mapii f = function
Empty -> Empty
| Node(l, v, d, r, h) ->
let l' = mapii f l in
let (v', d') = f v d in
if v' != v && Ord.compare v v' <> 0 then invalid_arg "Map.mapii";
let r' = mapii f r in
Node(l', v', d', r', h)
let rec fold f m accu =
match m with
Empty -> accu
| Node(l, v, d, r, _) ->
fold f l (f v d (fold f r accu))
type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
let rec cons_enum m e =
match m with
Empty -> e
| Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
let compare cmp m1 m2 =
let rec compare_aux e1 e2 =
match (e1, e2) with
(End, End) -> 0
| (End, _) -> -1
| (_, End) -> 1
| (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
let c = Ord.compare v1 v2 in
if c <> 0 then c else
let c = cmp d1 d2 in
if c <> 0 then c else
compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
in compare_aux (cons_enum m1 End) (cons_enum m2 End)
let equal cmp m1 m2 =
let rec equal_aux e1 e2 =
match (e1, e2) with
(End, End) -> true
| (End, _) -> false
| (_, End) -> false
| (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
Ord.compare v1 v2 = 0 && cmp d1 d2 &&
equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
in equal_aux (cons_enum m1 End) (cons_enum m2 End)
let val_combine r r' =
match r, r' with
`Ok , _ -> r'
| `Duplicate _, `Ok -> r
| `Duplicate _, _ -> r'
| _ , _ -> r
let rec validate_both v m v' =
match m with
Empty ->
let c = Ord.compare v v' in
if c < 0 then `Ok
else if c = 0 then `Duplicate v
else `Invalid (v, v')
| Node (l, v'', _, r, _) ->
val_combine (validate_both v l v'') (validate_both v'' r v')
let rec validate_left m v =
match m with
Empty ->
`Ok
| Node (l, v', _, r, _) ->
val_combine (validate_left l v') (validate_both v' r v)
let rec validate_right v m =
match m with
Empty ->
`Ok
| Node (l, v', _, r, _) ->
val_combine (validate_both v l v') (validate_right v' r)
let validate m =
match m with
Empty ->
`Ok
| Node (l, v, _, r, _) ->
val_combine (validate_left l v) (validate_right v r)
end
unison-2.40.102/ubase/safelist.mli 0000644 0061316 0061316 00000004127 11361646373 017027 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/safelist.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* All functions here are tail recursive and will work for arbitrary
sized lists (unlike some of the standard ones). The intention is that
the built-in List module should not be referred to outside this module. *)
(* Functions from built-in List module *)
val map : ('a -> 'b) -> 'a list -> 'b list
val rev_map : ('a -> 'b) -> 'a list -> 'b list
val append : 'a list -> 'a list -> 'a list
val rev_append : 'a list -> 'a list -> 'a list
val concat : 'a list list -> 'a list
val combine : 'a list -> 'b list -> ('a * 'b) list
val iter : ('a -> unit) -> 'a list -> unit
val iteri : (int -> 'a -> unit) -> 'a list -> unit (* zero-based *)
val rev : 'a list -> 'a list
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
val hd : 'a list -> 'a
val tl : 'a list -> 'a list
val nth : 'a list -> int -> 'a
val length : 'a list -> int
val mem : 'a -> 'a list -> bool
val flatten : 'a list list -> 'a list
val assoc : 'a -> ('a * 'b) list -> 'b
val for_all : ('a -> bool) -> 'a list -> bool
val exists : ('a -> bool) -> 'a list -> bool
val split : ('a * 'b) list -> 'a list * 'b list
val find : ('a -> bool) -> 'a list -> 'a
val filter : ('a -> bool) -> 'a list -> 'a list
val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
val sort : ('a -> 'a -> int) -> 'a list -> 'a list
(* Other useful list-processing functions *)
val filterMap : ('a -> 'b option) -> 'a list -> 'b list
val filterMap2 : ('a -> 'b option * 'c option) -> 'a list -> 'b list * 'c list
val transpose : 'a list list -> 'a list list
val filterBoth : ('a -> bool) -> 'a list -> ('a list * 'a list)
val allElementsEqual : 'a list -> bool
val flatten_map : ('a -> 'b list) -> 'a list -> 'b list
val remove : 'a -> 'a list -> 'a list
unison-2.40.102/ubase/META 0000644 0061316 0061316 00000000135 11361646373 015156 0 ustar bcpierce bcpierce requires = "unix"
version = "0.1"
archive(byte) = "ubase.cma"
archive(native) = "ubase.cmxa"
unison-2.40.102/ubase/prefs.ml 0000644 0061316 0061316 00000043404 11361646373 016164 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/prefs.ml *)
(* $I3: Copyright 1999-2002 (see COPYING for details) $ *)
let debug = Util.debug "prefs"
type 'a t =
{ mutable value : 'a; defaultValue : 'a; mutable names : string list;
mutable setInProfile : bool }
let read p = p.value
let set p v = p.setInProfile <- true; p.value <- v
let overrideDefault p v = if not p.setInProfile then p.value <- v
let name p = p.names
let readDefault p = p.defaultValue
let rawPref default name =
{ value = default; defaultValue = default; names = [name];
setInProfile = false }
(* ------------------------------------------------------------------------- *)
let profileName = ref None
let profileFiles = ref []
let profilePathname n =
let f = Util.fileInUnisonDir n in
if System.file_exists f then f
else Util.fileInUnisonDir (n ^ ".prf")
let thePrefsFile () =
match !profileName with
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 *)
(* them from. This is accomplished by associating each preference with a *)
(* printing function. *)
let printers = ref ([] : (string * (unit -> string list)) list)
let addprinter name f = printers := (name, f) :: !printers
(* ---------------------------------------------------------------------- *)
(* When we load a new profile, we need to reset all preferences to their *)
(* default values. Each preference has a resetter for doing this. *)
let resetters = ref []
let addresetter f = resetters := 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 *)
(* the preference settings. This is accomplished by dumping them on the *)
(* client side and loading on the server side; as each preference is *)
(* created, a dumper (marshaler) and a loader (parser) are added to the list *)
(* kept here... *)
type dumpedPrefs = (string * bool * string) list
let dumpers = ref ([] : (string * bool * (unit->string)) list)
let loaders = ref (Util.StringMap.empty : (string->unit) Util.StringMap.t)
let adddumper name optional f =
dumpers := (name,optional,f) :: !dumpers
let addloader name f =
loaders := Util.StringMap.add name f !loaders
let dump () = Safelist.map (fun (name, opt, f) -> (name, opt, f())) !dumpers
let load d =
Safelist.iter
(fun (name, opt, dumpedval) ->
match
try Some (Util.StringMap.find name !loaders) with Not_found -> None
with
Some loaderfn ->
loaderfn dumpedval
| None ->
if not opt then
raise (Util.Fatal
("Preference "^name^" not found: \
inconsistent Unison versions??")))
d
(* For debugging *)
let dumpPrefsToStderr() =
Printf.eprintf "Preferences:\n";
Safelist.iter
(fun (name,f) ->
Safelist.iter
(fun s -> Printf.eprintf "%s = %s\n" name s)
(f()))
!printers
(* ------------------------------------------------------------------------- *)
(* Each preference is associated with a handler function taking an argument *)
(* of appropriate type. These functions should raise IllegalValue if they *)
(* are invoked with a value that falls outside the range they expect. This *)
(* exception will be caught within the preferences module and used to *)
(* generate an appropriate usage message. *)
exception IllegalValue of string
(* aliasMap: prefName -> prefName *)
let aliasMap = ref (Util.StringMap.empty : string Util.StringMap.t)
let canonicalName nm =
try Util.StringMap.find nm !aliasMap with Not_found -> nm
type typ =
[`BOOL | `INT | `STRING | `STRING_LIST | `BOOLDEF | `CUSTOM | `UNKNOWN]
(* prefType : prefName -> type *)
let prefType = ref (Util.StringMap.empty : typ Util.StringMap.t)
let typ nm = try Util.StringMap.find nm !prefType with Not_found -> `UNKNOWN
(* prefs: prefName -> (doc, pspec, fulldoc) *)
let prefs =
ref (Util.StringMap.empty : (string * Uarg.spec * string) Util.StringMap.t)
let documentation nm =
try
let (doc, _, fulldoc) = Util.StringMap.find nm !prefs in
if doc <> "" && doc.[0] = '*' then raise Not_found;
let basic = doc = "" || doc.[0] <> '!' in
let doc =
if not basic then
String.sub doc 1 (String.length doc - 1)
else
doc
in
(doc, fulldoc, basic)
with Not_found ->
("", "", false)
let list () =
List.sort String.compare
(Util.StringMap.fold (fun nm _ l -> nm :: l) !prefType [])
(* aliased pref has *-prefixed doc and empty fulldoc *)
let alias pref newname =
(* pref must have been registered, so name pref is not empty, and will be *)
(* found in the map, no need for catching exception *)
let (_,pspec,_) = Util.StringMap.find (Safelist.hd (name pref)) !prefs in
prefs := Util.StringMap.add newname ("*", pspec, "") !prefs;
aliasMap := Util.StringMap.add newname (Safelist.hd (name pref)) !aliasMap;
pref.names <- newname :: pref.names
let registerPref name typ pspec doc fulldoc =
if Util.StringMap.mem name !prefs then
raise (Util.Fatal ("Preference " ^ name ^ " registered twice"));
prefs := Util.StringMap.add name (doc, pspec, fulldoc) !prefs;
(* Ignore internal preferences *)
if doc = "" || doc.[0] <> '*' then
prefType := Util.StringMap.add name typ !prefType
let createPrefInternal name typ local default doc fulldoc printer parsefn =
let newCell = rawPref default name in
registerPref name typ (parsefn newCell) doc fulldoc;
adddumper name local
(fun () -> Marshal.to_string (newCell.value, newCell.names) []);
addprinter name (fun () -> printer newCell.value);
addresetter
(fun () ->
newCell.setInProfile <- false; newCell.value <- newCell.defaultValue);
addloader name
(fun s ->
let (value, names) = Marshal.from_string s 0 in
newCell.value <- value);
newCell
let create name ?(local=false) default doc fulldoc intern printer =
createPrefInternal name `CUSTOM local default doc fulldoc printer
(fun cell -> Uarg.String (fun s -> set cell (intern (read cell) s)))
let createBool name ?(local=false) default doc fulldoc =
let doc = if default then doc ^ " (default true)" else doc in
createPrefInternal name `BOOL local default doc fulldoc
(fun v -> [if v then "true" else "false"])
(fun cell -> Uarg.Bool (fun b -> set cell b))
let createInt name ?(local=false) default doc fulldoc =
createPrefInternal name `INT local default doc fulldoc
(fun v -> [string_of_int v])
(fun cell -> Uarg.Int (fun i -> set cell i))
let createString name ?(local=false) default doc fulldoc =
createPrefInternal name `STRING local default doc fulldoc
(fun v -> [v])
(fun cell -> Uarg.String (fun s -> set cell s))
let createFspath name ?(local=false) default doc fulldoc =
createPrefInternal name `STRING local default doc fulldoc
(fun v -> [System.fspathToString v])
(fun cell -> Uarg.String (fun s -> set cell (System.fspathFromString s)))
let createStringList name ?(local=false) doc fulldoc =
createPrefInternal name `STRING_LIST local [] doc fulldoc
(fun v -> v)
(fun cell -> Uarg.String (fun s -> set cell (s:: read cell)))
let createBoolWithDefault name ?(local=false) doc fulldoc =
createPrefInternal name `BOOLDEF local `Default doc fulldoc
(fun v -> [match v with
`True -> "true"
| `False -> "false"
| `Default -> "default"])
(fun cell ->
Uarg.String
(fun s ->
let v =
match s with
"yes" | "true" -> `True
| "default" | "auto" -> `Default
| _ -> `False
in
set cell v))
(*****************************************************************************)
(* Command-line parsing *)
(*****************************************************************************)
let prefArg = function
Uarg.Bool(_) -> ""
| Uarg.Int(_) -> "n"
| Uarg.String(_) -> "xxx"
| _ -> assert false
let argspecs hook =
Util.StringMap.fold
(fun name (doc, pspec, _) l ->
("-" ^ name, hook name pspec, "")::l)
!prefs []
let oneLineDocs u =
let formatOne name pspec doc p =
if not p then "" else
let doc = if doc.[0] = '!'
then String.sub doc 1 ((String.length doc) - 1)
else doc in
let arg = prefArg pspec in
let arg = if arg = "" then "" else " " ^ arg in
let spaces =
String.make (max 1 (18 - String.length (name ^ arg))) ' ' in
" -" ^ name ^ arg ^ spaces ^ doc ^ "\n" in
let formatAll p =
String.concat ""
(Safelist.rev
(Util.StringMap.fold
(fun name (doc, pspec, _) l ->
(formatOne name pspec doc
(String.length doc > 0 && doc.[0] <> '*' && p doc)) :: l)
!prefs []))
in
u ^ "\n"
^ "Basic options: \n"
^ formatAll (fun doc -> doc.[0] <> '!')
^ "\nAdvanced options: \n"
^ formatAll (fun doc -> doc.[0] = '!')
let printUsage usage = Uarg.usage (argspecs (fun _ s -> s))
(oneLineDocs usage)
let processCmdLine usage hook =
Uarg.current := 0;
let argspecs = argspecs hook in
let defaultanonfun _ =
print_string "Anonymous arguments not allowed\n";
Uarg.usage argspecs (oneLineDocs usage);
exit 2
in
let anonfun =
try
let (_, p, _) = Util.StringMap.find "rest" !prefs in
match hook "rest" p with
Uarg.String stringFunction -> stringFunction
| _ -> defaultanonfun
with
Not_found -> defaultanonfun
in
try
Uarg.parse argspecs anonfun (oneLineDocs usage)
with IllegalValue str ->
raise(Util.Fatal(Printf.sprintf "%s \n%s\n" (oneLineDocs usage) str))
let parseCmdLine usage =
processCmdLine usage (fun _ sp -> sp)
(* Scan command line without actually setting any preferences; return a *)
(* string map associating a list of strings with each option appearing on *)
(* the command line. *)
let scanCmdLine usage =
let m = ref (Util.StringMap.empty : (string list) Util.StringMap.t) in
let insert name s =
let old = try Util.StringMap.find name !m with Not_found -> [] in
m := Util.StringMap.add name (s :: old) !m in
processCmdLine usage
(fun name p ->
match p with
Uarg.Bool _ -> Uarg.Bool (fun b -> insert name (string_of_bool b))
| Uarg.Int _ -> Uarg.Int (fun i -> insert name (string_of_int i))
| Uarg.String _ -> Uarg.String (fun s -> insert name s)
| _ -> assert false);
!m
(*****************************************************************************)
(* Preferences file parsing *)
(*****************************************************************************)
let string2bool name = function
"true" -> true
| "false" -> false
| other -> raise (Util.Fatal (name^" expects a boolean value, but \n"^other
^ " is not a boolean"))
let string2int name string =
try
int_of_string string
with Failure "int_of_string" ->
raise (Util.Fatal (name ^ " expects an integer value, but\n"
^ string ^ " is not an integer"))
(* Takes a filename and returns a list of "parsed lines" containing
(filename, lineno, varname, value)
in the same order as in the file. *)
let rec readAFile filename : (string * int * string * string) list =
let chan =
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
None -> close_in chan; parseLines filename lines
| Some(theLine) ->
let theLine =
(* A lot of Windows tools start a UTF-8 encoded file by a
byte-order mark. We skip it. *)
if lines = [] && Util.startswith theLine bom then
String.sub theLine 3 (String.length theLine - 3)
else
theLine
in
loop (theLine::lines) in
loop []
(* Takes a list of strings in reverse order and yields a list of "parsed lines"
in correct order *)
and parseLines filename lines =
let rec loop lines lineNum res =
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
else if Util.startswith theLine "include " then
match Util.splitIntoWords theLine ' ' with
[_;f] ->
let sublines = readAFile f in
loop rest (lineNum+1) (Safelist.append sublines res)
| _ -> raise (Util.Fatal(Printf.sprintf
"File \"%s\", line %d:\nGarbled 'include' directive: %s"
filename lineNum theLine))
else try
let pos = String.index theLine '=' in
let varName = Util.trimWhitespace (String.sub theLine 0 pos) in
let theResult =
Util.trimWhitespace (String.sub theLine (pos+1)
(String.length theLine - pos - 1)) in
loop rest (lineNum+1) ((filename, lineNum, varName, theResult)::res)
with Not_found -> (* theLine does not contain '=' *)
raise(Util.Fatal(Printf.sprintf
"File \"%s\", line %d:\nGarbled line (no '='):\n%s" filename lineNum theLine)) in
loop lines 1 []
let processLines lines =
Safelist.iter
(fun (fileName, lineNum, varName,theResult) ->
try
let _, theFunction, _ = Util.StringMap.find varName !prefs in
match theFunction with
Uarg.Bool boolFunction ->
boolFunction (string2bool varName theResult)
| Uarg.Int intFunction ->
intFunction (string2int varName theResult)
| Uarg.String stringFunction ->
stringFunction theResult
| _ -> assert false
with Not_found ->
raise (Util.Fatal ("File \""^ fileName ^ "\", line " ^
string_of_int lineNum ^ ": `" ^
varName ^ "' is not a valid option"))
| IllegalValue str ->
raise(Util.Fatal("File \""^ fileName ^ "\", line " ^
string_of_int lineNum ^ ": " ^ str)))
lines
let loadTheFile () =
match !profileName with
None -> ()
| Some(n) -> processLines(readAFile n)
let loadStrings l =
processLines (parseLines "" l)
(*****************************************************************************)
(* Printing *)
(*****************************************************************************)
let listVisiblePrefs () =
let l =
Util.StringMap.fold
(fun name (_, pspec, fulldoc) l ->
if String.length fulldoc > 0 then begin
(name, pspec, fulldoc) :: l
end else l) !prefs [] in
Safelist.stable_sort (fun (name1,_,_) (name2,_,_) -> compare name1 name2) l
let printFullDocs () =
Printf.eprintf "\\begin{description}\n";
Safelist.iter
(fun (name, pspec, fulldoc) ->
Printf.eprintf "\\item [{%s \\tt %s}]\n%s\n\n"
name (prefArg pspec) fulldoc)
(listVisiblePrefs());
Printf.eprintf "\\end{description}\n"
(*****************************************************************************)
(* Adding stuff to the prefs file *)
(*****************************************************************************)
let addprefsto = createString "addprefsto" ""
"!file to add new prefs to"
"By default, new preferences added by Unison (e.g., new \\verb|ignore| \
clauses) will be appended to whatever preference file Unison was told \
to load at the beginning of the run. Setting the preference \
\\texttt{addprefsto \\ARG{filename}} makes Unison \
add new preferences to the file named \\ARG{filename} instead."
let addLine l =
let filename =
if read addprefsto <> ""
then profilePathname (read addprefsto)
else thePrefsFile() in
try
debug (fun() ->
Util.msg "Adding '%s' to %s\n" l (System.fspathToDebugString filename));
let resultmsg =
l ^ "' added to profile " ^ System.fspathToPrintString filename in
let ochan =
System.open_out_gen [Open_wronly; Open_creat; Open_append] 0o600 filename
in
output_string ochan l;
output_string ochan "\n";
close_out ochan;
resultmsg
with
Sys_error e ->
begin
let resultmsg =
(Printf.sprintf "Could not write preferences file (%s)\n" e) in
Util.warn resultmsg;
resultmsg
end
let add name value = addLine (name ^ " = " ^ value)
let addComment c = ignore (addLine ("# " ^ c))
unison-2.40.102/ubase/util.ml 0000644 0061316 0061316 00000035144 11361646373 016024 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/util.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(*****************************************************************************)
(* CASE INSENSITIVE COMPARISON *)
(*****************************************************************************)
let nocase_cmp a b =
let alen = String.length a in
let blen = String.length b in
let minlen = if alen=minlen then compare alen blen
else
let c =
compare (Char.lowercase(String.get a i)) (Char.lowercase(String.get b i)) in
if c<>0 then c else loop (i+1) in
loop 0
let nocase_eq a b = (0 = (nocase_cmp a b))
(*****************************************************************************)
(* PRE-BUILT MAP AND SET MODULES *)
(*****************************************************************************)
module StringMap = Map.Make (String)
module StringSet = Set.Make (String)
let stringSetFromList l =
Safelist.fold_right StringSet.add l StringSet.empty
(*****************************************************************************)
(* Debugging / error messages *)
(*****************************************************************************)
let infos = ref ""
let clear_infos () =
if !infos <> "" then begin
print_string "\r";
print_string (String.make (String.length !infos) ' ');
print_string "\r";
flush stdout
end
let show_infos () =
if !infos <> "" then begin print_string !infos; flush stdout end
let set_infos s =
if s <> !infos then begin clear_infos (); infos := s; show_infos () end
let msg f =
clear_infos (); Uprintf.eprintf (fun () -> flush stderr; show_infos ()) f
let msg : ('a, out_channel, unit) format -> 'a = msg
(* ------------- Formatting stuff --------------- *)
let curr_formatter = ref Format.std_formatter
let format f = Format.fprintf (!curr_formatter) f
let format : ('a, Format.formatter, unit) format -> 'a = format
let format_to_string f =
let old_formatter = !curr_formatter in
curr_formatter := Format.str_formatter;
f ();
let s = Format.flush_str_formatter () in
curr_formatter := old_formatter;
s
let flush () = Format.pp_print_flush (!curr_formatter) ()
(*****************************************************************************)
(* GLOBAL DEBUGGING SWITCH *)
(*****************************************************************************)
let debugPrinter = ref None
let debug s th =
match !debugPrinter with
None -> assert false
| Some p -> p s th
(* This should be set by the UI to a function that can be used to warn users *)
let warnPrinter = ref None
(* The rest of the program invokes this function to warn users. *)
let warn message =
match !warnPrinter with
None -> ()
| Some p -> p message
(*****************************************************************************)
(* EXCEPTION HANDLING *)
(*****************************************************************************)
exception Fatal of string
exception Transient of string
let encodeException m kind e =
let reraise s =
match kind with
`Fatal -> raise (Fatal s)
| `Transient -> raise (Transient s)
in
let kindStr =
match kind with
`Fatal -> "Fatal"
| `Transient -> "Transient"
in
match e with
Unix.Unix_error(err,fnname,param) ->
let s = "Error in " ^ m ^ ":\n"
^ (Unix.error_message err)
^ " [" ^ 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
| Transient(s) ->
debug "exn" (fun() ->
if kind = `Fatal then
msg "In %s: Converting a Transient error to %s:\n%s\n" m kindStr s
else
msg "In %s: Propagating Transient error\n" m);
reraise s
| Not_found ->
let s = "Not_found raised in " ^ m
^ " (this indicates a bug!)" in
debug "exn"
(fun() -> msg "Converting a Not_found to %s:\n%s\n" kindStr s);
reraise s
| Invalid_argument a ->
let s = "Invalid_argument("^a^") raised in " ^ m
^ " (this indicates a bug!)" in
debug "exn"
(fun() -> msg "Converting an Invalid_argument to %s:\n%s\n" kindStr s);
reraise s
| Sys_error(s) ->
let s = "Error in " ^ m ^ ":\n" ^ s in
debug "exn"
(fun() -> msg "Converting a Sys_error to %s:\n%s\n" kindStr s);
reraise s
| Sys_blocked_io ->
let s = "Blocked IO error in " ^ m in
debug "exn"
(fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" kindStr s);
reraise s
| _ ->
raise e
let convertUnixErrorsToExn m f n e =
try f()
with
Unix.Unix_error(err,fnname,param) ->
let s = "Error in " ^ m ^ ":\n"
^ (Unix.error_message err)
^ " [" ^ fnname ^ "(" ^ param ^ ")]" in
debug "exn"
(fun() -> msg "Converting a Unix error to %s:\n%s\n" n s);
raise (e s)
| Transient(s) ->
debug "exn" (fun() ->
if n="Fatal" then
msg "In %s: Converting a Transient error to %s:\n%s\n" m n s
else
msg "In %s: Propagating Transient error\n" m);
raise (e s)
| Not_found ->
let s = "Not_found raised in " ^ m
^ " (this indicates a bug!)" in
debug "exn" (fun() -> msg "Converting a Not_found to %s:\n%s\n" n s);
raise (e s)
| End_of_file ->
let s = "End_of_file exception raised in " ^ m
^ " (this indicates a bug!)" in
debug "exn" (fun() -> msg "Converting an End_of_file to %s:\n%s\n" n s);
raise (e s)
| Sys_error(s) ->
let s = "Error in " ^ m ^ ":\n" ^ s in
debug "exn" (fun() -> msg "Converting a Sys_error to %s:\n%s\n" n s);
raise (e s)
| Sys_blocked_io ->
let s = "Blocked IO error in " ^ m in
debug "exn" (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n"
n s);
raise (e s)
let convertUnixErrorsToFatal m f =
convertUnixErrorsToExn m f "Fatal" (fun str -> Fatal(str))
let convertUnixErrorsToTransient m f =
convertUnixErrorsToExn m f "Transient" (fun str -> Transient(str))
let unwindProtect f cleanup =
try
f ()
with
Transient _ as e ->
debug "exn" (fun () -> msg "Exception caught by unwindProtect\n");
convertUnixErrorsToFatal "unwindProtect" (fun()-> cleanup e);
raise e
let finalize f cleanup =
try
let res = f () in
cleanup ();
res
with
Transient _ as e ->
debug "exn" (fun () -> msg "Exception caught by finalize\n");
convertUnixErrorsToFatal "finalize" cleanup;
raise e
type confirmation =
Succeeded
| Failed of string
let ignoreTransientErrors thunk =
try
thunk()
with
Transient(s) -> ()
let printException e =
try
raise e
with
Transient s -> s
| Fatal s -> s
| e -> Printexc.to_string e
(* Safe version of Unix getenv -- raises a comprehensible error message if
called with an env variable that doesn't exist *)
let safeGetenv var =
convertUnixErrorsToFatal
"querying environment"
(fun () ->
try System.getenv var
with Not_found ->
raise (Fatal ("Environment variable " ^ var ^ " not found")))
let process_status_to_string = function
Unix.WEXITED i -> Printf.sprintf "Exited with status %d" i
| Unix.WSIGNALED i -> Printf.sprintf "Killed by signal %d" i
| Unix.WSTOPPED i -> Printf.sprintf "Stopped by signal %d" i
(*****************************************************************************)
(* OS TYPE *)
(*****************************************************************************)
let osType =
match Sys.os_type with
"Win32" | "Cygwin" -> `Win32
| "Unix" -> `Unix
| other -> raise (Fatal ("Unknown OS: " ^ other))
let isCygwin = (Sys.os_type = "Cygwin")
(*****************************************************************************)
(* MISCELLANEOUS *)
(*****************************************************************************)
let monthname n =
Safelist.nth
["Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"]
n
let localtime f =
convertUnixErrorsToTransient "localtime" (fun()-> Unix.localtime f)
let time () =
convertUnixErrorsToTransient "time" Unix.time
let time2string timef =
try
let time = localtime timef in
(* Old-style:
Printf.sprintf
"%2d:%.2d:%.2d on %2d %3s, %4d"
time.Unix.tm_hour
time.Unix.tm_min
time.Unix.tm_sec
time.Unix.tm_mday
(monthname time.Unix.tm_mon)
(time.Unix.tm_year + 1900)
*)
Printf.sprintf
"%4d-%02d-%02d at %2d:%.2d:%.2d"
(time.Unix.tm_year + 1900)
(time.Unix.tm_mon + 1)
time.Unix.tm_mday
time.Unix.tm_hour
time.Unix.tm_min
time.Unix.tm_sec
with Transient _ ->
"(invalid date)"
let percentageOfTotal current total =
(int_of_float ((float current) *. 100.0 /. (float total)))
let percent2string p = Printf.sprintf "%3d%%" (truncate (max 0. (min 100. p)))
let extractValueFromOption = function
None -> raise (Fatal "extractValueFromOption failed")
| Some(v) -> v
let option2string (prt: 'a -> string) = function
Some x -> prt x
| None -> "N.A."
(*****************************************************************************)
(* String utility functions *)
(*****************************************************************************)
let truncateString string length =
let actualLength = String.length string in
if actualLength <= length then string^(String.make (length - actualLength) ' ')
else if actualLength < 3 then string
else (String.sub string 0 (length - 3))^ "..."
let findsubstring s1 s2 =
let l1 = String.length s1 in
let l2 = String.length s2 in
let rec loop i =
if i+l1 > l2 then None
else if s1 = String.sub s2 i l1 then Some(i)
else loop (i+1)
in loop 0
let rec replacesubstring s fromstring tostring =
match findsubstring fromstring s with
None -> s
| Some(i) ->
let before = String.sub s 0 i in
let afterpos = i + (String.length fromstring) in
let after = String.sub s afterpos ((String.length s) - afterpos) in
before ^ tostring ^ (replacesubstring after fromstring tostring)
let replacesubstrings s pairs =
Safelist.fold_left
(fun s' (froms,tos) -> replacesubstring s' froms tos)
s pairs
let startswith s1 s2 =
let l1 = String.length s1 in
let l2 = String.length s2 in
if l1 < l2 then false else
let rec loop i =
if i>=l2 then true
else if s1.[i] <> s2.[i] then false
else loop (i+1)
in loop 0
let endswith s1 s2 =
let l1 = String.length s1 in
let l2 = String.length s2 in
let offset = l1 - l2 in
if l1 < l2 then false else
let rec loop i =
if i>=l2 then true
else if s1.[i+offset] <> s2.[i] then false
else loop (i+1)
in loop 0
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)
(* FIX: quadratic! *)
let rec trimWhitespace s =
let l = String.length s in
if l=0 then s
else if s.[0]=' ' || s.[0]='\t' || s.[0]='\n' || s.[0]='\r' then
trimWhitespace (String.sub s 1 (l-1))
else if s.[l-1]=' ' || s.[l-1]='\t' || s.[l-1]='\n' || s.[l-1]='\r' then
trimWhitespace (String.sub s 0 (l-1))
else
s
let splitIntoWords (s:string) (c:char) =
let rec inword acc start pos =
if pos >= String.length(s) || s.[pos] = c then
betweenwords ((String.sub s start (pos-start)) :: acc) pos
else inword acc start (pos+1)
and betweenwords acc pos =
if pos >= (String.length s) then (Safelist.rev acc)
else if s.[pos]=c then betweenwords acc (pos+1)
else inword acc pos pos
in betweenwords [] 0
let rec splitIntoWordsByString s sep =
match findsubstring sep s with
None -> [s]
| Some(i) ->
let before = String.sub s 0 i in
let afterpos = i + (String.length sep) in
let after = String.sub s afterpos ((String.length s) - afterpos) in
before :: (splitIntoWordsByString after sep)
let padto n s = s ^ (String.make (max 0 (n - String.length s)) ' ')
(*****************************************************************************)
(* Building pathnames in the user's home dir *)
(*****************************************************************************)
let homeDir () =
System.fspathFromString
(if (osType = `Unix) || isCygwin then
safeGetenv "HOME"
else if osType = `Win32 then
(*We don't want the behavior of Unison to depends on whether it is run
from a Cygwin shell (where HOME is set) or in any other way (where
HOME is usually not set)
try System.getenv "HOME" (* Windows 9x with Cygwin HOME set *)
with Not_found ->
*)
try System.getenv "USERPROFILE" (* Windows NT/2K standard *)
with Not_found ->
try System.getenv "UNISON" (* Use UNISON dir if it is set *)
with Not_found ->
"c:/" (* Default *)
else
assert false (* osType can't be anything else *))
let fileInHomeDir n = System.fspathConcat (homeDir ()) n
(*****************************************************************************)
(* "Upcall" for building pathnames in the .unison dir *)
(*****************************************************************************)
let fileInUnisonDirFn = ref None
let supplyFileInUnisonDirFn f = fileInUnisonDirFn := Some(f)
let fileInUnisonDir n =
match !fileInUnisonDirFn with
None -> assert false
| Some(f) -> f n
unison-2.40.102/ubase/proplist.ml 0000644 0061316 0061316 00000002341 11361646373 016714 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/proplist.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
type 'a key = string
type t = Obj.t Util.StringMap.t
let names = ref Util.StringSet.empty
let register nm =
if (Util.StringSet.mem nm !names) then
raise (Util.Fatal
(Format.sprintf "Property lists: %s already registered!" nm));
names := Util.StringSet.add nm !names;
nm
let empty = Util.StringMap.empty
let mem = Util.StringMap.mem
let find (k : 'a key) m : 'a = Obj.obj (Util.StringMap.find k m)
let add (k : 'a key) (v : 'a) m = Util.StringMap.add k (Obj.repr v) m
unison-2.40.102/ubase/safelist.ml 0000644 0061316 0061316 00000010515 11361646373 016654 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ubase/safelist.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
let filterBoth f l =
let rec loop r1 r2 = function
[] -> (List.rev r1, List.rev r2)
| hd::tl ->
if f hd then loop (hd::r1) r2 tl
else loop r1 (hd::r2) tl
in loop [] [] l
let filterMap f l =
let rec loop r = function
[] -> List.rev r
| hd::tl -> begin
match f hd with
None -> loop r tl
| Some x -> loop (x::r) tl
end
in loop [] l
let filterMap2 f l =
let rec loop r s = function
[] -> List.rev r, List.rev s
| hd::tl -> begin
let (a, b) = f hd in
let r' = match a with None -> r | Some x -> x::r in
let s' = match b with None -> s | Some x -> x::s in
loop r' s' tl
end
in loop [] [] l
(* These are tail-recursive versions of the standard ones from the
List module *)
let rec concat_rec accu =
function
[] -> List.rev accu
| l::r -> concat_rec (List.rev_append l accu) r
let concat l = concat_rec [] l
let flatten = concat
let append l l' =
match l' with [] -> l | _ -> List.rev_append (List.rev l) l'
let rev_map f l =
let rec rmap_f accu = function
| [] -> accu
| a::l -> rmap_f (f a :: accu) l
in
rmap_f [] l
let map f l = List.rev (rev_map f l)
let rev_map2 f l1 l2 =
let rec rmap2_f accu l1 l2 =
match (l1, l2) with
| ([], []) -> accu
| (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2
| (_, _) -> invalid_arg "List.rev_map2"
in
rmap2_f [] l1 l2
;;
let map2 f l1 l2 = List.rev (rev_map2 f l1 l2)
let rec allElementsEqual = function
[] -> true
| [a] -> true
| a::b::rest -> a=b && (allElementsEqual (b::rest))
let rec fold_left f accu l =
match l with
[] -> accu
| a::_ ->
(* We don't want l to be live when f is called *)
let l' = List.tl l in
fold_left f (f accu a) l'
let split l =
let rec loop acc1 acc2 = function
[] -> (List.rev acc1, List.rev acc2)
| (x,y)::l -> loop (x::acc1) (y::acc2) l
in
loop [] [] l
let rec transpose_rec accu l =
match l with
[] | []::_ ->
accu
| [x]::_ ->
(map (function [x] -> x | _ -> invalid_arg "Safelist.transpose") l)::accu
| _ ->
let (l0, r) =
fold_left
(fun (l0, r) l1 ->
match l1 with
[] -> invalid_arg "Safelist.transpose (2)"
| a::r1 -> (a::l0, r1::r))
([], []) l
in
transpose_rec ((List.rev l0)::accu) (List.rev r)
let transpose l = List.rev (transpose_rec [] l)
let combine l1 l2 =
let rec loop acc = function
([], []) -> List.rev acc
| (a1::l1r, a2::l2r) -> loop ((a1, a2)::acc) (l1r,l2r)
| (_, _) -> invalid_arg "Util.combine"
in
loop [] (l1,l2)
let remove_assoc x l =
let rec loop acc = function
| [] -> List.rev acc
| (a, b as pair) :: rest ->
if a = x then loop acc rest else loop (pair::acc) rest
in
loop [] l
let fold_right f l accu =
fold_left (fun x y -> f y x) accu (List.rev l)
let flatten_map f l = flatten (map f l)
let remove x l =
let rec loop acc = function
| [] -> List.rev acc
| a :: rest ->
if a = x then loop acc rest else loop (a::acc) rest
in
loop [] l
let iteri f l =
let rec loop n = function
| [] -> ()
| h::t -> ((f n h); loop (n+1) t)
in loop 0 l
(* These are already tail recursive in the List module *)
let iter = List.iter
let iter2 = List.iter2
let rev = List.rev
let rev_append = List.rev_append
let hd = List.hd
let tl = List.tl
let nth = List.nth
let length = List.length
let mem = List.mem
let assoc = List.assoc
let for_all = List.for_all
let exists = List.exists
let find = List.find
let filter = List.filter
let stable_sort = List.stable_sort
let sort = List.sort
let partition = List.partition
unison-2.40.102/ui.mli 0000644 0061316 0061316 00000000440 11361646373 014525 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/ui.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* The module Ui provides only the user interface signature.
Implementations are provided by Uitext and Uitk. *)
module type SIG = sig
val start : unit -> unit
end
unison-2.40.102/pty.c 0000644 0061316 0061316 00000002656 11361646373 014400 0 ustar bcpierce bcpierce /* Stub code for controlling terminals on Mac OS X. */
#include
#include // alloc_tuple
#include // Store_field
#include // failwith
#include // ENOSYS
extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
extern void uerror (char * cmdname, value arg) Noreturn;
// openpty
#if defined(__linux)
#include
#define HAS_OPENPTY 1
#endif
#if defined(__APPLE__) || defined(__NetBSD__)
#include
#define HAS_OPENPTY 1
#endif
#ifdef __FreeBSD__
#include
#include
#define HAS_OPENPTY 1
#endif
#ifdef HAS_OPENPTY
#include
#include
CAMLprim value setControllingTerminal(value fdVal) {
int fd = Int_val(fdVal);
if (ioctl(fd, TIOCSCTTY, (char *) 0) < 0)
uerror("ioctl", (value) 0);
return Val_unit;
}
/* c_openpty: unit -> (int * Unix.file_descr) */
CAMLprim value c_openpty() {
int master,slave;
value pair;
if (openpty(&master,&slave,NULL,NULL,NULL) < 0)
uerror("openpty", (value) 0);
pair = alloc_tuple(2);
Store_field(pair,0,Val_int(master));
Store_field(pair,1,Val_int(slave));
return pair;
}
#else // not HAS_OPENPTY
#define Nothing ((value) 0)
CAMLprim value setControllingTerminal(value fdVal) {
unix_error (ENOSYS, "setControllingTerminal", Nothing);
}
CAMLprim value c_openpty() {
unix_error (ENOSYS, "openpty", Nothing);
}
#endif
unison-2.40.102/README 0000644 0061316 0061316 00000002161 11361646373 014267 0 ustar bcpierce bcpierce THE UNISON FILE SYNCHRONIZER
http://www.cis.upenn.edu/~bcpierce/unison
This directory is the source distribution for the unison file synchronizer.
Installation instructions are in the file INSTALL.
License and copying information can be found in the file COPYING
Full documentation can be found on the Unison home page.
Contacts:
- Bug reports should be sent to unison-help@cis.upenn.edu
- General questions and discussion should be sent to
unison-users@groups.yahoo.com
- You can subscribe to this list using Yahoo's web interface
http://groups.yahoo.com/group/unison-users
Credits:
OS X Unison Icon taken from Mac4Lin (LGPL)
http://sourceforge.net/projects/mac4lin/
Some icons in the OSX GUI are directly taken from Matt Ball's developer icons
(Creative Commons Attribution 3.0)
Others are based on Matt Ball's developer icons (Creative Commons Attribution 3.0)
http://www.mattballdesign.com/blog/2009/11/23/developer-icons-are-back-online/
OSX GUI elements from BWToolkit (three-clause BSD license)
http://www.brandonwalkin.com/bwtoolkit/
unison-2.40.102/fspath.ml 0000644 0061316 0061316 00000032256 12025627377 015237 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fspath.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* Defines an abstract type of absolute filenames (fspaths). Keeping the *)
(* type abstract lets us enforce some invariants which are important for *)
(* correct behavior of some system calls. *)
(* - *)
(* Invariants: *)
(* Fspath "" is not allowed *)
(* All root directories end in / *)
(* All non-root directories end in some other character *)
(* All separator characters are /, even in Windows *)
(* All fspaths are absolute *)
(* - *)
module Fs = System_impl.Fs
let debug = Util.debug "fspath"
let debugverbose = Util.debug "fsspath+"
type t = Fspath of string
let toString (Fspath f) = f
let toPrintString (Fspath f) = f
let toDebugString (Fspath f) = String.escaped f
let toSysPath (Fspath f) = System.fspathFromString f
(* Needed to hack around some ocaml/Windows bugs, see comment at stat, below *)
let winRootRx = Rx.rx "(([a-zA-Z]:)?/|//[^/]+/[^/]+/)"
(* FIX I think we could just check the last character of [d]. *)
let isRootDir d =
(* We assume all path separators are slashes in d *)
d="/" ||
(Util.osType = `Win32 && Rx.match_string winRootRx d)
let winRootFixRx = Rx.rx "//[^/]+/[^/]+"
let winRootFix d =
if Rx.match_string winRootFixRx d then d^"/" else d
(* [differentSuffix: fspath -> fspath -> (string * string)] returns the *)
(* least distinguishing suffixes of two fspaths, for displaying in the user *)
(* interface. *)
let differentSuffix (Fspath f1) (Fspath f2) =
if isRootDir f1 or isRootDir f2 then (f1,f2)
else begin
(* We use the invariant that neither f1 nor f2 ends in slash *)
let len1 = String.length f1 in
let len2 = String.length f2 in
let n =
(* The position of the character from the right where the fspaths *)
(* differ *)
let rec loop n =
let i1 = len1-n in
if i1<0 then n else
let i2 = len2-n in
if i2<0 then n else
if compare (String.get f1 i1) (String.get f2 i2) = 0
then loop (n+1)
else n in
loop 1 in
let suffix f len =
if n > len then f else
try
let n' = String.rindex_from f (len-n) '/' in
String.sub f (n'+1) (len-n'-1)
with Not_found -> f in
let s1 = suffix f1 len1 in
let s2 = suffix f2 len2 in
(s1,s2)
end
(* When an HFS file is stored on a non-HFS system it is stored as two
files, the data fork, and the rest of the file including resource
fork is stored in the AppleDouble file, which has the same name as
the data fork file with ._ prepended. *)
let appleDouble (Fspath f) =
if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else
let len = String.length f in
try
let i = 1 + String.rindex f '/' in
let res = String.create (len + 2) in
String.blit f 0 res 0 i;
res.[i] <- '.';
res.[i + 1] <- '_';
String.blit f i res (i + 2) (len - i);
Fspath res
with Not_found ->
assert false
let rsrc (Fspath f) =
if isRootDir f then raise(Invalid_argument "Fspath.rsrc") else
Fspath(f^"/..namedfork/rsrc")
(* WRAPPED SYSTEM CALLS *)
(* CAREFUL!
Windows porting issue:
Unix.LargeFile.stat "c:\\windows\\" will fail, you must use
Unix.LargeFile.stat "c:\\windows" instead.
The standard file selection dialog, however, will return a directory
with a trailing backslash.
Therefore, be careful to remove a trailing slash or backslash before
calling this in Windows.
BUT Windows shares are weird!
//raptor/trevor and //raptor/trevor/mirror are directories
and //raptor/trevor/.bashrc is a file. We observe the following:
Unix.LargeFile.stat "//raptor" will fail.
Unix.LargeFile.stat "//raptor/" will fail.
Unix.LargeFile.stat "//raptor/trevor" will fail.
Unix.LargeFile.stat "//raptor/trevor/" will succeed.
Unix.LargeFile.stat "//raptor/trevor/mirror" will succeed.
Unix.LargeFile.stat "//raptor/trevor/mirror/" will fail.
Unix.LargeFile.stat "//raptor/trevor/.bashrc/" will fail.
Unix.LargeFile.stat "//raptor/trevor/.bashrc" will succeed.
Not sure what happens for, e.g.,
Unix.LargeFile.stat "//raptor/FOO"
where //raptor/FOO is a file.
I guess the best we can do is:
To stat //host/xxx, assume xxx is a directory, and use
Unix.LargeFile.stat "//host/xxx/". If xxx is not a directory,
who knows.
To stat //host/path where path has length >1, don't use
a trailing slash.
The way I did this was to assume //host/xxx/ is a root directory.
Then by the invariants of fspath it should always end in /.
Unix.LargeFile.stat "c:" will fail.
Unix.LargeFile.stat "c:/" will succeed.
Unix.LargeFile.stat "c://" will fail.
(The Unix version of ocaml handles either a trailing slash or no
trailing slash.)
Invariant on fspath will guarantee that argument is OK for stat
*)
(* HACK:
Under Windows 98,
Unix.opendir "c:/" fails
Unix.opendir "c:/*" works
Unix.opendir "/" fails
Under Windows 2000,
Unix.opendir "c:/" works
Unix.opendir "c:/*" fails
Unix.opendir "/" fails
Unix.opendir "c:" works as well, but, this refers to the current
working directory AFAIK.
let opendir (Fspath d) =
if Util.osType<>`Win32 || not(isRootDir d) then Unix.opendir d else
try
Unix.opendir d
with Unix.Unix_error _ ->
Unix.opendir (d^"*")
*)
let child (Fspath f) n =
(* Note, f is not "" by invariants on Fspath *)
if
(* We use the invariant that f ends in / iff f is a root filename *)
isRootDir f
then
Fspath(Printf.sprintf "%s%s" f (Name.toString n))
else
Fspath (Printf.sprintf "%s%c%s" f '/' (Name.toString n))
let concat fspath path =
if Path.isEmpty path then
fspath
else begin
let Fspath fspath = fspath in
if
(* We use the invariant that f ends in / iff f is a root filename *)
isRootDir fspath
then
Fspath (fspath ^ Path.toString path)
else
let p = Path.toString path in
let l = String.length fspath in
let l' = String.length p in
let s = String.create (l + l' + 1) in
String.blit fspath 0 s 0 l;
s.[l] <- '/';
String.blit p 0 s (l + 1) l';
Fspath s
end
(* Filename.dirname is screwed up in Windows so we use this function. It *)
(* assumes that path separators are slashes. *)
let winBadDirnameArg = Rx.rx "[a-zA-Z]:/[^/]*"
let myDirname s =
if Util.osType=`Win32 && Rx.match_string winBadDirnameArg s
then String.sub s 0 3
else Filename.dirname s
(*****************************************************************************)
(* CANONIZING PATHS *)
(*****************************************************************************)
(* Convert a string to an fspath. HELP ENFORCE INVARIANTS listed above. *)
let localString2fspath s =
(* Force path separators to be slashes in Windows, handle weirdness in *)
(* Windows network names *)
let s =
if Util.osType = `Win32
then winRootFix (Fileutil.backslashes2forwardslashes s)
else s in
(* Note: s may still contain backslashes under Unix *)
if isRootDir s then Fspath s
else if String.length s > 0 then
let s' = Fileutil.removeTrailingSlashes s in
if String.length s' = 0 then Fspath "/" (* E.g., s="///" *)
else Fspath s'
else
(* Prevent Fspath "" *)
raise(Invalid_argument "Os.localString2fspath")
(* Return the canonical fspath of a filename (string), relative to the *)
(* current host, current directory. *)
(* THIS IS A HACK. It has to take account of some porting issues between *)
(* the Unix and Windows versions of ocaml, etc. In particular, the Unix, *)
(* Filename, and Sys modules of ocaml have subtle differences under Windows *)
(* and Unix. So, be very careful with any changes !!! *)
let canonizeFspath p0 =
let p = match p0 with None -> "." | Some "" -> "." | Some s -> s in
let p' =
begin
let original = Fs.getcwd() in
try
let newp =
(Fs.chdir p; (* This might raise Sys_error *)
Fs.getcwd()) in
Fs.chdir original;
newp
with
Sys_error why ->
(* We could not chdir to p. Either *)
(* - *)
(* (1) p does not exist *)
(* (2) p is a file *)
(* (3) p is a dir but we don't have permission *)
(* - *)
(* In any case, we try to cd to the parent of p, and if that *)
(* fails, we just quit. This works nicely for most cases of (1), *)
(* it works for (2), and on (3) it may leave a mess for someone *)
(* else to pick up. *)
let p = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes p else p in
if isRootDir p then raise
(Util.Fatal (Printf.sprintf
"Cannot find canonical name of root directory %s\n(%s)" p why));
let parent = myDirname p in
let parent' = begin
(try Fs.chdir parent with
Sys_error why2 -> raise (Util.Fatal (Printf.sprintf
"Cannot find canonical name of %s: unable to cd either to it\n
(%s)\nor to its parent %s\n(%s)" p why parent why2)));
Fs.getcwd() end in
Fs.chdir original;
let bn = Filename.basename p in
if bn="" then parent'
else toString(child (localString2fspath parent')
(Name.fromString bn))
end in
localString2fspath p'
(*
(* TJ--I'm disabling this for now. It is causing directories to be created *)
(* with the wrong case, e.g., an upper case directory that needs to be *)
(* propagated will be created with a lower case name. We'll see if the *)
(* weird problem with changing case is still happening. *)
if Util.osType<>`Win32 then localString2fspath p'
else
(* A strange bug turns up in Windows: sometimes p' has mixed case, *)
(* sometimes it is all lower case. (Sys.getcwd seems to make a random *)
(* choice.) Since file names are not case-sensitive in Windows we just *)
(* force everything to lower case. *)
(* NOTE: WE DON'T ENFORCE THAT FSPATHS CREATED BY CHILDFSPATH ARE ALL *)
(* LOWER CASE!! *)
let p' = String.lowercase p' in
localString2fspath p'
*)
let canonize x =
Util.convertUnixErrorsToFatal "canonizing path" (fun () -> canonizeFspath x)
let maxlinks = 100
let findWorkingDir fspath path =
let abspath = toString (concat fspath path) in
let realpath =
if not (Path.followLink path) then abspath else
let rec followlinks n p =
if n>=maxlinks then
raise
(Util.Transient (Printf.sprintf
"Too many symbolic links from %s" abspath));
try
let link = Fs.readlink p in
let linkabs =
if Filename.is_relative link then
Fs.fspathConcat (Fs.fspathDirname p) link
else link in
followlinks (n+1) linkabs
with
Unix.Unix_error _ -> p in
followlinks 0 abspath in
if isRootDir realpath then
raise (Util.Transient(Printf.sprintf
"The path %s is a root directory" abspath));
let realpath = Fileutil.removeTrailingSlashes realpath in
let p = Filename.basename realpath in
debug
(fun() ->
Util.msg "Os.findWorkingDir(%s,%s) = (%s,%s)\n"
(toString fspath)
(Path.toString path)
(myDirname realpath)
p);
(localString2fspath (myDirname realpath), Path.fromString p)
let quotes (Fspath f) = Uutil.quotes f
let compare (Fspath f1) (Fspath f2) = compare f1 f2
unison-2.40.102/main.ml 0000644 0061316 0061316 00000020620 11361646373 014665 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/main.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* ---------------------------------------------------------------------- *)
(* This is the main program -- the thing that gets executed first when
unison is run.
The Main module is actually a functor that takes the user interface
(e.g., Uitext or Uigtk) as a parameter. This allows us to build with
just one user interface at a time, which avoids having to always link
in all the libraries needed by all the user interfaces.
A non-functor interface is provided to allow the Mac GUI to reuse the
startup code for non-GUI options.
*)
(* ---------------------------------------------------------------------- *)
(* Some command-line arguments are handled specially during startup, e.g.,
-doc
-help
-version
-server
-socket
-ui
They are expected to appear on the command-line only, not in a
profile. In particular, -version and -doc will print to the
standard output, so they only make sense if invoked from the
command-line (and not a click-launched gui that has no standard
output).
Furthermore, the actions associated with these command-line
arguments are executed without loading a profile or doing the usual
command-line parsing. This is because we want to run the actions
without loading a profile; and then we can't do command-line
parsing because it is intertwined with profile loading.
NB: the Mac GUI handles these options itself and needs to change
if any more are added.
*)
let versionPrefName = "version"
let printVersionAndExit =
Prefs.createBool versionPrefName false "print version and exit"
("Print the current version number and exit. "
^ "(This option only makes sense on the command line.)")
let docsPrefName = "doc"
let docs =
Prefs.createString docsPrefName ""
"show documentation ('-doc topics' lists topics)"
( "The command-line argument \\texttt{-doc \\ARG{secname}} causes unison to "
^ "display section \\ARG{secname} of the manual on the standard output "
^ "and then exit. Use \\verb|-doc all| to display the whole manual, "
^ "which includes exactly the same information as the printed and HTML "
^ "manuals, modulo "
^ "formatting. Use \\verb|-doc topics| to obtain a list of the "
^ "names of the various sections that can be printed.")
let prefsdocsPrefName = "prefsdocs"
let prefsdocs =
Prefs.createBool prefsdocsPrefName false
"*show full documentation for all preferences (and then exit)"
""
let serverPrefName = "server"
let server =
Prefs.createBool serverPrefName false "*normal or server mode" ""
let socketPrefName = "socket"
let socket =
Prefs.create socketPrefName None
"!act as a server on a socket" ""
(fun _ -> fun i ->
(try
Some(int_of_string i)
with Failure "int_of_string" ->
raise(Prefs.IllegalValue "-socket must be followed by a number")))
(function None -> [] | Some(i) -> [string_of_int i]) ;;
let serverHostName = "host"
let serverHost =
Prefs.createString serverHostName ""
"!bind the socket to this host name in server socket mode" ""
(* User preference for which UI to use if there is a choice *)
let uiPrefName = "ui"
let interface =
Prefs.create uiPrefName Uicommon.Graphic
"!select UI ('text' or 'graphic'); command-line only"
("This preference selects either the graphical or the textual user "
^ "interface. Legal values are \\verb|graphic| or \\verb|text|. "
^ "\n\nBecause this option is processed specially during Unison's "
^ "start-up sequence, it can {\\em only} be used on the command line. "
^ "In preference files it has no effect."
^ "\n\nIf "
^ "the Unison executable was compiled with only a textual interface, "
^ "this option has "
^ "no effect. (The pre-compiled binaries are all compiled with both "
^ "interfaces available.)")
(fun _ -> function
"text" -> Uicommon.Text
| "graphic" -> Uicommon.Graphic
| other ->
raise (Prefs.IllegalValue ("option ui :\n\
text -> textual user interface\n\
graphic -> graphic user interface\n"
^other^ " is not a legal value")))
(function Uicommon.Text -> ["text"]
| Uicommon.Graphic -> ["graphic"]);;
let init() = begin
ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150});
let argv = Prefs.scanCmdLine Uicommon.usageMsg in
let catch_all f =
(try f () with e -> Util.msg "%s\n" (Uicommon.exn2string e); exit 1) in
(* Print version if requested *)
if Util.StringMap.mem versionPrefName argv then begin
Printf.printf "%s version %s\n" Uutil.myName Uutil.myVersion;
exit 0
end;
(* Print docs for all preferences if requested (this is used when building
the manual) *)
if Util.StringMap.mem prefsdocsPrefName argv then begin
Prefs.printFullDocs();
exit 0
end;
(* Display documentation if requested *)
begin try
begin match Util.StringMap.find docsPrefName argv with
[] ->
assert false
| "topics"::_ ->
Printf.printf "Documentation topics:\n";
Safelist.iter
(fun (sn,(n,doc)) ->
if sn<>"" then Printf.printf " %12s %s\n" sn n)
Strings.docs;
Printf.printf
"\nType \"%s -doc \" for detailed information about \n"
Uutil.myName;
Printf.printf
"or \"%s -doc all\" for the whole manual\n\n"
Uutil.myName
| "all"::_ ->
Printf.printf "\n";
Safelist.iter
(fun (sn,(n,doc)) -> if n<>"Junk" then Printf.printf "%s\n" doc)
Strings.docs
| topic::_ ->
(try
let (_,d) = Safelist.assoc topic Strings.docs in
Printf.printf "\n%s\n" d
with
Not_found ->
Printf.printf "Documentation topic %s not recognized:"
topic;
Printf.printf "\nType \"%s -doc topics\" for a list\n"
Uutil.myName)
end;
exit 0
with Not_found -> () end;
(* Install an appropriate function for finding preference files. (We put
this in Util just because the Prefs module lives below the Os module in the
dependency hierarchy, so Prefs can't call Os directly.) *)
Util.supplyFileInUnisonDirFn
(fun n -> Os.fileInUnisonDir(n));
(* Start a server if requested *)
if Util.StringMap.mem serverPrefName argv then begin
catch_all (fun () ->
Os.createUnisonDir();
Remote.beAServer();
exit 0)
end;
(* Start a socket server if requested *)
begin try
let i = List.hd (Util.StringMap.find socketPrefName argv) in
catch_all (fun () ->
Os.createUnisonDir();
Remote.waitOnPort
(begin try
match Util.StringMap.find serverHostName argv with
[] -> None
| s :: _ -> Some s
with Not_found ->
None
end)
i);
exit 0
with Not_found -> () end;
argv
end
(* non-GUI startup for Mac GUI version *)
let nonGuiStartup() = begin
let argv = init() in (* might not return *)
(* if it returns start a UI *)
(try
(match Util.StringMap.find uiPrefName argv with
"text"::_ -> (Uitext.Body.start Uicommon.Text; exit 0)
| "graphic"::_ -> () (* fallthru *)
| _ -> Prefs.printUsage Uicommon.usageMsg; exit 1)
with Not_found -> ());
()
end
module Body = functor(Ui : Uicommon.UI) -> struct
let argv = init() in (* might not return *)
(* if it returns start a UI *)
Ui.start
(try
(match Util.StringMap.find uiPrefName argv with
"text"::_ -> Uicommon.Text
| "graphic"::_ -> Uicommon.Graphic
| _ -> Prefs.printUsage Uicommon.usageMsg; exit 1)
with Not_found -> Ui.defaultUi)
end
unison-2.40.102/uigtk.ml 0000644 0061316 0061316 00000225520 11361646373 015072 0 ustar bcpierce bcpierce (* $I1: Unison file synchronizer: src/uigtk.ml $ *)
(* $I2: Last modified by vouillon on Thu, 09 Sep 2004 08:43:03 -0400 $ *)
(* $I3: Copyright 1999-2004 (see COPYING for details) $ *)
open Common
open Lwt
module Private = struct
let debug = Trace.debug "ui"
(**********************************************************************
LOW-LEVEL STUFF
**********************************************************************)
(**********************************************************************
Some message strings (build them here because they look ugly in the
middle of other code.
**********************************************************************)
let tryAgainMessage =
Printf.sprintf
"You can use %s to synchronize a local directory with another local directory,
or with a remote directory.
Please enter the first (local) directory that you want to synchronize."
Uutil.myName
(* ---- *)
let helpmessage = Printf.sprintf
"%s can synchronize a local directory with another local directory, or with
a directory on a remote machine.
To synchronize with a local directory, just enter the file name.
To synchronize with a remote directory, you must first choose a protocol
that %s will use to connect to the remote machine. Each protocol has
different requirements:
1) To synchronize using SSH, there must be an SSH client installed on
this machine and an SSH server installed on the remote machine. You
must enter the host to connect to, a user name (if different from
your user name on this machine), and the directory on the remote machine
(relative to your home directory on that machine).
2) To synchronize using RSH, there must be an RSH client installed on
this machine and an RSH server installed on the remote machine. You
must enter the host to connect to, a user name (if different from
your user name on this machine), and the directory on the remote machine
(relative to your home directory on that machine).
3) To synchronize using %s's socket protocol, there must be a %s
server running on the remote machine, listening to the port that you
specify here. (Use \"%s -socket xxx\" on the remote machine to
start the %s server.) You must enter the host, port, and the directory
on the remote machine (relative to the working directory of the
%s server running on that machine)."
Uutil.myName Uutil.myName Uutil.myName Uutil.myName Uutil.myName Uutil.myName Uutil.myName
(**********************************************************************
Font preferences
**********************************************************************)
let fontMonospaceMedium =
if Util.osType = `Win32 then
lazy (Gdk.Font.load "-*-Courier New-Medium-R-Normal--*-110-*-*-*-*-*-*")
else
lazy (Gdk.Font.load "-*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-*")
let fontMonospaceBold =
if Util.osType = `Win32 then
lazy (Gdk.Font.load "-*-Courier New-Bold-R-Normal--*-110-*-*-*-*-*-*")
else
lazy (Gdk.Font.load "-*-Courier-Bold-R-Normal--*-120-*-*-*-*-*-*")
(*********************************************************************
UI state variables
*********************************************************************)
type stateItem = { mutable ri : reconItem;
mutable bytesTransferred : Uutil.Filesize.t;
mutable whatHappened : Util.confirmation option }
let theState = ref [||]
let current = ref None
(* ---- *)
let currentWindow = ref None
let grabFocus t =
match !currentWindow with
Some w -> t#set_transient_for w;
w#misc#set_sensitive false
| None -> ()
let releaseFocus () =
begin match !currentWindow with
Some w -> w#misc#set_sensitive true
| None -> ()
end
(*********************************************************************
Lock management
*********************************************************************)
let busy = ref false
let getLock f =
if !busy then
Trace.status "Synchronizer is busy, please wait.."
else begin
busy := true; f (); busy := false
end
(**********************************************************************
Miscellaneous
**********************************************************************)
let gtk_sync () = while Glib.Main.iteration false do () done
(**********************************************************************
USEFUL LOW-LEVEL WIDGETS
**********************************************************************)
class scrolled_text ?editable ?word_wrap ?width ?height ?packing ?show
() =
let sw =
GBin.scrolled_window ?width ?height ?packing ~show:false
~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ()
in
let text = GEdit.text ?editable ?word_wrap ~packing:sw#add () in
object
inherit GObj.widget_full sw#as_widget
method text = text
method insert ?(font=fontMonospaceMedium) s =
text#freeze ();
text#delete_text ~start:0 ~stop:text#length;
text#insert ~font:(Lazy.force font) s;
text#thaw ()
method show () = sw#misc#show ()
initializer
if show <> Some false then sw#misc#show ()
end
(* ------ *)
(* oneBox: Display a message in a window and wait for the user
to hit the button. *)
let oneBox ~title ~message ~label =
let t = GWindow.dialog ~title ~wm_name:title
~modal:true ~position:`CENTER () in
grabFocus t;
let h = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:20) () in
ignore(GMisc.label ~justify:`LEFT ~text:message
~packing:(h#pack ~expand:false ~padding:20) ());
let b = GButton.button ~label ~packing:t#action_area#add () in
b#grab_default ();
ignore (b#connect#clicked ~callback:(fun () -> t#destroy()));
t#show ();
(* Do nothing until user destroys window *)
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
releaseFocus ()
let okBox ~title ~message = oneBox ~title ~message ~label:"OK"
(* ------ *)
(* twoBox: Display a message in a window and wait for the user
to hit one of two buttons. Return true if the first button is
chosen, false if the second button is chosen. *)
let twoBox ~title ~message ~alabel ~blabel =
let result = ref false in
let t = GWindow.dialog ~title ~wm_name:title ~modal:true
~position:`CENTER () in
grabFocus t;
let h = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:20) () in
ignore(GMisc.label ~justify:`LEFT ~text:message
~packing:(h#pack ~expand:false ~padding:20) ());
(*
ignore(GMisc.label ~text:message
~packing:(t#vbox#pack ~expand:false ~padding:4) ());
*)
let yes = GButton.button ~label:alabel ~packing:t#action_area#add ()
and no = GButton.button ~label:blabel ~packing:t#action_area#add () in
yes#grab_default ();
ignore (yes#connect#clicked
~callback:(fun () -> t#destroy (); result := true));
ignore (no#connect#clicked
~callback:(fun () -> t#destroy (); result := false));
t#show ();
(* Do nothing until user destroys window *)
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
releaseFocus ();
!result
(* ------ *)
(* Avoid recursive invocations of the function below (a window receives
delete events even when it is not sensitive) *)
let inExit = ref false
let doExit () = Lwt_unix.run (Update.unlockArchives ()); exit 0
let safeExit () =
if not !inExit then begin
inExit := true;
if not !busy then exit 0 else
if twoBox ~title:"Premature exit"
~message:"Unison is working, exit anyway ?"
~alabel:"Yes" ~blabel:"No"
then exit 0;
inExit := false
end
(* ------ *)
(* warnBox: Display a warning message in a window and wait (unless
we're in batch mode) for the user to hit "OK" or "Exit". *)
let warnBox title message =
if Prefs.read Globals.batch then begin
(* In batch mode, just pop up a window and go ahead *)
let t = GWindow.dialog ~title ~wm_name:title ~position:`CENTER () in
let h = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:20) () in
ignore(GMisc.label ~justify:`LEFT ~text:message
~packing:(h#pack ~expand:false ~padding:20) ());
let t_dismiss =
GButton.button ~label:"Dismiss" ~packing:t#action_area#add () in
t_dismiss#grab_default ();
let dismiss () = t#destroy () in
ignore (t_dismiss#connect#clicked ~callback:dismiss);
ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true));
t#show ()
end else begin
inExit := true;
let ok = twoBox ~title ~message ~alabel:"OK" ~blabel:"Exit" in
if not(ok) then doExit ();
inExit := false
end
(**********************************************************************
CHARACTER SET TRANSCODING
***********************************************************************)
(* Transcodage from Microsoft Windows Codepage 1252 to Unicode *)
(* Unison currently uses the "ASCII" Windows filesystem API. With
this API, filenames are encoded using a proprietary character
encoding. This encoding depends on the Windows setup, but in
Western Europe, the Windows Codepage 1252 is usually used.
GTK, on the other hand, uses the UTF-8 encoding. This code perform
the translation from Codepage 1252 to UTF-8. A call to [transcode]
should be wrapped around every string below that might contain
non-ASCII characters. *)
let code =
[| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18;
19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34;
35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50;
51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66;
67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82;
83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98;
99; 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111;
112; 113; 114; 115; 116; 117; 118; 119; 120; 121; 122; 123; 124;
125; 126; 127; 8364; 129; 8218; 131; 8222; 8230; 8224; 8225; 136;
8240; 352; 8249; 346; 356; 381; 377; 144; 8216; 8217; 8220; 8221;
8226; 8211; 8212; 152; 8482; 353; 8250; 347; 357; 382; 378; 160;
711; 728; 321; 164; 260; 166; 167; 168; 169; 350; 171; 172; 173;
174; 379; 176; 177; 731; 322; 180; 181; 182; 183; 184; 261; 351;
187; 376; 733; 317; 380; 340; 193; 194; 258; 196; 313; 262; 199;
268; 201; 280; 203; 282; 205; 206; 270; 272; 323; 327; 211; 212;
336; 214; 215; 344; 366; 218; 368; 220; 221; 354; 223; 341; 225;
226; 259; 228; 314; 263; 231; 269; 233; 281; 235; 283; 237; 238;
271; 273; 324; 328; 243; 244; 337; 246; 247; 345; 367; 250; 369;
252; 253; 355; 729 |]
let rec transcode_rec buf s i l =
if i < l then begin
let c = code.(Char.code s.[i]) in
if c < 0x80 then
Buffer.add_char buf (Char.chr c)
else if c < 0x800 then begin
Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0));
Buffer.add_char buf (Char.chr (c land 0x3f + 0x80))
end else if c < 0x10000 then begin
Buffer.add_char buf (Char.chr (c lsr 12 + 0xE0));
Buffer.add_char buf (Char.chr ((c lsr 6) land 0x3f + 0x80));
Buffer.add_char buf (Char.chr (c land 0x3f + 0x80))
end;
transcode_rec buf s (i + 1) l
end
let transcode s =
if Util.osType = `Win32 then
let buf = Buffer.create 32 in
transcode_rec buf s 0 (String.length s);
Buffer.contents buf
else
s
(**********************************************************************
HIGHER-LEVEL WIDGETS
***********************************************************************)
(*
XXX
* Accurate write accounting:
- Local copies on the remote side are ignored
- What about failures?
*)
class stats width height =
let pixmap = GDraw.pixmap ~width ~height () in
let area =
pixmap#set_foreground `WHITE;
pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height ();
GMisc.pixmap pixmap ~width ~height ~xpad:4 ~ypad:8 ()
in
object (self)
inherit GObj.widget_full area#as_widget
val mutable maxim = ref 0.
val mutable scale = ref 1.
val mutable min_scale = 1.
val values = Array.make width 0.
val mutable active = false
method activate a = active <- a
method scale h = truncate ((float height) *. h /. !scale)
method private rect i v' v =
let h = self#scale v in
let h' = self#scale v' in
let h1 = min h' h in
let h2 = max h' h in
pixmap#set_foreground `BLACK;
pixmap#rectangle
~filled:true ~x:i ~y:(height - h1) ~width:1 ~height:h1 ();
for h = h1 + 1 to h2 do
let v = truncate (65535. *. (float (h - h1) /. float (h2 - h1))) in
pixmap#set_foreground (`RGB (v, v, v));
pixmap#rectangle
~filled:true ~x:i ~y:(height - h) ~width:1 ~height:1 ();
done
method push v =
let need_max = values.(0) = !maxim in
for i = 0 to width - 2 do
values.(i) <- values.(i + 1)
done;
values.(width - 1) <- v;
if need_max then begin
maxim := 0.;
for i = 0 to width - 1 do maxim := max !maxim values.(i) done
end else
maxim := max !maxim v;
if active then begin
let need_resize =
!maxim > !scale || (!maxim > min_scale && !maxim < !scale /. 1.5) in
if need_resize then begin
scale := min_scale;
while !maxim > !scale do
scale := !scale *. 1.5
done;
pixmap#set_foreground `WHITE;
pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height ();
pixmap#set_foreground `BLACK;
for i = 0 to width - 1 do
self#rect i values.(max 0 (i - 1)) values.(i)
done
end else begin
pixmap#put_pixmap ~x:0 ~y:0 ~xsrc:1 (pixmap#pixmap);
pixmap#set_foreground `WHITE;
pixmap#rectangle
~filled:true ~x:(width - 1) ~y:0 ~width:1 ~height ();
self#rect (width - 1) values.(width - 2) values.(width - 1)
end;
area#misc#draw None
end
end
let clientWritten = ref 0.
let serverWritten = ref 0.
let statistics () =
let title = "Statistics" in
let t = GWindow.dialog ~title ~wm_name:title () in
let t_dismiss =
GButton.button ~label:"Dismiss" ~packing:t#action_area#add () in
t_dismiss#grab_default ();
let dismiss () = t#misc#hide () in
ignore (t_dismiss#connect#clicked ~callback:dismiss);
ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true));
let emission = new stats 320 50 in
t#vbox#pack ~expand:false ~padding:4 (emission :> GObj.widget);
let reception = new stats 320 50 in
t#vbox#pack ~expand:false ~padding:4 (reception :> GObj.widget);
let lst =
GList.clist
~packing:(t#vbox#add)
~titles_active:false
~titles:[""; "Client"; "Server"; "Total"] ()
in
lst#set_column ~auto_resize:true 0;
lst#set_column ~auto_resize:true ~justification:`RIGHT 1;
lst#set_column ~auto_resize:true ~justification:`RIGHT 2;
lst#set_column ~auto_resize:true ~justification:`RIGHT 3;
ignore (lst#append ["Reception rate"]);
ignore (lst#append ["Data received"]);
ignore (lst#append ["File data written"]);
let style = lst#misc#style#copy in
style#set_font (Lazy.force fontMonospaceMedium);
for r = 0 to 2 do
lst#set_row ~selectable:false r;
for c = 1 to 3 do
lst#set_cell ~style r c
done
done;
ignore (t#event#connect#map (fun _ ->
emission#activate true;
reception#activate true;
false));
ignore (t#event#connect#unmap (fun _ ->
emission#activate false;
reception#activate false;
false));
let delay = 0.5 in
let a = 0.5 in
let b = 0.8 in
let emittedBytes = ref 0. in
let emitRate = ref 0. in
let emitRate2 = ref 0. in
let receivedBytes = ref 0. in
let receiveRate = ref 0. in
let receiveRate2 = ref 0. in
let timeout _ =
emitRate :=
a *. !emitRate +.
(1. -. a) *. (!Remote.emittedBytes -. !emittedBytes) /. delay;
emitRate2 :=
b *. !emitRate2 +.
(1. -. b) *. (!Remote.emittedBytes -. !emittedBytes) /. delay;
emission#push !emitRate;
receiveRate :=
a *. !receiveRate +.
(1. -. a) *. (!Remote.receivedBytes -. !receivedBytes) /. delay;
receiveRate2 :=
b *. !receiveRate2 +.
(1. -. b) *. (!Remote.receivedBytes -. !receivedBytes) /. delay;
reception#push !receiveRate;
emittedBytes := !Remote.emittedBytes;
receivedBytes := !Remote.receivedBytes;
let kib2str v = Format.sprintf "%.0f B" v in
let rate2str v =
if v > 9.9e3 then begin
if v > 9.9e6 then
Format.sprintf "%4.0f MiB/s" (v /. 1e6)
else if v > 999e3 then
Format.sprintf "%4.1f MiB/s" (v /. 1e6)
else
Format.sprintf "%4.0f KiB/s" (v /. 1e3)
end else begin
if v > 990. then
Format.sprintf "%4.1f KiB/s" (v /. 1e3)
else if v > 99. then
Format.sprintf "%4.2f KiB/s" (v /. 1e3)
else
" "
end
in
lst#set_cell ~text:(rate2str !receiveRate2) 0 1;
lst#set_cell ~text:(rate2str !emitRate2) 0 2;
lst#set_cell ~text:
(rate2str (!receiveRate2 +. !emitRate2)) 0 3;
lst#set_cell ~text:(kib2str !receivedBytes) 1 1;
lst#set_cell ~text:(kib2str !emittedBytes) 1 2;
lst#set_cell ~text:
(kib2str (!receivedBytes +. !emittedBytes)) 1 3;
lst#set_cell ~text:(kib2str !clientWritten) 2 1;
lst#set_cell ~text:(kib2str !serverWritten) 2 2;
lst#set_cell ~text:
(kib2str (!clientWritten +. !serverWritten)) 2 3;
true
in
ignore (GMain.Timeout.add ~ms:(truncate (delay *. 1000.)) ~callback:timeout);
t
(****)
(* Standard file dialog *)
let file_dialog ~title ~callback ?filename () =
let sel = GWindow.file_selection ~title ~modal:true ?filename () in
grabFocus sel;
ignore (sel#cancel_button#connect#clicked ~callback:sel#destroy);
ignore (sel#ok_button#connect#clicked ~callback:
(fun () ->
let name = sel#get_filename in
sel#destroy ();
callback name));
sel#show ();
ignore (sel#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
releaseFocus ()
(* ------ *)
let fatalError message =
Trace.log ((transcode message) ^ "\n");
oneBox ~title:(Printf.sprintf "%s: Fatal error"
(String.capitalize Uutil.myName))
~message ~label:"Quit"
(* ------ *)
let tryAgainOrQuit message =
twoBox ~title:"Error" ~message ~alabel:"Try again" ~blabel:"Quit";;
(* ------ *)
let getFirstRoot() =
let t = GWindow.dialog ~title:"Root selection" ~wm_name:"Root selection"
~modal:true ~allow_grow:true () in
t#misc#grab_focus ();
let hb = GPack.hbox
~packing:(t#vbox#pack ~expand:false ~padding:15) () in
ignore(GMisc.label ~text:tryAgainMessage
~justify:`LEFT
~packing:(hb#pack ~expand:false ~padding:15) ());
let f1 = GPack.hbox ~spacing:4
~packing:(t#vbox#pack ~expand:true ~padding:4) () in
ignore (GMisc.label ~text:"Dir:" ~packing:(f1#pack ~expand:false) ());
let fileE = GEdit.entry ~packing:f1#add () in
fileE#misc#grab_focus ();
let browseCommand() =
file_dialog ~title:"Select a local directory"
~callback:fileE#set_text ~filename:fileE#text () in
let b = GButton.button ~label:"Browse"
~packing:(f1#pack ~expand:false) () in
ignore (b#connect#clicked ~callback:browseCommand);
let f3 = t#action_area in
let result = ref None in
let contCommand() =
result := Some(fileE#text);
t#destroy () in
let contButton = GButton.button ~label:"Continue" ~packing:f3#add () in
ignore (contButton#connect#clicked ~callback:contCommand);
ignore (fileE#connect#activate ~callback:contCommand);
contButton#grab_default ();
let quitButton = GButton.button ~label:"Quit" ~packing:f3#add () in
ignore (quitButton#connect#clicked
~callback:(fun () -> result := None; t#destroy()));
t#show ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
match !result with None -> None
| Some file ->
Some(Clroot.clroot2string(Clroot.ConnectLocal(Some file)))
(* ------ *)
let getSecondRoot () =
let t = GWindow.dialog ~title:"Root selection" ~wm_name:"Root selection"
~modal:true ~allow_grow:true () in
t#misc#grab_focus ();
let message = "Please enter the second directory you want to synchronize." in
let vb = t#vbox in
let hb = GPack.hbox ~packing:(vb#pack ~expand:false ~padding:15) () in
ignore(GMisc.label ~text:message
~justify:`LEFT
~packing:(hb#pack ~expand:false ~padding:15) ());
let helpB = GButton.button ~label:"Help" ~packing:hb#add () in
ignore (helpB#connect#clicked
~callback:(fun () -> okBox ~title:"Picking roots"
~message:helpmessage));
let result = ref None in
let f = GPack.vbox ~packing:(vb#pack ~expand:false) () in
let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in
ignore (GMisc.label ~text:"Directory:" ~packing:(f1#pack ~expand:false) ());
let fileE = GEdit.entry ~packing:f1#add () in
fileE#misc#grab_focus ();
let browseCommand() =
file_dialog ~title:"Select a local directory"
~callback:fileE#set_text ~filename:fileE#text () in
let b = GButton.button ~label:"Browse"
~packing:(f1#pack ~expand:false) () in
ignore (b#connect#clicked ~callback:browseCommand);
let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in
let localB = GButton.radio_button ~packing:(f0#pack ~expand:false)
~label:"Local" () in
let sshB = GButton.radio_button ~group:localB#group
~packing:(f0#pack ~expand:false)
~label:"SSH" () in
let rshB = GButton.radio_button ~group:localB#group
~packing:(f0#pack ~expand:false) ~label:"RSH" () in
let socketB = GButton.radio_button ~group:sshB#group
~packing:(f0#pack ~expand:false) ~label:"Socket" () in
let f2 = GPack.hbox ~spacing:4 ~packing:f#add () in
ignore (GMisc.label ~text:"Host:" ~packing:(f2#pack ~expand:false) ());
let hostE = GEdit.entry ~packing:f2#add () in
ignore (GMisc.label ~text:"(Optional) User:"
~packing:(f2#pack ~expand:false) ());
let userE = GEdit.entry ~packing:f2#add () in
ignore (GMisc.label ~text:"Port:"
~packing:(f2#pack ~expand:false) ());
let portE = GEdit.entry ~packing:f2#add () in
let varLocalRemote = ref (`Local : [`Local|`SSH|`RSH|`SOCKET]) in
let localState() =
varLocalRemote := `Local;
hostE#misc#set_sensitive false;
userE#misc#set_sensitive false;
portE#misc#set_sensitive false;
b#misc#set_sensitive true in
let remoteState() =
hostE#misc#set_sensitive true;
b#misc#set_sensitive false;
match !varLocalRemote with
`SOCKET ->
(portE#misc#set_sensitive true; userE#misc#set_sensitive false)
| _ ->
(portE#misc#set_sensitive false; userE#misc#set_sensitive true) in
let protoState x =
varLocalRemote := x;
remoteState() in
ignore (localB#connect#clicked ~callback:localState);
ignore (sshB#connect#clicked ~callback:(fun () -> protoState(`SSH)));
ignore (rshB#connect#clicked ~callback:(fun () -> protoState(`RSH)));
ignore (socketB#connect#clicked ~callback:(fun () -> protoState(`SOCKET)));
localState();
let getRoot() =
let file = fileE#text in
let user = userE#text in
let host = hostE#text in
match !varLocalRemote with
`Local ->
Clroot.clroot2string(Clroot.ConnectLocal(Some file))
| `SSH | `RSH ->
Clroot.clroot2string(
Clroot.ConnectByShell((if !varLocalRemote=`SSH then "ssh" else "rsh"),
host,
(if user="" then None else Some user),
Some portE#text,
Some file))
| `SOCKET ->
Clroot.clroot2string(
(* FIX: report an error if the port entry is not well formed *)
Clroot.ConnectBySocket(host,
portE#text,
Some file)) in
let contCommand() =
try
let root = getRoot() in
result := Some root;
t#destroy ()
with Failure "int_of_string" ->
if portE#text="" then
okBox ~title:"Error" ~message:"Please enter a port"
else okBox ~title:"Error"
~message:"The port you specify must be an integer"
| _ ->
okBox ~title:"Error"
~message:"Something's wrong with the values you entered, try again" in
let f3 = t#action_area in
let contButton = GButton.button ~label:"Continue" ~packing:f3#add () in
ignore (contButton#connect#clicked ~callback:contCommand);
contButton#grab_default ();
ignore (fileE#connect#activate ~callback:contCommand);
let quitButton = GButton.button ~label:"Quit" ~packing:f3#add () in
ignore (quitButton#connect#clicked ~callback:safeExit);
t#show ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
!result
(* ------ *)
type profileInfo = {roots:string list; label:string option}
(* ------ *)
let termInteract() =
(*
if Util.isOSX then Some(fun s -> "") (*FIXTJ*)
else
*)
None
(* ------ *)
let profileKeymap = Array.create 10 None
let provideProfileKey filename k profile info =
try
let i = int_of_string k in
if 0<=i && i<=9 then
match profileKeymap.(i) with
None -> profileKeymap.(i) <- Some(profile,info)
| Some(otherProfile,_) ->
raise (Util.Fatal
("Error scanning profile "^filename^":\n"
^ "shortcut key "^k^" is already bound to profile "
^ otherProfile))
else
raise (Util.Fatal
("Error scanning profile "^filename^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
with int_of_string -> raise (Util.Fatal
("Error scanning profile "^filename^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
(* ------ *)
let profilesAndRoots = ref []
let scanProfiles () =
Array.iteri (fun i _ -> profileKeymap.(i) <- None) profileKeymap;
profilesAndRoots :=
(Safelist.map
(fun f ->
let f = Filename.chop_suffix f ".prf" in
let filename = Prefs.profilePathname f in
let fileContents = Safelist.map (fun (_, _, n, v) -> (n, v)) (Prefs.readAFile f) in
let roots =
Safelist.map snd
(Safelist.filter (fun (n, _) -> n = "root") fileContents) in
let label =
try Some(Safelist.assoc "label" fileContents)
with Not_found -> None in
let info = {roots=roots; label=label} in
(* If this profile has a 'key' binding, put it in the keymap *)
(try
let k = Safelist.assoc "key" fileContents in
provideProfileKey filename k f info
with Not_found -> ());
(f, info))
(Safelist.filter (fun name -> not ( Util.startswith name ".#"
|| Util.startswith name Os.tempFilePrefix))
(Files.ls Os.unisonDir "*.prf")))
let getProfile () =
(* The selected profile *)
let result = ref None in
(* Build the dialog *)
let t = GWindow.dialog ~title:"Profiles" ~wm_name:"Profiles" ~width:400 () in
let okCommand() =
currentWindow := None;
t#destroy () in
let okButton = GButton.button ~label:"OK" ~packing:t#action_area#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#misc#set_sensitive false;
okButton#grab_default ();
let cancelCommand() = t#destroy (); exit 0 in
let cancelButton = GButton.button ~label:"Cancel"
~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
cancelButton#misc#set_can_default true;
let vb = t#vbox in
ignore (GMisc.label
~text:"Select an existing profile or create a new one"
~xpad:2 ~ypad:5 ~packing:(vb#pack ~expand:false) ());
let sw =
GBin.scrolled_window ~packing:(vb#add) ~height:200
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
let lst = GList.clist_poly ~selection_mode:`BROWSE ~packing:(sw#add) () in
let selRow = ref 0 in
let fillLst default =
scanProfiles();
lst#freeze ();
lst#clear ();
let i = ref 0 in (* FIX: Work around a lablgtk bug *)
Safelist.iter
(fun (profile, info) ->
let labeltext =
match info.label with None -> "" | Some(l) -> " ("^l^")" in
let s = profile ^ labeltext in
ignore (lst#append [s]);
if profile = default then selRow := !i;
lst#set_row_data !i (profile, info);
incr i)
(Safelist.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots);
let r = lst#rows in
let p = if r < 2 then 0. else float !selRow /. float (r - 1) in
lst#scroll_vertical `JUMP p;
lst#thaw () in
let tbl =
GPack.table ~rows:2 ~columns:2 ~packing:(vb#pack ~expand:true) () in
tbl#misc#set_sensitive false;
ignore (GMisc.label ~text:"Root 1:" ~xpad:2
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Root 2:" ~xpad:2
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let root1 =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X)
~editable:false () in
let root2 =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X)
~editable:false () in
root1#misc#set_can_focus false;
root2#misc#set_can_focus false;
let hb =
GPack.hbox ~border_width:2 ~spacing:2 ~packing:(vb#pack ~expand:false) ()
in
let nw =
GButton.button ~label:"Create new profile"
~packing:(hb#pack ~expand:false) () in
ignore (nw#connect#clicked ~callback:(fun () ->
let t =
GWindow.dialog ~title:"New profile" ~wm_name:"New profile" ~modal:true ()
in
let vb = GPack.vbox ~border_width:4 ~packing:t#vbox#add () in
let f = GPack.vbox ~packing:(vb#pack ~expand:true ~padding:4) () in
let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in
ignore (GMisc.label ~text:"Profile name:"
~packing:(f0#pack ~expand:false) ());
let prof = GEdit.entry ~packing:f0#add () in
prof#misc#grab_focus ();
let exit () = t#destroy (); GMain.Main.quit () in
ignore (t#event#connect#delete ~callback:(fun _ -> exit (); true));
let f3 = t#action_area in
let okCommand () =
let profile = prof#text in
if profile <> "" then
let filename = Prefs.profilePathname profile in
if System.file_exists filename then
okBox
~title:(Uutil.myName ^ " error")
~message:("Profile \""
^ profile
^ "\" already exists!\nPlease select another name.")
else
(* Make an empty file *)
let ch =
System.open_out_gen
[Open_wronly; Open_creat; Open_trunc] 0o600 filename in
close_out ch;
fillLst profile;
exit () in
let okButton = GButton.button ~label:"OK" ~packing:f3#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#grab_default ();
let cancelButton = GButton.button ~label:"Cancel" ~packing:f3#add () in
ignore (cancelButton#connect#clicked ~callback:exit);
t#show ();
grabFocus t;
GMain.Main.main ();
releaseFocus ()));
ignore (lst#connect#unselect_row ~callback:(fun ~row:_ ~column:_ ~event:_ ->
root1#set_text ""; root2#set_text "";
result := None;
tbl#misc#set_sensitive false;
okButton#misc#set_sensitive false));
let select_row i =
(* Inserting the first row triggers the signal, even before the row
data is set. So, we need to catch the corresponding exception *)
(try
let (profile, info) = lst#get_row_data i in
result := Some profile;
begin match info.roots with
[r1; r2] -> root1#set_text r1; root2#set_text r2;
tbl#misc#set_sensitive true
| _ -> root1#set_text ""; root2#set_text "";
tbl#misc#set_sensitive false
end;
okButton#misc#set_sensitive true
with Gpointer.Null -> ()) in
ignore (lst#connect#select_row
~callback:(fun ~row:i ~column:_ ~event:_ -> select_row i));
ignore (lst#event#connect#button_press ~callback:(fun ev ->
match GdkEvent.get_type ev with
`TWO_BUTTON_PRESS ->
okCommand ();
true
| _ ->
false));
fillLst "default";
select_row !selRow;
lst#misc#grab_focus ();
currentWindow := Some (t :> GWindow.window);
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
!result
(* ------ *)
let documentation sect =
let title = "Documentation" in
let t = GWindow.dialog ~title ~wm_name:title () in
let t_dismiss =
GButton.button ~label:"Dismiss" ~packing:t#action_area#add () in
t_dismiss#grab_default ();
let dismiss () = t#destroy () in
ignore (t_dismiss#connect#clicked ~callback:dismiss);
ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true));
let (name, docstr) = List.assoc sect Strings.docs in
let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:2) () in
let optionmenu =
GMenu.option_menu ~packing:(hb#pack ~expand:true ~fill:false) () in
let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in
let charH = 16 in
let t_text =
new scrolled_text ~editable:false
~width:(charW * 80) ~height:(charH * 20) ~packing:t#vbox#add ()
in
t_text#insert docstr;
let sect_idx = ref 0 in
let idx = ref 0 in
let menu = GMenu.menu () in
let addDocSection (shortname, (name, docstr)) =
if shortname <> "" && name <> "" then begin
if shortname = sect then sect_idx := !idx;
incr idx;
let item = GMenu.menu_item ~label:name ~packing:menu#append () in
ignore
(item#connect#activate ~callback:(fun () -> t_text#insert docstr))
end
in
Safelist.iter addDocSection Strings.docs;
optionmenu#set_menu menu;
optionmenu#set_history !sect_idx;
t#show ()
(* ------ *)
let messageBox ~title ?(label = "Dismiss") ?(action = fun t -> t#destroy)
?(modal = false) message =
let t = GWindow.dialog ~title ~wm_name:title ~modal ~position:`CENTER () in
let t_dismiss = GButton.button ~label ~packing:t#action_area#add () in
t_dismiss#grab_default ();
ignore (t_dismiss#connect#clicked ~callback:(action t));
let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in
let charH = 16 in
let t_text =
new scrolled_text ~editable:false
~width:(charW * 80) ~height:(charH * 20) ~packing:t#vbox#add ()
in
t_text#insert (transcode message);
ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true));
t#show ();
if modal then begin
grabFocus t;
GMain.Main.main ();
releaseFocus ()
end
(**********************************************************************
TOP-LEVEL WINDOW
**********************************************************************)
let myWindow = ref None
let getMyWindow () =
if not (Prefs.read Uicommon.reuseToplevelWindows) then begin
(match !myWindow with Some(w) -> w#destroy() | None -> ());
myWindow := None;
end;
let w = match !myWindow with
Some(w) ->
Safelist.iter w#remove w#children;
w
| None ->
(* Used to be ~position:`CENTER -- maybe that was better... *)
GWindow.window ~kind:`TOPLEVEL ~position:`CENTER
~wm_name:Uutil.myName () in
myWindow := Some(w);
w#set_border_width 4;
w
(* ------ *)
let displayWaitMessage () =
if not (Prefs.read Uicommon.contactquietly) then begin
let w = getMyWindow() in
ignore (GMisc.label ~text: (Uicommon.contactingServerMsg()) ~packing:(w#add) ());
w#set_border_width 20;
w#show();
ignore (w#event#connect#delete ~callback:(fun _ -> exit 0))
end
(* ------ *)
let rec createToplevelWindow () =
let toplevelWindow = getMyWindow() in
let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in
(*******************************************************************
Statistic window
*******************************************************************)
(* FIX: currently statistics window unavailable in the Cygwin version;
enabling it causes core dump. *)
let stat_win =
(if Util.isCygwin then
GWindow.dialog ()
else
statistics ())
in
(*******************************************************************
Groups of things that are sensitive to interaction at the same time
*******************************************************************)
let grAction = ref [] in
let grDiff = ref [] in
let grGo = ref [] in
let grRestart = ref [] in
let grAdd gr w = gr := w#misc::!gr in
let grSet gr st = List.iter (fun x -> x#set_sensitive st) !gr in
(*********************************************************************
Create the menu bar
*********************************************************************)
let topHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in
let menuBar =
GMenu.menu_bar ~border_width:0
~packing:(topHBox#pack ~expand:true) () in
let menus = new GMenu.factory ~accel_modi:[] menuBar in
let accel_group = menus#accel_group in
toplevelWindow#add_accel_group accel_group;
let add_submenu ?(modi=[]) ~label () =
new GMenu.factory ~accel_group ~accel_modi:modi (menus#add_submenu label)
in
let profileLabel =
GMisc.label ~text:"" ~packing:(topHBox#pack ~expand:false ~padding:2) () in
let displayNewProfileLabel p =
let label = Prefs.read Uicommon.profileLabel in
let s =
if p="" then ""
else if p="default" then label
else if label="" then p
else p ^ " (" ^ label ^ ")" in
let s = if s="" then "" else "Profile: " ^ s in
profileLabel#set_text s
in
begin match !Prefs.profileName with
None -> ()
| Some(p) -> displayNewProfileLabel p
end;
(*********************************************************************
Create the menus
*********************************************************************)
let fileMenu = add_submenu ~label:"Synchronization" ()
and actionsMenu = add_submenu ~label:"Actions" ()
and ignoreMenu = add_submenu ~modi:[`SHIFT] ~label:"Ignore" ()
and sortMenu = add_submenu ~label:"Sort" ()
and helpMenu = add_submenu ~label:"Help" () in
(*********************************************************************
Create the main window
*********************************************************************)
let mainWindow =
let sw =
GBin.scrolled_window ~packing:(toplevelVBox#add)
~height:(Prefs.read Uicommon.mainWindowHeight * 12)
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GList.clist ~columns:5 ~titles_show:true
~selection_mode:`BROWSE ~packing:sw#add () in
mainWindow#misc#grab_focus ();
let setMainWindowColumnHeaders () =
(* FIX: roots2string should return a pair *)
let s = Uicommon.roots2string () in
Array.iteri
(fun i data ->
mainWindow#set_column
~title_active:false ~auto_resize:true ~title:data i)
[| " " ^ String.sub s 0 12 ^ " "; " Action ";
" " ^ String.sub s 15 12 ^ " "; " Status "; " Path" |];
let status_width =
let font = mainWindow#misc#style#font in
4 + max (Gdk.Font.string_width font "working")
(Gdk.Font.string_width font "skipped") in
mainWindow#set_column ~justification:`CENTER 1;
mainWindow#set_column
~justification:`CENTER ~auto_resize:false ~width:status_width 3 in
setMainWindowColumnHeaders();
(*********************************************************************
Create the details window
*********************************************************************)
let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in
let charH = if Util.osType = `Win32 then 20 else 16 in
let detailsWindow =
let sw =
GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:false)
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GEdit.text ~editable:false ~height:(3 * charH) ~width: (128 * charW)
~line_wrap:false ~packing:sw#add () in
detailsWindow#misc#set_can_focus false;
let style = detailsWindow#misc#style#copy in
style#set_font (Lazy.force fontMonospaceMedium);
detailsWindow#misc#set_style style;
let updateButtons () =
match !current with
None ->
grSet grAction false;
grSet grDiff false
| Some row ->
let (activate1, activate2) =
match !theState.(row).whatHappened, !theState.(row).ri.replicas with
| None, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) ->
(true, true)
| Some _, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) ->
(false, true)
| Some _, _ ->
(false, false)
| None, _ ->
(true, false) in
grSet grAction activate1;
grSet grDiff activate2 in
let makeRowVisible row =
if mainWindow#row_is_visible row <> `FULL then begin
let adj = mainWindow#vadjustment in
let current = adj#value
and upper = adj#upper and lower = adj#lower in
let v =
float row /. float (mainWindow#rows + 1) *. (upper-.lower) +. lower
in
adj#set_value (min v (upper -. adj#page_size))
end in
let makeFirstUnfinishedVisible pRiInFocus =
let im = Array.length !theState in
let rec find i =
if i >= im then () else
match pRiInFocus (!theState.(i).ri), !theState.(i).whatHappened with
true, None -> makeRowVisible i
| _ -> find (i+1) in
find 0
in
let updateDetails () =
detailsWindow#freeze ();
detailsWindow#delete_text ~start:0 ~stop:detailsWindow#length;
begin match !current with
None ->
()
| Some row ->
makeRowVisible row;
let details =
match !theState.(row).whatHappened with
None -> Uicommon.details2string !theState.(row).ri " "
| Some(Util.Succeeded) -> Uicommon.details2string !theState.(row).ri " "
| Some(Util.Failed(s)) -> s in
detailsWindow#insert
(transcode (Path.toString !theState.(row).ri.path));
detailsWindow#insert "\n";
detailsWindow#insert details
end;
(* Display text *)
detailsWindow#thaw ();
updateButtons () in
(*********************************************************************
Status window
*********************************************************************)
let statusHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in
let statusWindow =
GMisc.statusbar ~packing:(statusHBox#pack ~expand:true) () in
let statusContext = statusWindow#new_context ~name:"status" in
ignore (statusContext#push "");
let displayStatus m =
statusContext#pop ();
ignore (statusContext#push m);
(* Force message to be displayed immediately *)
gtk_sync ()
in
let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in
(* Tell the Trace module about the status printer *)
Trace.messageDisplayer := displayStatus;
Trace.statusFormatter := formatStatus;
Trace.sendLogMsgsToStderr := false;
(*********************************************************************
Functions used to print in the main window
*********************************************************************)
let select i =
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.) in
ignore (mainWindow#connect#unselect_row ~callback:
(fun ~row ~column ~event -> current := None; updateDetails ()));
ignore (mainWindow#connect#select_row ~callback:
(fun ~row ~column ~event -> current := Some row; updateDetails ()));
let nextInteresting () =
let l = Array.length !theState in
let start = match !current with Some i -> i + 1 | None -> 0 in
let rec loop i =
if i < l then
match !theState.(i).ri.replicas with
Different (_, _, dir, _)
when not (Prefs.read Uicommon.auto) || !dir = Conflict ->
select i
| _ ->
loop (i + 1) in
loop start in
let selectSomethingIfPossible () =
if !current=None then nextInteresting () in
let columnsOf i =
let oldPath = if i = 0 then Path.empty else !theState.(i-1).ri.path in
let status =
match !theState.(i).whatHappened with
None -> " "
| Some conf ->
match !theState.(i).ri.replicas with
Different(_,_,{contents=Conflict},_) | Problem _ ->
" "
| _ ->
match conf with
Util.Succeeded -> "done "
| Util.Failed _ -> "failed" in
let s = Uicommon.reconItem2string oldPath !theState.(i).ri status in
(* FIX: This is ugly *)
(String.sub s 0 8,
String.sub s 9 5,
String.sub s 15 8,
String.sub s 25 6,
String.sub s 32 (String.length s - 32)) in
let greenPixel = "00dd00" in
let redPixel = "ff2040" in
let yellowPixel = "999900" in
let lightbluePixel = "8888FF" in
let blackPixel = "000000" in
let buildPixmap p =
GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in
let buildPixmaps f c1 =
(buildPixmap (f c1), buildPixmap (f lightbluePixel)) in
let rightArrow = buildPixmaps Pixmaps.copyAB greenPixel in
let leftArrow = buildPixmaps Pixmaps.copyBA greenPixel in
let ignoreAct = buildPixmaps Pixmaps.ignore redPixel in
let doneIcon = buildPixmap Pixmaps.success in
let failedIcon = buildPixmap Pixmaps.failure in
let rightArrowBlack = buildPixmap (Pixmaps.copyAB blackPixel) in
let leftArrowBlack = buildPixmap (Pixmaps.copyBA blackPixel) in
let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in
let mergeLogoBlack = buildPixmap (Pixmaps.mergeLogo blackPixel) in
let displayArrow i j action =
let changedFromDefault = match !theState.(j).ri.replicas with
Different(_,_,{contents=curr},default) -> curr<>default
| _ -> false in
let sel pixmaps =
if changedFromDefault then snd pixmaps else fst pixmaps in
match action with
"<-?->" -> mainWindow#set_cell ~pixmap:(sel ignoreAct) i 1
| "<-M->" -> mainWindow#set_cell ~pixmap:(sel mergeLogo) i 1
| "---->" -> mainWindow#set_cell ~pixmap:(sel rightArrow) i 1
| "<----" -> mainWindow#set_cell ~pixmap:(sel leftArrow) i 1
| "error" -> mainWindow#set_cell ~pixmap:failedIcon i 1
| _ -> assert false in
let displayStatusIcon i status =
match status with
| "failed" -> mainWindow#set_cell ~pixmap:failedIcon i 3
| "done " -> mainWindow#set_cell ~pixmap:doneIcon i 3
| _ -> mainWindow#set_cell ~text:status i 3 in
let displayMain() =
(* The call to mainWindow#clear below side-effect current,
so we save the current value before we clear out the main window and
rebuild it. *)
let savedCurrent = !current in
mainWindow#freeze ();
mainWindow#clear ();
for i = Array.length !theState - 1 downto 0 do
let (r1, action, r2, status, path) = columnsOf i in
ignore (mainWindow#prepend [ r1; ""; r2; status; transcode path ]);
displayArrow 0 i action
done;
debug (fun()-> Util.msg "reset current to %s\n"
(match savedCurrent with None->"None" | Some(i) -> string_of_int i));
if savedCurrent <> None then current := savedCurrent;
selectSomethingIfPossible ();
begin match !current with Some idx -> select idx | None -> () end;
mainWindow#thaw ();
updateDetails ();
in
let redisplay i =
let (r1, action, r2, status, path) = columnsOf i in
mainWindow#freeze ();
mainWindow#set_cell ~text:r1 i 0;
displayArrow i i action;
mainWindow#set_cell ~text:r2 i 2;
displayStatusIcon i status;
mainWindow#set_cell ~text:(transcode path) i 4;
if status = "failed" then begin
mainWindow#set_cell
~text:(path ^ " [failed: click on this line for details]") i 4
end;
mainWindow#thaw ();
if !current = Some i then updateDetails ();
updateButtons () in
let globalProgressBar =
GMisc.statusbar ~packing:(statusHBox#pack ~expand:false) () in
let globalProgressContext = globalProgressBar#new_context ~name:"prog" in
ignore (globalProgressContext#push "");
let totalBytesToTransfer = ref Uutil.Filesize.zero in
let totalBytesTransferred = ref Uutil.Filesize.zero in
let displayGlobalProgress s =
globalProgressContext#pop ();
ignore (globalProgressContext#push s);
(* Force message to be displayed immediately *)
gtk_sync () in
let showGlobalProgress b =
(* Concatenate the new message *)
totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b;
let s =
Util.percent2string
(Uutil.Filesize.percentageOfTotalSize
!totalBytesTransferred !totalBytesToTransfer)
in
displayGlobalProgress (s^" ")
in
let initGlobalProgress b =
totalBytesToTransfer := b;
totalBytesTransferred := Uutil.Filesize.zero;
showGlobalProgress Uutil.Filesize.zero
in
let (root1,root2) = Globals.roots () in
let root1IsLocal = fst root1 = Local in
let root2IsLocal = fst root2 = Local in
let showProgress i bytes dbg =
(* XXX There should be a way to reset the amount of bytes transferred... *)
let i = Uutil.File.toLine i in
let item = !theState.(i) in
item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes;
let b = item.bytesTransferred in
let len = Common.riLength item.ri in
let newstatus =
if b = Uutil.Filesize.zero || len = Uutil.Filesize.zero then "start "
else if len = Uutil.Filesize.zero then
Printf.sprintf "%5s " (Uutil.Filesize.toString b)
else Util.percent2string (Uutil.Filesize.percentageOfTotalSize b len) in
let dbg = if Trace.enabled "progress" then dbg ^ "/" else "" in
let newstatus = dbg ^ newstatus in
mainWindow#set_cell ~text:newstatus i 3;
showGlobalProgress bytes;
gtk_sync ();
begin match item.ri.replicas with
Different (_, _, dir, _) ->
begin match !dir with
Replica1ToReplica2 ->
if root2IsLocal then
clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes
else
serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes
| Replica2ToReplica1 ->
if root1IsLocal then
clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes
else
serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes
| Conflict | Merge ->
(* Diff / merge *)
clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes
end
| _ ->
assert false
end
in
(* Install showProgress so that we get called back by low-level
file transfer stuff *)
Uutil.setProgressPrinter showProgress;
(* Apply new ignore patterns to the current state, expecting that the
number of reconitems will grow smaller. Adjust the display, being
careful to keep the cursor as near as possible to its position
before the new ignore patterns take effect. *)
let ignoreAndRedisplay () =
let lst = Array.to_list !theState in
(* FIX: we should actually test whether any prefix is now ignored *)
let keep sI = not (Globals.shouldIgnore sI.ri.path) in
begin match !current with
None ->
theState := Array.of_list (Safelist.filter keep lst)
| Some index ->
let i = ref index in
let l = ref [] in
Array.iteri
(fun j sI -> if keep sI then l := sI::!l
else if j < !i then decr i)
!theState;
theState := Array.of_list (Safelist.rev !l);
current := if !l = [] then None
else Some (min (!i) ((Array.length !theState) - 1));
end;
displayMain() in
let sortAndRedisplay () =
current := None;
let compareRIs = Sortri.compareReconItems() in
Array.stable_sort (fun si1 si2 -> compareRIs si1.ri si2.ri) !theState;
displayMain() in
(******************************************************************
Main detect-updates-and-reconcile logic
******************************************************************)
let detectUpdatesAndReconcile () =
grSet grAction false;
grSet grDiff false;
grSet grGo false;
grSet grRestart false;
let (r1,r2) = Globals.roots () in
let t = Trace.startTimer "Checking for updates" in
let findUpdates () =
Trace.status "Looking for changes";
let updates = Update.findUpdates () in
Trace.showTimer t;
updates in
let reconcile updates =
let t = Trace.startTimer "Reconciling" in
Recon.reconcileAll updates in
let (reconItemList, thereAreEqualUpdates, dangerousPaths) =
reconcile (findUpdates ()) in
Trace.showTimer t;
if reconItemList = [] then
if thereAreEqualUpdates then
Trace.status "Replicas have been changed only in identical ways since last sync"
else
Trace.status "Everything is up to date"
else
Trace.status "Check and/or adjust selected actions; then press Go";
theState :=
Array.of_list
(Safelist.map
(fun ri -> { ri = ri; bytesTransferred = Uutil.Filesize.zero;
whatHappened = None })
reconItemList);
current := None;
displayMain();
grSet grGo (Array.length !theState > 0);
grSet grRestart true;
if dangerousPaths <> [] then begin
Prefs.set Globals.batch false;
Util.warn (Uicommon.dangerousPathMsg dangerousPaths)
end;
in
(*********************************************************************
Help menu
*********************************************************************)
let addDocSection (shortname, (name, docstr)) =
if shortname <> "" && name <> "" then
ignore (helpMenu#add_item
~callback:(fun () -> documentation shortname)
name) in
Safelist.iter addDocSection Strings.docs;
(*********************************************************************
Ignore menu
*********************************************************************)
let addRegExpByPath pathfunc =
match !current with
Some i ->
Uicommon.addIgnorePattern (pathfunc !theState.(i).ri.path);
ignoreAndRedisplay ()
| None ->
() in
grAdd grAction
(ignoreMenu#add_item ~key:GdkKeysyms._i
~callback:(fun () -> getLock (fun () ->
addRegExpByPath Uicommon.ignorePath))
"Permanently ignore this path");
grAdd grAction
(ignoreMenu#add_item ~key:GdkKeysyms._E
~callback:(fun () -> getLock (fun () ->
addRegExpByPath Uicommon.ignoreExt))
"Permanently ignore files with this extension");
grAdd grAction
(ignoreMenu#add_item ~key:GdkKeysyms._N
~callback:(fun () -> getLock (fun () ->
addRegExpByPath Uicommon.ignoreName))
"Permanently ignore files with this name (in any dir)");
(*
grAdd grRestart
(ignoreMenu#add_item ~callback:
(fun () -> getLock ignoreDialog) "Edit ignore patterns");
*)
(*********************************************************************
Sort menu
*********************************************************************)
grAdd grAction
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortByName();
sortAndRedisplay()))
"Sort entries by name");
grAdd grAction
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortBySize();
sortAndRedisplay()))
"Sort entries by size");
grAdd grAction
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortNewFirst();
sortAndRedisplay()))
"Sort new entries first");
grAdd grAction
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.restoreDefaultSettings();
sortAndRedisplay()))
"Go back to default ordering");
(*********************************************************************
Main function : synchronize
*********************************************************************)
let synchronize () =
if Array.length !theState = 0 then
Trace.status "Nothing to synchronize"
else begin
grSet grAction false;
grSet grDiff false;
grSet grGo false;
grSet grRestart false;
Trace.status "Propagating changes";
Transport.logStart ();
let totalLength =
Array.fold_left
(fun l si -> Uutil.Filesize.add l (Common.riLength si.ri))
Uutil.Filesize.zero !theState in
displayGlobalProgress " ";
initGlobalProgress totalLength;
let t = Trace.startTimer "Propagating changes" in
let im = Array.length !theState in
let rec loop i actions pRiThisRound =
if i < im then begin
let theSI = !theState.(i) in
let action =
match theSI.whatHappened with
None ->
if not (pRiThisRound theSI.ri) then
return ()
else
catch (fun () ->
Transport.transportItem
theSI.ri (Uutil.File.ofLine i)
(fun title text ->
Trace.status (Printf.sprintf "\n%s\n\n%s\n\n" title text); true)
>>= (fun () ->
return Util.Succeeded))
(fun e ->
match e with
Util.Transient s ->
return (Util.Failed s)
| _ ->
fail e)
>>= (fun res ->
theSI.whatHappened <- Some res;
redisplay i;
makeFirstUnfinishedVisible pRiThisRound;
gtk_sync ();
return ())
| Some _ ->
return () (* Already processed this one (e.g. merged it) *)
in
loop (i + 1) (action :: actions) pRiThisRound
end else
return actions
in
Lwt_unix.run
(loop 0 [] (fun ri -> not (Common.isDeletion ri)) >>= (fun actions ->
Lwt_util.join actions));
Lwt_unix.run
(loop 0 [] Common.isDeletion >>= (fun actions ->
Lwt_util.join actions));
Transport.logFinish ();
Trace.showTimer t;
Trace.status "Updating synchronizer state";
let t = Trace.startTimer "Updating synchronizer state" in
Update.commitUpdates();
Trace.showTimer t;
let failures =
let count =
Array.fold_left
(fun l si ->
l + (match si.whatHappened with Some(Util.Failed(_)) -> 1 | _ -> 0))
0 !theState in
if count = 0 then "" else
Printf.sprintf "%d failure%s" count (if count=1 then "" else "s") in
let skipped =
let count =
Array.fold_left
(fun l si ->
l + (if problematic si.ri then 1 else 0))
0 !theState in
if count = 0 then "" else
Printf.sprintf "%d skipped" count in
Trace.status
(Printf.sprintf "Synchronization complete %s%s%s"
failures (if failures=""||skipped="" then "" else ", ") skipped);
displayGlobalProgress "";
grSet grRestart true
end in
(*********************************************************************
Action bar
*********************************************************************)
let actionBar =
GButton.toolbar
~orientation:`HORIZONTAL ~tooltips:true ~space_size:10
~packing:(toplevelVBox#pack ~expand:false) () in
(*********************************************************************
Quit button
*********************************************************************)
actionBar#insert_space ();
ignore (actionBar#insert_button ~text:"Quit" ~callback:safeExit ());
(*********************************************************************
Go button
*********************************************************************)
actionBar#insert_space ();
grAdd grGo
(actionBar#insert_button ~text:"Go"
(* tooltip:"Go with displayed actions" *)
~callback:(fun () ->
getLock synchronize) ());
(*********************************************************************
Restart button
*********************************************************************)
let detectCmdName = "Restart" in
let detectCmd () =
getLock detectUpdatesAndReconcile;
if Prefs.read Globals.batch then begin
Prefs.set Globals.batch false; synchronize()
end
in
actionBar#insert_space ();
grAdd grRestart
(actionBar#insert_button ~text:detectCmdName ~callback:detectCmd ());
(*********************************************************************
Buttons for <--, M, -->, Skip
*********************************************************************)
let doAction f =
match !current with
Some i ->
let theSI = !theState.(i) in
begin match theSI.whatHappened, theSI.ri.replicas with
None, Different(_, _, dir, _) ->
f dir;
redisplay i;
nextInteresting ()
| _ ->
()
end
| None ->
() in
let leftAction _ = doAction (fun dir -> dir := Replica2ToReplica1) in
let rightAction _ = doAction (fun dir -> dir := Replica1ToReplica2) in
let questionAction _ = doAction (fun dir -> dir := Conflict) in
let mergeAction _ = doAction (fun dir -> dir := Merge) in
actionBar#insert_space ();
grAdd grAction
(actionBar#insert_button
~icon:((GMisc.pixmap leftArrowBlack ())#coerce)
~callback:leftAction ());
actionBar#insert_space ();
grAdd grAction
(actionBar#insert_button
~icon:((GMisc.pixmap mergeLogoBlack())#coerce)
~callback:mergeAction ());
actionBar#insert_space ();
grAdd grAction
(actionBar#insert_button
~icon:((GMisc.pixmap rightArrowBlack ())#coerce)
~callback:rightAction ());
actionBar#insert_space ();
grAdd grAction
(actionBar#insert_button ~text:"Skip" ~callback:questionAction ());
(*********************************************************************
Diff / merge buttons
*********************************************************************)
let diffCmd () =
match !current with
Some i ->
getLock (fun () ->
Uicommon.showDiffs !theState.(i).ri
(fun title text -> messageBox ~title text)
Trace.status (Uutil.File.ofLine i))
| None ->
() in
actionBar#insert_space ();
grAdd grDiff (actionBar#insert_button ~text:"Diff" ~callback:diffCmd ());
(*
let mergeCmd () =
match !current with
Some i ->
getLock (fun () ->
toplevelWindow#misc#set_sensitive false;
begin try
Uicommon.applyMerge !theState.(i).ri
(Uutil.File.ofLine i)
(fun title text ->
Trace.status (Printf.sprintf "%s: %s" title text))
true;
!theState.(i).whatHappened <- Some(Util.Succeeded);
toplevelWindow#misc#set_sensitive true
with
Util.Transient(s) ->
toplevelWindow#misc#set_sensitive true;
oneBox "Merge failed" s "Continue"
end;
redisplay i;
nextInteresting();
gtk_sync())
| None ->
()
in
actionBar#insert_space ();
grAdd grDiff (actionBar#insert_button ~text:"Merge" ~callback:mergeCmd ());
*)
(*********************************************************************
Keyboard commands
*********************************************************************)
ignore
(mainWindow#event#connect#key_press ~callback:
begin fun ev ->
let key = GdkEvent.Key.keyval ev in
if key = GdkKeysyms._Left then begin
leftAction (); GtkSignal.stop_emit (); true
end else if key = GdkKeysyms._Right then begin
rightAction (); GtkSignal.stop_emit (); true
end else
false
end);
(*********************************************************************
Action menu
*********************************************************************)
let (root1,root2) = Globals.roots () in
let loc1 = root2hostname root1 in
let loc2 = root2hostname root2 in
let descr =
if loc1 = loc2 then "left to right" else
Printf.sprintf "from %s to %s" loc1 loc2 in
let left =
actionsMenu#add_item ~key:GdkKeysyms._greater ~callback:rightAction
("Propagate this path " ^ descr) in
grAdd grAction left;
left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater;
let merge = actionsMenu#add_item ~key:GdkKeysyms._m ~callback:mergeAction
"Merge the files" in
grAdd grAction merge;
merge#add_accelerator ~group:accel_group GdkKeysyms._m;
let descl =
if loc1 = loc2 then "right to left" else
Printf.sprintf "from %s to %s" loc2 loc1 in
let right =
actionsMenu#add_item ~key:GdkKeysyms._less ~callback:leftAction
("Propagate this path " ^ descl) in
grAdd grAction right;
right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._less;
grAdd grAction
(actionsMenu#add_item ~key:GdkKeysyms._slash ~callback:questionAction
"Do not propagate changes to this path");
(* Override actions *)
ignore (actionsMenu#add_separator ());
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Replica1ToReplica2 `Prefer)
!theState;
displayMain()))
"Resolve all conflicts in favor of first root");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Replica2ToReplica1 `Prefer)
!theState;
displayMain()))
"Resolve all conflicts in favor of second root");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Newer `Prefer)
!theState;
displayMain()))
"Resolve all conflicts in favor of most recently modified");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Older `Prefer)
!theState;
displayMain()))
"Resolve all conflicts in favor of least recently modified");
ignore (actionsMenu#add_separator ());
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Replica1ToReplica2 `Force)
!theState;
displayMain()))
"Force all changes from first root to second");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Replica2ToReplica1 `Force)
!theState;
displayMain()))
"Force all changes from second root to first");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Newer `Force)
!theState;
displayMain()))
"Force newer files to replace older ones");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Older `Force)
!theState;
displayMain()))
"Force older files to replace newer ones");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.setDirection si.ri `Merge `Force)
!theState;
displayMain()))
"Revert all paths to the merging default, if avaible");
ignore (actionsMenu#add_separator ());
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
Array.iter
(fun si -> Recon.revertToDefaultDirection si.ri)
!theState;
displayMain()))
"Revert all paths to Unison's recommendations");
grAdd grAction
(actionsMenu#add_item
~callback:(fun () -> getLock (fun () ->
match !current with
Some i ->
let theSI = !theState.(i) in
Recon.revertToDefaultDirection theSI.ri;
redisplay i;
nextInteresting ()
| None ->
()))
"Revert selected path to Unison's recommendations");
(* Diff *)
ignore (actionsMenu#add_separator ());
grAdd grDiff (actionsMenu#add_item ~key:GdkKeysyms._d ~callback:diffCmd
"Show diffs for selected path");
(* grAdd grDiff (actionsMenu#add_item ~key:GdkKeysyms._m ~callback:mergeCmd
"Merge versions of selected path");*)
(*********************************************************************
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_item ~key:GdkKeysyms._g
~callback:(fun () ->
getLock synchronize)
"Go");
grAdd grRestart
(fileMenu#add_item ~key:GdkKeysyms._r
~callback:(fun () -> reloadProfile(); detectCmd())
detectCmdName);
grAdd grRestart
(fileMenu#add_item ~key:GdkKeysyms._a
~callback:(fun () ->
reloadProfile();
Prefs.set Globals.batch true;
detectCmd())
"Detect updates and proceed (without waiting)");
grAdd grRestart
(fileMenu#add_item ~key:GdkKeysyms._f
~callback:(
fun () ->
let rec loop i acc =
if i >= Array.length (!theState) then acc else
let notok =
(match !theState.(i).whatHappened with
None-> true
| Some(Util.Failed _) -> true
| Some(Util.Succeeded) -> false)
|| match !theState.(i).ri.replicas with
Problem _ -> true
| Different(rc1,rc2,dir,_) ->
(match !dir with
Conflict -> true
| _ -> false) in
if notok then loop (i+1) (i::acc)
else loop (i+1) (acc) in
let failedindices = loop 0 [] in
let failedpaths =
List.map (fun i -> !theState.(i).ri.path) failedindices in
debug (fun()-> Util.msg "Restarting with paths = %s\n"
(String.concat ", " (List.map
(fun p -> "'"^(Path.toString p)^"'")
failedpaths)));
Prefs.set Globals.paths failedpaths; detectCmd())
"Recheck unsynchronized items");
ignore (fileMenu#add_separator ());
grAdd grRestart
(fileMenu#add_item ~key:GdkKeysyms._p
~callback:(fun _ ->
match getProfile() with
None -> ()
| Some(p) -> loadProfile p; detectCmd())
"Select a new profile from the profile dialog");
let fastProf name key =
grAdd grRestart
(fileMenu#add_item ~key:key
~callback:(fun _ ->
if System.file_exists (Prefs.profilePathname name) then begin
Trace.status ("Loading profile " ^ name);
loadProfile name; detectCmd()
end else
Trace.status ("Profile " ^ name ^ " not found"))
("Select profile " ^ name)) in
let fastKeysyms =
[| GdkKeysyms._0; GdkKeysyms._1; GdkKeysyms._2; GdkKeysyms._3;
GdkKeysyms._4; GdkKeysyms._5; GdkKeysyms._6; GdkKeysyms._7;
GdkKeysyms._8; GdkKeysyms._9 |] in
Array.iteri
(fun i v -> match v with
None -> ()
| Some(profile, info) ->
fastProf profile fastKeysyms.(i))
profileKeymap;
if not Util.isCygwin then
(ignore (fileMenu#add_separator ());
ignore (fileMenu#add_item
~callback:(fun _ -> stat_win#show ()) "Statistics"));
ignore (fileMenu#add_separator ());
ignore (fileMenu#add_item ~key:GdkKeysyms._q ~callback:safeExit "Quit");
(*********************************************************************
Expert menu
*********************************************************************)
if Prefs.read Uicommon.expert then begin
let expertMenu = add_submenu ~label:"Expert" () in
let addDebugToggle modname =
let cm =
expertMenu#add_check_item ~active:(Trace.enabled modname)
~callback:(fun b -> Trace.enable modname b)
("Debug '" ^ modname ^ "'") in
cm#set_show_toggle true in
addDebugToggle "all";
addDebugToggle "verbose";
addDebugToggle "update";
ignore (expertMenu#add_separator ());
ignore (expertMenu#add_item
~callback:(fun () ->
Printf.fprintf stderr "\nGC stats now:\n";
Gc.print_stat stderr;
Printf.fprintf stderr "\nAfter major collection:\n";
Gc.full_major(); Gc.print_stat stderr;
flush stderr)
"Show memory/GC stats")
end;
(*********************************************************************
Finish up
*********************************************************************)
grSet grAction false;
grSet grDiff false;
grSet grGo false;
grSet grRestart false;
ignore (toplevelWindow#event#connect#delete ~callback:
(fun _ -> safeExit (); true));
toplevelWindow#show ();
currentWindow := Some toplevelWindow;
detectCmd ()
(*********************************************************************
STARTUP
*********************************************************************)
let start _ =
begin try
(* Initialize the GTK library *)
ignore (GMain.Main.init ());
Util.warnPrinter := Some (warnBox "Warning");
(* Ask the Remote module to call us back at regular intervals during
long network operations. *)
let rec tick () =
gtk_sync ();
Lwt_unix.sleep 0.1 >>= tick
in
ignore_result (tick ());
Uicommon.uiInit
fatalError
tryAgainOrQuit
displayWaitMessage
getProfile
getFirstRoot
getSecondRoot
(termInteract());
scanProfiles();
createToplevelWindow();
(* Display the ui *)
ignore (GMain.Timeout.add 500 (fun _ -> true));
(* Hack: this allows signals such as SIGINT to be
handled even when Gtk is waiting for events *)
GMain.Main.main ()
with
Util.Transient(s) | Util.Fatal(s) -> fatalError s
| exn -> fatalError (Uicommon.exn2string exn)
end
end (* module Private *)
(*********************************************************************
UI SELECTION
*********************************************************************)
module Body : Uicommon.UI = struct
let start = function
Uicommon.Text -> Uitext.Body.start Uicommon.Text
| Uicommon.Graphic ->
let displayAvailable =
Util.osType = `Win32
||
try System.getenv "DISPLAY" <> "" with Not_found -> false
in
if displayAvailable then Private.start Uicommon.Graphic
else Uitext.Body.start Uicommon.Text
let defaultUi = Uicommon.Graphic
end (* module Body *)
unison-2.40.102/stasher.mli 0000644 0061316 0061316 00000002564 11361646373 015572 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/stasher.mli *)
(* $I2: Last modified by lescuyer on *)
(* $I3: Copyright 1999-2005 (see COPYING for details) $ *)
(* This module maintains backups for general purpose and *)
(* as archives for mergeable files. *)
(* Make a backup copy of a file, if needed; if the third parameter is
`AndRemove, then the file is either backed up by renaming or else
deleted if no backup is needed. *)
val backup:
Fspath.t -> Path.local ->
[`AndRemove | `ByCopying] -> Update.archive -> unit
(* Stashes of current versions (so that we have archives when needed for merging) *)
val stashCurrentVersion:
Fspath.t (* fspath to stash *)
-> Path.local (* path to stash *)
-> Path.local option (* path to actual bits to be stashed (used to stash an
additional archive version in addition to the current version) *)
-> unit
(* Retrieve a stashed version *)
val getRecentVersion:
Fspath.t
-> Path.local
-> Os.fullfingerprint
-> Fspath.t option
(* Return the location of the backup directory *)
val backupDirectory : unit -> Fspath.t
(* Check whether current version of a path is being stashed *)
val shouldBackupCurrent : Path.t -> bool
(* Low-level backupdir preference *)
val backupdir : string Prefs.t
(* Initialize the module *)
val initBackups: unit -> unit
unison-2.40.102/external.ml 0000644 0061316 0061316 00000006556 11361646373 015577 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/external.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(*****************************************************************************)
(* RUNNING EXTERNAL PROGRAMS *)
(*****************************************************************************)
let debug = Util.debug "external"
let (>>=) = Lwt.bind
open Lwt
let readChannelTillEof c =
let rec loop lines =
try let l = input_line c in
(* Util.msg "%s\n" l; *)
loop (l::lines)
with End_of_file -> lines in
String.concat "\n" (Safelist.rev (loop []))
let readChannelTillEof_lwt c =
let rec loop lines =
let lo =
try
Some(Lwt_unix.run (Lwt_unix.input_line c))
with End_of_file -> None
in
match lo with
Some l -> loop (l :: lines)
| None -> lines
in
String.concat "\n" (Safelist.rev (loop []))
let readChannelsTillEof l =
let rec suckitdry lines c =
Lwt.catch
(fun() -> Lwt_unix.input_line c >>= (fun l -> return (Some l)))
(fun e -> match e with End_of_file -> return None | _ -> raise e)
>>= (fun lo ->
match lo with
None -> return lines
| Some l -> suckitdry (l :: lines) c) in
Lwt_util.map
(fun c ->
suckitdry [] c
>>= (fun res -> return (String.concat "\n" (Safelist.rev res))))
l
let runExternalProgram cmd =
if Util.osType = `Win32 && not Util.isCygwin then begin
debug (fun()-> Util.msg "Executing external program windows-style\n");
let c = System.open_process_in ("\"" ^ cmd ^ "\"") in
let log = readChannelTillEof c in
let returnValue = System.close_process_in c in
let mergeResultLog =
cmd ^
(if log <> "" then "\n\n" ^ log else "") ^
(if returnValue <> Unix.WEXITED 0 then
"\n\n" ^ Util.process_status_to_string returnValue
else
"") in
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
readChannelsTillEof [out;err]
>>= (function [logOut;logErr] ->
let returnValue = System.close_process_full desc in
let logOut = Util.trimWhitespace logOut in
let logErr = Util.trimWhitespace logErr in
return (returnValue, (
(* cmd
^ "\n\n" ^ *)
(if logOut = "" || logErr = ""
then logOut ^ logErr
else logOut ^ "\n\n" ^ ("Error Output:" ^ logErr))
^ (if returnValue = Unix.WEXITED 0
then ""
else "\n\n" ^ Util.process_status_to_string returnValue)))
(* Stop typechechecker from complaining about non-exhaustive pattern above *)
| _ -> assert false)
unison-2.40.102/osx.mli 0000644 0061316 0061316 00000001652 11361646373 014727 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/osx.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
val init : bool -> unit
val isMacOSX : bool
val rsrc : bool Prefs.t
type 'a ressInfo
type ressStamp = unit ressInfo
type info =
{ ressInfo : (Fspath.t * int64) ressInfo;
finfo : string }
val defaultInfos : [> `DIRECTORY | `FILE ] -> info
val getFileInfos : Fspath.t -> Path.local -> [> `DIRECTORY | `FILE ] -> info
val setFileInfos : Fspath.t -> Path.local -> string -> unit
val ressUnchanged :
'a ressInfo -> 'b ressInfo -> float option -> bool -> bool
val ressFingerprint : Fspath.t -> Path.local -> info -> Fingerprint.t
val ressLength : 'a ressInfo -> Uutil.Filesize.t
val ressDummy : ressStamp
val ressStampToString : ressStamp -> string
val stamp : info -> ressStamp
val openRessIn : Fspath.t -> Path.local -> in_channel
val openRessOut : Fspath.t -> Path.local -> Uutil.Filesize.t -> out_channel
unison-2.40.102/unicode_tables.ml 0000644 0061316 0061316 00000225216 11362021603 016711 0 ustar bcpierce bcpierce (*-*-coding: utf-8;-*-*)
let norm_ascii =
"\000\001\002\003\004\005\006\007\b\t\n\011\012\r\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031 !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\127"
let norm_repl =
"\003à\003á\003â\003ã\003ä\003å\002æ\003ç\003è\003é\003ê\003ë\003ì\003í\003î\003ï\002ð\003ñ\003ò\003ó\003ô\003õ\003ö\002ø\003ù\003ú\003û\003ü\003ý\002þ\003ÿ\003ā\003ă\003ą\003ć\003ĉ\003ċ\003č\003ď\002đ\003ē\003ĕ\003ė\003ę\003ě\003ĝ\003ğ\003ġ\003ģ\003ĥ\002ħ\003ĩ\003ī\003ĭ\003į\003i̇\002ij\003ĵ\003ķ\003ĺ\003ļ\003ľ\002ŀ\002ł\003ń\003ņ\003ň\002ŋ\003ō\003ŏ\003ő\002œ\003ŕ\003ŗ\003ř\003ś\003ŝ\003ş\003š\003ţ\003ť\002ŧ\003ũ\003ū\003ŭ\003ů\003ű\003ų\003ŵ\003ŷ\003ź\003ż\003ž\002ɓ\002ƃ\002ƅ\002ɔ\002ƈ\002ɖ\002ɗ\002ƌ\002ǝ\002ə\002ɛ\002ƒ\002ɠ\002ɣ\002ɩ\002ɨ\002ƙ\002ɯ\002ɲ\002ɵ\003ơ\002ƣ\002ƥ\002ƨ\002ʃ\002ƭ\002ʈ\003ư\002ʊ\002ʋ\002ƴ\002ƶ\002ʒ\002ƹ\002ƽ\002dž\002lj\002nj\003ǎ\003ǐ\003ǒ\003ǔ\005ǖ\005ǘ\005ǚ\005ǜ\005ǟ\005ǡ\004ǣ\002ǥ\003ǧ\003ǩ\003ǫ\005ǭ\004ǯ\003ǰ\002dz\003ǵ\003ǹ\005ǻ\004ǽ\004ǿ\003ȁ\003ȃ\003ȅ\003ȇ\003ȉ\003ȋ\003ȍ\003ȏ\003ȑ\003ȓ\003ȕ\003ȗ\003ș\003ț\003ȟ\003ȧ\003ȩ\005ȫ\005ȭ\003ȯ\005ȱ\003ȳ\002̀\002́\002̓\004̈́\002ʹ\001;\004΅\004ά\002·\004έ\004ή\004ί\004ό\004ύ\004ώ\006ΐ\002α\002β\002γ\002δ\002ε\002ζ\002η\002θ\002ι\002κ\002λ\002μ\002ν\002ξ\002ο\002π\002ρ\002σ\002τ\002υ\002φ\002χ\002ψ\002ω\004ϊ\004ϋ\006ΰ\004ϓ\004ϔ\002ϣ\002ϥ\002ϧ\002ϩ\002ϫ\002ϭ\002ϯ\004ѐ\004ё\002ђ\004ѓ\002є\002ѕ\002і\004ї\002ј\002љ\002њ\002ћ\004ќ\004ѝ\004ў\002џ\002а\002б\002в\002г\002д\002е\002ж\002з\002и\004й\002к\002л\002м\002н\002о\002п\002р\002с\002т\002у\002ф\002х\002ц\002ч\002ш\002щ\002ъ\002ы\002ь\002э\002ю\002я\002ѡ\002ѣ\002ѥ\002ѧ\002ѩ\002ѫ\002ѭ\002ѯ\002ѱ\002ѳ\002ѵ\004ѷ\002ѹ\002ѻ\002ѽ\002ѿ\002ҁ\002ґ\002ғ\002ҕ\002җ\002ҙ\002қ\002ҝ\002ҟ\002ҡ\002ң\002ҥ\002ҧ\002ҩ\002ҫ\002ҭ\002ү\002ұ\002ҳ\002ҵ\002ҷ\002ҹ\002һ\002ҽ\002ҿ\004ӂ\002ӄ\002ӈ\002ӌ\004ӑ\004ӓ\002ӕ\004ӗ\002ә\004ӛ\004ӝ\004ӟ\002ӡ\004ӣ\004ӥ\004ӧ\002ө\004ӫ\004ӭ\004ӯ\004ӱ\004ӳ\004ӵ\004ӹ\002ա\002բ\002գ\002դ\002ե\002զ\002է\002ը\002թ\002ժ\002ի\002լ\002խ\002ծ\002կ\002հ\002ձ\002ղ\002ճ\002մ\002յ\002ն\002շ\002ո\002չ\002պ\002ջ\002ռ\002ս\002վ\002տ\002ր\002ց\002ւ\002փ\002ք\002օ\002ֆ\004آ\004أ\004ؤ\004إ\004ئ\004ۀ\004ۂ\004ۓ\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006ୈ\006ୋ\006ୌ\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006ො\009ෝ\006ෞ\006གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006ྐྵ\006ဦ\003ა\003ბ\003გ\003დ\003ე\003ვ\003ზ\003თ\003ი\003კ\003ლ\003მ\003ნ\003ო\003პ\003ჟ\003რ\003ს\003ტ\003უ\003ფ\003ქ\003ღ\003ყ\003შ\003ჩ\003ც\003ძ\003წ\003ჭ\003ხ\003ჯ\003ჰ\003ჱ\003ჲ\003ჳ\003ჴ\003ჵ\003ḁ\003ḃ\003ḅ\003ḇ\005ḉ\003ḋ\003ḍ\003ḏ\003ḑ\003ḓ\005ḕ\005ḗ\003ḙ\003ḛ\005ḝ\003ḟ\003ḡ\003ḣ\003ḥ\003ḧ\003ḩ\003ḫ\003ḭ\005ḯ\003ḱ\003ḳ\003ḵ\003ḷ\005ḹ\003ḻ\003ḽ\003ḿ\003ṁ\003ṃ\003ṅ\003ṇ\003ṉ\003ṋ\005ṍ\005ṏ\005ṑ\005ṓ\003ṕ\003ṗ\003ṙ\003ṛ\005ṝ\003ṟ\003ṡ\003ṣ\005ṥ\005ṧ\005ṩ\003ṫ\003ṭ\003ṯ\003ṱ\003ṳ\003ṵ\003ṷ\005ṹ\005ṻ\003ṽ\003ṿ\003ẁ\003ẃ\003ẅ\003ẇ\003ẉ\003ẋ\003ẍ\003ẏ\003ẑ\003ẓ\003ẕ\003ẖ\003ẗ\003ẘ\003ẙ\004ẛ\003ạ\003ả\005ấ\005ầ\005ẩ\005ẫ\005ậ\005ắ\005ằ\005ẳ\005ẵ\005ặ\003ẹ\003ẻ\003ẽ\005ế\005ề\005ể\005ễ\005ệ\003ỉ\003ị\003ọ\003ỏ\005ố\005ồ\005ổ\005ỗ\005ộ\005ớ\005ờ\005ở\005ỡ\005ợ\003ụ\003ủ\005ứ\005ừ\005ử\005ữ\005ự\003ỳ\003ỵ\003ỷ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἄ\006ἅ\006ἆ\006ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἔ\006ἕ\004ἠ\004ἡ\006ἢ\006ἣ\006ἤ\006ἥ\006ἦ\006ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἴ\006ἵ\006ἶ\006ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὄ\006ὅ\004ὐ\004ὑ\006ὒ\006ὓ\006ὔ\006ὕ\006ὖ\006ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὤ\006ὥ\006ὦ\006ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004ὺ\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ᾄ\008ᾅ\008ᾆ\008ᾇ\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ᾔ\008ᾕ\008ᾖ\008ᾗ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ᾤ\008ᾥ\008ᾦ\008ᾧ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006ᾴ\004ᾶ\006ᾷ\004῁\006ῂ\004ῃ\006ῄ\004ῆ\006ῇ\005῍\005῎\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\005῝\005῞\005῟\004ῠ\004ῡ\006ῢ\004ῤ\004ῥ\004ῦ\006ῧ\004῭\001`\006ῲ\004ῳ\006ῴ\004ῶ\006ῷ\002´\000\003ⅰ\003ⅱ\003ⅲ\003ⅳ\003ⅴ\003ⅵ\003ⅶ\003ⅷ\003ⅸ\003ⅹ\003ⅺ\003ⅻ\003ⅼ\003ⅽ\003ⅾ\003ⅿ\003ⓐ\003ⓑ\003ⓒ\003ⓓ\003ⓔ\003ⓕ\003ⓖ\003ⓗ\003ⓘ\003ⓙ\003ⓚ\003ⓛ\003ⓜ\003ⓝ\003ⓞ\003ⓟ\003ⓠ\003ⓡ\003ⓢ\003ⓣ\003ⓤ\003ⓥ\003ⓦ\003ⓧ\003ⓨ\003ⓩ\006が\006ぎ\006ぐ\006げ\006ご\006ざ\006じ\006ず\006ぜ\006ぞ\006だ\006ぢ\006づ\006で\006ど\006ば\006ぱ\006び\006ぴ\006ぶ\006ぷ\006べ\006ぺ\006ぼ\006ぽ\006ゔ\006ゞ\006ガ\006ギ\006グ\006ゲ\006ゴ\006ザ\006ジ\006ズ\006ゼ\006ゾ\006ダ\006ヂ\006ヅ\006デ\006ド\006バ\006パ\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\001\001\001\001\001\001\001\001\001 \001
\001 \001 \001
\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001 \001 \001 \001 \001\"\001*\001:\001<\001>\001?\001\\\001|\001 \001.\004יִ\004ײַ\004שׁ\004שׂ\006שּׁ\006שּׂ\004אַ\004אָ\004אּ\004בּ\004גּ\004דּ\004הּ\004וּ\004זּ\004טּ\004יּ\004ךּ\004כּ\004לּ\004מּ\004נּ\004סּ\004ףּ\004פּ\004צּ\004קּ\004רּ\004שּ\004תּ\004וֹ\004בֿ\004כֿ\004פֿ\003ａ\003ｂ\003ｃ\003ｄ\003ｅ\003ｆ\003ｇ\003ｈ\003ｉ\003ｊ\003ｋ\003ｌ\003ｍ\003ｎ\003ｏ\003ｐ\003ｑ\003ｒ\003ｓ\003ｔ\003ｕ\003ｖ\003ｗ\003ｘ\003ｙ\003ｚ"
let norm_prim =
"\000\000\000\002\003\004\005\006\007\000\000\000\000\008\009\010\011\012\013\014\015\016\000\000\017\000\000\018\000\000\000\000\000\000\000\000\019\020\000\021\022\023\000\000\000\024\025\026\000\027\000\028\000\029\000\030\000\000\000\000\000\031\032\000\033\000\034\035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\037\038\039\040\041\042\043\044\045\000\000\000\046\000\000\000\000\000\000\000\000\000\000\000\000\047\048\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\049\050\051\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\053\054\000\000\000\000\000\000\000\000\000\000\000\000\000\055\056\000\000\000"
let norm_second_high =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\000\002\002\002\002\000\002\002\002\002\002\002\002\000\002\000\002\002\002\002\002\002\000\003\000\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\002\003\003\003\003\003\003\000\000\003\003\000\003\000\003\003\000\003\003\003\000\000\003\003\003\003\000\003\003\000\003\003\003\000\000\000\003\003\000\003\003\003\003\000\003\000\000\003\000\003\000\000\003\000\003\003\003\003\003\003\000\003\000\003\003\000\000\000\003\000\000\000\000\000\000\000\003\003\000\003\003\000\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\004\004\004\004\004\004\004\000\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\004\004\000\000\000\000\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\004\004\004\004\004\004\000\004\000\004\004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005\005\005\005\000\005\005\005\005\005\005\005\005\005\004\004\004\004\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\005\005\004\004\004\000\000\000\000\005\005\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\006\006\006\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\000\005\000\000\000\005\000\000\000\000\005\005\005\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\006\006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\000\006\006\006\000\000\000\006\000\000\000\006\000\000\000\000\006\006\006\006\006\000\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\006\006\006\006\006\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\006\006\006\006\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\008\008\000\009\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\000\011\000\000\000\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\000\000\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\012\012\012\012\012\012\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\000\000\012\012\012\012\013\013\000\000\013\013\013\013\013\013\013\013\000\013\000\013\000\013\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\004\013\004\013\004\013\004\013\004\013\004\013\004\000\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\013\013\013\013\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\014\014\014\014\013\004\014\000\005\000\000\014\014\014\014\000\014\014\013\004\013\004\014\014\014\014\014\014\014\004\000\000\014\014\014\014\013\004\000\014\014\014\014\014\015\005\015\015\015\015\014\014\013\004\015\015\004\015\000\000\015\015\015\000\015\015\013\004\013\004\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\015\000\015\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\016\000\016\000\016\000\000\000\000\000\000\016\016\000\016\016\000\016\016\000\016\016\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\017\000\017\000\017\000\000\000\000\000\000\017\017\000\017\017\000\017\017\000\017\017\000\017\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\017\017\017\017\000\000\000\017\000\000\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\017\000\000\000\000\000\000\000\000\000\000\017\017\017\017\017\018\018\018\018\018\018\018\018\000\018\018\018\018\018\000\018\000\018\018\000\018\018\000\018\018\018\018\018\018\018\018\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\000\000\000\000\000"
let norm_second_low =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\008\012\016\020\024\027\031\035\039\043\047\051\055\059\063\066\070\074\078\082\086\000\090\093\097\101\105\109\113\000\000\004\008\012\016\020\000\027\031\035\039\043\047\051\055\059\000\066\070\074\078\082\086\000\000\093\097\101\105\109\000\116\120\120\124\124\128\128\132\132\136\136\140\140\144\144\148\148\152\000\155\155\159\159\163\163\167\167\171\171\175\175\179\179\183\183\187\187\191\191\195\000\198\198\202\202\206\206\210\210\214\000\218\000\221\221\225\225\000\229\229\233\233\237\237\241\000\244\000\247\247\251\251\255\255\000\003\000\006\006\010\010\014\014\018\000\021\021\025\025\029\029\033\033\037\037\041\041\045\045\049\049\053\053\057\000\060\060\064\064\068\068\072\072\076\076\080\080\084\084\088\088\116\092\092\096\096\100\100\000\000\104\107\000\110\000\113\116\000\119\122\125\000\000\128\131\134\137\000\140\143\000\146\149\152\000\000\000\155\158\000\161\164\164\168\000\171\000\000\174\000\177\000\000\180\000\183\186\186\190\193\196\000\199\000\202\205\000\000\000\208\000\000\000\000\000\000\000\211\211\000\214\214\000\217\217\000\220\220\224\224\228\228\232\232\236\236\242\242\248\248\254\254\000\004\004\010\010\016\016\021\000\024\024\028\028\032\032\036\036\042\042\047\051\051\000\054\054\000\000\058\058\062\062\068\068\073\073\078\078\082\082\086\086\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\130\130\000\000\134\134\000\000\000\000\000\000\138\138\142\142\146\146\152\152\158\158\162\162\168\168\000\000\000\000\000\000\000\000\000\000\000\000\172\175\000\178\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\186\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\191\196\201\204\209\214\000\219\000\224\229\234\241\244\247\250\253\000\003\006\009\012\015\018\021\024\027\030\033\000\036\039\042\045\048\051\054\057\062\196\204\209\214\067\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\000\000\000\000\000\057\062\219\224\229\000\000\000\000\074\079\000\000\000\000\000\000\000\000\000\000\000\000\000\084\000\087\000\090\000\093\000\096\000\099\000\102\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\118\123\126\129\132\137\140\143\146\149\154\159\164\167\170\173\176\179\182\185\188\191\194\199\202\205\208\211\214\217\220\223\226\229\232\235\238\241\244\247\250\253\000\003\006\000\000\000\000\000\000\000\000\000\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\000\118\000\000\000\132\000\000\000\000\149\154\159\000\009\000\012\000\015\000\018\000\021\000\024\000\027\000\030\000\033\000\036\000\039\000\042\042\047\000\050\000\053\000\056\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\062\000\065\000\068\000\071\000\074\000\077\000\080\000\083\000\086\000\089\000\092\000\095\000\098\000\101\000\104\000\107\000\110\000\113\000\116\000\119\000\122\000\125\000\128\000\131\000\000\134\134\139\000\000\000\142\000\000\000\145\000\000\000\000\148\148\153\153\158\000\161\161\166\000\169\169\174\174\179\179\184\000\187\187\192\192\197\197\202\000\205\205\210\210\215\215\220\220\225\225\230\230\000\000\235\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\240\243\246\249\252\255\002\005\008\011\014\017\020\023\026\029\032\035\038\041\044\047\050\053\056\059\062\065\068\071\074\077\080\083\086\089\092\095\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\098\103\108\113\118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\123\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\145\000\000\152\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\159\166\173\180\187\194\201\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\215\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\236\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\015\022\000\000\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\043\050\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\057\064\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\078\085\092\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\099\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\106\000\000\000\000\000\000\113\120\000\127\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\151\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\172\179\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\000\000\203\000\000\000\000\210\000\000\000\000\217\000\000\000\000\224\000\000\000\000\000\000\000\000\000\000\000\000\231\000\000\000\000\000\000\000\000\000\238\000\245\252\000\003\000\000\000\000\000\000\000\000\010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\024\000\000\000\000\031\000\000\000\000\038\000\000\000\000\045\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\066\070\074\078\082\086\090\094\098\102\106\110\114\118\122\126\130\134\138\142\146\150\154\158\162\166\170\174\178\182\186\190\194\198\202\206\210\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\218\218\222\222\226\226\230\230\234\234\240\240\244\244\248\248\252\252\000\000\004\004\010\010\016\016\020\020\024\024\030\030\034\034\038\038\042\042\046\046\050\050\054\054\058\058\062\062\068\068\072\072\076\076\080\080\084\084\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\132\132\138\138\144\144\150\150\154\154\158\158\162\162\166\166\172\172\176\176\180\180\184\184\190\190\196\196\202\202\206\206\210\210\214\214\218\218\222\222\226\226\230\230\236\236\242\242\246\246\250\250\254\254\002\002\006\006\010\010\014\014\018\018\022\022\026\026\030\030\034\034\038\042\046\050\000\054\000\000\000\000\059\059\063\063\067\067\073\073\079\079\085\085\091\091\097\097\103\103\109\109\115\115\121\121\127\127\131\131\135\135\139\139\145\145\151\151\157\157\163\163\169\169\173\173\177\177\181\181\185\185\191\191\197\197\203\203\209\209\215\215\221\221\227\227\233\233\239\239\245\245\249\249\253\253\003\003\009\009\015\015\021\021\027\027\031\031\035\035\039\039\000\000\000\000\000\000\043\048\053\060\067\074\081\088\043\048\053\060\067\074\081\088\095\100\105\112\119\126\000\000\095\100\105\112\119\126\000\000\133\138\143\150\157\164\171\178\133\138\143\150\157\164\171\178\185\190\195\202\209\216\223\230\185\190\195\202\209\216\223\230\237\242\247\254\005\012\000\000\237\242\247\254\005\012\000\000\019\024\029\036\043\050\057\064\000\024\000\036\000\050\000\064\071\076\081\088\095\102\109\116\071\076\081\088\095\102\109\116\123\196\128\204\133\209\138\214\143\219\148\224\153\229\000\000\158\165\172\181\190\199\208\217\158\165\172\181\190\199\208\217\226\233\240\249\002\011\020\029\226\233\240\249\002\011\020\029\038\045\052\061\070\079\088\097\038\045\052\061\070\079\088\097\106\111\116\123\128\000\135\140\106\111\123\196\123\000\009\000\000\147\152\159\164\000\171\176\128\204\133\209\159\183\189\195\201\206\211\234\000\000\218\223\201\206\138\214\000\230\236\242\248\253\002\067\009\014\019\024\248\253\148\224\014\031\191\036\000\000\038\045\050\000\057\062\143\219\153\229\045\069\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\073\077\081\085\089\093\097\101\105\109\113\117\121\125\129\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\137\141\145\149\153\157\161\165\169\173\177\181\185\189\193\197\201\205\209\213\217\221\225\229\233\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\248\000\255\000\006\000\013\000\020\000\027\000\034\000\041\000\048\000\055\000\062\000\000\069\000\076\000\083\000\000\000\000\000\000\090\097\000\104\111\000\118\125\000\132\139\000\146\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\160\000\000\000\000\000\000\000\000\000\167\000\000\000\000\000\000\000\000\000\000\000\000\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\237\000\244\000\251\000\000\002\000\009\000\016\000\000\000\000\000\000\023\030\000\037\044\000\051\058\000\065\072\000\079\086\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\093\000\000\100\107\114\121\000\000\000\128\000\000\135\137\139\141\143\145\147\149\151\153\155\157\159\161\163\165\167\169\171\173\175\177\179\181\183\185\187\189\191\193\195\197\199\201\203\205\207\209\211\213\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\222\000\000\000\000\000\000\000\000\000\000\227\232\237\244\251\000\005\010\015\020\025\030\035\000\040\045\050\055\060\000\065\000\070\075\000\080\085\000\090\095\100\105\110\115\120\125\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\135\139\143\147\151\155\159\163\167\171\175\179\183\187\191\195\199\203\207\211\215\219\223\227\231\235\000\000\000\000\000"
let decomp_ascii =
"\000\001\002\003\004\005\006\007\b\t\n\011\012\r\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031 !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\127"
let decomp_repl =
"\003À\003Á\003Â\003Ã\003Ä\003Å\003Ç\003È\003É\003Ê\003Ë\003Ì\003Í\003Î\003Ï\003Ñ\003Ò\003Ó\003Ô\003Õ\003Ö\003Ù\003Ú\003Û\003Ü\003Ý\003à\003á\003â\003ã\003ä\003å\003ç\003è\003é\003ê\003ë\003ì\003í\003î\003ï\003ñ\003ò\003ó\003ô\003õ\003ö\003ù\003ú\003û\003ü\003ý\003ÿ\003Ā\003ā\003Ă\003ă\003Ą\003ą\003Ć\003ć\003Ĉ\003ĉ\003Ċ\003ċ\003Č\003č\003Ď\003ď\003Ē\003ē\003Ĕ\003ĕ\003Ė\003ė\003Ę\003ę\003Ě\003ě\003Ĝ\003ĝ\003Ğ\003ğ\003Ġ\003ġ\003Ģ\003ģ\003Ĥ\003ĥ\003Ĩ\003ĩ\003Ī\003ī\003Ĭ\003ĭ\003Į\003į\003İ\003Ĵ\003ĵ\003Ķ\003ķ\003Ĺ\003ĺ\003Ļ\003ļ\003Ľ\003ľ\003Ń\003ń\003Ņ\003ņ\003Ň\003ň\003Ō\003ō\003Ŏ\003ŏ\003Ő\003ő\003Ŕ\003ŕ\003Ŗ\003ŗ\003Ř\003ř\003Ś\003ś\003Ŝ\003ŝ\003Ş\003ş\003Š\003š\003Ţ\003ţ\003Ť\003ť\003Ũ\003ũ\003Ū\003ū\003Ŭ\003ŭ\003Ů\003ů\003Ű\003ű\003Ų\003ų\003Ŵ\003ŵ\003Ŷ\003ŷ\003Ÿ\003Ź\003ź\003Ż\003ż\003Ž\003ž\003Ơ\003ơ\003Ư\003ư\003Ǎ\003ǎ\003Ǐ\003ǐ\003Ǒ\003ǒ\003Ǔ\003ǔ\005Ǖ\005ǖ\005Ǘ\005ǘ\005Ǚ\005ǚ\005Ǜ\005ǜ\005Ǟ\005ǟ\005Ǡ\005ǡ\004Ǣ\004ǣ\003Ǧ\003ǧ\003Ǩ\003ǩ\003Ǫ\003ǫ\005Ǭ\005ǭ\004Ǯ\004ǯ\003ǰ\003Ǵ\003ǵ\003Ǹ\003ǹ\005Ǻ\005ǻ\004Ǽ\004ǽ\004Ǿ\004ǿ\003Ȁ\003ȁ\003Ȃ\003ȃ\003Ȅ\003ȅ\003Ȇ\003ȇ\003Ȉ\003ȉ\003Ȋ\003ȋ\003Ȍ\003ȍ\003Ȏ\003ȏ\003Ȑ\003ȑ\003Ȓ\003ȓ\003Ȕ\003ȕ\003Ȗ\003ȗ\003Ș\003ș\003Ț\003ț\003Ȟ\003ȟ\003Ȧ\003ȧ\003Ȩ\003ȩ\005Ȫ\005ȫ\005Ȭ\005ȭ\003Ȯ\003ȯ\005Ȱ\005ȱ\003Ȳ\003ȳ\002̀\002́\002̓\004̈́\002ʹ\001;\004΅\004Ά\002·\004Έ\004Ή\004Ί\004Ό\004Ύ\004Ώ\006ΐ\004Ϊ\004Ϋ\004ά\004έ\004ή\004ί\006ΰ\004ϊ\004ϋ\004ό\004ύ\004ώ\004ϓ\004ϔ\004Ѐ\004Ё\004Ѓ\004Ї\004Ќ\004Ѝ\004Ў\004Й\004й\004ѐ\004ё\004ѓ\004ї\004ќ\004ѝ\004ў\004Ѷ\004ѷ\004Ӂ\004ӂ\004Ӑ\004ӑ\004Ӓ\004ӓ\004Ӗ\004ӗ\004Ӛ\004ӛ\004Ӝ\004ӝ\004Ӟ\004ӟ\004Ӣ\004ӣ\004Ӥ\004ӥ\004Ӧ\004ӧ\004Ӫ\004ӫ\004Ӭ\004ӭ\004Ӯ\004ӯ\004Ӱ\004ӱ\004Ӳ\004ӳ\004Ӵ\004ӵ\004Ӹ\004ӹ\004آ\004أ\004ؤ\004إ\004ئ\004ۀ\004ۂ\004ۓ\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006ୈ\006ୋ\006ୌ\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006ො\009ෝ\006ෞ\006གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006ྐྵ\006ဦ\003Ḁ\003ḁ\003Ḃ\003ḃ\003Ḅ\003ḅ\003Ḇ\003ḇ\005Ḉ\005ḉ\003Ḋ\003ḋ\003Ḍ\003ḍ\003Ḏ\003ḏ\003Ḑ\003ḑ\003Ḓ\003ḓ\005Ḕ\005ḕ\005Ḗ\005ḗ\003Ḙ\003ḙ\003Ḛ\003ḛ\005Ḝ\005ḝ\003Ḟ\003ḟ\003Ḡ\003ḡ\003Ḣ\003ḣ\003Ḥ\003ḥ\003Ḧ\003ḧ\003Ḩ\003ḩ\003Ḫ\003ḫ\003Ḭ\003ḭ\005Ḯ\005ḯ\003Ḱ\003ḱ\003Ḳ\003ḳ\003Ḵ\003ḵ\003Ḷ\003ḷ\005Ḹ\005ḹ\003Ḻ\003ḻ\003Ḽ\003ḽ\003Ḿ\003ḿ\003Ṁ\003ṁ\003Ṃ\003ṃ\003Ṅ\003ṅ\003Ṇ\003ṇ\003Ṉ\003ṉ\003Ṋ\003ṋ\005Ṍ\005ṍ\005Ṏ\005ṏ\005Ṑ\005ṑ\005Ṓ\005ṓ\003Ṕ\003ṕ\003Ṗ\003ṗ\003Ṙ\003ṙ\003Ṛ\003ṛ\005Ṝ\005ṝ\003Ṟ\003ṟ\003Ṡ\003ṡ\003Ṣ\003ṣ\005Ṥ\005ṥ\005Ṧ\005ṧ\005Ṩ\005ṩ\003Ṫ\003ṫ\003Ṭ\003ṭ\003Ṯ\003ṯ\003Ṱ\003ṱ\003Ṳ\003ṳ\003Ṵ\003ṵ\003Ṷ\003ṷ\005Ṹ\005ṹ\005Ṻ\005ṻ\003Ṽ\003ṽ\003Ṿ\003ṿ\003Ẁ\003ẁ\003Ẃ\003ẃ\003Ẅ\003ẅ\003Ẇ\003ẇ\003Ẉ\003ẉ\003Ẋ\003ẋ\003Ẍ\003ẍ\003Ẏ\003ẏ\003Ẑ\003ẑ\003Ẓ\003ẓ\003Ẕ\003ẕ\003ẖ\003ẗ\003ẘ\003ẙ\004ẛ\003Ạ\003ạ\003Ả\003ả\005Ấ\005ấ\005Ầ\005ầ\005Ẩ\005ẩ\005Ẫ\005ẫ\005Ậ\005ậ\005Ắ\005ắ\005Ằ\005ằ\005Ẳ\005ẳ\005Ẵ\005ẵ\005Ặ\005ặ\003Ẹ\003ẹ\003Ẻ\003ẻ\003Ẽ\003ẽ\005Ế\005ế\005Ề\005ề\005Ể\005ể\005Ễ\005ễ\005Ệ\005ệ\003Ỉ\003ỉ\003Ị\003ị\003Ọ\003ọ\003Ỏ\003ỏ\005Ố\005ố\005Ồ\005ồ\005Ổ\005ổ\005Ỗ\005ỗ\005Ộ\005ộ\005Ớ\005ớ\005Ờ\005ờ\005Ở\005ở\005Ỡ\005ỡ\005Ợ\005ợ\003Ụ\003ụ\003Ủ\003ủ\005Ứ\005ứ\005Ừ\005ừ\005Ử\005ử\005Ữ\005ữ\005Ự\005ự\003Ỳ\003ỳ\003Ỵ\003ỵ\003Ỷ\003ỷ\003Ỹ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἄ\006ἅ\006ἆ\006ἇ\004Ἀ\004Ἁ\006Ἂ\006Ἃ\006Ἄ\006Ἅ\006Ἆ\006Ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἔ\006ἕ\004Ἐ\004Ἑ\006Ἒ\006Ἓ\006Ἔ\006Ἕ\004ἠ\004ἡ\006ἢ\006ἣ\006ἤ\006ἥ\006ἦ\006ἧ\004Ἠ\004Ἡ\006Ἢ\006Ἣ\006Ἤ\006Ἥ\006Ἦ\006Ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἴ\006ἵ\006ἶ\006ἷ\004Ἰ\004Ἱ\006Ἲ\006Ἳ\006Ἴ\006Ἵ\006Ἶ\006Ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὄ\006ὅ\004Ὀ\004Ὁ\006Ὂ\006Ὃ\006Ὄ\006Ὅ\004ὐ\004ὑ\006ὒ\006ὓ\006ὔ\006ὕ\006ὖ\006ὗ\004Ὑ\006Ὓ\006Ὕ\006Ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὤ\006ὥ\006ὦ\006ὧ\004Ὠ\004Ὡ\006Ὢ\006Ὣ\006Ὤ\006Ὥ\006Ὦ\006Ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004ὺ\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ᾄ\008ᾅ\008ᾆ\008ᾇ\006ᾈ\006ᾉ\008ᾊ\008ᾋ\008ᾌ\008ᾍ\008ᾎ\008ᾏ\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ᾔ\008ᾕ\008ᾖ\008ᾗ\006ᾘ\006ᾙ\008ᾚ\008ᾛ\008ᾜ\008ᾝ\008ᾞ\008ᾟ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ᾤ\008ᾥ\008ᾦ\008ᾧ\006ᾨ\006ᾩ\008ᾪ\008ᾫ\008ᾬ\008ᾭ\008ᾮ\008ᾯ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006ᾴ\004ᾶ\006ᾷ\004Ᾰ\004Ᾱ\004Ὰ\004ᾼ\002ι\004῁\006ῂ\004ῃ\006ῄ\004ῆ\006ῇ\004Ὲ\004Ὴ\004ῌ\005῍\005῎\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\004Ῐ\004Ῑ\004Ὶ\005῝\005῞\005῟\004ῠ\004ῡ\006ῢ\004ῤ\004ῥ\004ῦ\006ῧ\004Ῠ\004Ῡ\004Ὺ\004Ῥ\004῭\001`\006ῲ\004ῳ\006ῴ\004ῶ\006ῷ\004Ὸ\004Ὼ\004ῼ\002´\006が\006ぎ\006ぐ\006げ\006ご\006ざ\006じ\006ず\006ぜ\006ぞ\006だ\006ぢ\006づ\006で\006ど\006ば\006ぱ\006び\006ぴ\006ぶ\006ぷ\006べ\006ぺ\006ぼ\006ぽ\006ゔ\006ゞ\006ガ\006ギ\006グ\006ゲ\006ゴ\006ザ\006ジ\006ズ\006ゼ\006ゾ\006ダ\006ヂ\006ヅ\006デ\006ド\006バ\006パ\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\001\001\001\001\001\001\001\001\001 \001
\001 \001 \001
\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001 \001 \001 \001 \001\"\001*\001:\001<\001>\001?\001\\\001|\001 \001.\004יִ\004ײַ\004שׁ\004שׂ\006שּׁ\006שּׂ\004אַ\004אָ\004אּ\004בּ\004גּ\004דּ\004הּ\004וּ\004זּ\004טּ\004יּ\004ךּ\004כּ\004לּ\004מּ\004נּ\004סּ\004ףּ\004פּ\004צּ\004קּ\004רּ\004שּ\004תּ\004וֹ\004בֿ\004כֿ\004פֿ"
let decomp_prim =
"\000\000\000\002\003\004\005\006\007\000\000\000\000\008\009\010\011\012\000\013\000\000\000\000\014\000\000\015\000\000\000\000\000\000\000\000\016\017\000\018\019\020\000\000\000\021\022\023\000\024\000\025\000\026\000\027\000\000\000\000\000\028\029\000\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\031\032\033\034\035\036\037\038\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\039\040\041\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\042\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\043\044\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
let decomp_second_high =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\003\003\003\003\003\000\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\000\003\003\003\003\003\003\003\003\003\000\000\000\003\003\003\003\000\003\003\003\003\003\003\000\000\000\000\003\003\003\003\003\003\000\000\000\003\003\003\003\003\003\000\000\003\003\003\003\003\003\003\003\004\004\004\004\004\004\004\004\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\004\004\004\005\000\000\005\005\005\005\005\005\005\005\005\005\005\000\000\000\005\005\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\000\000\005\005\000\000\000\000\000\000\005\005\005\005\005\005\005\006\006\006\006\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\006\006\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\006\006\006\006\006\006\000\006\000\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\006\006\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\006\006\006\000\000\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\000\006\000\000\000\006\000\000\000\000\006\006\006\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\000\006\000\000\000\006\000\000\000\000\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\000\000\007\007\000\000\007\007\007\007\007\007\000\000\007\007\007\007\007\007\000\000\007\007\007\007\007\007\007\007\007\007\007\007\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\008\008\008\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\009\009\000\009\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\012\000\000\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\014\014\014\014\000\000\000\000\000\000\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\000\014\014\014\014\014\014\000\000\014\014\014\014\014\014\014\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\015\015\015\015\015\015\000\000\015\015\015\016\016\016\016\016\000\016\000\016\000\016\000\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\006\016\006\016\006\016\006\016\006\016\006\016\006\000\000\016\016\016\016\016\016\016\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\000\018\018\018\018\018\006\018\000\018\000\000\018\018\018\018\000\018\018\018\006\018\006\018\018\018\018\018\018\018\006\000\000\018\018\019\019\019\006\000\019\019\019\019\019\019\006\019\019\019\019\019\019\019\006\019\019\006\019\000\000\019\019\019\000\019\019\019\006\019\006\019\019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\000\019\000\019\000\019\000\000\000\000\000\000\020\020\000\020\020\000\020\020\000\020\020\000\020\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\000\020\000\020\000\020\000\000\000\000\000\000\020\020\000\020\020\000\020\020\000\020\020\000\020\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\000\000\021\021\021\021\000\000\000\021\000\000\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\000\021\000\000\000\000\000\000\000\000\000\000\021\021\021\021\021\021\021\021\021\021\021\021\021\000\021\021\021\021\021\000\021\000\021\021\000\021\021\000\022\022\022\022\022\022\022\022\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
let decomp_second_low =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\008\012\016\020\000\024\028\032\036\040\044\048\052\056\000\060\064\068\072\076\080\000\000\084\088\092\096\100\000\000\104\108\112\116\120\124\000\128\132\136\140\144\148\152\156\160\000\164\168\172\176\180\184\000\000\188\192\196\200\204\000\208\212\216\220\224\228\232\236\240\244\248\252\000\004\008\012\016\000\000\020\024\028\032\036\040\044\048\052\056\060\064\068\072\076\080\084\088\092\096\000\000\100\104\108\112\116\120\124\128\132\000\000\000\136\140\144\148\000\152\156\160\164\168\172\000\000\000\000\176\180\184\188\192\196\000\000\000\200\204\208\212\216\220\000\000\224\228\232\236\240\244\248\252\000\004\008\012\016\020\024\028\032\036\000\000\040\044\048\052\056\060\064\068\072\076\080\084\088\092\096\100\104\108\112\116\120\124\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\136\000\000\000\000\000\000\000\000\000\000\000\000\000\140\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\148\152\156\160\164\168\172\176\180\186\192\198\204\210\216\222\000\228\234\240\246\252\001\000\000\006\010\014\018\022\026\030\036\042\047\052\000\000\000\056\060\000\000\064\068\072\078\084\089\094\099\104\108\112\116\120\124\128\132\136\140\144\148\152\156\160\164\168\172\176\180\184\188\192\196\200\204\208\212\000\000\216\220\000\000\000\000\000\000\224\228\232\236\240\246\252\002\008\012\016\022\028\032\000\000\000\000\000\000\000\000\000\000\000\000\036\039\000\042\045\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\050\000\000\000\000\000\000\000\000\000\053\000\000\000\000\000\000\055\060\065\068\073\078\000\083\000\088\093\098\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\120\125\130\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\142\147\152\157\162\000\000\000\000\167\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\177\182\000\187\000\000\000\192\000\000\000\000\197\202\207\000\000\000\000\000\000\000\000\000\000\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\222\227\000\232\000\000\000\237\000\000\000\000\242\247\252\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\000\000\000\000\000\011\016\000\000\000\000\000\000\000\000\000\000\000\000\000\021\026\031\036\000\000\041\046\000\000\051\056\061\066\071\076\000\000\081\086\091\096\101\106\000\000\111\116\121\126\131\136\141\146\151\156\161\166\000\000\171\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\181\186\191\196\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\206\000\211\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\216\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\000\000\228\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\242\249\000\007\014\021\028\035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\042\049\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\056\063\000\070\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\077\000\000\084\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\091\098\105\000\000\112\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\119\000\000\126\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\140\147\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\161\168\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\196\203\000\210\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\227\234\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\255\006\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\000\000\000\000\000\000\000\000\000\030\000\000\000\000\037\000\000\000\000\044\000\000\000\000\051\000\000\000\000\000\000\000\000\000\000\000\000\058\000\000\000\000\000\000\000\000\000\065\000\072\079\000\086\000\000\000\000\000\000\000\000\093\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\100\000\000\000\000\000\000\000\000\000\107\000\000\000\000\114\000\000\000\000\121\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\149\153\157\161\165\169\173\177\181\187\193\197\201\205\209\213\217\221\225\229\233\239\245\251\001\005\009\013\017\023\029\033\037\041\045\049\053\057\061\065\069\073\077\081\085\089\093\099\105\109\113\117\121\125\129\133\137\143\149\153\157\161\165\169\173\177\181\185\189\193\197\201\205\209\213\217\221\227\233\239\245\251\001\007\013\017\021\025\029\033\037\041\045\051\057\061\065\069\073\077\081\087\093\099\105\111\117\121\125\129\133\137\141\145\149\153\157\161\165\169\173\179\185\191\197\201\205\209\213\217\221\225\229\233\237\241\245\249\253\001\005\009\013\017\021\025\029\033\037\041\045\049\053\057\000\061\000\000\000\000\066\070\074\078\082\088\094\100\106\112\118\124\130\136\142\148\154\160\166\172\178\184\190\196\202\206\210\214\218\222\226\232\238\244\250\000\006\012\018\024\030\034\038\042\046\050\054\058\062\068\074\080\086\092\098\104\110\116\122\128\134\140\146\152\158\164\170\176\182\186\190\194\198\204\210\216\222\228\234\240\246\252\002\006\010\014\018\022\026\030\000\000\000\000\000\000\034\039\044\051\058\065\072\079\086\091\096\103\110\117\124\131\138\143\148\155\162\169\000\000\176\181\186\193\200\207\000\000\214\219\224\231\238\245\252\003\010\015\020\027\034\041\048\055\062\067\072\079\086\093\100\107\114\119\124\131\138\145\152\159\166\171\176\183\190\197\000\000\204\209\214\221\228\235\000\000\242\247\252\003\010\017\024\031\000\038\000\043\000\050\000\057\064\069\074\081\088\095\102\109\116\121\126\133\140\147\154\161\168\115\173\120\178\125\183\130\188\152\193\157\198\162\000\000\203\210\217\226\235\244\253\006\015\022\029\038\047\056\065\074\083\090\097\106\115\124\133\142\151\158\165\174\183\192\201\210\219\226\233\242\251\004\013\022\031\038\045\054\063\072\081\090\099\104\109\116\121\000\128\133\140\145\150\060\155\000\160\000\000\163\168\175\180\000\187\192\199\068\204\073\209\214\220\226\232\237\242\098\000\000\249\254\005\010\015\078\000\020\026\032\038\043\048\135\055\060\065\070\077\082\087\088\092\097\055\102\000\000\104\111\116\000\123\128\135\083\140\093\145\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\153\000\160\000\167\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\000\237\000\244\000\251\000\000\000\000\000\000\002\009\000\016\023\000\030\037\000\044\051\000\058\065\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\000\000\000\000\000\000\000\000\000\079\000\000\000\000\000\000\000\000\000\000\000\000\000\086\000\093\000\100\000\107\000\114\000\121\000\128\000\135\000\142\000\149\000\156\000\163\000\000\170\000\177\000\184\000\000\000\000\000\000\191\198\000\205\212\000\219\226\000\233\240\000\247\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\012\019\026\033\000\000\000\040\000\000\047\049\051\053\055\057\059\061\063\065\067\069\071\073\075\077\079\081\083\085\087\089\091\093\095\097\099\101\103\105\107\109\111\113\115\117\119\121\123\125\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\134\000\000\000\000\000\000\000\000\000\000\139\144\149\156\163\168\173\178\183\188\193\198\203\000\208\213\218\223\228\000\233\000\238\243\000\248\253\000\002\007\012\017\022\027\032\037\042\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
unison-2.40.102/uigtk2.mli 0000644 0061316 0061316 00000000222 11361646373 015313 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/uigtk2.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
module Body : Uicommon.UI
unison-2.40.102/copy.ml 0000644 0061316 0061316 00000103267 11361646373 014724 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/copy.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
let (>>=) = Lwt.bind
let debug = Trace.debug "copy"
(****)
let protect f g =
try
f ()
with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e ->
begin try g () with Sys_error _ | Unix.Unix_error _ -> () end;
raise e
let lwt_protect f g =
Lwt.catch f
(fun e ->
begin match e with
Sys_error _ | Unix.Unix_error _ | Util.Transient _ ->
begin try g () with Sys_error _ | Unix.Unix_error _ -> () end
| _ ->
()
end;
Lwt.fail e)
(****)
(* Check whether the source file has been modified during synchronization *)
let checkContentsChangeLocal
fspathFrom pathFrom archDesc archDig archStamp archRess paranoid =
let info = Fileinfo.get true fspathFrom pathFrom in
let clearlyModified =
info.Fileinfo.typ <> `FILE
|| Props.length info.Fileinfo.desc <> Props.length archDesc
|| Osx.ressLength info.Fileinfo.osX.Osx.ressInfo <>
Osx.ressLength archRess
in
let dataClearlyUnchanged =
not clearlyModified
&& Props.same_time info.Fileinfo.desc archDesc
&& not (Fpcache.excelFile pathFrom)
&& match archStamp with
Some (Fileinfo.InodeStamp inode) -> info.Fileinfo.inode = inode
| Some (Fileinfo.CtimeStamp ctime) -> true
| None -> false
in
let ressClearlyUnchanged =
not clearlyModified
&& Osx.ressUnchanged archRess info.Fileinfo.osX.Osx.ressInfo
None dataClearlyUnchanged
in
if dataClearlyUnchanged && ressClearlyUnchanged then begin
if paranoid then begin
let newDig = Os.fingerprint fspathFrom pathFrom info in
if archDig <> newDig then begin
Update.markPossiblyUpdated fspathFrom pathFrom;
raise (Util.Transient (Printf.sprintf
"The source file %s\n\
has been modified but the fast update detection mechanism\n\
failed to detect it. Try running once with the fastcheck\n\
option set to 'no'."
(Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
end
end
end else if
clearlyModified
|| archDig <> Os.fingerprint fspathFrom pathFrom info
then
raise (Util.Transient (Printf.sprintf
"The source file %s\nhas been modified during synchronization. \
Transfer aborted."
(Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
let checkContentsChangeOnRoot =
Remote.registerRootCmd
"checkContentsChange"
(fun (fspathFrom,
(pathFrom, archDesc, archDig, archStamp, archRess, paranoid)) ->
checkContentsChangeLocal
fspathFrom pathFrom archDesc archDig archStamp archRess paranoid;
Lwt.return ())
let checkContentsChange
root pathFrom archDesc archDig archStamp archRess paranoid =
checkContentsChangeOnRoot
root (pathFrom, archDesc, archDig, archStamp, archRess, paranoid)
(****)
let fileIsTransferred fspathTo pathTo desc fp ress =
let info = Fileinfo.get false fspathTo pathTo in
(info,
info.Fileinfo.typ = `FILE
&&
Props.length info.Fileinfo.desc = Props.length desc
&&
Osx.ressLength info.Fileinfo.osX.Osx.ressInfo =
Osx.ressLength ress
&&
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
(* Paranoid check: recompute the transferred file's digest to match it
with the archive's *)
let paranoidCheck fspathTo pathTo realPathTo desc fp ress =
let info = Fileinfo.get false fspathTo pathTo in
let fp' = Os.fingerprint fspathTo pathTo info in
if fp' <> fp then begin
Lwt.return (Failure (Os.reasonForFingerprintMismatch fp fp'))
end else
Lwt.return (Success info)
let saveTempFileLocal (fspathTo, (pathTo, realPathTo, reason)) =
let savepath =
Os.tempPath ~fresh:true fspathTo
(match Path.deconstructRev realPathTo with
Some (nm, _) -> Path.addSuffixToFinalName
(Path.child Path.empty nm) "-bad"
| None -> Path.fromString "bad")
in
Os.rename "save temp" fspathTo pathTo fspathTo savepath;
Lwt.fail
(Util.Transient
(Printf.sprintf
"The file %s was incorrectly transferred (fingerprint mismatch in %s) \
-- temp file saved as %s"
(Path.toString pathTo)
reason
(Fspath.toDebugString (Fspath.concat fspathTo savepath))))
let saveTempFileOnRoot =
Remote.registerRootCmd "saveTempFile" saveTempFileLocal
(****)
let removeOldTempFile fspathTo pathTo =
if Os.exists fspathTo pathTo then begin
debug (fun() -> Util.msg "Removing old temp file %s / %s\n"
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
Os.delete fspathTo pathTo
end
let openFileIn fspath path kind =
match kind with
`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
`DATA ->
let fullpath = Fspath.concat fspath path in
let flags = [Unix.O_WRONLY;Unix.O_CREAT] in
let perm = 0o600 in
begin match Util.osType with
`Win32 ->
Fs.open_out_gen
[Open_wronly; Open_creat; Open_excl; Open_binary] perm fullpath
| `Unix ->
let fd =
try
Fs.openfile fullpath (Unix.O_EXCL :: flags) perm
with
Unix.Unix_error
((Unix.EOPNOTSUPP | Unix.EUNKNOWNERR 524), _, _) ->
(* O_EXCL not supported under a Netware NFS-mounted filesystem.
Solaris and Linux report different errors. *)
Fs.openfile fullpath (Unix.O_TRUNC :: flags) perm
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
let setFileinfo fspathTo pathTo realPathTo update desc =
match update with
`Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc
| `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc
(****)
let copyContents fspathFrom pathFrom fspathTo pathTo fileKind fileLength ido =
let use_id f = match ido with Some id -> f id | None -> () in
let inFd = openFileIn fspathFrom pathFrom fileKind in
protect
(fun () ->
let outFd = openFileOut fspathTo pathTo fileKind fileLength in
protect
(fun () ->
Uutil.readWriteBounded inFd outFd fileLength
(fun l ->
use_id (fun id ->
Uutil.showProgress id (Uutil.Filesize.ofInt l) "l"));
close_in inFd;
close_out outFd)
(fun () -> close_out_noerr outFd))
(fun () -> close_in_noerr inFd)
let localFile
fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido =
Util.convertUnixErrorsToTransient
"copying locally"
(fun () ->
debug (fun () ->
Util.msg "Copy.localFile %s / %s to %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathFrom)
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
removeOldTempFile fspathTo pathTo;
copyContents
fspathFrom pathFrom fspathTo pathTo `DATA (Props.length desc) ido;
if ressLength > Uutil.Filesize.zero then
copyContents
fspathFrom pathFrom fspathTo pathTo `RESS ressLength ido;
setFileinfo fspathTo pathTo realPathTo update desc)
(****)
let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id =
if not (Prefs.read Xferhint.xferbycopying) then None else
Util.convertUnixErrorsToTransient "tryCopyMovedFile" (fun() ->
debug (fun () -> Util.msg "tryCopyMovedFile: -> %s /%s/\n"
(Path.toString pathTo) (Os.fullfingerprint_to_string fp));
match Xferhint.lookup fp with
None ->
None
| Some (candidateFspath, candidatePath, hintHandle) ->
debug (fun () ->
Util.msg
"tryCopyMovedFile: found match at %s,%s. Try local copying\n"
(Fspath.toDebugString candidateFspath)
(Path.toString candidatePath));
try
(* If candidateFspath is the replica root, the argument
[true] is correct. Otherwise, we don't expect to point
to a symlink, and therefore we still get the correct
result. *)
let info = Fileinfo.get true candidateFspath candidatePath in
if
info.Fileinfo.typ <> `ABSENT &&
Props.length info.Fileinfo.desc = Props.length desc
then begin
localFile
candidateFspath candidatePath fspathTo pathTo realPathTo
update desc (Osx.ressLength ress) (Some id);
let (info, isTransferred) =
fileIsTransferred fspathTo pathTo desc fp ress in
if isTransferred then begin
debug (fun () -> Util.msg "tryCopyMoveFile: success.\n");
let msg =
Printf.sprintf
"Shortcut: copied %s/%s from local file %s/%s\n"
(Fspath.toPrintString fspathTo)
(Path.toString realPathTo)
(Fspath.toPrintString candidateFspath)
(Path.toString candidatePath)
in
Some (info, msg)
end else begin
debug (fun () ->
Util.msg "tryCopyMoveFile: candidate file %s modified!\n"
(Path.toString candidatePath));
Xferhint.deleteEntry hintHandle;
None
end
end else begin
debug (fun () ->
Util.msg "tryCopyMoveFile: candidate file %s disappeared!\n"
(Path.toString candidatePath));
Xferhint.deleteEntry hintHandle;
None
end
with
Util.Transient s ->
debug (fun () ->
Util.msg
"tryCopyMovedFile: local copy from %s didn't work [%s]"
(Path.toString candidatePath) s);
Xferhint.deleteEntry hintHandle;
None)
(****)
(* The file transfer functions here depend on an external module
'transfer' that implements a generic transmission and the rsync
algorithm for optimizing the file transfer in the case where a
similar file already exists on the target. *)
let rsyncActivated =
Prefs.createBool "rsync" true
"!activate the rsync transfer mode"
("Unison uses the 'rsync algorithm' for 'diffs-only' transfer "
^ "of updates to large files. Setting this flag to false makes Unison "
^ "use whole-file transfers instead. Under normal circumstances, "
^ "there is no reason to do this, but if you are having trouble with "
^ "repeated 'rsync failure' errors, setting it to "
^ "false should permit you to synchronize the offending files.")
let decompressor = ref Remote.MsgIdMap.empty
let processTransferInstruction conn (file_id, ti) =
Util.convertUnixErrorsToTransient
"processing a transfer instruction"
(fun () ->
ignore (Remote.MsgIdMap.find file_id !decompressor ti))
let marshalTransferInstruction =
(fun (file_id, (data, pos, len)) rem ->
(Remote.encodeInt file_id :: (data, pos, len) :: rem,
len + Remote.intSize)),
(fun buf pos ->
let len = Bytearray.length buf - pos - Remote.intSize in
(Remote.decodeInt buf pos, (buf, pos + Remote.intSize, len)))
let streamTransferInstruction =
Remote.registerStreamCmd
"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
(fun () ->
streamTransferInstruction conn
(fun processTransferInstructionRemotely ->
(* We abort the file transfer on error if it has not
already started *)
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 =
match biOpt with
None ->
Transfer.send infd sizeFrom showProgress
| Some bi ->
Transfer.Rsync.rsyncCompress
bi infd sizeFrom showProgress
in
compr
(fun ti -> processTransferInstructionRemotely (file_id, ti))
>>= fun () ->
close_in infd;
Lwt.return ())
(fun () ->
close_in_noerr infd)))
(fun e ->
(* We cannot wrap the code above with the handler below,
as the code is executed asynchronously. *)
Util.convertUnixErrorsToTransient "transferring file contents"
(fun () -> raise e))
let compressRemotely = Remote.registerServerCmd "compress" compress
let close_all infd outfd =
Util.convertUnixErrorsToTransient
"closing files"
(fun () ->
begin match !infd with
Some fd -> close_in fd; infd := None
| None -> ()
end;
begin match !outfd with
Some fd -> close_out fd; outfd := None
| None -> ()
end)
let close_all_no_error infd outfd =
begin match !infd with
Some fd -> close_in_noerr fd
| None -> ()
end;
begin match !outfd with
Some fd -> close_out_noerr fd
| None -> ()
end
(* Lazy creation of the destination file *)
let destinationFd fspath path kind len outfd id =
match !outfd with
None ->
(* We abort the file transfer on error if it has not
already started *)
if kind <> `RESS then Abort.check id;
let fd = openFileOut fspath path kind len in
showPrefixProgress id kind;
outfd := Some fd;
fd
| 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
let l = Transfer.Rsync.memoryFootprint srcFileSize destFileSize in
Lwt_util.run_in_region rsyncReg l f
let transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
fileKind srcFileSize id =
(* 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 =
Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in
let destFileSize =
match update with
`Copy ->
Uutil.Filesize.zero
| `Update (destFileDataSize, destFileRessSize) ->
match fileKind with
`DATA | `DATA_APPEND _ -> destFileDataSize
| `RESS -> destFileRessSize
in
let useRsync =
Prefs.read rsyncActivated
&&
Transfer.Rsync.aboveRsyncThreshold destFileSize
&&
Transfer.Rsync.aboveRsyncThreshold srcFileSize
in
rsyncThrottle useRsync srcFileSize destFileSize (fun () ->
let (bi, decompr) =
if useRsync then
Util.convertUnixErrorsToTransient
"preprocessing file"
(fun () ->
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
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 close_all infd outfd))
else
(None,
(* Simple generic decompressor *)
fun ti ->
let fd =
destinationFd fspathTo pathTo fileKind srcFileSize outfd id in
let eof = Transfer.receive fd showProgress ti in
if eof then close_all infd outfd)
in
let file_id = Remote.newMsgId () in
Lwt.catch
(fun () ->
decompressor := Remote.MsgIdMap.add file_id decompr !decompressor;
compressRemotely connFrom
(bi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id)
>>= fun () ->
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 :=
Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
close_all_no_error infd outfd;
Lwt.fail e))
(****)
let transferRessourceForkAndSetFileinfo
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id =
(* Resource fork *)
let ressLength = Osx.ressLength ress in
begin if ressLength > Uutil.Filesize.zero then
transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
`RESS ressLength id
else
Lwt.return ()
end >>= fun () ->
setFileinfo fspathTo pathTo realPathTo update desc;
paranoidCheck fspathTo pathTo realPathTo desc fp ress
let reallyTransferFile
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
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));
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
(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
(****)
let filesBeingTransferred = Hashtbl.create 17
let wakeupNextTransfer fp =
match
try
Some (Queue.take (Hashtbl.find filesBeingTransferred fp))
with Queue.Empty ->
None
with
None ->
Hashtbl.remove filesBeingTransferred fp
| Some next ->
Lwt.wakeup next ()
let executeTransfer fp f =
Lwt.try_bind f
(fun res -> wakeupNextTransfer fp; Lwt.return res)
(fun e -> wakeupNextTransfer fp; Lwt.fail e)
(* Keep track of which file contents are being transferred, and delay
the transfer of a file with the same contents as another file being
currently transferred. This way, the second transfer can be
skipped and replaced by a local copy. *)
let rec registerFileTransfer pathTo fp f =
if not (Prefs.read Xferhint.xferbycopying) then f () else
match
try Some (Hashtbl.find filesBeingTransferred fp) with Not_found -> None
with
None ->
let q = Queue.create () in
Hashtbl.add filesBeingTransferred fp q;
executeTransfer fp f
| Some q ->
debug (fun () -> Util.msg "delaying tranfer of file %s\n"
(Path.toString pathTo));
let res = Lwt.wait () in
Queue.push res q;
res >>= fun () ->
executeTransfer fp f
(****)
let copyprog =
Prefs.createString "copyprog" "rsync --partial --inplace --compress"
"!external program for copying large files"
("A string giving the name of an "
^ "external program that can be used to copy large files efficiently "
^ "(plus command-line switches telling it to copy files in-place). "
^ "The default setting invokes {\\tt rsync} with appropriate "
^ "options---most users should not need to change it.")
let copyprogrest =
Prefs.createString
"copyprogrest" "rsync --partial --append-verify --compress"
"!variant of copyprog for resuming partial transfers"
("A variant of {\\tt copyprog} that names an external program "
^ "that should be used to continue the transfer of a large file "
^ "that has already been partially transferred. Typically, "
^ "{\\tt copyprogrest} will just be {\\tt copyprog} "
^ "with one extra option (e.g., {\\tt --partial}, for rsync). "
^ "The default setting invokes {\\tt rsync} with appropriate "
^ "options---most users should not need to change it.")
let copythreshold =
Prefs.createInt "copythreshold" (-1)
"!use copyprog on files bigger than this (if >=0, in Kb)"
("A number indicating above what filesize (in kilobytes) Unison should "
^ "use the external "
^ "copying utility specified by {\\tt copyprog}. Specifying 0 will cause "
^ "{\\em all} copies to use the external program; "
^ "a negative number will prevent any files from using it. "
^ "The default is -1. "
^ "See \\sectionref{speeding}{Making Unison Faster on Large Files} "
^ "for more information.")
let copyquoterem =
Prefs.createBoolWithDefault "copyquoterem"
"!add quotes to remote file name for copyprog (true/false/default)"
("When set to {\\tt true}, this flag causes Unison to add an extra layer "
^ "of quotes to the remote path passed to the external copy program. "
^ "This is needed by rsync, for example, which internally uses an ssh "
^ "connection requiring an extra level of quoting for paths containing "
^ "spaces. When this flag is set to {\\tt default}, extra quotes are "
^ "added if the value of {\\tt copyprog} contains the string "
^ "{\\tt rsync}.")
let copymax =
Prefs.createInt "copymax" 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, _ -> ""
| Common.Remote h, _ ->
(* Find the (unique) nonlocal root *)
match
Safelist.find (function Clroot.ConnectLocal _ -> false | _ -> true)
(Safelist.map Clroot.parseRoot (Globals.rawRoots()))
with
Clroot.ConnectByShell (_,rawhost,uo,_,_) ->
(match uo with None -> "" | Some u -> u ^ "@")
^ rawhost ^ ":"
(* Note that we don't do anything with the port -- hopefully
this will not affect many people. If we did want to include it,
we'd have to fiddle with the rsync parameters in a slightly
deeper way. *)
| Clroot.ConnectBySocket (h',_,_) ->
h ^ ":"
| Clroot.ConnectLocal _ -> assert false
let shouldUseExternalCopyprog update desc =
Prefs.read copyprog <> ""
&& Prefs.read copythreshold >= 0
&& Props.length desc >= Uutil.Filesize.ofInt64 (Int64.of_int 1)
&& Props.length desc >=
Uutil.Filesize.ofInt64
(Int64.mul (Int64.of_int 1000)
(Int64.of_int (Prefs.read copythreshold)))
&& update = `Copy
let prepareExternalTransfer fspathTo pathTo =
let info = Fileinfo.get false fspathTo pathTo in
match info.Fileinfo.typ with
`FILE when Props.length info.Fileinfo.desc > Uutil.Filesize.zero ->
let perms = Props.perms info.Fileinfo.desc in
let perms' = perms lor 0o600 in
begin try
Fs.chmod (Fspath.concat fspathTo pathTo) perms'
with Unix.Unix_error _ -> () end;
true
| `ABSENT ->
false
| _ ->
debug (fun() -> Util.msg "Removing old temp file %s / %s\n"
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
Os.delete fspathTo pathTo;
false
let finishExternalTransferLocal connFrom
(fspathFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) =
let info = Fileinfo.get false fspathTo pathTo in
if
info.Fileinfo.typ <> `FILE ||
Props.length info.Fileinfo.desc <> Props.length desc
then
raise (Util.Transient (Printf.sprintf
"External copy program did not create target file (or bad length): %s"
(Path.toString pathTo)));
transferRessourceForkAndSetFileinfo
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id >>= fun res ->
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return res
let finishExternalTransferOnRoot =
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 =
Uutil.showProgress id Uutil.Filesize.zero "ext";
let prog =
if useExistingTarget then
Prefs.read copyprogrest
else
Prefs.read copyprog
in
let extraquotes = Prefs.read copyquoterem = `True
|| ( Prefs.read copyquoterem = `Default
&& Util.findsubstring "rsync" prog <> None) in
let addquotes root s =
match root with
| Common.Local, _ -> s
| Common.Remote _, _ -> if extraquotes then Uutil.quotes s else s in
let fromSpec =
(formatConnectionInfo rootFrom)
^ (addquotes rootFrom
(Fspath.toString (Fspath.concat (snd rootFrom) pathFrom))) in
let toSpec =
(formatConnectionInfo rootTo)
^ (addquotes rootTo
(Fspath.toString (Fspath.concat fspathTo pathTo))) in
let cmd = prog ^ " "
^ (Uutil.quotes fromSpec) ^ " "
^ (Uutil.quotes toSpec) in
Trace.log (Printf.sprintf "%s\n" cmd);
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"
(Path.toString pathFrom)
l (if l="" then "" else "\n"));
Uutil.showProgress id (Props.length desc) "ext";
finishExternalTransferOnRoot rootTo rootFrom
(snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id)
(****)
let transferFileLocal connFrom
(fspathFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) =
let (tempInfo, isTransferred) =
fileIsTransferred fspathTo pathTo desc fp ress in
if isTransferred then begin
(* File is already fully transferred (from some interrupted
previous transfer). *)
(* Make sure permissions are right. *)
let msg =
Printf.sprintf
"%s/%s has already been transferred\n"
(Fspath.toDebugString fspathTo) (Path.toString realPathTo)
in
let len = Uutil.Filesize.add (Props.length desc) (Osx.ressLength ress) in
Uutil.showProgress id len "alr";
setFileinfo fspathTo pathTo realPathTo update desc;
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (Success tempInfo, Some msg))
end else
registerFileTransfer pathTo fp
(fun () ->
match
tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id
with
Some (info, msg) ->
(* Transfer was performed by copying *)
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (Success info, Some msg))
| None ->
if shouldUseExternalCopyprog update desc then
Lwt.return (`EXTERNAL (prepareExternalTransfer fspathTo pathTo))
else begin
reallyTransferFile
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id tempInfo >>= fun status ->
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (status, None))
end)
let transferFileOnRoot =
Remote.registerRootCmdWithConnection "transferFile" transferFileLocal
(* We limit the size of the output buffers to about 512 KB
(we cannot go above the limit below plus 64) *)
let transferFileReg = Lwt_util.make_region 440
let bufferSize sz =
min 64 ((truncate (Uutil.Filesize.toFloat sz) + 1023) / 1024)
(* Token queue *)
+
8 (* Read buffer *)
let transferFile
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id =
let f () =
Abort.check id;
transferFileOnRoot rootTo rootFrom
(snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) >>= fun status ->
match status with
`DONE (status, msg) ->
begin match msg with
Some msg ->
(* If the file was already present or transferred by copying
on the server, we need to update the amount of data
transferred so far here. *)
if fst rootTo <> Common.Local then begin
let len =
Uutil.Filesize.add (Props.length desc) (Osx.ressLength ress)
in
Uutil.showProgress id len "rem"
end;
Trace.log msg
| None ->
()
end;
Lwt.return status
| `EXTERNAL useExistingTarget ->
transferFileUsingExternalCopyprog
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id useExistingTarget
in
(* When streaming, we only transfer one file at a time, so we don't
need to limit the number of concurrent transfers *)
if Prefs.read Remote.streamingActivated then
f ()
else
let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in
Lwt_util.run_in_region transferFileReg bufSz f
(****)
let file rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp stamp ress id =
debug (fun() -> Util.msg "copyRegFile(%s,%s) -> (%s,%s,%s,%s,%s)\n"
(Common.root2string rootFrom) (Path.toString pathFrom)
(Common.root2string rootTo) (Path.toString realPathTo)
(Fspath.toDebugString fspathTo) (Path.toString pathTo)
(Props.toString desc));
let timer = Trace.startTimer "Transmitting file" in
begin match rootFrom, rootTo with
(Common.Local, fspathFrom), (Common.Local, realFspathTo) ->
localFile
fspathFrom pathFrom fspathTo pathTo realPathTo
update desc (Osx.ressLength ress) (Some id);
paranoidCheck fspathTo pathTo realPathTo desc fp ress
| _ ->
transferFile
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id
end >>= fun status ->
Trace.showTimer timer;
match status with
Success info ->
checkContentsChange rootFrom pathFrom desc fp stamp ress false
>>= fun () ->
Lwt.return info
| Failure reason ->
(* Maybe we failed because the source file was modified.
We check this before reporting a failure *)
checkContentsChange rootFrom pathFrom desc fp stamp ress true
>>= fun () ->
(* This function always fails! *)
saveTempFileOnRoot rootTo (pathTo, realPathTo, reason)
unison-2.40.102/mkProjectInfo.ml 0000644 0061316 0061316 00000007720 12025627377 016522 0 ustar bcpierce bcpierce (* Program for printing project info into a Makefile. Documentation below. *)
(* FIX: When the time comes for the next alpha-release, remember to
increment the archive version number first. See update.ml. *)
let projectName = "unison"
let majorVersion = 2
let minorVersion = 40
let pointVersionOrigin = 409 (* Revision that corresponds to point version 0 *)
(* Documentation:
This is a program to construct a version of the form Major.Minor.Point,
e.g., 2.10.4.
The Point release number is calculated from the Subversion revision number,
so it will be automatically incremented on svn commit.
The Major and Minor numbers are hard coded, as is the revision number
corresponding to the 0 point release.
If you want to increment the Major or Minor number, you will have to do a
little thinking to get the Point number back to 0. Suppose the current svn
revision number is 27, and we have below
let majorVersion = 2
let minorVersion = 11
let pointVersionOrigin = 3
This means that the current Unison version is 2.11.24, since 27-3 = 24.
If we want to change the release to 3.0.0 we need to change things to
let majorVersion = 3
let minorVersion = 0
let pointVersionOrigin = 28
and then do a svn commit.
The first two lines are obvious. The last line says that Subversion
revision 28 corresponds to a 0 point release. Since we were at revision
27 and we're going to do a commit before making a release, we
will be at 28 after the commit and this will be Unison version 3.0.0.
*)
(* ---------------------------------------------------------------------- *)
(* You shouldn't need to edit below. *)
let revisionString = "$Rev: 511 $";;
(* BCP (1/10): This bit was added to help with getting Unison via bazaar, but it
was never used much and I'm not confident it's working. I'll comment it out
for now, but if it hasn't been needed or fixed in a few months, the next
person that edits this file should delete it...
(* extract a substring using a regular expression *)
let extract_str re str =
let _ = Str.search_forward (Str.regexp re) str 0 in
Str.matched_group 1 str;;
let extract_int re str = int_of_string (extract_str re str);;
(* run the bzr tool to get version information for bzr branches *)
exception BzrException of Unix.process_status;;
let bzr args =
let bzr = (try Sys.getenv "BZR" with Not_found -> "bzr") in
let cmd = bzr ^ " " ^ args in
let inc = Unix.open_process_in cmd in
let buf = Buffer.create 16 in
(try
while true do
Buffer.add_channel buf inc 1
done
with End_of_file -> ());
let status = Unix.close_process_in inc in
match status with
Unix.WEXITED 0 -> Buffer.contents buf
| _ -> raise (BzrException status);;
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:
- The mentioned revision number might not be part of this branch
- The mentioned revision number might be rhs of some merge
- The bzr-svn plugin might be outdated or not installed at all
On the whole, getting this to work seems too much effort for now.
So we'll simply use the revno as is as the point version,
and revisit offsetting them if unison should ever move its trunk to bzr.
let pvo = extract_int "^revno:[ \t]*\\([0-9]+\\)[ \t]*$"
(bzr ("log -r svn:" ^
string_of_int pointVersionOrigin)) in
*)
extract_int "^\\([0-9]+\\)$" (bzr "revno") (* - pvo *);;
*)
let pointVersion =
Scanf.sscanf revisionString "$Rev: %d " (fun x -> x) - pointVersionOrigin;;
Printf.printf "MAJORVERSION=%d.%d\n" majorVersion minorVersion;;
Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion pointVersion;;
Printf.printf "NAME=%s\n" projectName;;
unison-2.40.102/stasher.ml 0000644 0061316 0061316 00000054327 11361646373 015425 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/stasher.ml *)
(* $I2: Last modified by lescuyer *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* --------------------------------------------------------------------------*)
(* Preferences for backing up and stashing *)
let debug = Util.debug "stasher"
let verbose = Util.debug "stasher+"
let backuplocation =
Prefs.createString "backuploc" "central"
"!where backups are stored ('local' or 'central')"
("This preference determines whether backups should be kept locally, near the "
^ "original files, or"
^" in a central directory specified by the \\texttt{backupdir} "
^"preference. If set to \\verb|local|, backups will be kept in "
^"the same directory as the original files, and if set to \\verb|central|,"
^" \\texttt{backupdir} will be used instead.")
let _ = Prefs.alias backuplocation "backuplocation"
let backup =
Pred.create "backup" ~advanced:true
("Including the preference \\texttt{-backup \\ARG{pathspec}} "
^ "causes Unison to keep backup files for each path that matches "
^ "\\ARG{pathspec}. These backup files are kept in the "
^ "directory specified by the \\verb|backuplocation| preference. The backups are named "
^ "according to the \\verb|backupprefix| and \\verb|backupsuffix| preferences."
^ " The number of versions that are kept is determined by the "
^ "\\verb|maxbackups| preference."
^ "\n\n The syntax of \\ARG{pathspec} is described in "
^ "\\sectionref{pathspec}{Path Specification}.")
let _ = Pred.alias backup "mirror"
let backupnot =
Pred.create "backupnot" ~advanced:true
("The values of this preference specify paths or individual files or"
^ " regular expressions that should {\\em not} "
^ "be backed up, even if the {\\tt backup} preference selects "
^ "them---i.e., "
^ "it selectively overrides {\\tt backup}. The same caveats apply here "
^ "as with {\\tt ignore} and {\\tt ignorenot}.")
let _ = Pred.alias backupnot "mirrornot"
let shouldBackup p =
let s = (Path.toString p) in
Pred.test backup s && not (Pred.test backupnot s)
let backupprefix =
Prefs.createString "backupprefix" ".bak.$VERSION."
"!prefix for the names of backup files"
("When a backup for a file \\verb|NAME| is created, it is stored "
^ "in a directory specified by \\texttt{backuplocation}, in a file called "
^ "\\texttt{backupprefix}\\verb|NAME|\\texttt{backupsuffix}."
^ " \\texttt{backupprefix} can include a directory name (causing Unison to "
^ "keep all backup files for a given directory in a subdirectory with this name), and both "
^ " \\texttt{backupprefix} and \\texttt{backupsuffix} can contain the string"
^ "\\ARG{\\$VERSION}, which will be replaced by the \\emph{age} of the backup "
^ "(1 for the most recent, 2 for the second most recent, and so on...)."
^ " This keyword is ignored if it appears in a directory name"
^ " in the prefix; if it does not appear anywhere"
^ " in the prefix or the suffix, it will be automatically"
^ " placed at the beginning of the suffix. "
^ "\n\n"
^ "One thing to be careful of: If the {\\tt backuploc} preference is set "
^ "to {\\tt local}, Unison will automatically ignore {\\em all} files "
^ "whose prefix and suffix match {\\tt backupprefix} and {\\tt backupsuffix}. "
^ "So be careful to choose values for these preferences that are sufficiently "
^ "different from the names of your real files.")
let backupsuffix =
Prefs.createString "backupsuffix" ""
"!a suffix to be added to names of backup files"
("See \\texttt{backupprefix} for full documentation.")
let backups =
Prefs.createBool "backups" false
"!keep backup copies of all files (see also 'backup')"
("Setting this flag to true is equivalent to "
^" setting \\texttt{backuplocation} to \\texttt{local}"
^" and \\texttt{backup} to \\verb|Name *|.")
(* The following function is used to express the old backup preference, if set,
in the terms of the new preferences *)
let translateOldPrefs () =
match (Pred.extern backup, Pred.extern backupnot, Prefs.read backups) with
([], [], true) ->
debug (fun () ->
Util.msg "backups preference set: translated into backup and backuplocation\n");
Pred.intern backup ["Name *"];
Prefs.set backuplocation "local"
| (_, _, false) ->
()
| _ -> raise (Util.Fatal ( "Both old 'backups' preference and "
^ "new 'backup' preference are set!"))
let maxbackups =
Prefs.createInt "maxbackups" 2
"!number of backed up versions of a file"
("This preference specifies the number of backup versions that will "
^ "be kept by unison, for each path that matches the predicate "
^ "\\verb|backup|. The default is 2.")
let _ = Prefs.alias maxbackups "mirrorversions"
let _ = Prefs.alias maxbackups "backupversions"
let backupdir =
Prefs.createString "backupdir" ""
"!directory for storing centralized backups"
("If this preference is set, Unison will use it as the name of the "
^ "directory used to store backup files specified by "
^ "the {\\tt backup} preference, when {\\tt backuplocation} is set"
^ " to \\verb|central|. It is checked {\\em after} the "
^ "{\\tt UNISONBACKUPDIR} environment variable.")
let backupDirectory () =
Util.convertUnixErrorsToTransient "backupDirectory()" (fun () ->
try Fspath.canonize (Some (System.getenv "UNISONBACKUPDIR"))
with Not_found ->
try Fspath.canonize (Some (System.getenv "UNISONMIRRORDIR"))
with Not_found ->
if Prefs.read backupdir <> ""
then Fspath.canonize (Some (Prefs.read backupdir))
else Fspath.canonize
(Some (System.fspathToString (Os.fileInUnisonDir "backup"))))
let backupcurrent =
Pred.create "backupcurr" ~advanced:true
("Including the preference \\texttt{-backupcurr \\ARG{pathspec}} "
^" causes Unison to keep a backup of the {\\em current} version of every file "
^ "matching \\ARG{pathspec}. "
^" This file will be saved as a backup with version number 000. Such"
^" backups can be used as inputs to external merging programs, for instance. See "
^ "the documentatation for the \\verb|merge| preference."
^" For more details, see \\sectionref{merge}{Merging Conflicting Versions}."
^"\n\n The syntax of \\ARG{pathspec} is described in "
^ "\\sectionref{pathspec}{Path Specification}.")
let backupcurrentnot =
Pred.create "backupcurrnot" ~advanced:true
"Exceptions to \\verb|backupcurr|, like the \\verb|ignorenot| preference."
let shouldBackupCurrent p =
(* BCP: removed next line [Apr 2007]: causes ALL mergeable files to be backed
up, which is probably not what users want -- the backupcurrent
switch should be used instead.
Globals.shouldMerge p || *)
(let s = Path.toString p in
Pred.test backupcurrent s && not (Pred.test backupcurrentnot s))
let _ = Pred.alias backupcurrent "backupcurrent"
let _ = Pred.alias backupcurrentnot "backupcurrentnot"
(* ---------------------------------------------------------------------------*)
(* NB: We use Str.regexp here because we need group matching to retrieve
and increment version numbers from backup file names. We only use
it here, though: to check if a path should be backed up or ignored, we
use Rx instead. (This is important because the Str regexp functions are
terribly slow.) *)
(* A tuple of string option * string * string, describing a regular
expression that matches the filenames of unison backups according
to the current preferences. The first regexp is an option to match
the local directory, if any, in which backups are stored; the second
one matches the prefix, the third the suffix.
Note that we always use forward slashes here (rather than using backslashes
when running on windows) because we are constructing rx's that are going to
be matched against Path.t's. (Strictly speaking, we ought to ask the Path
module what the path separator character is, rather than assuming it is slash,
but this is never going to change.)
*)
let backup_rx () =
let version_rx = "\\([0-9]+\\)" in
let prefix = Prefs.read backupprefix in
let suffix = Str.quote (Prefs.read backupsuffix) in
let (udir, uprefix) =
((match Filename.dirname prefix with
| "." -> ""
| s -> (Fileutil.backslashes2forwardslashes s)^"/"),
Filename.basename prefix) in
let (dir, prefix) =
((match udir with "" -> None | _ -> Some(Str.quote udir)), Str.quote uprefix) in
if Str.string_match (Str.regexp ".*\\\\\\$VERSION.*") (prefix^suffix) 0 then
(dir,
Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx prefix,
Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx suffix)
else
raise (Util.Fatal "Either backupprefix or backupsuffix must contain '$VERSION'")
(* We ignore files whose name ends in .unison.bak, since people may still have these
lying around from using previous versions of Unison. *)
let oldBackupPrefPathspec = "Name *.unison.bak"
(* This function creates Rx regexps based on the preferences to ignore
backups of old and current versions. *)
let addBackupFilesToIgnorePref () =
let (dir_rx, prefix_rx, suffix_rx) = backup_rx() in
let regexp_to_rx s =
Str.global_replace (Str.regexp "\\\\(") ""
(Str.global_replace (Str.regexp "\\\\)") "" s) in
let (full, dir) =
let d =
match dir_rx with
None -> "/"
| Some s -> regexp_to_rx s in
let p = regexp_to_rx prefix_rx in
let s = regexp_to_rx suffix_rx in
debug (fun() -> Util.msg "d = %s\n" d);
("(.*/)?"^p^".*"^s, "(.*/)?"^(String.sub d 0 (String.length d - 1))) in
let theRegExp =
match dir_rx with
None -> "Regex " ^ full
| Some _ -> "Regex " ^ dir in
Globals.addRegexpToIgnore oldBackupPrefPathspec;
if Prefs.read backuplocation = "local" then begin
debug (fun () ->
Util.msg "New pattern being added to ignore preferences (for backup files):\n %s\n"
theRegExp);
Globals.addRegexpToIgnore theRegExp
end
(* We use references for functions that compute the prefixes and suffixes
in order to avoid using functions from the Str module each time we need them. *)
let make_prefix = ref (fun i -> assert false)
let make_suffix = ref (fun i -> assert false)
(* This function updates the function used to create prefixes and suffixes
for naming backup files, according to the preferences. *)
let updateBackupNamingFunctions () =
let makeFun s =
match Str.full_split (Str.regexp "\\$VERSION") s with
[] -> (fun _ -> "")
| [Str.Text t] ->
(fun _ -> t)
| [Str.Delim _; Str.Text t] ->
(fun i -> Printf.sprintf "%d%s" i t)
| [Str.Text t; Str.Delim _] ->
(fun i -> Printf.sprintf "%s%d" t i)
| [Str.Text t; Str.Delim _; Str.Text t'] ->
(fun i -> Printf.sprintf "%s%d%s" t i t')
| _ -> raise (Util.Fatal (
"The tag $VERSION should only appear "
^"once in the backupprefix and backupsuffix preferences.")) in
make_prefix := makeFun (Prefs.read backupprefix);
make_suffix := makeFun (Prefs.read backupsuffix);
debug (fun () -> Util.msg
"Prefix and suffix regexps for backup filenames have been updated\n")
(*------------------------------------------------------------------------------------*)
let makeBackupName path i =
(* if backups are kept centrally, the current version has exactly
the same name as the original, for convenience. *)
if i=0 && Prefs.read backuplocation = "central" then
path
else
Path.addSuffixToFinalName
(Path.addPrefixToFinalName path (!make_prefix i))
(!make_suffix i)
let stashDirectory fspath =
match Prefs.read backuplocation with
"central" -> backupDirectory ()
| "local" -> fspath
| _ -> raise (Util.Fatal ("backuplocation preference should be set"
^"to central or local."))
let showContent typ fspath path =
match typ with
| `FILE -> Fingerprint.toString (Fingerprint.file fspath path)
| `SYMLINK -> Os.readLink fspath path
| `DIRECTORY -> "DIR"
| `ABSENT -> "ABSENT"
(* Generates a file name for a backup file. If backup file already exists,
the old file will be renamed with the count incremented. The newest
backup file is always the one with version number 1, larger numbers mean
older files. *)
(* BCP: Note that the way we keep bumping up the backup numbers on all existing
backup files could make backups very expensive if someone sets maxbackups to a
sufficiently large number!
*)
let backupPath fspath path =
let sFspath = stashDirectory fspath in
let rec f i =
let tempPath = makeBackupName path i in
if Os.exists sFspath tempPath then
if i < Prefs.read maxbackups then
Os.rename "backupPath" sFspath tempPath sFspath (f (i + 1))
else if i >= Prefs.read maxbackups then
Os.delete sFspath tempPath;
tempPath in
let rec mkdirectories backdir =
verbose (fun () -> Util.msg
"mkdirectories %s %s\n"
(Fspath.toDebugString sFspath) (Path.toString backdir));
if not (Os.exists sFspath Path.empty) then
Os.createDir sFspath Path.empty Props.dirDefault;
match Path.deconstructRev backdir with
None -> ()
| Some (_, parent) ->
mkdirectories parent;
let props = (Fileinfo.get false sFspath Path.empty).Fileinfo.desc in
if not (Os.exists sFspath backdir) then Os.createDir sFspath backdir props in
let path0 = makeBackupName path 0 in
let sourceTyp = (Fileinfo.get true fspath path).Fileinfo.typ in
let path0Typ = (Fileinfo.get false sFspath path0).Fileinfo.typ in
if ( sourceTyp = `FILE && path0Typ = `FILE
&& (Fingerprint.file fspath path) = (Fingerprint.file sFspath path0))
|| ( sourceTyp = `SYMLINK && path0Typ = `SYMLINK
&& (Os.readLink fspath path) = (Os.readLink sFspath path0))
then begin
debug (fun()-> Util.msg
"[%s / %s] = [%s / %s] = %s: no need to back up\n"
(Fspath.toDebugString sFspath) (Path.toString path0)
(Fspath.toDebugString fspath) (Path.toString path)
(showContent sourceTyp fspath path));
None
end else begin
debug (fun()-> Util.msg
"stashed [%s / %s] = %s is not equal to new [%s / %s] = %s (or one is a dir): stash!\n"
(Fspath.toDebugString sFspath) (Path.toString path0)
(showContent path0Typ sFspath path0)
(Fspath.toDebugString fspath) (Path.toString path)
(showContent sourceTyp fspath path));
let sPath = f 0 in
(* Make sure the parent directory exists *)
begin match Path.deconstructRev sPath with
| None -> mkdirectories Path.empty
| Some (_, backdir) -> mkdirectories backdir
end;
Some(sFspath, sPath)
end
(*------------------------------------------------------------------------------------*)
let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) arch =
debug (fun () -> Util.msg
"backup: %s / %s\n"
(Fspath.toDebugString fspath)
(Path.toString path));
Util.convertUnixErrorsToTransient "backup" (fun () ->
let (workingDir,realPath) = Fspath.findWorkingDir fspath path in
let disposeIfNeeded() =
if finalDisposition = `AndRemove then
Os.delete workingDir realPath in
if not (Os.exists workingDir realPath) then
debug (fun () -> Util.msg
"File %s in %s does not exist, so no need to back up\n"
(Path.toString path) (Fspath.toDebugString fspath))
else if shouldBackup path then begin
match backupPath fspath path with
None -> disposeIfNeeded()
| Some (backRoot, backPath) ->
debug (fun () -> Util.msg "Backing up %s / %s to %s in %s\n"
(Fspath.toDebugString fspath) (Path.toString path)
(Path.toString backPath) (Fspath.toDebugString backRoot));
let byCopying() =
let rec copy p backp =
let info = Fileinfo.get true fspath p in
match info.Fileinfo.typ with
| `SYMLINK ->
debug (fun () -> Util.msg " Copying link %s / %s to %s / %s\n"
(Fspath.toDebugString fspath) (Path.toString p)
(Fspath.toDebugString backRoot) (Path.toString backp));
Os.symlink backRoot backp (Os.readLink fspath p)
| `FILE ->
debug (fun () -> Util.msg " Copying file %s / %s to %s / %s\n"
(Fspath.toDebugString fspath) (Path.toString p)
(Fspath.toDebugString backRoot) (Path.toString backp));
Copy.localFile fspath p backRoot backp backp
`Copy info.Fileinfo.desc
(Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) None
| `DIRECTORY ->
debug (fun () -> Util.msg " Copying directory %s / %s to %s / %s\n"
(Fspath.toDebugString fspath) (Path.toString p)
(Fspath.toDebugString backRoot) (Path.toString backp));
Os.createDir backRoot backp info.Fileinfo.desc;
let ch = Os.childrenOf fspath p in
Safelist.iter (fun n -> copy (Path.child p n) (Path.child backp n)) ch
| `ABSENT -> assert false in
copy path backPath;
debug (fun () -> Util.msg " Finished copying; deleting %s / %s\n"
(Fspath.toDebugString fspath) (Path.toString path));
disposeIfNeeded() in
begin if finalDisposition = `AndRemove then
try
(*FIX: this does the wrong thing with followed symbolic links!*)
Os.rename "backup" workingDir realPath backRoot backPath
with Util.Transient _ ->
debug (fun () -> Util.msg "Rename failed -- copying instead\n");
byCopying()
else
byCopying()
end;
Update.iterFiles backRoot backPath arch Xferhint.insertEntry
end else begin
debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n"
(Fspath.toDebugString fspath)
(Path.toString path));
disposeIfNeeded()
end)
(*------------------------------------------------------------------------------------*)
let rec stashCurrentVersion fspath path sourcePathOpt =
if shouldBackupCurrent path then
Util.convertUnixErrorsToTransient "stashCurrentVersion" (fun () ->
let sourcePath = match sourcePathOpt with None -> path | Some p -> p in
debug (fun () -> Util.msg "stashCurrentVersion of %s (drawn from %s) in %s\n"
(Path.toString path) (Path.toString sourcePath) (Fspath.toDebugString fspath));
let stat = Fileinfo.get true fspath sourcePath in
match stat.Fileinfo.typ with
`ABSENT -> ()
| `DIRECTORY ->
assert (sourcePathOpt = None);
debug (fun () -> Util.msg "Stashing recursively because file is a directory\n");
ignore (Safelist.iter
(fun n ->
let pathChild = Path.child path n in
if not (Globals.shouldIgnore pathChild) then
stashCurrentVersion fspath (Path.child path n) None)
(Os.childrenOf fspath path))
| `SYMLINK ->
begin match backupPath fspath path with
| None -> ()
| Some (stashFspath,stashPath) ->
Os.symlink stashFspath stashPath (Os.readLink fspath sourcePath)
end
| `FILE ->
begin match backupPath fspath path with
| None -> ()
| Some (stashFspath, stashPath) ->
Copy.localFile
fspath sourcePath
stashFspath stashPath stashPath
`Copy
stat.Fileinfo.desc
(Osx.ressLength stat.Fileinfo.osX.Osx.ressInfo)
None
end)
let _ =
Update.setStasherFun (fun fspath path -> stashCurrentVersion fspath path None)
(*------------------------------------------------------------------------------------*)
(* This function tries to find a backup of a recent version of the file at location
(fspath, path) in the current replica, matching the given fingerprint. If no file
is found, then the functions returns None *without* searching on the other replica *)
let getRecentVersion fspath path fingerprint =
debug (fun () ->
Util.msg "getRecentVersion of %s in %s\n"
(Path.toString path)
(Fspath.toDebugString fspath));
Util.convertUnixErrorsToTransient "getRecentVersion" (fun () ->
let dir = stashDirectory fspath in
let rec aux_find i =
let path = makeBackupName path i in
if Os.exists dir path &&
(let dig = Os.fingerprint dir path (Fileinfo.get false dir path) in
dig = fingerprint)
then begin
debug (fun () ->
Util.msg "recent version %s found in %s\n"
(Path.toString path)
(Fspath.toDebugString dir));
Some (Fspath.concat dir path)
end else
if i = Prefs.read maxbackups then begin
debug (fun () ->
Util.msg "No recent version was available for %s on this root.\n"
(Fspath.toDebugString (Fspath.concat fspath path)));
None
end else
aux_find (i+1)
in
aux_find 0)
(*------------------------------------------------------------------------------------*)
(* This function initializes the Stasher module according to the preferences
defined in the profile. It should be called whenever a profile is reloaded. *)
let initBackupsLocal () =
debug (fun () -> Util.msg "initBackupsLocal\n");
translateOldPrefs ();
addBackupFilesToIgnorePref ();
updateBackupNamingFunctions ()
let initBackupsRoot: Common.root -> unit -> unit Lwt.t =
Remote.registerRootCmd
"initBackups"
(fun (fspath, ()) ->
Lwt.return (initBackupsLocal ()))
let initBackups () =
Lwt_unix.run (
Globals.allRootsIter (fun r -> initBackupsRoot r ()))
unison-2.40.102/osx.ml 0000644 0061316 0061316 00000045027 11453636173 014561 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/osx.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(*
See
http://www.opensource.apple.com/source/copyfile/copyfile-42/copyfile.c
*)
let debug = Trace.debug "osx"
(****)
external isMacOSXPred : unit -> bool = "isMacOSX"
let isMacOSX = isMacOSXPred ()
(****)
let rsrcSync =
Prefs.createBoolWithDefault "rsrc"
"!synchronize resource forks (true/false/default)"
"When set to {\\tt true}, this flag causes Unison to synchronize \
resource forks and HFS meta-data. On filesystems that do not \
natively support resource forks, this data is stored in \
Carbon-compatible .\\_ AppleDouble files. When the flag is set \
to {\\tt false}, Unison will not synchronize these data. \
Ordinarily, the flag is set to {\\tt default}, and these data are
automatically synchronized if either host is running OSX. In \
rare circumstances it is useful to set the flag manually."
(* Defining this variable as a preference ensures that it will be propagated
to the other host during initialization *)
let rsrc =
Prefs.createBool "rsrc-aux" false
"*synchronize resource forks and HFS meta-data" ""
let init b =
Prefs.set rsrc
(Prefs.read rsrcSync = `True ||
(Prefs.read rsrcSync = `Default && b))
(****)
let doubleMagic = "\000\005\022\007"
let doubleVersion = "\000\002\000\000"
let doubleFiller = String.make 16 '\000'
let ressource_fork_empty_tag = "This resource fork intentionally left blank "
let finfoLength = 32L
let emptyFinderInfo () = String.make 32 '\000'
let empty_ressource_fork =
"\000\000\001\000" ^
"\000\000\001\000" ^
"\000\000\000\000" ^
"\000\000\000\030" ^
ressource_fork_empty_tag ^
String.make (66+128) '\000' ^
"\000\000\001\000" ^
"\000\000\001\000" ^
"\000\000\000\000" ^
"\000\000\000\030" ^
"\000\000\000\000" ^
"\000\000\000\000" ^
"\000\028\000\030" ^
"\255\255"
let empty_attribute_chunk () =
"\000\000" ^ (* pad *)
"ATTR" ^ (* magic *)
"\000\000\000\000" ^ (* debug tag *)
"\000\000\014\226" ^ (* total size *)
"\000\000\000\156" ^ (* data_start *)
"\000\000\000\000" ^ (* data_length *)
"\000\000\000\000" ^ (* reserved *)
"\000\000\000\000" ^
"\000\000\000\000" ^
"\000\000" ^ (* flags *)
"\000\000" ^ (* num_attrs *)
String.make 3690 '\000'
let getInt2 buf ofs = (Char.code buf.[ofs]) * 256 + Char.code buf.[ofs + 1]
let getInt4 buf ofs =
let get i = Int64.of_int (Char.code buf.[ofs + i]) in
let combine x y = Int64.logor (Int64.shift_left x 8) y in
combine (combine (combine (get 0) (get 1)) (get 2)) (get 3)
let getID buf ofs =
let get i = Char.code buf.[ofs + i] in
if get ofs <> 0 || get (ofs + 1) <> 0 || get (ofs + 2) <> 0 then
`UNKNOWN
else
match get (ofs + 3) with
2 -> `RSRC
| 9 -> `FINFO
| _ -> `UNKNOWN
let setInt4 v =
let s = String.create 4 in
let set i =
s.[i] <-
Char.chr (Int64.to_int (Int64.logand 255L
(Int64.shift_right v (24 - 8 * i)))) in
set 0; set 1; set 2; set 3;
s
let fail dataFspath dataPath doubleFspath msg =
debug (fun () -> Util.msg "called 'fail'");
raise (Util.Transient
(Format.sprintf
"The AppleDouble Header file '%s' \
associated to data file %s is malformed: %s"
(Fspath.toPrintString doubleFspath)
(Fspath.toPrintString (Fspath.concat dataFspath dataPath)) msg))
let readDouble dataFspath dataPath doubleFspath inch len =
let buf = String.create len in
begin try
really_input inch buf 0 len
with End_of_file ->
fail dataFspath dataPath doubleFspath "truncated"
end;
buf
let readDoubleFromOffset dataFspath dataPath doubleFspath inch offset len =
LargeFile.seek_in inch offset;
readDouble dataFspath dataPath doubleFspath inch len
let writeDoubleFromOffset outch offset str =
LargeFile.seek_out outch offset;
output_string outch str
let protect f g =
try
f ()
with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e ->
begin try g () with Sys_error _ | Unix.Unix_error _ -> () end;
raise e
let openDouble dataFspath dataPath =
let doubleFspath = Fspath.appleDouble (Fspath.concat dataFspath dataPath) in
let inch =
try Fs.open_in_bin doubleFspath with Sys_error _ -> raise Not_found in
protect (fun () ->
Util.convertUnixErrorsToTransient "opening AppleDouble file" (fun () ->
let header = readDouble dataFspath dataPath doubleFspath inch 26 in
if String.sub header 0 4 <> doubleMagic then
fail dataFspath dataPath doubleFspath "bad magic number";
if String.sub header 4 4 <> doubleVersion then
fail dataFspath dataPath doubleFspath "bad version";
let numEntries = getInt2 header 24 in
let entries = ref [] in
for i = 1 to numEntries do
let entry = readDouble dataFspath dataPath doubleFspath inch 12 in
let id = getID entry 0 in
let ofs = getInt4 entry 4 in
let len = getInt4 entry 8 in
entries := (id, (ofs, len)) :: !entries
done;
(doubleFspath, inch, !entries)))
(fun () -> close_in_noerr inch)
(****)
type 'a ressInfo =
NoRess
| HfsRess of Uutil.Filesize.t
| AppleDoubleRess of int * float * float * Uutil.Filesize.t * 'a
type ressStamp = unit ressInfo
let ressStampToString r =
match r with
NoRess ->
"NoRess"
| HfsRess len ->
Format.sprintf "Hfs(%s)" (Uutil.Filesize.toString len)
| AppleDoubleRess (ino, mtime, ctime, len, _) ->
Format.sprintf "Hfs(%d,%f,%f,%s)"
ino mtime ctime (Uutil.Filesize.toString len)
type info =
{ ressInfo : (Fspath.t * int64) ressInfo;
finfo : string }
external getFileInfosInternal :
System.fspath -> bool -> string * int64 = "getFileInfos"
external setFileInfosInternal :
System.fspath -> string -> unit = "setFileInfos"
let defaultInfos typ =
match typ with
`FILE -> { ressInfo = NoRess; finfo = "F" }
| `DIRECTORY -> { ressInfo = NoRess; finfo = "D" }
| _ -> { ressInfo = NoRess; finfo = "" }
let noTypeCreator = String.make 10 '\000'
(* Remove trailing zeroes *)
let trim s =
let rec trim_rec s pos =
if pos > 0 && s.[pos - 1] = '\000' then
trim_rec s (pos - 1)
else
String.sub s 0 pos
in
trim_rec s (String.length s)
let extractInfo typ info =
let flags = String.sub info 8 2 in
let xflags = String.sub info 24 2 in
let typeCreator = String.sub info 0 8 in
(* Ignore hasBeenInited flag *)
flags.[0] <- Char.chr (Char.code flags.[0] land 0xfe);
(* If the extended flags should be ignored, clear them *)
let xflags =
if Char.code xflags.[0] land 0x80 <> 0 then "\000\000" else xflags
in
let info =
match typ with
`FILE -> "F" ^ typeCreator ^ flags ^ xflags
| `DIRECTORY -> "D" ^ flags ^ xflags
in
trim info
let getFileInfos dataFspath dataPath typ =
if not (Prefs.read rsrc) then defaultInfos typ else
match typ with
(`FILE | `DIRECTORY) as typ ->
Util.convertUnixErrorsToTransient "getting file informations" (fun () ->
try
let (fInfo, rsrcLength) =
getFileInfosInternal
(Fspath.toSysPath (Fspath.concat dataFspath dataPath))
(typ = `FILE)
in
{ ressInfo =
if rsrcLength = 0L then NoRess
else HfsRess (Uutil.Filesize.ofInt64 rsrcLength);
finfo = extractInfo typ fInfo }
with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) ->
(* Not a HFS volume. Look for an AppleDouble file *)
try
let (workingDir, realPath) =
Fspath.findWorkingDir dataFspath dataPath in
let (doubleFspath, inch, entries) =
openDouble workingDir realPath in
let (rsrcOffset, rsrcLength) =
try
let (offset, len) = Safelist.assoc `RSRC entries in
(* We need to check that the ressource fork is not a
dummy one included for compatibility reasons *)
if len = 286L &&
protect (fun () ->
LargeFile.seek_in inch (Int64.add offset 16L);
let len = String.length ressource_fork_empty_tag in
let buf = String.create len in
really_input inch buf 0 len;
buf = ressource_fork_empty_tag)
(fun () -> close_in_noerr inch)
then
(0L, 0L)
else
(offset, len)
with Not_found ->
(0L, 0L)
in
debug (fun () ->
Util.msg
"AppleDouble for file %s / %s: ressource fork length: %d\n"
(Fspath.toDebugString dataFspath) (Path.toString dataPath)
(Int64.to_int rsrcLength));
let finfo =
protect (fun () ->
try
let (ofs, len) = Safelist.assoc `FINFO entries in
if len < finfoLength then
fail dataFspath dataPath doubleFspath "bad finder info";
readDoubleFromOffset
dataFspath dataPath doubleFspath inch ofs 32
with Not_found ->
String.make 32 '\000')
(fun () -> close_in_noerr inch)
in
close_in inch;
let stats =
Util.convertUnixErrorsToTransient "stating AppleDouble file"
(fun () -> Fs.stat doubleFspath) in
{ ressInfo =
if rsrcLength = 0L then NoRess else
AppleDoubleRess
(begin match Util.osType with
`Win32 -> 0
| `Unix -> (* The inode number is truncated so that
it fits in a 31 bit ocaml integer *)
stats.Unix.LargeFile.st_ino land 0x3FFFFFFF
end,
stats.Unix.LargeFile.st_mtime,
begin match Util.osType with
`Win32 -> (* Was "stats.Unix.LargeFile.st_ctime", but
this was bogus: Windows ctimes are
not reliable. [BCP, Apr 07] *)
0.
| `Unix -> 0.
end,
Uutil.Filesize.ofInt64 rsrcLength,
(doubleFspath, rsrcOffset));
finfo = extractInfo typ finfo }
with Not_found ->
defaultInfos typ)
| _ ->
defaultInfos typ
let zeroes = String.make 13 '\000'
let insertInfo fullInfo info =
let info = info ^ zeroes in
let isFile = info.[0] = 'F' in
let offset = if isFile then 9 else 1 in
(* Type and creator *)
if isFile then String.blit info 1 fullInfo 0 8;
(* Finder flags *)
String.blit info offset fullInfo 8 2;
(* Extended finder flags *)
String.blit info (offset + 2) fullInfo 24 2;
fullInfo
let setFileInfos dataFspath dataPath finfo =
assert (finfo <> "");
Util.convertUnixErrorsToTransient "setting file informations" (fun () ->
try
let p = Fspath.toSysPath (Fspath.concat dataFspath dataPath) in
let (fullFinfo, _) = getFileInfosInternal p false in
setFileInfosInternal p (insertInfo fullFinfo finfo)
with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) ->
(* Not an HFS volume. Look for an AppleDouble file *)
let (workingDir, realPath) = Fspath.findWorkingDir dataFspath dataPath in
begin try
let (doubleFspath, inch, entries) = openDouble workingDir realPath in
begin try
let (ofs, len) = Safelist.assoc `FINFO entries in
if len < finfoLength then
fail dataFspath dataPath doubleFspath "bad finder info";
let fullFinfo =
protect
(fun () ->
let res =
readDoubleFromOffset
dataFspath dataPath doubleFspath inch ofs 32 in
close_in inch;
res)
(fun () -> close_in_noerr inch)
in
let outch =
Fs.open_out_gen [Open_wronly; Open_binary] 0o600 doubleFspath in
protect
(fun () ->
writeDoubleFromOffset outch ofs (insertInfo fullFinfo finfo);
close_out outch)
(fun () ->
close_out_noerr outch);
with Not_found ->
close_in_noerr inch;
raise (Util.Transient
(Format.sprintf
"Unable to set the file type and creator: \n\
The AppleDouble file '%s' has no fileinfo entry."
(Fspath.toPrintString doubleFspath)))
end
with Not_found ->
(* No AppleDouble file, create one if needed. *)
if finfo <> "F" && finfo <> "D" then begin
let doubleFspath =
Fspath.appleDouble (Fspath.concat workingDir realPath) in
let outch =
Fs.open_out_gen
[Open_wronly; Open_creat; Open_excl; Open_binary] 0o600
doubleFspath
in
(* Apparently, for compatibility with various old versions
of Mac OS X that did not follow the AppleDouble specification,
we have to include a dummy ressource fork...
We also put an empty extended attribute section at the
end of the finder info section, mimicking the Mac OS X
kernel behavior. *)
protect (fun () ->
output_string outch doubleMagic;
output_string outch doubleVersion;
output_string outch doubleFiller;
output_string outch "\000\002"; (* Two entries *)
output_string outch "\000\000\000\009"; (* Finder info *)
output_string outch "\000\000\000\050"; (* offset *)
output_string outch "\000\000\014\176"; (* length *)
output_string outch "\000\000\000\002"; (* Ressource fork *)
output_string outch "\000\000\014\226"; (* offset *)
output_string outch "\000\000\001\030"; (* length *)
output_string outch (insertInfo (emptyFinderInfo ()) finfo);
output_string outch (empty_attribute_chunk ());
(* extended attributes *)
output_string outch empty_ressource_fork;
close_out outch)
(fun () -> close_out_noerr outch)
end
end)
let ressUnchanged info info' t0 dataUnchanged =
match info, info' with
NoRess, NoRess ->
true
| HfsRess len, HfsRess len' ->
dataUnchanged && len = len'
| AppleDoubleRess (ino, mt, ct, _, _),
AppleDoubleRess (ino', mt', ct', _, _) ->
ino = ino' && mt = mt' && ct = ct' &&
if Some mt' <> t0 then
true
else begin
begin try
Unix.sleep 1
with Unix.Unix_error _ -> () end;
false
end
| _ ->
false
(****)
let name1 = Name.fromString "..namedfork"
let name2 = Name.fromString "rsrc"
let ressPath p = Path.child (Path.child p name1) name2
let stamp info =
match info.ressInfo with
NoRess ->
NoRess
| (HfsRess len) as s ->
s
| AppleDoubleRess (inode, mtime, ctime, len, _) ->
AppleDoubleRess (inode, mtime, ctime, len, ())
let ressFingerprint fspath path info =
match info.ressInfo with
NoRess ->
Fingerprint.dummy
| HfsRess _ ->
Fingerprint.file fspath (ressPath path)
| AppleDoubleRess (_, _, _, len, (path, offset)) ->
debug (fun () ->
Util.msg "ressource fork fingerprint: path %s, offset %d, len %d"
(Fspath.toString path)
(Int64.to_int offset) (Uutil.Filesize.toInt len));
Fingerprint.subfile path offset len
let ressLength ress =
match ress with
NoRess -> Uutil.Filesize.zero
| HfsRess len -> len
| AppleDoubleRess (_, _, _, len, _) -> len
let ressDummy = NoRess
(****)
let openRessIn fspath path =
Util.convertUnixErrorsToTransient "reading resource fork" (fun () ->
try
Unix.in_channel_of_descr
(Fs.openfile
(Fspath.concat fspath (ressPath path))
[Unix.O_RDONLY] 0o444)
with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
let (doublePath, inch, entries) = openDouble fspath path in
try
let (rsrcOffset, rsrcLength) = Safelist.assoc `RSRC entries in
protect (fun () -> LargeFile.seek_in inch rsrcOffset)
(fun () -> close_in_noerr inch);
inch
with Not_found ->
close_in_noerr inch;
raise (Util.Transient "No resource fork found"))
let openRessOut fspath path length =
Util.convertUnixErrorsToTransient "writing resource fork" (fun () ->
try
Unix.out_channel_of_descr
(Fs.openfile
(Fspath.concat fspath (ressPath path))
[Unix.O_WRONLY;Unix.O_TRUNC] 0o600)
with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
let path = Fspath.appleDouble (Fspath.concat fspath path) in
let outch =
Fs.open_out_gen
[Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path
in
protect (fun () ->
output_string outch doubleMagic;
output_string outch doubleVersion;
output_string outch doubleFiller;
output_string outch "\000\002"; (* Two entries *)
output_string outch "\000\000\000\009"; (* Finder info *)
output_string outch "\000\000\000\050"; (* offset *)
output_string outch "\000\000\014\176"; (* length *)
output_string outch "\000\000\000\002"; (* Resource fork *)
output_string outch "\000\000\014\226"; (* offset *)
(* FIX: should check for overflow! *)
output_string outch (setInt4 (Uutil.Filesize.toInt64 length));
(* length *)
output_string outch (emptyFinderInfo ());
output_string outch (empty_attribute_chunk ());
(* extended attributes *)
flush outch)
(fun () -> close_out_noerr outch);
outch)
unison-2.40.102/BUGS.txt 0000644 0061316 0061316 00000014225 11361646373 014714 0 ustar bcpierce bcpierce OUTSTANDING UNISON BUGS
=======================
SHOWSTOPPERS
============
Mac OSX, Windows XP:
- Unison does not understand extended attributes (OSX) or alternate data
streams (XP) and will not synchronize them properly.
Linux, Solaris:
- None known.
---------------------------------------------------------------------------
SERIOUS
=======
[June 2006, Jim]
By the way, there is a bug if you are doing a merge and
are propagating times, the times of the merged file end
up different so you have to sync again. I guess this
might be a feature, I don't know which way to propagate
the times...
==> Best to make them both equal to the time of merging
[July 2002, Findler]
I get this message from unison:
Fatal error: Internal error: New archives are not identical.
Retaining original archives. Please run Unison again to bring them
up to date.
If you get this message again, please notify unison-help@cis.upenn.edu.
and I think that I know what's going wrong. Unison is somehow using a
key consisting of the result of `hostname' (and maybe other stuff) to
uniquely identify an archive. I have two macos x machine and I use both
of them to sync to a third (solaris) place. The problem seems to be
that unison can't tell the difference between two macos x machines,
since the default setup under macos x always gives the hostname
"localhost".
--
So, I wonder if there is some other way to distinguish the two
hostnames. Things that come to mind: ip addresses (but that can be bad
if the machine moves around), ethernet addresses (but my laptop has two
of them -- still better than ip addresses, I think) or perhaps some
macos-specific mechanism for getting the macos name of the computer.
--
For now, I've just changed the result of `hostname' on one of my
machines, but I just made up something that no DNS server agrees with,
so that might cause me trouble down the line, I'd bet.
===> We should use some more information to make sure the archive names are
unique enough. But what, exactly?
[APril 2002, Jason Eisner] Recently I found an aliasing problem that may
endanger Unison's semantics.
--
The problem is with the "follow" directive, which is documented like
this: "Including the preference -follow causes Unison to
treat symbolic links matching as 'invisible' and behave as
if the thing pointed to by the link had appeared literally at this
place in the replica."
--
If one of these invisible (elsewhere called "transparent") symlinks
points outside the replica, all is well and good. But if it points to
something in the replica, then Unison now has two names for the same
file. It doesn't currently detect the aliasing. As a result, it keeps
separate information for the two names in the archive files.
[A long example is in a mailmessage in BCP's files]
starting Unison on two non-existent local directories leads to an
assertion failure in path.ml
---------------------------------------------------------------------------
MINOR
=====
Sascha Kuzins [July 2002]
The server crashes everytime the client is finished.
"Fatal Error: Error in waiting on port: "
"The network name is not available anymore" (rough translation from
German)
I use Unison on two XP Professional machines, German versions, with the
simple tcp connection.
BCP [May 2002]
The "rescan paths that failed previous sync" function misses some files.
E.g., if a directory has failed to transfer because the disk ran out of
space and I hit 'f', it will come back with "Everything is up to date",
even though doing a full re-sync will again recognize the directory as
needing to be transferred.
Jason Eisner [April, 2002]
The Merge feature does not appear to modify file times. Thus, when
times=true, using the Merge feature on
changed ? changed myfile
turns it into
props ? props myfile
and to finish the sync, I have to decide which file time "wins."
This differs from the behavior that I would expect and find more
convenient: namely, if I perform the merge at 3pm, then it counts as a
change to BOTH replicas of myfile and they should both end up with a
time of 3pm.
So I'd suggest that myfile in the local replica should have its
modtime as well as its contents changed to that of
#unisonmerged-myfile (the temporary file produced by the Merge
program). Then this modtime and contents should be propagated to the
remote myfile as usual, handling clock skew as for any other propagation.
Other file properties should probably NOT be propagated.
Karl Moerder:
The synchronization of modification times does not work on directories
(WinNT folders) or on read-only files. I found this when I tried to
synchronize mod times on an otherwise synchronized tree. It failed
gracefully on these. The "[click..." message is a nice touch.
==> [Nothing we can do for read-only files; need to patch ocaml for
directories...]
"After I synchronized two directories I created a new profile, which
defaulted to the same directories. I synchronized again (no changes,
which was fine) but the Unison program did not save the directory names
in the new profile. Later attemts to use that new profile failed, of
course, and further random clicking resulted in a message asking me to
delete non-existent lock files. I responded by exiting the program,
manually deleting the .prf file, and starting over. This is a minor
bug, I suppose, the root cause of which is the failure to save the
directory names in a new profile when they were copied unchanged from a
previous profile and/or no files had changed in these directories --
the type of bug that can only affect a new user, and so easy to
overlook in testing."
The "Diff" window [under Windows] sometimes shows nothing. Does this
arise from a missing "Diff" program? We should detect this case!
---------------------------------------------------------------------------
COSMETIC
========
Interactively adding an ignore pattern for src will not make
src/RECENTNEWS immediately disappear (as it does not directly match
the pattern)...
unison-2.40.102/recon.ml 0000644 0061316 0061316 00000072561 11453636173 015061 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/recon.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Common
(* ------------------------------------------------------------------------- *)
(* Handling of prefer/force *)
(* ------------------------------------------------------------------------- *)
let debug = Trace.debug "recon"
let setDirection ri dir force =
match ri.replicas with
Different
({rc1 = rc1; rc2 = rc2; direction = d; default_direction = default } as diff)
when force=`Force || default=Conflict ->
if dir=`Replica1ToReplica2 then
diff.direction <- Replica1ToReplica2
else if dir=`Replica2ToReplica1 then
diff.direction <- Replica2ToReplica1
else if dir=`Merge then begin
if Globals.shouldMerge ri.path1 then diff.direction <- Merge
end else begin (* dir = `Older or dir = `Newer *)
match rc1.status, rc2.status with
`Deleted, _ ->
if default=Conflict then
diff.direction <- Replica2ToReplica1
| _, `Deleted ->
if default=Conflict then
diff.direction <- Replica1ToReplica2
| _ ->
let comp = Props.time rc1.desc -. Props.time rc2.desc in
let comp = if dir=`Newer then -. comp else comp in
if comp<0.0 then
diff.direction <- Replica1ToReplica2
else
diff.direction <- Replica2ToReplica1
end
| _ ->
()
let revertToDefaultDirection ri =
match ri.replicas with
Different diff -> diff.direction <- diff.default_direction
| _ -> ()
(* Find out which direction we need to propagate changes if we want to *)
(* consider the given root to be the "truth" *)
(* -- *)
(* root := "older" | "newer" | *)
(* return value := 'Older | 'Newer | 'Replica1ToReplica2 | *)
(* 'Replica2ToReplica1 *)
(* -- *)
let root2direction root =
if root="older" then `Older
else if root="newer" then `Newer
else
let (r1, r2) = Globals.rawRootPair () in
debug (fun() ->
Printf.eprintf "root2direction called to choose %s from %s and %s\n"
root r1 r2);
if r1 = root then `Replica1ToReplica2 else
if r2 = root then `Replica2ToReplica1 else
raise (Util.Fatal (Printf.sprintf
"%s (given as argument to 'prefer' or 'force' preference)\nis not one of \
the current roots:\n %s\n %s" root r1 r2))
let forceRoot: string Prefs.t =
Prefs.createString "force" ""
"!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}. "
^ "This effectively changes Unison from a synchronizer into a mirroring "
^ "utility. \n\n"
^ "You can also specify \\verb|-force newer| (or \\verb|-force older|) "
^ "to force Unison to choose the file with the later (earlier) "
^ "modtime. In this case, the \\verb|-times| preference must also "
^ "be enabled.\n\n"
^ "This preference is overridden by the \\verb|forcepartial| preference.\n\n"
^ "This preference should be used only if you are {\\em sure} you "
^ "know what you are doing!")
let forceRootPartial: Pred.t =
Pred.create "forcepartial" ~advanced:true
("Including the preference \\texttt{forcepartial = \\ARG{PATHSPEC} -> \\ARG{root}} causes Unison to "
^ "resolve all differences (even non-conflicting changes) in favor of "
^ "\\ARG{root} for the files in \\ARG{PATHSPEC} (see \\sectionref{pathspec}{Path Specification} "
^ "for more information). "
^ "This effectively changes Unison from a synchronizer into a mirroring "
^ "utility. \n\n"
^ "You can also specify \\verb|forcepartial PATHSPEC -> newer| "
^ "(or \\verb|forcepartial PATHSPEC older|) "
^ "to force Unison to choose the file with the later (earlier) "
^ "modtime. In this case, the \\verb|-times| preference must also "
^ "be enabled.\n\n"
^ "This preference should be used only if you are {\\em sure} you "
^ "know what you are doing!")
let preferRoot: string Prefs.t =
Prefs.createString "prefer" ""
"!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 "
^ "for the \\verb|root| preference, plus the special values "
^ "\\verb|newer| and \\verb|older|.) \n\n"
^ "This preference is overridden by the \\verb|preferpartial| preference.\n\n"
^ "This preference should be used only if you are {\\em sure} you "
^ "know what you are doing!")
let preferRootPartial: Pred.t =
Pred.create "preferpartial" ~advanced:true
("Including the preference \\texttt{preferpartial = \\ARG{PATHSPEC} -> \\ARG{root}} "
^ "causes Unison always to "
^ "resolve conflicts in favor of \\ARG{root}, rather than asking for "
^ "guidance from the user, for the files in \\ARG{PATHSPEC} (see "
^ "\\sectionref{pathspec}{Path Specification} "
^ "for more information). (The syntax of \\ARG{root} is the same as "
^ "for the \\verb|root| preference, plus the special values "
^ "\\verb|newer| and \\verb|older|.) \n\n"
^ "This preference should be used only if you are {\\em sure} you "
^ "know what you are doing!")
(* [lookupPreferredRoot (): string * [`Force | `Prefer]] checks validity of *)
(* preferences "force"/"preference", returns a pair (root, force) *)
let lookupPreferredRoot () =
if Prefs.read forceRoot <> "" then
(Prefs.read forceRoot, `Force)
else if Prefs.read preferRoot <> "" then
(Prefs.read preferRoot, `Prefer)
else
("",`Prefer)
(* [lookupPreferredRootPartial: Path.t -> string * [`Force | `Prefer]] checks validity of *)
(* preferences "forcepartial", returns a pair (root, force) *)
let lookupPreferredRootPartial p =
let s = Path.toString p in
if Pred.test forceRootPartial s then
(Pred.assoc forceRootPartial s, `Force)
else if Pred.test preferRootPartial s then
(Pred.assoc preferRootPartial s, `Prefer)
else
("",`Prefer)
let noDeletion =
Prefs.createStringList "nodeletion"
"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\n\
This preference can be included twice, once for each root, if you \
want to prevent any deletion.")
let noUpdate =
Prefs.createStringList "noupdate"
"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\n\
This preference can be included twice, once for each root, if you \
want to prevent any update.")
let noCreation =
Prefs.createStringList "nocreation"
"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\n\
This preference can be included twice, once for each root, if you \
want to prevent any creation.")
let noDeletionPartial =
Pred.create "nodeletionpartial" ~advanced:true
("Including the preference \
\\texttt{nodeletionpartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file deletion in \\ARG{PATHSPEC} \
on root \\ARG{root} (see \\sectionref{pathspec}{Path Specification} \
for more information). It is recommended to use {\\tt BelowPath} \
patterns when selecting a directory and all its contents.")
let noUpdatePartial =
Pred.create "noupdatepartial" ~advanced:true
("Including the preference \
\\texttt{noupdatepartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file update or deletion in \
\\ARG{PATHSPEC} on root \\ARG{root} (see \
\\sectionref{pathspec}{Path Specification} for more information). \
It is recommended to use {\\tt BelowPath} \
patterns when selecting a directory and all its contents.")
let noCreationPartial =
Pred.create "nocreationpartial" ~advanced:true
("Including the preference \
\\texttt{nocreationpartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file creation in \\ARG{PATHSPEC} \
on root \\ARG{root} (see \\sectionref{pathspec}{Path Specification} \
for more information). \
It is recommended to use {\\tt BelowPath} \
patterns when selecting a directory and all its contents.")
let partialCancelPref actionKind =
match actionKind with
`DELETION -> noDeletionPartial
| `UPDATE -> noUpdatePartial
| `CREATION -> noCreationPartial
let cancelPref actionKind =
match actionKind with
`DELETION -> noDeletion
| `UPDATE -> noUpdate
| `CREATION -> noCreation
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
let shouldCancel path rc1 rc2 root2 =
let test kind =
List.mem root2 (Prefs.read (cancelPref kind))
||
List.mem root2 (Pred.assoc_all (partialCancelPref kind) path)
in
match actionKind rc1 rc2 with
`UPDATE -> test `UPDATE
| `DELETION -> test `UPDATE || test `DELETION
| `CREATION -> test `CREATION
let filterRi root1 root2 ri =
match ri.replicas with
Problem _ ->
()
| Different diff ->
if
match diff.direction with
Replica1ToReplica2 ->
shouldCancel (Path.toString ri.path1) diff.rc1 diff.rc2 root2
| Replica2ToReplica1 ->
shouldCancel (Path.toString ri.path1) diff.rc2 diff.rc1 root1
| Conflict | Merge ->
false
then
diff.direction <- Conflict
let filterRis ris =
let (root1, root2) = Globals.rawRootPair () in
Safelist.iter (fun ri -> filterRi root1 root2 ri) ris
(* Use the current values of the '-prefer ' and '-force ' *)
(* preferences to override the reconciler's choices *)
let overrideReconcilerChoices ris =
let (root,force) = lookupPreferredRoot() in
if root<>"" then begin
let dir = root2direction root in
Safelist.iter (fun ri -> setDirection ri dir force) ris
end;
Safelist.iter (fun ri ->
let (rootp,forcep) = lookupPreferredRootPartial ri.path1 in
if rootp<>"" then begin
let dir = root2direction rootp in
setDirection ri dir forcep
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 *)
let checkThatPreferredRootIsValid () =
let test_root predname = function
| "" | "newer" -> ()
| "older" as r ->
if not (Prefs.read Props.syncModtimes) then
raise (Util.Transient (Printf.sprintf
"The '%s=%s' preference can only be used with 'times=true'"
predname r))
| r -> ignore (root2direction r) in
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);
let checkPref extract (pref, prefName) =
try
let root =
List.find (fun r -> not (List.mem r (Globals.rawRoots ())))
(extract 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
List.iter (checkPref Prefs.read)
[noDeletion, "nodeletion"; noUpdate, "noupdate"; noCreation, "nocreation"];
List.iter (checkPref Pred.extern_associated_strings)
[noDeletionPartial, "nodeletionpartial";
noUpdatePartial, "noupdatepartial";
noCreationPartial, "nocreationpartial"]
(* ------------------------------------------------------------------------- *)
(* Main Reconciliation stuff *)
(* ------------------------------------------------------------------------- *)
exception UpdateError of string
let rec checkForError ui =
match ui with
NoUpdates ->
()
| Error err ->
raise (UpdateError err)
| Updates (uc, _) ->
match uc with
Dir (_, children, _, _) ->
Safelist.iter (fun (_, uiSub) -> checkForError uiSub) children
| Absent | File _ | Symlink _ ->
()
let rec collectErrors ui rem =
match ui with
NoUpdates ->
rem
| Error err ->
err :: rem
| Updates (uc, _) ->
match uc with
Dir (_, children, _, _) ->
Safelist.fold_right
(fun (_, uiSub) rem -> collectErrors uiSub rem) children rem
| Absent | File _ | Symlink _ ->
rem
(* lifting errors in individual updates to replica problems *)
let propagateErrors allowPartial (rplc: Common.replicas): Common.replicas =
match rplc with
Problem _ ->
rplc
| Different diff when allowPartial ->
Different { diff with
errors1 = collectErrors diff.rc1.ui [];
errors2 = collectErrors diff.rc2.ui [] }
| Different diff ->
try
checkForError diff.rc1.ui;
try
checkForError diff.rc2.ui;
rplc
with UpdateError err ->
Problem ("[root 2]: " ^ err)
with UpdateError err ->
Problem ("[root 1]: " ^ err)
type singleUpdate = Rep1Updated | Rep2Updated
let update2replicaContent path (conflict: bool) ui props ucNew oldType:
Common.replicaContent =
let size = Update.updateSize path ui in
match ucNew with
Absent ->
{typ = `ABSENT; status = `Deleted; desc = Props.dummy;
ui = ui; size = size; props = props}
| File (desc, ContentsSame) ->
{typ = `FILE; status = `PropsChanged; desc = desc;
ui = ui; size = size; props = props}
| File (desc, _) when oldType <> `FILE ->
{typ = `FILE; status = `Created; desc = desc;
ui = ui; size = size; props = props}
| File (desc, ContentsUpdated _) ->
{typ = `FILE; status = `Modified; desc = desc;
ui = ui; size = size; props = props}
| Symlink l when oldType <> `SYMLINK ->
{typ = `SYMLINK; status = `Created; desc = Props.dummy;
ui = ui; size = size; props = props}
| Symlink l ->
{typ = `SYMLINK; status = `Modified; desc = Props.dummy;
ui = ui; size = size; props = props}
| Dir (desc, _, _, _) when oldType <> `DIRECTORY ->
{typ = `DIRECTORY; status = `Created; desc = desc;
ui = ui; size = size; props = props}
| Dir (desc, _, PropsUpdated, _) ->
{typ = `DIRECTORY; status = `PropsChanged; desc = desc;
ui = ui; size = size; props = props}
| Dir (desc, _, PropsSame, _) when conflict ->
(* Special case: the directory contents has been modified and the *)
(* directory is in conflict. (We don't want to display a conflict *)
(* between an unchanged directory and a file, for instance: this would *)
(* be rather puzzling to the user) *)
{typ = `DIRECTORY; status = `Modified; desc = desc;
ui = ui; size = size; props = props}
| Dir (desc, _, PropsSame, _) ->
{typ = `DIRECTORY; status = `Unchanged; desc =desc;
ui = ui; size = size; props = props}
let oldType (prev: Common.prevState): Fileinfo.typ =
match prev with
Previous (typ, _, _, _) -> typ
| New -> `ABSENT
let oldDesc (prev: Common.prevState): Props.t =
match prev with
Previous (_, desc, _, _) -> desc
| New -> Props.dummy
(* [describeUpdate ui] returns the replica contents for both the case of *)
(* updating and the case of non-updating *)
let describeUpdate path props' ui props
: Common.replicaContent * Common.replicaContent =
match ui with
Updates (ucNewStatus, prev) ->
let typ = oldType prev in
(update2replicaContent path false ui props ucNewStatus typ,
{typ = typ; status = `Unchanged; desc = oldDesc prev;
ui = NoUpdates; size = Update.updateSize path NoUpdates;
props = props'})
| _ -> assert false
(* Computes the reconItems when only one side has been updated. (We split *)
(* this out into a separate function to avoid duplicating all the symmetric *)
(* cases.) *)
let rec reconcileNoConflict allowPartial path props' ui props whatIsUpdated
(result: (Name.t * Name.t, Common.replicas) Tree.u)
: (Name.t * Name.t, Common.replicas) Tree.u =
let different() =
let rcUpdated, rcNotUpdated = describeUpdate path props' ui props in
match whatIsUpdated with
Rep2Updated ->
Different {rc1 = rcNotUpdated; rc2 = rcUpdated;
direction = Replica2ToReplica1;
default_direction = Replica2ToReplica1;
errors1 = []; errors2 = []}
| Rep1Updated ->
Different {rc1 = rcUpdated; rc2 = rcNotUpdated;
direction = Replica1ToReplica2;
default_direction = Replica1ToReplica2;
errors1 = []; errors2 = []} in
match ui with
| NoUpdates -> result
| Error err ->
Tree.add result (Problem err)
| Updates (Dir (desc, children, permchg, _),
Previous(`DIRECTORY, _, _, _)) ->
let r =
if permchg = PropsSame then result else Tree.add result (different ())
in
Safelist.fold_left
(fun result (theName, uiChild) ->
Tree.leave
(reconcileNoConflict allowPartial (Path.child path theName)
[] uiChild [] whatIsUpdated
(Tree.enter result (theName, theName))))
r children
| Updates _ ->
Tree.add result (propagateErrors allowPartial (different ()))
(* [combineChildrn children1 children2] combines two name-sorted lists of *)
(* type [(Name.t * Common.updateItem) list] to a single list of type *)
(* [(Name.t * Common.updateItem * Common.updateItem] *)
let combineChildren children1 children2 =
(* NOTE: This function assumes children1 and children2 are sorted. *)
let rec loop r children1 children2 =
match children1,children2 with
[],_ ->
Safelist.rev_append r
(Safelist.map
(fun (name,ui) -> (name,NoUpdates,name,ui)) children2)
| _,[] ->
Safelist.rev_append r
(Safelist.map
(fun (name,ui) -> (name,ui,name,NoUpdates)) children1)
| (name1,ui1)::rem1, (name2,ui2)::rem2 ->
let dif = Name.compare name1 name2 in
if dif = 0 then
loop ((name1,ui1,name2,ui2)::r) rem1 rem2
else if dif < 0 then
loop ((name1,ui1,name1,NoUpdates)::r) rem1 children2
else
loop ((name2,NoUpdates,name2,ui2)::r) children1 rem2
in
loop [] children1 children2
(* File are marked equal in groups of 5000 to lower memory consumption *)
let add_equal (counter, archiveUpdated) equal v =
let eq = Tree.add equal v in
incr counter;
archiveUpdated := true;
if !counter = 5000 then begin
counter := 0;
let (t, eq) = Tree.slice eq in (* take a snapshot of the tree *)
Update.markEqual t; (* work on it *)
eq (* and return the leftover spine *)
end else
eq
(* The main reconciliation function: takes a path and two updateItem *)
(* structures and returns a list of reconItems containing suggestions for *)
(* propagating changes to make the two replicas equal. *)
(* -- *)
(* It uses two accumulators: *)
(* equals: (Name.t * Name.t, Common.updateContent * Common.updateContent) *)
(* Tree.u *)
(* unequals: (Name.t * Name.t, Common.replicas) Tree.u *)
(* -- *)
let rec reconcile
allowPartial path ui1 props1 ui2 props2 counter equals unequals =
let different uc1 uc2 oldType equals unequals =
(equals,
Tree.add unequals
(propagateErrors allowPartial
(Different {rc1 = update2replicaContent
path true ui1 props1 uc1 oldType;
rc2 = update2replicaContent
path true ui2 props2 uc2 oldType;
direction = Conflict; default_direction = Conflict;
errors1 = []; errors2 = []}))) in
let toBeMerged uc1 uc2 oldType equals unequals =
(equals,
Tree.add unequals
(propagateErrors allowPartial
(Different {rc1 = update2replicaContent
path true ui1 props1 uc1 oldType;
rc2 = update2replicaContent
path true ui2 props2 uc2 oldType;
direction = Merge; default_direction = Merge;
errors1 = []; errors2 = []}))) in
match (ui1, ui2) with
(Error s, _) ->
(equals, Tree.add unequals (Problem s))
| (_, Error s) ->
(equals, Tree.add unequals (Problem s))
| (NoUpdates, _) ->
(equals,
reconcileNoConflict
allowPartial path props1 ui2 props2 Rep2Updated unequals)
| (_, NoUpdates) ->
(equals,
reconcileNoConflict
allowPartial path props2 ui1 props1 Rep1Updated unequals)
| (Updates (Absent, _), Updates (Absent, _)) ->
(add_equal counter equals (Absent, Absent), unequals)
| (Updates (Dir (desc1, children1, propsChanged1, _) as uc1, prevState1),
Updates (Dir (desc2, children2, propsChanged2, _) as uc2, prevState2)) ->
(* See if the directory itself should have a reconItem *)
let dirResult =
if propsChanged1 = PropsSame && propsChanged2 = PropsSame then
(equals, unequals)
else if Props.similar desc1 desc2 then
let uc1 = Dir (desc1, [], PropsSame, false) in
let uc2 = Dir (desc2, [], PropsSame, false) in
(add_equal counter equals (uc1, uc2), unequals)
else
let action =
if propsChanged1 = PropsSame then Replica2ToReplica1
else if propsChanged2 = PropsSame then Replica1ToReplica2
else Conflict in
(equals,
Tree.add unequals
(Different
{rc1 = update2replicaContent path false ui1 [] uc1 `DIRECTORY;
rc2 = update2replicaContent path false ui2 [] uc2 `DIRECTORY;
direction = action; default_direction = action;
errors1 = []; errors2 = []}))
in
(* Apply reconcile on children. *)
Safelist.fold_left
(fun (equals, unequals) (name1,ui1,name2,ui2) ->
let (eq, uneq) =
reconcile
allowPartial (Path.child path name1) ui1 [] ui2 [] counter
(Tree.enter equals (name1, name2))
(Tree.enter unequals (name1, name2))
in
(Tree.leave eq, Tree.leave uneq))
dirResult
(combineChildren children1 children2)
| (Updates (File (desc1,contentsChanged1) as uc1, prev),
Updates (File (desc2,contentsChanged2) as uc2, _)) ->
begin match contentsChanged1, contentsChanged2 with
ContentsUpdated (dig1, _, ress1), ContentsUpdated (dig2, _, ress2)
when dig1 = dig2 ->
if Props.similar desc1 desc2 then
(add_equal counter equals (uc1, uc2), unequals)
else
(* Special case: when both sides are modified files but their contents turn *)
(* out to be the same, we want to display them as 'perms' rather than 'new' *)
(* on both sides, to avoid confusing the user. (The Transfer module also *)
(* expect this.) *)
let uc1' = File(desc1,ContentsSame) in
let uc2' = File(desc2,ContentsSame) in
different uc1' uc2' (oldType prev) equals unequals
| ContentsSame, ContentsSame when Props.similar desc1 desc2 ->
(add_equal counter equals (uc1, uc2), unequals)
| ContentsUpdated _, ContentsUpdated _
when Globals.shouldMerge path ->
toBeMerged uc1 uc2 (oldType prev) equals unequals
| _ ->
different uc1 uc2 (oldType prev) equals unequals
end
| (Updates (Symlink(l1) as uc1, prev),
Updates (Symlink(l2) as uc2, _)) ->
if l1 = l2 then
(add_equal counter equals (uc1, uc2), unequals)
else
different uc1 uc2 (oldType prev) equals unequals
| (Updates (uc1, prev), Updates (uc2, _)) ->
different uc1 uc2 (oldType prev) equals unequals
(* Sorts the paths so that they will be displayed in order *)
let sortPaths pathUpdatesList =
Sort.list
(fun (p1, _) (p2, _) -> Path.compare p1 p2 <= 0)
pathUpdatesList
let rec enterPath p1 p2 t =
match Path.deconstruct p1, Path.deconstruct p2 with
None, None ->
t
| Some (nm1, p1'), Some (nm2, p2') ->
enterPath p1' p2' (Tree.enter t (nm1, nm2))
| _ ->
assert false (* Cannot happen, as the paths are equal up to case *)
let rec leavePath p t =
match Path.deconstruct p with
None -> t
| Some (nm, p') -> leavePath p' (Tree.leave t)
(* A path is dangerous if one replica has been emptied but not the other *)
let dangerousPath u1 u2 =
let emptied u =
match u with
Updates (Absent, _) -> true
| Updates (Dir (_, _, _, empty), _) -> empty
| _ -> false
in
emptied u1 <> emptied u2
(* The second component of the return value is true if there is at least one *)
(* file that is updated in the same way on both roots *)
let reconcileList allowPartial
(pathUpdatesList:
((Path.local * Common.updateItem * Props.t list) *
(Path.local * Common.updateItem * Props.t list)) list)
: Common.reconItem list * bool * Path.t list =
let counter = ref 0 in
let archiveUpdated = ref false in
let (equals, unequals, dangerous) =
Safelist.fold_left
(fun (equals, unequals, dangerous)
((path1,ui1,props1),(path2,ui2,props2)) ->
(* We make the paths global as we may concatenate them with
names from the other replica *)
let path1 = Path.makeGlobal path1 in
let path2 = Path.makeGlobal path2 in
let (equals, unequals) =
reconcile allowPartial
path1 ui1 props1 ui2 props2 (counter, archiveUpdated)
(enterPath path1 path2 equals)
(enterPath path1 path2 unequals)
in
(leavePath path1 equals, leavePath path1 unequals,
if dangerousPath ui1 ui2 then path1 :: dangerous else dangerous))
(Tree.start, Tree.start, []) pathUpdatesList in
let unequals = Tree.finish unequals in
debug (fun() -> Util.msg "reconcile: %d results\n" (Tree.size unequals));
let equals = Tree.finish equals in
Update.markEqual equals;
(* Commit archive updates done up to now *)
if !archiveUpdated then Update.commitUpdates ();
let result =
Tree.flatten unequals (Path.empty, Path.empty)
(fun (p1, p2) (nm1, nm2) -> (Path.child p1 nm1, Path.child p2 nm2)) [] in
let unsorted =
Safelist.map
(fun ((p1, p2), rplc) -> {path1 = p1; path2 = p2; replicas = rplc})
result in
let sorted = Sortri.sortReconItems unsorted in
overrideReconcilerChoices sorted;
(sorted, not (Tree.is_empty equals), dangerous)
(* This is the main function: it takes a list of updateItem lists and,
according to the roots and paths of synchronization, builds the
corresponding reconItem list. A second component indicates whether there
is any file updated in the same way on both sides. *)
let reconcileAll ?(allowPartial = false) updatesList =
Trace.status "Reconciling changes";
debug (fun() -> Util.msg "reconcileAll\n");
reconcileList allowPartial updatesList
unison-2.40.102/uigtk2.ml 0000644 0061316 0061316 00000463352 11361646373 015163 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/uigtk2.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Common
open Lwt
module Private = struct
let debug = Trace.debug "ui"
let myNameCapitalized = String.capitalize Uutil.myName
(**********************************************************************
LOW-LEVEL STUFF
**********************************************************************)
(**********************************************************************
Some message strings (build them here because they look ugly in the
middle of other code.
**********************************************************************)
let tryAgainMessage =
Printf.sprintf
"You can use %s to synchronize a local directory with another local directory,
or with a remote directory.
Please enter the first (local) directory that you want to synchronize."
myNameCapitalized
(* ---- *)
let helpmessage = Printf.sprintf
"%s can synchronize a local directory with another local directory, or with
a directory on a remote machine.
To synchronize with a local directory, just enter the file name.
To synchronize with a remote directory, you must first choose a protocol
that %s will use to connect to the remote machine. Each protocol has
different requirements:
1) To synchronize using SSH, there must be an SSH client installed on
this machine and an SSH server installed on the remote machine. You
must enter the host to connect to, a user name (if different from
your user name on this machine), and the directory on the remote machine
(relative to your home directory on that machine).
2) To synchronize using RSH, there must be an RSH client installed on
this machine and an RSH server installed on the remote machine. You
must enter the host to connect to, a user name (if different from
your user name on this machine), and the directory on the remote machine
(relative to your home directory on that machine).
3) To synchronize using %s's socket protocol, there must be a %s
server running on the remote machine, listening to the port that you
specify here. (Use \"%s -socket xxx\" on the remote machine to
start the %s server.) You must enter the host, port, and the directory
on the remote machine (relative to the working directory of the
%s server running on that machine)."
myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized
(**********************************************************************
Font preferences
**********************************************************************)
let fontMonospace = lazy (Pango.Font.from_string "monospace")
let fontBold = lazy (Pango.Font.from_string "bold")
let fontItalic = lazy (Pango.Font.from_string "italic")
(**********************************************************************
Unison icon
**********************************************************************)
(* This does not work with the current version of Lablgtk, due to a bug
let icon =
GdkPixbuf.from_data ~width:48 ~height:48 ~has_alpha:true
(Gpointer.region_of_string Pixmaps.icon_data)
*)
let icon =
let p = GdkPixbuf.create ~width:48 ~height:48 ~has_alpha:true () in
Gpointer.blit
(Gpointer.region_of_string Pixmaps.icon_data) (GdkPixbuf.get_pixels p);
p
let leftPtrWatch =
lazy
(let bitmap =
Gdk.Bitmap.create_from_data
~width:32 ~height:32 Pixmaps.left_ptr_watch
in
let color =
Gdk.Color.alloc ~colormap:(Gdk.Color.get_system_colormap ()) `BLACK in
Gdk.Cursor.create_from_pixmap
(bitmap :> Gdk.pixmap) ~mask:bitmap ~fg:color ~bg:color ~x:2 ~y:2)
let make_busy w =
if Util.osType <> `Win32 then
Gdk.Window.set_cursor w#misc#window (Lazy.force leftPtrWatch)
let make_interactive w =
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
*********************************************************************)
type stateItem = { mutable ri : reconItem;
mutable bytesTransferred : Uutil.Filesize.t;
mutable bytesToTransfer : Uutil.Filesize.t;
mutable whatHappened : (Util.confirmation * string option) option}
let theState = ref [||]
module IntSet = Set.Make (struct type t = int let compare = compare end)
let current = ref IntSet.empty
let currentRow () =
if IntSet.cardinal !current = 1 then Some (IntSet.choose !current) else None
(* ---- *)
let theToplevelWindow = ref None
let setToplevelWindow w = theToplevelWindow := Some w
let toplevelWindow () =
match !theToplevelWindow with
Some w -> w
| None -> assert false
(*********************************************************************
Lock management
*********************************************************************)
let busy = ref false
let getLock f =
if !busy then
Trace.status "Synchronizer is busy, please wait.."
else begin
busy := true; f (); busy := false
end
(**********************************************************************
Miscellaneous
**********************************************************************)
let sync_action = ref None
let last = ref (0.)
let gtk_sync forced =
let t = Unix.gettimeofday () in
if !last = 0. || forced || t -. !last > 0.05 then begin
last := t;
begin match !sync_action with
Some f -> f ()
| None -> ()
end;
while Glib.Main.iteration false do () done
end
(**********************************************************************
CHARACTER SET TRANSCODING
***********************************************************************)
(* Transcodage from Microsoft Windows Codepage 1252 to Unicode *)
(* Unison currently uses the "ASCII" Windows filesystem API. With
this API, filenames are encoded using a proprietary character
encoding. This encoding depends on the Windows setup, but in
Western Europe, the Windows Codepage 1252 is usually used.
GTK, on the other hand, uses the UTF-8 encoding. This code perform
the translation from Codepage 1252 to UTF-8. A call to [transcode]
should be wrapped around every string below that might contain
non-ASCII characters. *)
let code =
[| 0x0020; 0x0001; 0x0002; 0x0003; 0x0004; 0x0005; 0x0006; 0x0007;
0x0008; 0x0009; 0x000A; 0x000B; 0x000C; 0x000D; 0x000E; 0x000F;
0x0010; 0x0011; 0x0012; 0x0013; 0x0014; 0x0015; 0x0016; 0x0017;
0x0018; 0x0019; 0x001A; 0x001B; 0x001C; 0x001D; 0x001E; 0x001F;
0x0020; 0x0021; 0x0022; 0x0023; 0x0024; 0x0025; 0x0026; 0x0027;
0x0028; 0x0029; 0x002A; 0x002B; 0x002C; 0x002D; 0x002E; 0x002F;
0x0030; 0x0031; 0x0032; 0x0033; 0x0034; 0x0035; 0x0036; 0x0037;
0x0038; 0x0039; 0x003A; 0x003B; 0x003C; 0x003D; 0x003E; 0x003F;
0x0040; 0x0041; 0x0042; 0x0043; 0x0044; 0x0045; 0x0046; 0x0047;
0x0048; 0x0049; 0x004A; 0x004B; 0x004C; 0x004D; 0x004E; 0x004F;
0x0050; 0x0051; 0x0052; 0x0053; 0x0054; 0x0055; 0x0056; 0x0057;
0x0058; 0x0059; 0x005A; 0x005B; 0x005C; 0x005D; 0x005E; 0x005F;
0x0060; 0x0061; 0x0062; 0x0063; 0x0064; 0x0065; 0x0066; 0x0067;
0x0068; 0x0069; 0x006A; 0x006B; 0x006C; 0x006D; 0x006E; 0x006F;
0x0070; 0x0071; 0x0072; 0x0073; 0x0074; 0x0075; 0x0076; 0x0077;
0x0078; 0x0079; 0x007A; 0x007B; 0x007C; 0x007D; 0x007E; 0x007F;
0x20AC; 0x1234; 0x201A; 0x0192; 0x201E; 0x2026; 0x2020; 0x2021;
0x02C6; 0x2030; 0x0160; 0x2039; 0x0152; 0x1234; 0x017D; 0x1234;
0x1234; 0x2018; 0x2019; 0x201C; 0x201D; 0x2022; 0x2013; 0x2014;
0x02DC; 0x2122; 0x0161; 0x203A; 0x0153; 0x1234; 0x017E; 0x0178;
0x00A0; 0x00A1; 0x00A2; 0x00A3; 0x00A4; 0x00A5; 0x00A6; 0x00A7;
0x00A8; 0x00A9; 0x00AA; 0x00AB; 0x00AC; 0x00AD; 0x00AE; 0x00AF;
0x00B0; 0x00B1; 0x00B2; 0x00B3; 0x00B4; 0x00B5; 0x00B6; 0x00B7;
0x00B8; 0x00B9; 0x00BA; 0x00BB; 0x00BC; 0x00BD; 0x00BE; 0x00BF;
0x00C0; 0x00C1; 0x00C2; 0x00C3; 0x00C4; 0x00C5; 0x00C6; 0x00C7;
0x00C8; 0x00C9; 0x00CA; 0x00CB; 0x00CC; 0x00CD; 0x00CE; 0x00CF;
0x00D0; 0x00D1; 0x00D2; 0x00D3; 0x00D4; 0x00D5; 0x00D6; 0x00D7;
0x00D8; 0x00D9; 0x00DA; 0x00DB; 0x00DC; 0x00DD; 0x00DE; 0x00DF;
0x00E0; 0x00E1; 0x00E2; 0x00E3; 0x00E4; 0x00E5; 0x00E6; 0x00E7;
0x00E8; 0x00E9; 0x00EA; 0x00EB; 0x00EC; 0x00ED; 0x00EE; 0x00EF;
0x00F0; 0x00F1; 0x00F2; 0x00F3; 0x00F4; 0x00F5; 0x00F6; 0x00F7;
0x00F8; 0x00F9; 0x00FA; 0x00FB; 0x00FC; 0x00FD; 0x00FE; 0x00FF |]
let rec transcodeRec buf s i l =
if i < l then begin
let c = code.(Char.code s.[i]) in
if c < 0x80 then
Buffer.add_char buf (Char.chr c)
else if c < 0x800 then begin
Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0));
Buffer.add_char buf (Char.chr (c land 0x3f + 0x80))
end else if c < 0x10000 then begin
Buffer.add_char buf (Char.chr (c lsr 12 + 0xE0));
Buffer.add_char buf (Char.chr ((c lsr 6) land 0x3f + 0x80));
Buffer.add_char buf (Char.chr (c land 0x3f + 0x80))
end;
transcodeRec buf s (i + 1) l
end
let transcodeDoc s =
let buf = Buffer.create 1024 in
transcodeRec buf s 0 (String.length s);
Buffer.contents buf
(****)
let escapeMarkup s = Glib.Markup.escape_text s
let transcodeFilename s =
if Prefs.read Case.unicodeEncoding then
Unicode.protect s
else if Util.osType = `Win32 then transcodeDoc s else
try
Glib.Convert.filename_to_utf8 s
with Glib.Convert.Error _ ->
Unicode.protect s
let transcode s =
if Prefs.read Case.unicodeEncoding then
Unicode.protect s
else
try
Glib.Convert.locale_to_utf8 s
with Glib.Convert.Error _ ->
Unicode.protect s
(**********************************************************************
USEFUL LOW-LEVEL WIDGETS
**********************************************************************)
class scrolled_text ?editable ?shadow_type ?word_wrap
~width ~height ?packing ?show
() =
let sw =
GBin.scrolled_window ?packing ~show:false
?shadow_type ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ()
in
let text = GText.view ?editable ~wrap_mode:`WORD ~packing:sw#add () in
object
inherit GObj.widget_full sw#as_widget
method text = text
method insert s = text#buffer#set_text s;
method show () = sw#misc#show ()
initializer
text#misc#set_size_chars ~height ~width ();
if show <> Some false then sw#misc#show ()
end
(* ------ *)
(* Display a message in a window and wait for the user
to hit the button. *)
let okBox ~parent ~title ~typ ~message =
let t =
GWindow.message_dialog
~parent ~title ~message_type:typ ~message ~modal:true
~buttons:GWindow.Buttons.ok () in
ignore (t#run ()); t#destroy ()
(* ------ *)
let primaryText msg =
Printf.sprintf "%s"
(escapeMarkup msg)
(* twoBox: Display a message in a window and wait for the user
to hit one of two buttons. Return true if the first button is
chosen, false if the second button is chosen. *)
let twoBox ?(kind=`DIALOG_WARNING) ~parent ~title ~astock ~bstock message =
let t =
GWindow.dialog ~parent ~border_width:6 ~modal:true ~no_separator:true
~allow_grow:false () in
t#vbox#set_spacing 12;
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:kind ~icon_size:`DIALOG
~yalign:0. ~packing:h1#pack ());
let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in
ignore (GMisc.label
~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message)
~selectable:true ~yalign:0. ~packing:v1#add ());
t#add_button_stock bstock `NO;
t#add_button_stock astock `YES;
t#set_default_response `NO;
t#show();
let res = t#run () in
t#destroy ();
res = `YES
(* ------ *)
(* Avoid recursive invocations of the function below (a window receives
delete events even when it is not sensitive) *)
let inExit = ref false
let doExit () = Lwt_unix.run (Update.unlockArchives ()); exit 0
let safeExit () =
if not !inExit then begin
inExit := true;
if not !busy then exit 0 else
if twoBox ~parent:(toplevelWindow ()) ~title:"Premature exit"
~astock:`YES ~bstock:`NO
"Unison is working, exit anyway ?"
then exit 0;
inExit := false
end
(* ------ *)
(* warnBox: Display a warning message in a window and wait (unless
we're in batch mode) for the user to hit "OK" or "Exit". *)
let warnBox ~parent title message =
let message = transcode message in
if Prefs.read Globals.batch then begin
(* In batch mode, just pop up a window and go ahead *)
let t =
GWindow.dialog ~parent
~border_width:6 ~modal:true ~no_separator:true ~allow_grow:false () in
t#vbox#set_spacing 12;
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG
~yalign:0. ~packing:h1#pack ());
let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in
ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^
escapeMarkup message)
~selectable:true ~yalign:0. ~packing:v1#add ());
t#add_button_stock `CLOSE `CLOSE;
t#set_default_response `CLOSE;
ignore (t#connect#response ~callback:(fun _ -> t#destroy ()));
t#show ()
end else begin
inExit := true;
let ok =
twoBox ~parent:(toplevelWindow ()) ~title ~astock:`OK ~bstock:`QUIT
message in
if not(ok) then doExit ();
inExit := false
end
(****)
let accel_paths = Hashtbl.create 17
let underscore_re = Str.regexp_string "_"
class ['a] gMenuFactory
?(accel_group=GtkData.AccelGroup.create ())
?(accel_path="/")
?(accel_modi=[`CONTROL])
?(accel_flags=[`VISIBLE]) (menu_shell : 'a) =
object (self)
val menu_shell : #GMenu.menu_shell = menu_shell
val group = accel_group
val m = accel_modi
val flags = (accel_flags:Gtk.Tags.accel_flag list)
val accel_path = accel_path
method menu = menu_shell
method accel_group = group
method accel_path = accel_path
method private bind
?(modi=m) ?key ?callback label ?(name=label) (item : GMenu.menu_item) =
menu_shell#append item;
let accel_path = accel_path ^ name in
let accel_path = Str.global_replace underscore_re "" accel_path in
(* Default accel path value *)
if not (Hashtbl.mem accel_paths accel_path) then begin
Hashtbl.add accel_paths accel_path ();
GtkData.AccelMap.add_entry accel_path ?key ~modi
end;
(* Register this accel path *)
GtkBase.Widget.set_accel_path item#as_widget accel_path accel_group;
Gaux.may callback ~f:(fun callback -> item#connect#activate ~callback)
method add_item ?key ?modi ?callback ?submenu label =
let item = GMenu.menu_item ~use_mnemonic:true ~label () in
self#bind ?modi ?key ?callback label item;
Gaux.may (submenu : GMenu.menu option) ~f:item#set_submenu;
item
method add_image_item ?(image : GObj.widget option)
?modi ?key ?callback ?stock ?name label =
let item =
GMenu.image_menu_item ~use_mnemonic:true ?image ~label ?stock () in
match stock with
| None ->
self#bind ?modi ?key ?callback label ?name
(item : GMenu.image_menu_item :> GMenu.menu_item);
item
| Some s ->
try
let st = GtkStock.Item.lookup s in
self#bind
?modi ?key:(if st.GtkStock.keyval=0 then key else None)
?callback label ?name
(item : GMenu.image_menu_item :> GMenu.menu_item);
item
with Not_found -> item
method add_check_item ?active ?modi ?key ?callback label =
let item = GMenu.check_menu_item ~label ~use_mnemonic:true ?active () in
self#bind label ?modi ?key
?callback:(Gaux.may_map callback ~f:(fun f () -> f item#active))
(item : GMenu.check_menu_item :> GMenu.menu_item);
item
method add_separator () = GMenu.separator_item ~packing:menu_shell#append ()
method add_submenu label =
let item = GMenu.menu_item ~use_mnemonic:true ~label () in
self#bind label item;
(GMenu.menu ~packing:item#set_submenu (), item)
method replace_submenu (item : GMenu.menu_item) =
GMenu.menu ~packing:item#set_submenu ()
end
(**********************************************************************
HIGHER-LEVEL WIDGETS
***********************************************************************)
class stats width height =
let pixmap = GDraw.pixmap ~width ~height () in
let area =
pixmap#set_foreground `WHITE;
pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height ();
GMisc.pixmap pixmap ~width ~height ~xpad:4 ~ypad:8 ()
in
object (self)
inherit GObj.widget_full area#as_widget
val mutable maxim = ref 0.
val mutable scale = ref 1.
val mutable min_scale = 1.
val values = Array.make width 0.
val mutable active = false
method redraw () =
scale := min_scale;
while !maxim > !scale do
scale := !scale *. 1.5
done;
pixmap#set_foreground `WHITE;
pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height ();
pixmap#set_foreground `BLACK;
for i = 0 to width - 1 do
self#rect i values.(max 0 (i - 1)) values.(i)
done
method activate a = active <- a; if a then self#redraw ()
method scale h = truncate ((float height) *. h /. !scale)
method private rect i v' v =
let h = self#scale v in
let h' = self#scale v' in
let h1 = min h' h in
let h2 = max h' h in
pixmap#set_foreground `BLACK;
pixmap#rectangle
~filled:true ~x:i ~y:(height - h1) ~width:1 ~height:h1 ();
for h = h1 + 1 to h2 do
let v = truncate (65535. *. (float (h - h1) /. float (h2 - h1))) in
let v = (v / 4096) * 4096 in (* Only use 16 gray levels *)
pixmap#set_foreground (`RGB (v, v, v));
pixmap#rectangle
~filled:true ~x:i ~y:(height - h) ~width:1 ~height:1 ();
done
method push v =
let need_max = values.(0) = !maxim in
for i = 0 to width - 2 do
values.(i) <- values.(i + 1)
done;
values.(width - 1) <- v;
if need_max then begin
maxim := 0.;
for i = 0 to width - 1 do maxim := max !maxim values.(i) done
end else
maxim := max !maxim v;
if active then begin
let need_resize =
!maxim > !scale || (!maxim > min_scale && !maxim < !scale /. 1.5) in
if need_resize then
self#redraw ()
else begin
pixmap#put_pixmap ~x:0 ~y:0 ~xsrc:1 (pixmap#pixmap);
pixmap#set_foreground `WHITE;
pixmap#rectangle
~filled:true ~x:(width - 1) ~y:0 ~width:1 ~height ();
self#rect (width - 1) values.(width - 2) values.(width - 1)
end;
area#misc#draw None
end
end
let clientWritten = ref 0.
let serverWritten = ref 0.
let emitRate2 = ref 0.
let receiveRate2 = ref 0.
let rate2str v =
if v > 9.9e3 then begin
if v > 9.9e6 then
Format.sprintf "%1.0f MiB/s" (v /. 1e6)
else if v > 999e3 then
Format.sprintf "%1.1f MiB/s" (v /. 1e6)
else
Format.sprintf "%1.0f KiB/s" (v /. 1e3)
end else begin
if v > 990. then
Format.sprintf "%1.1f KiB/s" (v /. 1e3)
else if v > 99. then
Format.sprintf "%1.2f KiB/s" (v /. 1e3)
else
" "
end
let statistics () =
let title = "Statistics" in
let t = GWindow.dialog ~title () in
let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in
t_dismiss#grab_default ();
let dismiss () = t#misc#hide () in
ignore (t_dismiss#connect#clicked ~callback:dismiss);
ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true));
let emission = new stats 320 50 in
t#vbox#pack ~expand:false ~padding:4 (emission :> GObj.widget);
let reception = new stats 320 50 in
t#vbox#pack ~expand:false ~padding:4 (reception :> GObj.widget);
let lst =
GList.clist
~packing:(t#vbox#add)
~titles_active:false
~titles:[""; "Client"; "Server"; "Total"] ()
in
lst#set_column ~auto_resize:true 0;
lst#set_column ~auto_resize:true ~justification:`RIGHT 1;
lst#set_column ~auto_resize:true ~justification:`RIGHT 2;
lst#set_column ~auto_resize:true ~justification:`RIGHT 3;
ignore (lst#append ["Reception rate"]);
ignore (lst#append ["Data received"]);
ignore (lst#append ["File data written"]);
for r = 0 to 2 do
lst#set_row ~selectable:false r
done;
ignore (t#event#connect#map (fun _ ->
emission#activate true;
reception#activate true;
false));
ignore (t#event#connect#unmap (fun _ ->
emission#activate false;
reception#activate false;
false));
let delay = 0.5 in
let a = 0.5 in
let b = 0.8 in
let emittedBytes = ref 0. in
let emitRate = ref 0. in
let receivedBytes = ref 0. in
let receiveRate = ref 0. in
let stopCounter = ref 0 in
let updateTable () =
let kib2str v = Format.sprintf "%.0f B" v in
lst#set_cell ~text:(rate2str !receiveRate2) 0 1;
lst#set_cell ~text:(rate2str !emitRate2) 0 2;
lst#set_cell ~text:
(rate2str (!receiveRate2 +. !emitRate2)) 0 3;
lst#set_cell ~text:(kib2str !receivedBytes) 1 1;
lst#set_cell ~text:(kib2str !emittedBytes) 1 2;
lst#set_cell ~text:
(kib2str (!receivedBytes +. !emittedBytes)) 1 3;
lst#set_cell ~text:(kib2str !clientWritten) 2 1;
lst#set_cell ~text:(kib2str !serverWritten) 2 2;
lst#set_cell ~text:
(kib2str (!clientWritten +. !serverWritten)) 2 3
in
let timeout _ =
emitRate :=
a *. !emitRate +.
(1. -. a) *. (!Remote.emittedBytes -. !emittedBytes) /. delay;
emitRate2 :=
b *. !emitRate2 +.
(1. -. b) *. (!Remote.emittedBytes -. !emittedBytes) /. delay;
emission#push !emitRate;
receiveRate :=
a *. !receiveRate +.
(1. -. a) *. (!Remote.receivedBytes -. !receivedBytes) /. delay;
receiveRate2 :=
b *. !receiveRate2 +.
(1. -. b) *. (!Remote.receivedBytes -. !receivedBytes) /. delay;
reception#push !receiveRate;
emittedBytes := !Remote.emittedBytes;
receivedBytes := !Remote.receivedBytes;
if !stopCounter > 0 then decr stopCounter;
if !stopCounter = 0 then begin
emitRate2 := 0.; receiveRate2 := 0.;
end;
updateTable ();
!stopCounter <> 0
in
let startStats () =
if !stopCounter = 0 then begin
emittedBytes := !Remote.emittedBytes;
receivedBytes := !Remote.receivedBytes;
stopCounter := -1;
ignore (GMain.Timeout.add ~ms:(truncate (delay *. 1000.))
~callback:timeout)
end else
stopCounter := -1
in
let stopStats () = stopCounter := 10 in
(t, startStats, stopStats)
(****)
(* Standard file dialog *)
let file_dialog ~parent ~title ~callback ?filename () =
let sel = GWindow.file_selection ~parent ~title ~modal:true ?filename () in
ignore (sel#cancel_button#connect#clicked ~callback:sel#destroy);
ignore (sel#ok_button#connect#clicked ~callback:
(fun () ->
let name = sel#filename in
sel#destroy ();
callback name));
sel#show ();
ignore (sel#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ()
(* ------ *)
let fatalError message =
Trace.log (message ^ "\n");
let title = "Fatal error" in
let t =
GWindow.dialog ~parent:(toplevelWindow ())
~border_width:6 ~modal:true ~no_separator:true ~allow_grow:false () in
t#vbox#set_spacing 12;
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:`DIALOG_ERROR ~icon_size:`DIALOG
~yalign:0. ~packing:h1#pack ());
let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in
ignore (GMisc.label
~markup:(primaryText title ^ "\n\n" ^
escapeMarkup (transcode message))
~line_wrap:true ~selectable:true ~yalign:0. ~packing:v1#add ());
t#add_button_stock `QUIT `QUIT;
t#set_default_response `QUIT;
t#show(); ignore (t#run ()); t#destroy ();
exit 1
(* ------ *)
let tryAgainOrQuit = fatalError
(* ------ *)
let getFirstRoot () =
let t = GWindow.dialog ~parent:(toplevelWindow ()) ~title:"Root selection"
~modal:true ~allow_grow:true () in
t#misc#grab_focus ();
let hb = GPack.hbox
~packing:(t#vbox#pack ~expand:false ~padding:15) () in
ignore(GMisc.label ~text:tryAgainMessage
~justify:`LEFT
~packing:(hb#pack ~expand:false ~padding:15) ());
let f1 = GPack.hbox ~spacing:4
~packing:(t#vbox#pack ~expand:true ~padding:4) () in
ignore (GMisc.label ~text:"Dir:" ~packing:(f1#pack ~expand:false) ());
let fileE = GEdit.entry ~packing:f1#add () in
fileE#misc#grab_focus ();
let browseCommand() =
file_dialog ~parent:t ~title:"Select a local directory"
~callback:fileE#set_text ~filename:fileE#text () in
let b = GButton.button ~label:"Browse"
~packing:(f1#pack ~expand:false) () in
ignore (b#connect#clicked ~callback:browseCommand);
let f3 = t#action_area in
let result = ref None in
let contCommand() =
result := Some(fileE#text);
t#destroy () in
let quitButton = GButton.button ~stock:`QUIT ~packing:f3#add () in
ignore (quitButton#connect#clicked
~callback:(fun () -> result := None; t#destroy()));
let contButton = GButton.button ~stock:`OK ~packing:f3#add () in
ignore (contButton#connect#clicked ~callback:contCommand);
ignore (fileE#connect#activate ~callback:contCommand);
contButton#grab_default ();
t#show ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
match !result with None -> None
| Some file ->
Some(Clroot.clroot2string(Clroot.ConnectLocal(Some file)))
(* ------ *)
let getSecondRoot () =
let t = GWindow.dialog ~parent:(toplevelWindow ()) ~title:"Root selection"
~modal:true ~allow_grow:true () in
t#misc#grab_focus ();
let message = "Please enter the second directory you want to synchronize." in
let vb = t#vbox in
let hb = GPack.hbox ~packing:(vb#pack ~expand:false ~padding:15) () in
ignore(GMisc.label ~text:message
~justify:`LEFT
~packing:(hb#pack ~expand:false ~padding:15) ());
let helpB = GButton.button ~stock:`HELP ~packing:hb#add () in
ignore (helpB#connect#clicked
~callback:(fun () -> okBox ~parent:t ~title:"Picking roots" ~typ:`INFO
~message:helpmessage));
let result = ref None in
let f = GPack.vbox ~packing:(vb#pack ~expand:false) () in
let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in
ignore (GMisc.label ~text:"Directory:" ~packing:(f1#pack ~expand:false) ());
let fileE = GEdit.entry ~packing:f1#add () in
fileE#misc#grab_focus ();
let browseCommand() =
file_dialog ~parent:t ~title:"Select a local directory"
~callback:fileE#set_text ~filename:fileE#text () in
let b = GButton.button ~label:"Browse"
~packing:(f1#pack ~expand:false) () in
ignore (b#connect#clicked ~callback:browseCommand);
let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in
let localB = GButton.radio_button ~packing:(f0#pack ~expand:false)
~label:"Local" () in
let sshB = GButton.radio_button ~group:localB#group
~packing:(f0#pack ~expand:false)
~label:"SSH" () in
let rshB = GButton.radio_button ~group:localB#group
~packing:(f0#pack ~expand:false) ~label:"RSH" () in
let socketB = GButton.radio_button ~group:sshB#group
~packing:(f0#pack ~expand:false) ~label:"Socket" () in
let f2 = GPack.hbox ~spacing:4 ~packing:f#add () in
ignore (GMisc.label ~text:"Host:" ~packing:(f2#pack ~expand:false) ());
let hostE = GEdit.entry ~packing:f2#add () in
ignore (GMisc.label ~text:"(Optional) User:"
~packing:(f2#pack ~expand:false) ());
let userE = GEdit.entry ~packing:f2#add () in
ignore (GMisc.label ~text:"Port:"
~packing:(f2#pack ~expand:false) ());
let portE = GEdit.entry ~packing:f2#add () in
let varLocalRemote = ref (`Local : [`Local|`SSH|`RSH|`SOCKET]) in
let localState() =
varLocalRemote := `Local;
hostE#misc#set_sensitive false;
userE#misc#set_sensitive false;
portE#misc#set_sensitive false;
b#misc#set_sensitive true in
let remoteState() =
hostE#misc#set_sensitive true;
b#misc#set_sensitive false;
match !varLocalRemote with
`SOCKET ->
(portE#misc#set_sensitive true; userE#misc#set_sensitive false)
| _ ->
(portE#misc#set_sensitive false; userE#misc#set_sensitive true) in
let protoState x =
varLocalRemote := x;
remoteState() in
ignore (localB#connect#clicked ~callback:localState);
ignore (sshB#connect#clicked ~callback:(fun () -> protoState(`SSH)));
ignore (rshB#connect#clicked ~callback:(fun () -> protoState(`RSH)));
ignore (socketB#connect#clicked ~callback:(fun () -> protoState(`SOCKET)));
localState();
let getRoot() =
let file = fileE#text in
let user = userE#text in
let host = hostE#text in
let port = portE#text in
match !varLocalRemote with
`Local ->
Clroot.clroot2string(Clroot.ConnectLocal(Some file))
| `SSH | `RSH ->
Clroot.clroot2string(
Clroot.ConnectByShell((if !varLocalRemote=`SSH then "ssh" else "rsh"),
host,
(if user="" then None else Some user),
(if port="" then None else Some port),
Some file))
| `SOCKET ->
Clroot.clroot2string(
(* FIX: report an error if the port entry is not well formed *)
Clroot.ConnectBySocket(host,
portE#text,
Some file)) in
let contCommand() =
try
let root = getRoot() in
result := Some root;
t#destroy ()
with Failure "int_of_string" ->
if portE#text="" then
okBox ~parent:t ~title:"Error" ~typ:`ERROR ~message:"Please enter a port"
else okBox ~parent:t ~title:"Error" ~typ:`ERROR
~message:"The port you specify must be an integer"
| _ ->
okBox ~parent:t ~title:"Error" ~typ:`ERROR
~message:"Something's wrong with the values you entered, try again" in
let f3 = t#action_area in
let quitButton =
GButton.button ~stock:`QUIT ~packing:f3#add () in
ignore (quitButton#connect#clicked ~callback:safeExit);
let contButton =
GButton.button ~stock:`OK ~packing:f3#add () in
ignore (contButton#connect#clicked ~callback:contCommand);
contButton#grab_default ();
ignore (fileE#connect#activate ~callback:contCommand);
t#show ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
!result
(* ------ *)
let getPassword rootName msg =
let t =
GWindow.dialog ~parent:(toplevelWindow ())
~title:"Unison: SSH connection" ~position:`CENTER
~no_separator:true ~modal:true ~allow_grow:false ~border_width:6 () in
t#misc#grab_focus ();
t#vbox#set_spacing 12;
let header =
primaryText
(Format.sprintf "Connecting to '%s'..." (Unicode.protect rootName)) in
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:`DIALOG_AUTHENTICATION ~icon_size:`DIALOG
~yalign:0. ~packing:h1#pack ());
let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in
ignore(GMisc.label ~markup:(header ^ "\n\n" ^
escapeMarkup (Unicode.protect msg))
~selectable:true ~yalign:0. ~packing:v1#pack ());
let passwordE = GEdit.entry ~packing:v1#pack ~visibility:false () in
passwordE#misc#grab_focus ();
t#add_button_stock `QUIT `QUIT;
t#add_button_stock `OK `OK;
t#set_default_response `OK;
ignore (passwordE#connect#activate ~callback:(fun _ -> t#response `OK));
t#show();
let res = t#run () in
let pwd = passwordE#text in
t#destroy ();
gtk_sync true;
begin match res with
`DELETE_EVENT | `QUIT -> safeExit (); ""
| `OK -> pwd
end
let termInteract = Some getPassword
(* ------ *)
type profileInfo = {roots:string list; label:string option}
(* ------ *)
let profileKeymap = Array.create 10 None
let provideProfileKey filename k profile info =
try
let i = int_of_string k in
if 0<=i && i<=9 then
match profileKeymap.(i) with
None -> profileKeymap.(i) <- Some(profile,info)
| Some(otherProfile,_) ->
raise (Util.Fatal
("Error scanning profile "^
System.fspathToPrintString filename ^":\n"
^ "shortcut key "^k^" is already bound to profile "
^ otherProfile))
else
raise (Util.Fatal
("Error scanning profile "^ System.fspathToPrintString filename ^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
with Failure "int_of_string" -> raise (Util.Fatal
("Error scanning profile "^ System.fspathToPrintString filename ^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
(* ------ *)
module React = struct
type 'a t = { mutable state : 'a; mutable observers : ('a -> unit) list }
let make v =
let res = { state = v; observers = [] } in
let update v =
if res.state <> v then begin
res.state <- v; List.iter (fun f -> f v) res.observers
end
in
(res, update)
let const v = fst (make v)
let add_observer x f = x.observers <- f :: x.observers
let state x = x.state
let lift f x =
let (res, update) = make (f (state x)) in
add_observer x (fun v -> update (f v));
res
let lift2 f x y =
let (res, update) = make (f (state x) (state y)) in
add_observer x (fun v -> update (f v (state y)));
add_observer y (fun v -> update (f (state x) v));
res
let lift3 f x y z =
let (res, update) = make (f (state x) (state y) (state z)) in
add_observer x (fun v -> update (f v (state y) (state z)));
add_observer y (fun v -> update (f (state x) v (state z)));
add_observer z (fun v -> update (f (state x) (state y) v));
res
let iter f x = f (state x); add_observer x f
type 'a event = { mutable ev_observers : ('a -> unit) list }
let make_event () =
let res = { ev_observers = [] } in
let trigger v = List.iter (fun f -> f v) res.ev_observers in
(res, trigger)
let add_ev_observer x f = x.ev_observers <- f :: x.ev_observers
let hold v e =
let (res, update) = make v in
add_ev_observer e update;
res
let iter_ev f e = add_ev_observer e f
let lift_ev f e =
let (res, trigger) = make_event () in
add_ev_observer e (fun x -> trigger (f x));
res
module Ops = struct
let (>>) x f = lift f x
let (>|) x f = iter f x
let (>>>) x f = lift_ev f x
let (>>|) x f = iter_ev f x
end
end
module GtkReact = struct
let entry (e : #GEdit.entry) =
let (res, update) = React.make e#text in
ignore (e#connect#changed ~callback:(fun () -> update (e#text)));
res
let text_combo ((c, _) : _ GEdit.text_combo) =
let (res, update) = React.make c#active in
ignore (c#connect#changed ~callback:(fun () -> update (c#active)));
res
let toggle_button (b : #GButton.toggle_button) =
let (res, update) = React.make b#active in
ignore (b#connect#toggled ~callback:(fun () -> update (b#active)));
res
let file_chooser (c : #GFile.chooser) =
let (res, update) = React.make c#filename in
ignore (c#connect#selection_changed
~callback:(fun () -> update (c#filename)));
res
let current_tree_view_selection (t : #GTree.view) =
let m =t#model in
List.map (fun p -> m#get_row_reference p) t#selection#get_selected_rows
let tree_view_selection_changed t =
let (res, trigger) = React.make_event () in
ignore (t#selection#connect#changed
~callback:(fun () -> trigger (current_tree_view_selection t)));
res
let tree_view_selection t =
React.hold (current_tree_view_selection t) (tree_view_selection_changed t)
let label (l : #GMisc.label) x = React.iter (fun v -> l#set_text v) x
let label_underlined (l : #GMisc.label) x =
React.iter (fun v -> l#set_text v; l#set_use_underline true) x
let label_markup (l : #GMisc.label) x =
React.iter (fun v -> l#set_text v; l#set_use_markup true) x
let show w x =
React.iter (fun b -> if b then w#misc#show () else w#misc#hide ()) x
let set_sensitive w x = React.iter (fun b -> w#misc#set_sensitive b) x
end
open React.Ops
(* ------ *)
(* Resize an object (typically, a label with line wrapping) so that it
use all its available space *)
let adjustSize (w : #GObj.widget) =
let notYet = ref true in
ignore
(w#misc#connect#size_allocate ~callback:(fun r ->
if !notYet then begin
notYet := false;
(* JV: I have no idea where the 12 comes from. Without it,
a window resize may happen. *)
w#misc#set_size_request ~width:(max 10 (r.Gtk.width - 12)) ()
end))
let createProfile parent =
let assistant = GAssistant.assistant ~modal:true () in
assistant#set_transient_for parent#as_window;
assistant#set_modal true;
assistant#set_title "Profile Creation";
let nonEmpty s = s <> "" in
(*
let integerRe =
Str.regexp "\\([+-]?[0-9]+\\|0o[0-7]+\\|0x[0-9a-zA-Z]+\\)" in
*)
let integerRe = Str.regexp "[0-9]+" in
let isInteger s =
Str.string_match integerRe s 0 && Str.matched_string s = s in
(* Introduction *)
let intro =
GMisc.label
~xpad:12 ~ypad:12
~text:"Welcome to the Unison Profile Creation Assistant.\n\n\
Click \"Forward\" to begin."
() in
ignore
(assistant#append_page
~title:"Profile Creation"
~page_type:`INTRO
~complete:true
intro#as_widget);
(* Profile name and description *)
let description = GPack.vbox ~border_width:12 ~spacing:6 () in
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Please enter the name of the profile and \
possibly a short description."
~packing:(description#pack ~expand:false) ());
let tbl =
let al = GBin.alignment ~packing:(description#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
let nameEntry =
GEdit.entry ~activates_default:true
~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) () in
let name = GtkReact.entry nameEntry in
ignore (GMisc.label ~text:"Profile _name:" ~xalign:0.
~use_underline:true ~mnemonic_widget:nameEntry
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
let labelEntry =
GEdit.entry ~activates_default:true
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) () in
let label = GtkReact.entry labelEntry in
ignore (GMisc.label ~text:"_Description:" ~xalign:0.
~use_underline:true ~mnemonic_widget:labelEntry
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let existingProfileLabel =
GMisc.label ~xalign:1. ~packing:(description#pack ~expand:false) ()
in
adjustSize existingProfileLabel;
GtkReact.label_markup existingProfileLabel
(name >> fun s -> Format.sprintf " Profile %s already exists."
(escapeMarkup s));
let profileExists =
name >> fun s -> s <> "" && System.file_exists (Prefs.profilePathname s)
in
GtkReact.show existingProfileLabel profileExists;
ignore
(assistant#append_page
~title:"Profile Description"
~page_type:`CONTENT
description#as_widget);
let setPageComplete page b = assistant#set_page_complete page#as_widget b in
React.lift2 (&&) (name >> nonEmpty) (profileExists >> not)
>| setPageComplete description;
let connection = GPack.vbox ~border_width:12 ~spacing:18 () in
let al = GBin.alignment ~packing:(connection#pack ~expand:false) () in
al#set_left_padding 12;
let vb =
GPack.vbox ~spacing:6 ~packing:(al#add) () in
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"You can use Unison to synchronize a local directory \
with another local directory, or with a remote directory."
~packing:(vb#pack ~expand:false) ());
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Please select the kind of synchronization \
you want to perform."
~packing:(vb#pack ~expand:false) ());
let tbl =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
ignore (GMisc.label ~text:"Description:" ~xalign:0. ~yalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let kindCombo =
let al =
GBin.alignment ~xscale:0. ~xalign:0.
~packing:(tbl#attach ~left:1 ~top:0) () in
GEdit.combo_box_text
~strings:["Local"; "Using SSH"; "Using RSH";
"Through a plain TCP connection"]
~active:0 ~packing:(al#add) ()
in
ignore (GMisc.label ~text:"Synchronization _kind:" ~xalign:0.
~use_underline:true ~mnemonic_widget:(fst kindCombo)
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
let kind =
GtkReact.text_combo kindCombo
>> fun i -> List.nth [`Local; `SSH; `RSH; `SOCKET] i
in
let isLocal = kind >> fun k -> k = `Local in
let isSSH = kind >> fun k -> k = `SSH in
let isSocket = kind >> fun k -> k = `SOCKET in
let descrLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
adjustSize descrLabel;
GtkReact.label descrLabel
(kind >> fun k ->
match k with
`Local ->
"Local synchronization."
| `SSH ->
"This is the recommended way to synchronize \
with a remote machine. A\xc2\xa0remote instance of Unison is \
automatically started via SSH."
| `RSH ->
"Synchronization with a remote machine by starting \
automatically a remote instance of Unison via RSH."
| `SOCKET ->
"Synchronization with a remote machine by connecting \
to an instance of Unison already listening \
on a specific TCP port.");
let vb = GPack.vbox ~spacing:6 ~packing:(connection#add) () in
GtkReact.show vb (isLocal >> not);
ignore (GMisc.label ~markup:"Configuration" ~xalign:0.
~packing:(vb#pack ~expand:false) ());
let al = GBin.alignment ~packing:(vb#add) () in
al#set_left_padding 12;
let vb = GPack.vbox ~spacing:6 ~packing:(al#add) () in
let requirementLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~packing:(vb#pack ~expand:false) ()
in
adjustSize requirementLabel;
GtkReact.label requirementLabel
(kind >> fun k ->
match k with
`Local ->
""
| `SSH ->
"There must be an SSH client installed on this machine, \
and Unison and an SSH server installed on the remote machine."
| `RSH ->
"There must be an RSH client installed on this machine, \
and Unison and an RSH server installed on the remote machine."
| `SOCKET ->
"There must be a Unison server running on the remote machine, \
listening on the port that you specify here. \
(Use \"Unison -socket xxx\" on the remote machine to start \
the Unison server.)");
let connDescLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~packing:(vb#pack ~expand:false) ()
in
adjustSize connDescLabel;
GtkReact.label connDescLabel
(kind >> fun k ->
match k with
`Local -> ""
| `SSH -> "Please enter the host to connect to and a user name, \
if different from your user name on this machine."
| `RSH -> "Please enter the host to connect to and a user name, \
if different from your user name on this machine."
| `SOCKET -> "Please enter the host and port to connect to.");
let tbl =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
let hostEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) () in
let host = GtkReact.entry hostEntry in
ignore (GMisc.label ~text:"_Host:" ~xalign:0.
~use_underline:true ~mnemonic_widget:hostEntry
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
let userEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
GtkReact.show userEntry (isSocket >> not);
let user = GtkReact.entry userEntry in
GtkReact.show
(GMisc.label ~text:"_User:" ~xalign:0. ~yalign:0.
~use_underline:true ~mnemonic_widget:userEntry
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ())
(isSocket >> not);
let portEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
GtkReact.show portEntry isSocket;
let port = GtkReact.entry portEntry in
GtkReact.show
(GMisc.label ~text:"_Port:" ~xalign:0. ~yalign:0.
~use_underline:true ~mnemonic_widget:portEntry
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ())
isSocket;
let compressLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~text:"Data compression can greatly improve performance \
on slow connections. However, it may slow down \
things on (fast) local networks."
~packing:(vb#pack ~expand:false) ()
in
adjustSize compressLabel;
GtkReact.show compressLabel isSSH;
let compressButton =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
(GButton.check_button ~label:"Enable _compression" ~use_mnemonic:true
~active:true ~packing:(al#add) ())
in
GtkReact.show compressButton isSSH;
let compress = GtkReact.toggle_button compressButton in
(*XXX Disabled for now... *)
(*
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true
~text:"If this is possible, it is recommended that Unison \
attempts to connect immediately to the remote machine, \
so that it can perform some auto-detections."
~packing:(vb#pack ~expand:false) ());
let connectImmediately =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GtkReact.toggle_button
(GButton.check_button ~label:"Connect _immediately" ~use_mnemonic:true
~active:true ~packing:(al#add) ())
in
let connectImmediately =
React.lift2 (&&) connectImmediately (isLocal >> not) in
*)
let pageComplete =
React.lift2 (||) isLocal
(React.lift2 (&&) (host >> nonEmpty)
(React.lift2 (||) (isSocket >> not) (port >> isInteger)))
in
ignore
(assistant#append_page
~title:"Connection Setup"
~page_type:`CONTENT
connection#as_widget);
pageComplete >| setPageComplete connection;
(* Connection to server *)
(*XXX Disabled for now... Fill in this page
let connectionInProgress = GMisc.label ~text:"..." () in
let p =
assistant#append_page
~title:"Connecting to Server..."
~page_type:`PROGRESS
connectionInProgress#as_widget
in
ignore
(assistant#connect#prepare (fun () ->
if assistant#current_page = p then begin
if React.state connectImmediately then begin
(* XXXX start connection... *)
assistant#set_page_complete connectionInProgress#as_widget true
end else
assistant#set_current_page (p + 1)
end));
*)
(* Directory selection *)
let directorySelection = GPack.vbox ~border_width:12 ~spacing:6 () in
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Please select the two directories that you want to synchronize."
~packing:(directorySelection#pack ~expand:false) ());
let secondDirLabel1 =
GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"The second directory is relative to your home \
directory on the remote machine."
~packing:(directorySelection#pack ~expand:false) ()
in
adjustSize secondDirLabel1;
GtkReact.show secondDirLabel1 ((React.lift2 (||) isLocal isSocket) >> not);
let secondDirLabel2 =
GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"The second directory is relative to \
the working directory of the Unison server \
running on the remote machine."
~packing:(directorySelection#pack ~expand:false) ()
in
adjustSize secondDirLabel2;
GtkReact.show secondDirLabel2 isSocket;
let tbl =
let al =
GBin.alignment ~packing:(directorySelection#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
(*XXX Should focus on this button when becomes visible... *)
let firstDirButton =
GFile.chooser_button ~action:`SELECT_FOLDER ~title:"First Directory"
~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) ()
in
isLocal >| (fun b -> firstDirButton#set_title
(if b then "First Directory" else "Local Directory"));
GtkReact.label_underlined
(GMisc.label ~xalign:0.
~mnemonic_widget:firstDirButton
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ())
(isLocal >> fun b ->
if b then "_First directory:" else "_Local directory:");
let noneToEmpty o = match o with None -> "" | Some s -> s in
let firstDir = GtkReact.file_chooser firstDirButton >> noneToEmpty in
let secondDirButton =
GFile.chooser_button ~action:`SELECT_FOLDER ~title:"Second Directory"
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) () in
let secondDirLabel =
GMisc.label ~xalign:0.
~text:"Se_cond directory:"
~use_underline:true ~mnemonic_widget:secondDirButton
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) () in
GtkReact.show secondDirButton isLocal;
GtkReact.show secondDirLabel isLocal;
let remoteDirEdit =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
let remoteDirLabel =
GMisc.label ~xalign:0.
~text:"_Remote directory:"
~use_underline:true ~mnemonic_widget:remoteDirEdit
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ()
in
GtkReact.show remoteDirEdit (isLocal >> not);
GtkReact.show remoteDirLabel (isLocal >> not);
let secondDir =
React.lift3 (fun b l r -> if b then l else r) isLocal
(GtkReact.file_chooser secondDirButton >> noneToEmpty)
(GtkReact.entry remoteDirEdit)
in
ignore
(assistant#append_page
~title:"Directory Selection"
~page_type:`CONTENT
directorySelection#as_widget);
React.lift2 (||) (isLocal >> not) (React.lift2 (<>) firstDir secondDir)
>| setPageComplete directorySelection;
(* Specific options *)
let options = GPack.vbox ~border_width:18 ~spacing:12 () in
(* Do we need to set specific options for FAT partitions?
If under Windows, then all the options are set properly, except for
ignoreinodenumbers in case one replica is on a FAT partition on a
remote non-Windows machine. As this is unlikely, we do not
handle this case. *)
let fat =
if Util.osType = `Win32 then
React.const false
else begin
let vb =
GPack.vbox ~spacing:6 ~packing:(options#pack ~expand:false) () in
let fatLabel =
GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Select the following option if one of your \
directory is on a FAT partition. This is typically \
the case for a USB stick."
~packing:(vb#pack ~expand:false) ()
in
adjustSize fatLabel;
let fatButton =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
(GButton.check_button
~label:"Synchronization involving a _FAT partition"
~use_mnemonic:true ~active:false ~packing:(al#add) ())
in
GtkReact.toggle_button fatButton
end
in
(* Fastcheck is safe except on FAT partitions and on Windows when
not in Unicode mode where there is a very slight chance of
missing an update when a file is moved onto another with the same
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 = 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
~text:"When synchronizing in case insensitive mode, \
Unison has to make some assumptions regarding \
filename encoding. If ensure, use Unicode."
~packing:(vb#pack ~expand:false) ());
let vb =
let al = GBin.alignment
~xscale:0. ~xalign:0. ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.vbox ~spacing:0 ~packing:(al#add) ()
in
ignore
(GMisc.label ~xalign:0. ~text:"Filename encoding:"
~packing:(vb#pack ~expand:false) ());
let hb =
let al = GBin.alignment
~xscale:0. ~xalign:0. ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.button_box `VERTICAL ~layout:`START
~spacing:0 ~packing:(al#add) ()
in
let unicodeButton =
GButton.radio_button ~label:"_Unicode" ~use_mnemonic:true ~active:true
~packing:(hb#add) ()
in
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
~page_type:`CONTENT
options#as_widget
in
ignore
(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
~xpad:12 ~ypad:12
~text:"You have now finished filling in the profile.\n\n\
Click \"Apply\" to create it."
() in
ignore
(assistant#append_page
~title:"Done" ~complete:true
~page_type:`CONFIRM
conclusion#as_widget);
let profileName = ref None in
let saveProfile () =
let filename = Prefs.profilePathname (React.state name) in
begin try
let ch =
System.open_out_gen [Open_wronly; Open_creat; Open_excl] 0o600 filename
in
Printf.fprintf ch "# Unison preferences\n";
let label = React.state label in
if label <> "" then Printf.fprintf ch "label = %s\n" label;
Printf.fprintf ch "root = %s\n" (React.state firstDir);
let secondDir = React.state secondDir in
let host = React.state host in
let user = match React.state user with "" -> None | u -> Some u in
let secondRoot =
match React.state kind with
`Local -> Clroot.ConnectLocal (Some secondDir)
| `SSH -> Clroot.ConnectByShell
("ssh", host, user, None, Some secondDir)
| `RSH -> Clroot.ConnectByShell
("rsh", host, user, None, Some secondDir)
| `SOCKET -> Clroot.ConnectBySocket
(host, React.state port, Some secondDir)
in
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 Printf.fprintf ch "fat = true\n";
close_out ch;
profileName := Some (React.state name)
with Sys_error _ as e ->
okBox ~parent:assistant ~typ:`ERROR ~title:"Could not save profile"
~message:(Uicommon.exn2string e)
end;
assistant#destroy ();
in
ignore (assistant#connect#close ~callback:saveProfile);
ignore (assistant#connect#destroy ~callback:GMain.Main.quit);
ignore (assistant#connect#cancel ~callback:assistant#destroy);
assistant#show ();
GMain.Main.main ();
!profileName
(* ------ *)
let nameOfType t =
match t with
`BOOL -> "boolean"
| `BOOLDEF -> "boolean"
| `INT -> "integer"
| `STRING -> "text"
| `STRING_LIST -> "text list"
| `CUSTOM -> "custom"
| `UNKNOWN -> "unknown"
let defaultValue t =
match t with
`BOOL -> ["true"]
| `BOOLDEF -> ["true"]
| `INT -> ["0"]
| `STRING -> [""]
| `STRING_LIST -> []
| `CUSTOM -> []
| `UNKNOWN -> []
let editPreference parent nm ty vl =
let t =
GWindow.dialog ~parent ~border_width:12
~no_separator:true ~title:"Edit the Preference"
~modal:true () in
let vb = t#vbox in
vb#set_spacing 6;
let isList =
match ty with
`STRING_LIST | `CUSTOM | `UNKNOWN -> true
| _ -> false
in
let columns = if isList then 5 else 4 in
let rows = if isList then 3 else 2 in
let tbl =
GPack.table ~rows ~columns ~col_spacings:12 ~row_spacings:6
~packing:(vb#pack ~expand:false) () in
ignore (GMisc.label ~text:"Preference:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Description:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Type:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:2 ~expand:`NONE) ());
ignore (GMisc.label ~text:(Unicode.protect nm) ~xalign:0. ~selectable:true ()
~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X));
let (doc, _, _) = Prefs.documentation nm in
ignore (GMisc.label ~text:doc ~xalign:0. ~selectable:true ()
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X));
ignore (GMisc.label ~text:(nameOfType ty) ~xalign:0. ~selectable:true ()
~packing:(tbl#attach ~left:1 ~top:2 ~expand:`X));
let newValue =
if isList then begin
let valueLabel =
GMisc.label ~text:"V_alue:" ~use_underline:true ~xalign:0. ~yalign:0.
~packing:(tbl#attach ~left:0 ~top:3 ~expand:`NONE) ()
in
let cols = new GTree.column_list in
let c_value = cols#add Gobject.Data.string in
let c_ml = cols#add Gobject.Data.caml in
let lst_store = GTree.list_store cols in
let lst =
let sw =
GBin.scrolled_window ~packing:(tbl#attach ~left:1 ~top:3 ~expand:`X)
~shadow_type:`IN ~height:200 ~width:400
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GTree.view ~model:lst_store ~headers_visible:false
~reorderable:true ~packing:sw#add () in
valueLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
let column =
GTree.view_column
~renderer:(GTree.cell_renderer_text [], ["text", c_value]) ()
in
ignore (lst#append_column column);
let vb =
GPack.button_box
`VERTICAL ~layout:`START ~spacing:6
~packing:(tbl#attach ~left:2 ~top:3 ~expand:`NONE) ()
in
let selection = GtkReact.tree_view_selection lst in
let hasSel = selection >> fun l -> l <> [] in
let addB =
GButton.button ~stock:`ADD ~packing:(vb#pack ~expand:false) () in
let removeB =
GButton.button ~stock:`REMOVE ~packing:(vb#pack ~expand:false) () in
let editB =
GButton.button ~stock:`EDIT ~packing:(vb#pack ~expand:false) () in
let upB =
GButton.button ~stock:`GO_UP ~packing:(vb#pack ~expand:false) () in
let downB =
GButton.button ~stock:`GO_DOWN ~packing:(vb#pack ~expand:false) () in
List.iter (fun b -> b#set_xalign 0.) [addB; removeB; editB; upB; downB];
GtkReact.set_sensitive removeB hasSel;
let editLabel =
GMisc.label ~text:"Edited _item:"
~use_underline:true ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:4 ~expand:`NONE) ()
in
let editEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:4 ~expand:`X) () in
editLabel#set_mnemonic_widget (Some (editEntry :> GObj.widget));
let edit = GtkReact.entry editEntry in
let edited =
React.lift2
(fun l txt ->
match l with
[rf] -> lst_store#get ~row:rf#iter ~column:c_ml <> txt
| _ -> false)
selection edit
in
GtkReact.set_sensitive editB edited;
let selectionChange = GtkReact.tree_view_selection_changed lst in
selectionChange >>| (fun s ->
match s with
[rf] -> editEntry#set_text
(lst_store#get ~row:rf#iter ~column:c_value)
| _ -> ());
let add () =
let txt = editEntry#text in
let row = lst_store#append () in
lst_store#set ~row ~column:c_value txt;
lst_store#set ~row ~column:c_ml txt;
lst#selection#select_iter row;
lst#scroll_to_cell (lst_store#get_path row) column
in
ignore (addB#connect#clicked ~callback:add);
ignore (editEntry#connect#activate ~callback:add);
let remove () =
match React.state selection with
[rf] -> let i = rf#iter in
if lst_store#iter_next i then
lst#selection#select_iter i
else begin
let p = rf#path in
if GTree.Path.prev p then
lst#selection#select_path p
end;
ignore (lst_store#remove rf#iter)
| _ -> ()
in
ignore (removeB#connect#clicked ~callback:remove);
let edit () =
match React.state selection with
[rf] -> let row = rf#iter in
let txt = editEntry#text in
lst_store#set ~row ~column:c_value txt;
lst_store#set ~row ~column:c_ml txt
| _ -> ()
in
ignore (editB#connect#clicked ~callback:edit);
let updateUpDown l =
let (upS, downS) =
match l with
[rf] -> (GTree.Path.prev rf#path, lst_store#iter_next rf#iter)
| _ -> (false, false)
in
upB#misc#set_sensitive upS;
downB#misc#set_sensitive downS
in
selectionChange >>| updateUpDown;
ignore (lst_store#connect#after#row_deleted
~callback:(fun _ -> updateUpDown (React.state selection)));
let go_up () =
match React.state selection with
[rf] -> let p = rf#path in
if GTree.Path.prev p then begin
let i = rf#iter in
let i' = lst_store#get_iter p in
ignore (lst_store#swap i i');
lst#scroll_to_cell (lst_store#get_path i) column
end;
updateUpDown (React.state selection)
| _ -> ()
in
ignore (upB#connect#clicked ~callback:go_up);
let go_down () =
match React.state selection with
[rf] -> let i = rf#iter in
if lst_store#iter_next i then begin
let i' = rf#iter in
ignore (lst_store#swap i i');
lst#scroll_to_cell (lst_store#get_path i') column
end;
updateUpDown (React.state selection)
| _ -> ()
in
ignore (downB#connect#clicked ~callback:go_down);
List.iter
(fun v ->
let row = lst_store#append () in
lst_store#set ~row ~column:c_value (Unicode.protect v);
lst_store#set ~row ~column:c_ml v)
vl;
(fun () ->
let l = ref [] in
lst_store#foreach
(fun _ row -> l := lst_store#get ~row ~column:c_ml :: !l; false);
List.rev !l)
end else begin
let v = List.hd vl in
begin match ty with
`BOOL | `BOOLDEF ->
let hb =
GPack.button_box `HORIZONTAL ~layout:`START
~packing:(tbl#attach ~left:1 ~top:3 ~expand:`X) ()
in
let isTrue = v = "true" || v = "yes" in
let trueB =
GButton.radio_button ~label:"_True" ~use_mnemonic:true
~active:isTrue ~packing:(hb#add) ()
in
ignore
(GButton.radio_button ~label:"_False" ~use_mnemonic:true
~group:trueB#group ~active:(not isTrue) ~packing:(hb#add) ());
ignore
(GMisc.label ~text:"Value:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:3 ~expand:`NONE) ());
(fun () -> [if trueB#active then "true" else "false"])
| `INT | `STRING ->
let valueEntry =
GEdit.entry ~text:(List.hd vl) ~width_chars: 40
~activates_default:true
~packing:(tbl#attach ~left:1 ~top:3 ~expand:`X) ()
in
ignore
(GMisc.label ~text:"V_alue:" ~use_underline:true ~xalign:0.
~mnemonic_widget:valueEntry
~packing:(tbl#attach ~left:0 ~top:3 ~expand:`NONE) ());
(fun () -> [valueEntry#text])
| `STRING_LIST | `CUSTOM | `UNKNOWN ->
assert false
end
end
in
let ok = ref false in
let cancelCommand () = t#destroy () in
let cancelButton =
GButton.button ~stock:`CANCEL ~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
let okCommand _ = ok := true; t#destroy () in
let okButton =
GButton.button ~stock:`OK ~packing:t#action_area#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#grab_default ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
if !ok then Some (newValue ()) else None
let markupRe = Str.regexp "<\\([a-z]+\\)>\\|\\|&\\([a-z]+\\);"
let entities =
[("amp", "&"); ("lt", "<"); ("gt", ">"); ("quot", "\""); ("apos", "'")]
let rec insertMarkupRec tags (t : #GText.view) s i tl =
try
let j = Str.search_forward markupRe s i in
if j > i then
t#buffer#insert ~tags:(List.flatten tl) (String.sub s i (j - i));
let tag = try Some (Str.matched_group 1 s) with Not_found -> None in
match tag with
Some tag ->
insertMarkupRec tags t s (Str.group_end 0)
((try [List.assoc tag tags] with Not_found -> []) :: tl)
| None ->
let entity = try Some (Str.matched_group 3 s) with Not_found -> None in
match entity with
None ->
insertMarkupRec tags t s (Str.group_end 0) (List.tl tl)
| Some ent ->
begin try
t#buffer#insert ~tags:(List.flatten tl) (List.assoc ent entities)
with Not_found -> () end;
insertMarkupRec tags t s (Str.group_end 0) tl
with Not_found ->
let j = String.length s in
if j > i then
t#buffer#insert ~tags:(List.flatten tl) (String.sub s i (j - i))
let insertMarkup tags t s =
t#buffer#set_text ""; insertMarkupRec tags t s 0 []
let documentPreference ~compact ~packing =
let vb = GPack.vbox ~spacing:6 ~packing () in
ignore (GMisc.label ~markup:"Documentation" ~xalign:0.
~packing:(vb#pack ~expand:false) ());
let al = GBin.alignment ~packing:(vb#pack ~expand:true ~fill:true) () in
al#set_left_padding 12;
let columns = if compact then 3 else 2 in
let tbl =
GPack.table ~rows:2 ~columns ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
tbl#misc#set_sensitive false;
ignore (GMisc.label ~text:"Short description:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Long description:" ~xalign:0. ~yalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let shortDescr =
GMisc.label ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X)
~xalign:0. ~selectable:true () in
let longDescr =
let sw =
if compact then
GBin.scrolled_window ~height:128 ~width:640
~packing:(tbl#attach ~left:0 ~top:2 ~right:2 ~expand:`BOTH)
~shadow_type:`IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
else
GBin.scrolled_window ~height:128 ~width:640
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`BOTH)
~shadow_type:`IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
in
GText.view ~editable:false ~packing:sw#add ~wrap_mode:`WORD ()
in
let (>>>) x f = f x in
let newlineRe = Str.regexp "\n *" in
let styleRe = Str.regexp "{\\\\\\([a-z]+\\) \\([^{}]*\\)}" in
let verbRe = Str.regexp "\\\\verb|\\([^|]*\\)|" in
let argRe = Str.regexp "\\\\ARG{\\([^{}]*\\)}" in
let textttRe = Str.regexp "\\\\texttt{\\([^{}]*\\)}" in
let emphRe = Str.regexp "\\\\emph{\\([^{}]*\\)}" in
let sectionRe = Str.regexp "\\\\sectionref{\\([^{}]*\\)}{\\([^{}]*\\)}" in
let emdash = Str.regexp_string "---" in
let parRe = Str.regexp "\\\\par *" in
let underRe = Str.regexp "\\\\_ *" in
let dollarRe = Str.regexp "\\\\\\$ *" in
let formatDoc doc =
doc >>>
Str.global_replace newlineRe " " >>>
escapeMarkup >>>
Str.global_substitute styleRe
(fun s ->
try
let tag =
match Str.matched_group 1 s with
"em" -> "i"
| "tt" -> "tt"
| _ -> raise Exit
in
Format.sprintf "<%s>%s" tag (Str.matched_group 2 s) tag
with Exit ->
Str.matched_group 0 s) >>>
Str.global_replace verbRe "\\1" >>>
Str.global_replace argRe "\\1" >>>
Str.global_replace textttRe "\\1" >>>
Str.global_replace emphRe "\\1" >>>
Str.global_replace sectionRe "Section '\\2'" >>>
Str.global_replace emdash "\xe2\x80\x94" >>>
Str.global_replace parRe "\n" >>>
Str.global_replace underRe "_" >>>
Str.global_replace dollarRe "_"
in
let tags =
let create = longDescr#buffer#create_tag in
[("i", create [`FONT_DESC (Lazy.force fontItalic)]);
("tt", create [`FONT_DESC (Lazy.force fontMonospace)])]
in
fun nm ->
let (short, long, _) =
match nm with
Some nm ->
tbl#misc#set_sensitive true;
Prefs.documentation nm
| _ ->
tbl#misc#set_sensitive false;
("", "", false)
in
shortDescr#set_text (String.capitalize short);
insertMarkup tags longDescr (formatDoc long)
(* longDescr#buffer#set_text (formatDoc long)*)
let addPreference parent =
let t =
GWindow.dialog ~parent ~border_width:12
~no_separator:true ~title:"Add a Preference"
~modal:true () in
let vb = t#vbox in
(* vb#set_spacing 18;*)
let paned = GPack.paned `VERTICAL ~packing:vb#add () in
let lvb = GPack.vbox ~spacing:6 ~packing:paned#pack1 () in
let preferenceLabel =
GMisc.label
~text:"_Preferences:" ~use_underline:true
~xalign:0. ~packing:(lvb#pack ~expand:false) ()
in
let cols = new GTree.column_list in
let c_name = cols#add Gobject.Data.string in
let basic_store = GTree.list_store cols in
let full_store = GTree.list_store cols in
let lst =
let sw =
GBin.scrolled_window ~packing:(lvb#pack ~expand:true)
~shadow_type:`IN ~height:200 ~width:400
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GTree.view ~headers_visible:false ~packing:sw#add () in
preferenceLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
ignore (lst#append_column
(GTree.view_column
~renderer:(GTree.cell_renderer_text [], ["text", c_name]) ()));
let hiddenPrefs =
["auto"; "doc"; "silent"; "terse"; "testserver"; "version"] in
let shownPrefs =
["label"; "key"] in
let insert (store : #GTree.list_store) all =
List.iter
(fun nm ->
if
all || List.mem nm shownPrefs ||
(let (_, _, basic) = Prefs.documentation nm in basic &&
not (List.mem nm hiddenPrefs))
then begin
let row = store#append () in
store#set ~row ~column:c_name nm
end)
(Prefs.list ())
in
insert basic_store false;
insert full_store true;
let showAll =
GtkReact.toggle_button
(GButton.check_button ~label:"_Show all preferences"
~use_mnemonic:true ~active:false ~packing:(lvb#pack ~expand:false) ())
in
showAll >|
(fun b ->
lst#set_model
(Some (if b then full_store else basic_store :> GTree.model)));
let selection = GtkReact.tree_view_selection lst in
let updateDoc = documentPreference ~compact:true ~packing:paned#pack2 in
selection >|
(fun l ->
let nm =
match l with
[rf] ->
let row = rf#iter in
let store =
if React.state showAll then full_store else basic_store in
Some (store#get ~row ~column:c_name)
| _ ->
None
in
updateDoc nm);
let cancelCommand () = t#destroy () in
let cancelButton =
GButton.button ~stock:`CANCEL ~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
ignore (t#event#connect#delete ~callback:(fun _ -> cancelCommand (); true));
let ok = ref false in
let addCommand _ = ok := true; t#destroy () in
let addButton =
GButton.button ~stock:`ADD ~packing:t#action_area#add () in
ignore (addButton#connect#clicked ~callback:addCommand);
GtkReact.set_sensitive addButton (selection >> fun l -> l <> []);
ignore (lst#connect#row_activated ~callback:(fun _ _ -> addCommand ()));
addButton#grab_default ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
if not !ok then None else
match React.state selection with
[rf] ->
let row = rf#iter in
let store =
if React.state showAll then full_store else basic_store in
Some (store#get ~row ~column:c_name)
| _ ->
None
let editProfile parent name =
let t =
GWindow.dialog ~parent ~border_width:12
~no_separator:true ~title:(Format.sprintf "%s - Profile Editor" name)
~modal:true () in
let vb = t#vbox in
(* t#vbox#set_spacing 18;*)
let paned = GPack.paned `VERTICAL ~packing:vb#add () in
let lvb = GPack.vbox ~spacing:6 ~packing:paned#pack1 () in
let preferenceLabel =
GMisc.label
~text:"_Preferences:" ~use_underline:true
~xalign:0. ~packing:(lvb#pack ~expand:false) ()
in
let hb = GPack.hbox ~spacing:12 ~packing:(lvb#add) () in
let cols = new GTree.column_list in
let c_name = cols#add Gobject.Data.string in
let c_type = cols#add Gobject.Data.string in
let c_value = cols#add Gobject.Data.string in
let c_ml = cols#add Gobject.Data.caml in
let lst_store = GTree.list_store cols in
let lst_sorted_store = GTree.model_sort lst_store in
lst_sorted_store#set_sort_column_id 0 `ASCENDING;
let lst =
let sw =
GBin.scrolled_window ~packing:(hb#pack ~expand:true)
~shadow_type:`IN ~height:300 ~width:600
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GTree.view ~model:lst_sorted_store ~packing:sw#add
~headers_clickable:true () in
preferenceLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
let vc_name =
GTree.view_column
~title:"Name"
~renderer:(GTree.cell_renderer_text [], ["text", c_name]) () in
vc_name#set_sort_column_id 0;
ignore (lst#append_column vc_name);
ignore (lst#append_column
(GTree.view_column
~title:"Type"
~renderer:(GTree.cell_renderer_text [], ["text", c_type]) ()));
ignore (lst#append_column
(GTree.view_column
~title:"Value"
~renderer:(GTree.cell_renderer_text [], ["text", c_value]) ()));
let vb =
GPack.button_box
`VERTICAL ~layout:`START ~spacing:6 ~packing:(hb#pack ~expand:false) ()
in
let selection = GtkReact.tree_view_selection lst in
let hasSel = selection >> fun l -> l <> [] in
let addB =
GButton.button ~stock:`ADD ~packing:(vb#pack ~expand:false) () in
let editB =
GButton.button ~stock:`EDIT ~packing:(vb#pack ~expand:false) () in
let deleteB =
GButton.button ~stock:`DELETE ~packing:(vb#pack ~expand:false) () in
List.iter (fun b -> b#set_xalign 0.) [addB; editB; deleteB];
GtkReact.set_sensitive editB hasSel;
GtkReact.set_sensitive deleteB hasSel;
let (modified, setModified) = React.make false in
let formatValue vl = Unicode.protect (String.concat ", " vl) in
let deletePref () =
match React.state selection with
[rf] ->
let row = lst_sorted_store#convert_iter_to_child_iter rf#iter in
let (nm, ty, vl) = lst_store#get ~row ~column:c_ml in
if
twoBox ~kind:`DIALOG_QUESTION ~parent:t ~title:"Preference Deletion"
~bstock:`CANCEL ~astock:`DELETE
(Format.sprintf "Do you really want to delete preference %s?"
(Unicode.protect nm))
then begin
ignore (lst_store#remove row);
setModified true
end
| _ ->
()
in
let editPref path =
let row =
lst_sorted_store#convert_iter_to_child_iter
(lst_sorted_store#get_iter path) in
let (nm, ty, vl) = lst_store#get ~row ~column:c_ml in
match editPreference t nm ty vl with
Some [] ->
deletePref ()
| Some vl' when vl <> vl' ->
lst_store#set ~row ~column:c_ml (nm, ty, vl');
lst_store#set ~row ~column:c_value (formatValue vl');
setModified true
| _ ->
()
in
let add () =
match addPreference t with
None ->
()
| Some nm ->
let existing = ref false in
lst_store#foreach
(fun path row ->
let (nm', _, _) = lst_store#get ~row ~column:c_ml in
if nm = nm' then begin
existing := true; editPref path; true
end else
false);
if not !existing then begin
let ty = Prefs.typ nm in
match editPreference parent nm ty (defaultValue ty) with
Some vl when vl <> [] ->
let row = lst_store#append () in
lst_store#set ~row ~column:c_name (Unicode.protect nm);
lst_store#set ~row ~column:c_type (nameOfType ty);
lst_store#set ~row ~column:c_ml (nm, ty, vl);
lst_store#set ~row ~column:c_value (formatValue vl);
setModified true
| _ ->
()
end
in
ignore (addB#connect#clicked ~callback:add);
ignore (editB#connect#clicked
~callback:(fun () ->
match React.state selection with
[p] -> editPref p#path
| _ -> ()));
ignore (deleteB#connect#clicked ~callback:deletePref);
let updateDoc = documentPreference ~compact:true ~packing:paned#pack2 in
selection >|
(fun l ->
let nm =
match l with
[rf] ->
let row = rf#iter in
Some (lst_sorted_store#get ~row ~column:c_name)
| _ ->
None
in
updateDoc nm);
ignore (lst#connect#row_activated ~callback:(fun path _ -> editPref path));
let group l =
let rec groupRec l k vl l' =
match l with
(k', v) :: r ->
if k = k' then
groupRec r k (v :: vl) l'
else
groupRec r k' [v] ((k, vl) :: l')
| [] ->
Safelist.fold_left
(fun acc (k, l) -> (k, List.rev l) :: acc) [] ((k, vl) :: l')
in
match l with
(k, v) :: r -> groupRec r k [v] []
| [] -> []
in
let lastOne l = [List.hd (Safelist.rev l)] in
let normalizeValue t vl =
match t with
`BOOL | `INT | `STRING -> lastOne vl
| `STRING_LIST | `CUSTOM | `UNKNOWN -> vl
| `BOOLDEF ->
let l = lastOne vl in
if l = ["default"] || l = ["auto"] then [] else l
in
let (>>>) x f = f x in
Prefs.readAFile name
>>> List.map (fun (_, _, nm, v) -> Prefs.canonicalName nm, v)
>>> List.stable_sort (fun (nm, _) (nm', _) -> compare nm nm')
>>> group
>>> List.iter
(fun (nm, vl) ->
let nm = Prefs.canonicalName nm in
let ty = Prefs.typ nm in
let vl = normalizeValue ty vl in
if vl <> [] then begin
let row = lst_store#append () in
lst_store#set ~row ~column:c_name (Unicode.protect nm);
lst_store#set ~row ~column:c_type (nameOfType ty);
lst_store#set ~row ~column:c_value (formatValue vl);
lst_store#set ~row ~column:c_ml (nm, ty, vl)
end);
let applyCommand _ =
if React.state modified then begin
let filename = Prefs.profilePathname name in
try
let ch =
System.open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600
filename
in
(*XXX Should trim whitespaces and check for '\n' at some point *)
Printf.fprintf ch "# Unison preferences\n";
lst_store#foreach
(fun path row ->
let (nm, _, vl) = lst_store#get ~row ~column:c_ml in
List.iter (fun v -> Printf.fprintf ch "%s = %s\n" nm v) vl;
false);
close_out ch;
setModified false
with Sys_error _ as e ->
okBox ~parent:t ~typ:`ERROR ~title:"Could not save profile"
~message:(Uicommon.exn2string e)
end
in
let applyButton =
GButton.button ~stock:`APPLY ~packing:t#action_area#add () in
ignore (applyButton#connect#clicked ~callback:applyCommand);
GtkReact.set_sensitive applyButton modified;
let cancelCommand () = t#destroy () in
let cancelButton =
GButton.button ~stock:`CANCEL ~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
ignore (t#event#connect#delete ~callback:(fun _ -> cancelCommand (); true));
let okCommand _ = applyCommand (); t#destroy () in
let okButton =
GButton.button ~stock:`OK ~packing:t#action_area#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#grab_default ();
(*
List.iter
(fun (nm, _, long) ->
try
let long = formatDoc long in
ignore (Str.search_forward (Str.regexp_string "\\") long 0);
Format.eprintf "%s %s@." nm long
with Not_found -> ())
(Prefs.listVisiblePrefs ());
*)
(*
TODO:
- Extra tabs for common preferences
(should keep track of any change, or blacklist some preferences)
- Add, modify, delete
- Keep track of whether there is any change (apply button)
*)
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ()
(* ------ *)
let profilesAndRoots = ref []
let scanProfiles () =
Array.iteri (fun i _ -> profileKeymap.(i) <- None) profileKeymap;
profilesAndRoots :=
(Safelist.map
(fun f ->
let f = Filename.chop_suffix f ".prf" in
let filename = Prefs.profilePathname f in
let fileContents = Safelist.map (fun (_, _, n, v) -> (n, v)) (Prefs.readAFile f) in
let roots =
Safelist.map snd
(Safelist.filter (fun (n, _) -> n = "root") fileContents) in
let label =
try Some(Safelist.assoc "label" fileContents)
with Not_found -> None in
let info = {roots=roots; label=label} in
(* If this profile has a 'key' binding, put it in the keymap *)
(try
let k = Safelist.assoc "key" fileContents in
provideProfileKey filename k f info
with Not_found -> ());
(f, info))
(Safelist.filter (fun name -> not ( Util.startswith name ".#"
|| Util.startswith name Os.tempFilePrefix))
(Files.ls Os.unisonDir "*.prf")))
let getProfile quit =
let ok = ref false in
(* Build the dialog *)
let t =
GWindow.dialog ~parent:(toplevelWindow ()) ~border_width:12
~no_separator:true ~title:"Profile Selection"
~modal:true () in
t#set_default_width 550;
let cancelCommand _ = t#destroy () in
let cancelButton =
GButton.button ~stock:(if quit then `QUIT else `CANCEL)
~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
ignore (t#event#connect#delete ~callback:(fun _ -> cancelCommand (); true));
cancelButton#misc#set_can_default true;
let okCommand() = ok := true; t#destroy () in
let okButton =
GButton.button ~stock:`OPEN ~packing:t#action_area#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#misc#set_sensitive false;
okButton#grab_default ();
let vb = t#vbox in
t#vbox#set_spacing 18;
let al = GBin.alignment ~packing:(vb#add) () in
al#set_left_padding 12;
let lvb = GPack.vbox ~spacing:6 ~packing:(al#add) () in
let selectLabel =
GMisc.label
~text:"Select a _profile:" ~use_underline:true
~xalign:0. ~packing:(lvb#pack ~expand:false) ()
in
let hb = GPack.hbox ~spacing:12 ~packing:(lvb#add) () in
let sw =
GBin.scrolled_window ~packing:(hb#pack ~expand:true) ~height:300
~shadow_type:`IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
let cols = new GTree.column_list in
let c_name = cols#add Gobject.Data.string in
let c_label = cols#add Gobject.Data.string in
let c_ml = cols#add Gobject.Data.caml in
let lst_store = GTree.list_store cols in
let lst = GTree.view ~model:lst_store ~packing:sw#add () in
selectLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
let vc_name =
GTree.view_column
~title:"Profile"
~renderer:(GTree.cell_renderer_text [], ["text", c_name]) ()
in
ignore (lst#append_column vc_name);
ignore (lst#append_column
(GTree.view_column
~title:"Description"
~renderer:(GTree.cell_renderer_text [], ["text", c_label]) ()));
let vb = GPack.vbox ~spacing:6 ~packing:(vb#pack ~expand:false) () in
ignore (GMisc.label ~markup:"Summary" ~xalign:0.
~packing:(vb#pack ~expand:false) ());
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
let tbl =
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
tbl#misc#set_sensitive false;
ignore (GMisc.label ~text:"First root:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Second root:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let root1 =
GMisc.label ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X)
~xalign:0. ~selectable:true () in
let root2 =
GMisc.label ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X)
~xalign:0. ~selectable:true () in
let fillLst default =
scanProfiles();
lst_store#clear ();
Safelist.iter
(fun (profile, info) ->
let labeltext =
match info.label with None -> "" | Some l -> l in
let row = lst_store#append () in
lst_store#set ~row ~column:c_name (Unicode.protect profile);
lst_store#set ~row ~column:c_label (Unicode.protect labeltext);
lst_store#set ~row ~column:c_ml (profile, info);
if Some profile = default then begin
lst#selection#select_iter row;
lst#scroll_to_cell (lst_store#get_path row) vc_name
end)
(Safelist.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots)
in
let selection = GtkReact.tree_view_selection lst in
let hasSel = selection >> fun l -> l <> [] in
let selInfo =
selection >> fun l ->
match l with
[rf] -> Some (lst_store#get ~row:rf#iter ~column:c_ml, rf)
| _ -> None
in
selInfo >|
(fun info ->
match info with
Some ((profile, info), _) ->
begin match info.roots with
[r1; r2] -> root1#set_text (Unicode.protect r1);
root2#set_text (Unicode.protect r2);
tbl#misc#set_sensitive true
| _ -> root1#set_text ""; root2#set_text "";
tbl#misc#set_sensitive false
end
| None ->
root1#set_text ""; root2#set_text "";
tbl#misc#set_sensitive false);
GtkReact.set_sensitive okButton hasSel;
let vb =
GPack.button_box
`VERTICAL ~layout:`START ~spacing:6 ~packing:(hb#pack ~expand:false) ()
in
let addButton =
GButton.button ~stock:`ADD ~packing:(vb#pack ~expand:false) () in
ignore (addButton#connect#clicked
~callback:(fun () ->
match createProfile t with
Some p -> fillLst (Some p) | None -> ()));
let editButton =
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; fillLst (Some p)));
GtkReact.set_sensitive editButton hasSel;
let deleteProfile () =
match React.state selInfo with
Some ((profile, _), rf) ->
if
twoBox ~kind:`DIALOG_QUESTION ~parent:t ~title:"Profile Deletion"
~bstock:`CANCEL ~astock:`DELETE
(Format.sprintf "Do you really want to delete profile %s?"
(transcode profile))
then begin
try
System.unlink (Prefs.profilePathname profile);
ignore (lst_store#remove rf#iter)
with Unix.Unix_error _ -> ()
end
| None ->
()
in
let deleteButton =
GButton.button ~stock:`DELETE ~packing:(vb#pack ~expand:false) () in
ignore (deleteButton#connect#clicked ~callback:deleteProfile);
GtkReact.set_sensitive deleteButton hasSel;
List.iter (fun b -> b#set_xalign 0.) [addButton; editButton; deleteButton];
ignore (lst#connect#row_activated ~callback:(fun _ _ -> okCommand ()));
fillLst None;
lst#misc#grab_focus ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
match React.state selInfo with
Some ((p, _), _) when !ok -> Some p
| _ -> None
(* ------ *)
let documentation sect =
let title = "Documentation" in
let t = GWindow.dialog ~title () in
let t_dismiss =
GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in
t_dismiss#grab_default ();
let dismiss () = t#destroy () in
ignore (t_dismiss#connect#clicked ~callback:dismiss);
ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true));
let (name, docstr) = Safelist.assoc sect Strings.docs in
let docstr = transcodeDoc docstr in
let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:2) () in
let optionmenu =
GMenu.option_menu ~packing:(hb#pack ~expand:true ~fill:false) () in
let t_text =
new scrolled_text ~editable:false
~width:80 ~height:20 ~packing:t#vbox#add ()
in
t_text#insert docstr;
let sect_idx = ref 0 in
let idx = ref 0 in
let menu = GMenu.menu () in
let addDocSection (shortname, (name, docstr)) =
if shortname <> "" && name <> "" then begin
if shortname = sect then sect_idx := !idx;
incr idx;
let item = GMenu.menu_item ~label:name ~packing:menu#append () in
let docstr = transcodeDoc docstr in
ignore
(item#connect#activate ~callback:(fun () -> t_text#insert docstr))
end
in
Safelist.iter addDocSection Strings.docs;
optionmenu#set_menu menu;
optionmenu#set_history !sect_idx;
t#show ()
(* ------ *)
let messageBox ~title ?(action = fun t -> t#destroy) message =
let utitle = transcode title in
let t = GWindow.dialog ~title:utitle ~position:`CENTER () in
let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in
t_dismiss#grab_default ();
ignore (t_dismiss#connect#clicked ~callback:(action t));
let t_text =
new scrolled_text ~editable:false
~width:80 ~height:20 ~packing:t#vbox#add ()
in
t_text#insert message;
ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true));
t#show ()
(* twoBoxAdvanced: Display a message in a window and wait for the user
to hit one of two buttons. Return true if the first button is
chosen, false if the second button is chosen. Also has a button for
showing more details to the user in a messageBox dialog *)
let twoBoxAdvanced
~parent ~title ~message ~longtext ~advLabel ~astock ~bstock =
let t =
GWindow.dialog ~parent ~border_width:6 ~modal:true ~no_separator:true
~allow_grow:false () in
t#vbox#set_spacing 12;
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:`DIALOG_QUESTION ~icon_size:`DIALOG
~yalign:0. ~packing:h1#pack ());
let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in
ignore (GMisc.label
~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message)
~selectable:true ~yalign:0. ~packing:v1#add ());
t#add_button_stock `CANCEL `NO;
let cmd () =
messageBox ~title:"Details" longtext
in
t#add_button advLabel `HELP;
t#add_button_stock `APPLY `YES;
t#set_default_response `NO;
let res = ref false in
let setRes signal =
match signal with
`YES -> res := true; t#destroy ()
| `NO -> res := false; t#destroy ()
| `HELP -> cmd ()
| _ -> ()
in
ignore (t#connect#response ~callback:setRes);
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show();
GMain.Main.main();
!res
let summaryBox ~parent ~title ~message ~f =
let t =
GWindow.dialog ~parent ~border_width:6 ~modal:true ~no_separator:true
~allow_grow:false ~focus_on_map:false () in
t#vbox#set_spacing 12;
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG
~yalign:0. ~packing:h1#pack ());
let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in
ignore (GMisc.label
~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message)
~selectable:true ~xalign:0. ~yalign:0. ~packing:v1#add ());
let exp = GBin.expander ~spacing:12 ~label:"Show details" ~packing:v1#add () in
let t_text =
new scrolled_text ~editable:false ~shadow_type:`IN
~width:60 ~height:10 ~packing:exp#add ()
in
f (t_text#text);
t#add_button_stock `OK `OK;
t#set_default_response `OK;
let setRes signal = t#destroy () in
ignore (t#connect#response ~callback:setRes);
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show();
GMain.Main.main()
(**********************************************************************
TOP-LEVEL WINDOW
**********************************************************************)
let displayWaitMessage () =
make_busy (toplevelWindow ());
Trace.status (Uicommon.contactingServerMsg ())
(* ------ *)
type status = NoStatus | Done | Failed
let createToplevelWindow () =
let toplevelWindow =
GWindow.window ~kind:`TOPLEVEL ~position:`CENTER
~title:myNameCapitalized ()
in
setToplevelWindow toplevelWindow;
(* There is already a default icon under Windows, and transparent
icons are not supported by all version of Windows *)
if Util.osType <> `Win32 then toplevelWindow#set_icon (Some icon);
let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in
(*******************************************************************
Statistic window
*******************************************************************)
let (statWin, startStats, stopStats) = statistics () in
(*******************************************************************
Groups of things that are sensitive to interaction at the same time
*******************************************************************)
let grAction = ref [] in
let grDiff = ref [] in
let grGo = ref [] in
let grRescan = ref [] in
let grDetail = ref [] in
let grAdd gr w = gr := w#misc::!gr in
let grSet gr st = Safelist.iter (fun x -> x#set_sensitive st) !gr in
let grDisactivateAll () =
grSet grAction false;
grSet grDiff false;
grSet grGo false;
grSet grRescan false;
grSet grDetail false
in
(*********************************************************************
Create the menu bar
*********************************************************************)
let topHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in
let menuBar =
GMenu.menu_bar ~border_width:0
~packing:(topHBox#pack ~expand:true) () in
let menus = new gMenuFactory ~accel_modi:[] menuBar in
let accel_group = menus#accel_group in
toplevelWindow#add_accel_group accel_group;
let add_submenu ?(modi=[]) label =
let (menu, item) = menus#add_submenu label in
(new gMenuFactory ~accel_group:(menus#accel_group)
~accel_path:(menus#accel_path ^ label ^ "/")
~accel_modi:modi menu,
item)
in
let replace_submenu ?(modi=[]) label item =
let menu = menus#replace_submenu item in
new gMenuFactory ~accel_group:(menus#accel_group)
~accel_path:(menus#accel_path ^ label ^ "/")
~accel_modi:modi menu
in
let profileLabel =
GMisc.label ~text:"" ~packing:(topHBox#pack ~expand:false ~padding:2) () in
let displayNewProfileLabel () =
let p = match !Prefs.profileName with None -> "" | Some p -> p in
let label = Prefs.read Uicommon.profileLabel in
let s =
match p, label with
"", _ -> ""
| _, "" -> p
| "default", _ -> label
| _ -> Format.sprintf "%s (%s)" p label
in
toplevelWindow#set_title
(if s = "" then myNameCapitalized else
Format.sprintf "%s [%s]" myNameCapitalized s);
let s = if s="" then "No profile" else "Profile: " ^ s in
profileLabel#set_text (transcode s)
in
displayNewProfileLabel ();
(*********************************************************************
Create the menus
*********************************************************************)
let (fileMenu, _) = add_submenu "_Synchronization" in
let (actionMenu, actionItem) = add_submenu "_Actions" in
let (ignoreMenu, _) = add_submenu ~modi:[`SHIFT] "_Ignore" in
let (sortMenu, _) = add_submenu "S_ort" in
let (helpMenu, _) = add_submenu "_Help" in
(*********************************************************************
Action bar
*********************************************************************)
let actionBar =
let hb = GBin.handle_box ~packing:(toplevelVBox#pack ~expand:false) () in
GButton.toolbar ~style:`BOTH
(* 2003-0519 (stse): how to set space size in gtk 2.0? *)
(* Answer from Jacques Garrigue: this can only be done in
the user's.gtkrc, not programmatically *)
~orientation:`HORIZONTAL ~tooltips:true (* ~space_size:10 *)
~packing:(hb#add) () in
(*********************************************************************
Create the main window
*********************************************************************)
let mainWindowSW =
GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:true)
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
in
let sizeMainWindow () =
let ctx = mainWindowSW#misc#pango_context in
let metrics = ctx#get_metrics () in
let h = GPango.to_pixels (metrics#ascent+metrics#descent) in
mainWindowSW#misc#set_size_request
~height:((h + 1) * (Prefs.read Uicommon.mainWindowHeight + 1) + 10) ()
in
let mainWindow =
GList.clist ~columns:5 ~titles_show:true
~selection_mode:`MULTIPLE ~packing:mainWindowSW#add ()
in
(*
let cols = new GTree.column_list in
let c_replica1 = cols#add Gobject.Data.string in
let c_action = cols#add Gobject.Data.gobject in
let c_replica2 = cols#add Gobject.Data.string in
let c_status = cols#add Gobject.Data.string in
let c_path = cols#add Gobject.Data.string in
let lst_store = GTree.list_store cols in
let lst =
GTree.view ~model:lst_store ~packing:(toplevelVBox#add)
~headers_clickable:false () in
let s = Uicommon.roots2string () in
ignore (lst#append_column
(GTree.view_column
~title:(" " ^ Unicode.protect (String.sub s 0 12) ^ " ")
~renderer:(GTree.cell_renderer_text [], ["text", c_replica1]) ()));
ignore (lst#append_column
(GTree.view_column ~title:" Action "
~renderer:(GTree.cell_renderer_pixbuf [], ["pixbuf", c_action]) ()));
ignore (lst#append_column
(GTree.view_column
~title:(" " ^ Unicode.protect (String.sub s 15 12) ^ " ")
~renderer:(GTree.cell_renderer_text [], ["text", c_replica2]) ()));
ignore (lst#append_column
(GTree.view_column ~title:" Status " ()));
ignore (lst#append_column
(GTree.view_column ~title:" Path "
~renderer:(GTree.cell_renderer_text [], ["text", c_path]) ()));
*)
(*
let status_width =
let font = mainWindow#misc#style#font in
4 + max (max (Gdk.Font.string_width font "working")
(Gdk.Font.string_width font "skipped"))
(Gdk.Font.string_width font " Action ")
in
*)
mainWindow#set_column ~justification:`CENTER 1;
mainWindow#set_column
~justification:`CENTER (*~auto_resize:false ~width:status_width*) 3;
let setMainWindowColumnHeaders s =
Array.iteri
(fun i data ->
mainWindow#set_column
~title_active:false ~auto_resize:true ~title:data i)
[| " " ^ Unicode.protect (String.sub s 0 12) ^ " "; " Action ";
" " ^ Unicode.protect (String.sub s 15 12) ^ " "; " Status ";
" Path" |];
sizeMainWindow ()
in
setMainWindowColumnHeaders " ";
(*********************************************************************
Create the details window
*********************************************************************)
let showDetCommand () =
let details =
match currentRow () with
None ->
None
| Some row ->
let path = Path.toString !theState.(row).ri.path1 in
match !theState.(row).whatHappened with
Some (Util.Failed _, Some det) ->
Some ("Merge execution details for file" ^
transcodeFilename path,
det)
| _ ->
match !theState.(row).ri.replicas with
Problem err ->
Some ("Errors for file " ^ transcodeFilename path, err)
| Different diff ->
let prefix s l =
Safelist.map (fun err -> Format.sprintf "%s%s\n" s err) l
in
let errors =
Safelist.append
(prefix "[root 1]: " diff.errors1)
(prefix "[root 2]: " diff.errors2)
in
let errors =
match !theState.(row).whatHappened with
Some (Util.Failed err, _) -> err :: errors
| _ -> errors
in
Some ("Errors for file " ^ transcodeFilename path,
String.concat "\n" errors)
in
match details with
None -> ((* Should not happen *))
| Some (title, details) -> messageBox ~title (transcode details)
in
let detailsWindowSW =
GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:false)
~shadow_type:`IN ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ()
in
let detailsWindow =
GText.view ~editable:false ~packing:detailsWindowSW#add ()
in
let detailsWindowPath = detailsWindow#buffer#create_tag [] in
let detailsWindowInfo =
detailsWindow#buffer#create_tag [`FONT_DESC (Lazy.force fontMonospace)] in
let detailsWindowError =
detailsWindow#buffer#create_tag [`WRAP_MODE `WORD] in
detailsWindow#misc#set_size_chars ~height:3 ~width:112 ();
detailsWindow#misc#set_can_focus false;
let updateButtons () =
if not !busy then
let actionPossible row =
let si = !theState.(row) in
match si.whatHappened, si.ri.replicas with
None, Different _ -> true
| _ -> false
in
match currentRow () with
None ->
grSet grAction (IntSet.exists actionPossible !current);
grSet grDiff false;
grSet grDetail false
| Some row ->
let details =
begin match !theState.(row).ri.replicas with
Different diff -> diff.errors1 <> [] || diff.errors2 <> []
| Problem _ -> true
end
||
begin match !theState.(row).whatHappened with
Some (Util.Failed _, _) -> true
| _ -> false
end
in
grSet grDetail details;
let activateAction = actionPossible row in
let activateDiff =
activateAction &&
match !theState.(row).ri.replicas with
Different {rc1 = {typ = `FILE}; rc2 = {typ = `FILE}} ->
true
| _ ->
false
in
grSet grAction activateAction;
grSet grDiff activateDiff
in
let makeRowVisible row =
if mainWindow#row_is_visible row <> `FULL then begin
let adj = mainWindow#vadjustment in
let upper = adj#upper and lower = adj#lower in
let v =
float row /. float (mainWindow#rows + 1) *. (upper-.lower) +. lower
in
adj#set_value (min v (upper -. adj#page_size));
end in
(*
let makeFirstUnfinishedVisible pRiInFocus =
let im = Array.length !theState in
let rec find i =
if i >= im then makeRowVisible im else
match pRiInFocus (!theState.(i).ri), !theState.(i).whatHappened with
true, None -> makeRowVisible i
| _ -> find (i+1) in
find 0
in
*)
let updateDetails () =
begin match currentRow () with
None ->
detailsWindow#buffer#set_text ""
| Some row ->
(* makeRowVisible row;*)
let (formated, details) =
match !theState.(row).whatHappened with
| Some(Util.Failed(s), _) ->
(false, s)
| None | Some(Util.Succeeded, _) ->
match !theState.(row).ri.replicas with
Problem _ ->
(false, Uicommon.details2string !theState.(row).ri " ")
| Different _ ->
(true, Uicommon.details2string !theState.(row).ri " ")
in
let path = Path.toString !theState.(row).ri.path1 in
detailsWindow#buffer#set_text "";
detailsWindow#buffer#insert ~tags:[detailsWindowPath]
(transcodeFilename path);
let len = String.length details in
let details =
if details.[len - 1] = '\n' then String.sub details 0 (len - 1)
else details
in
if details <> "" then
detailsWindow#buffer#insert
~tags:[if formated then detailsWindowInfo else detailsWindowError]
("\n" ^ transcode details)
end;
(* Display text *)
updateButtons () in
(*********************************************************************
Status window
*********************************************************************)
let statusHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in
let progressBar =
GRange.progress_bar ~packing:(statusHBox#pack ~expand:false) () in
progressBar#misc#set_size_chars ~height:1 ~width:28 ();
progressBar#set_pulse_step 0.02;
let progressBarPulse = ref false in
let statusWindow =
GMisc.statusbar ~packing:(statusHBox#pack ~expand:true) () in
let statusContext = statusWindow#new_context ~name:"status" in
ignore (statusContext#push "");
let displayStatus m =
statusContext#pop ();
if !progressBarPulse then progressBar#pulse ();
ignore (statusContext#push (transcode m));
(* Force message to be displayed immediately *)
gtk_sync false
in
let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in
(* Tell the Trace module about the status printer *)
Trace.messageDisplayer := displayStatus;
Trace.statusFormatter := formatStatus;
Trace.sendLogMsgsToStderr := false;
(*********************************************************************
Functions used to print in the main window
*********************************************************************)
let delayUpdates = ref false in
let hasFocus = ref false in
let select i scroll =
if !hasFocus then begin
(* If we have the focus, we move the focus row directely *)
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.
We delay updates to make sure not to change the button
states unnecessarily (which could result in a button
losing the focus). *)
delayUpdates := true;
mainWindow#unselect_all ();
mainWindow#select i 0;
delayUpdates := false;
if scroll then makeRowVisible i;
updateDetails ()
end
in
ignore (mainWindow#event#connect#focus_in ~callback:
(fun _ ->
hasFocus := true;
(* Adjust the focus row. We cannot do it immediately,
otherwise the focus row is not drawn correctly. *)
ignore (GMain.Idle.add (fun () ->
begin match currentRow () with
Some i -> select i false
| None -> ()
end;
false));
false));
ignore (mainWindow#event#connect#focus_out ~callback:
(fun _ -> hasFocus := false; false));
ignore (mainWindow#connect#select_row ~callback:
(fun ~row ~column ~event ->
current := IntSet.add row !current;
if not !delayUpdates then updateDetails ()));
ignore (mainWindow#connect#unselect_row ~callback:
(fun ~row ~column ~event ->
current := IntSet.remove row !current;
if not !delayUpdates then updateDetails ()));
let nextInteresting () =
let l = Array.length !theState in
let start = match currentRow () with Some i -> i + 1 | None -> 0 in
let rec loop i =
if i < l then
match !theState.(i).ri.replicas with
Different {direction = dir}
when not (Prefs.read Uicommon.auto) || dir = Conflict ->
select i true
| _ ->
loop (i + 1) in
loop start in
let selectSomethingIfPossible () =
if IntSet.is_empty !current then nextInteresting () in
let columnsOf i =
let oldPath = if i = 0 then Path.empty else !theState.(i-1).ri.path1 in
let status =
match !theState.(i).ri.replicas with
Different {direction = Conflict} | Problem _ ->
NoStatus
| _ ->
match !theState.(i).whatHappened with
None -> NoStatus
| Some (Util.Succeeded, _) -> Done
| Some (Util.Failed _, _) -> Failed
in
let (r1, action, r2, path) =
Uicommon.reconItem2stringList oldPath !theState.(i).ri in
(r1, action, r2, status, path)
in
let greenPixel = "00dd00" in
let redPixel = "ff2040" in
let lightbluePixel = "8888FF" in
let orangePixel = "ff9303" in
(*
let yellowPixel = "999900" in
let blackPixel = "000000" in
*)
let buildPixmap p =
GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in
let buildPixmaps f c1 =
(buildPixmap (f c1), buildPixmap (f lightbluePixel)) in
let doneIcon = buildPixmap Pixmaps.success in
let failedIcon = buildPixmap Pixmaps.failure in
let rightArrow = buildPixmaps Pixmaps.copyAB greenPixel in
let leftArrow = buildPixmaps Pixmaps.copyBA greenPixel in
let orangeRightArrow = buildPixmaps Pixmaps.copyAB orangePixel in
let orangeLeftArrow = buildPixmaps Pixmaps.copyBA orangePixel in
let ignoreAct = buildPixmaps Pixmaps.ignore redPixel in
let failedIcons = (failedIcon, failedIcon) in
let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in
(*
let rightArrowBlack = buildPixmap (Pixmaps.copyAB blackPixel) in
let leftArrowBlack = buildPixmap (Pixmaps.copyBA blackPixel) in
let mergeLogoBlack = buildPixmap (Pixmaps.mergeLogo blackPixel) in
*)
let displayArrow i j action =
let changedFromDefault = match !theState.(j).ri.replicas with
Different diff -> diff.direction <> diff.default_direction
| _ -> false in
let sel pixmaps =
if changedFromDefault then snd pixmaps else fst pixmaps in
let pixmaps =
match action with
Uicommon.AError -> failedIcons
| Uicommon.ASkip _ -> ignoreAct
| Uicommon.ALtoR false -> rightArrow
| Uicommon.ALtoR true -> orangeRightArrow
| Uicommon.ARtoL false -> leftArrow
| Uicommon.ARtoL true -> orangeLeftArrow
| Uicommon.AMerge -> mergeLogo
in
mainWindow#set_cell ~pixmap:(sel pixmaps) i 1
in
let displayStatusIcon i status =
match status with
| Failed -> mainWindow#set_cell ~pixmap:failedIcon i 3
| Done -> mainWindow#set_cell ~pixmap:doneIcon i 3
| NoStatus -> mainWindow#set_cell ~text:" " i 3 in
let displayMain() =
(* The call to mainWindow#clear below side-effect current,
so we save the current value before we clear out the main window and
rebuild it. *)
let savedCurrent = currentRow () in
mainWindow#freeze ();
mainWindow#clear ();
for i = Array.length !theState - 1 downto 0 do
let (r1, action, r2, status, path) = columnsOf i in
(*
let row = lst_store#prepend () in
lst_store#set ~row ~column:c_replica1 r1;
lst_store#set ~row ~column:c_replica2 r2;
lst_store#set ~row ~column:c_status status;
lst_store#set ~row ~column:c_path path;
*)
ignore (mainWindow#prepend
[ r1; ""; r2; ""; transcodeFilename path ]);
displayArrow 0 i action;
displayStatusIcon i status
done;
debug (fun()-> Util.msg "reset current to %s\n"
(match savedCurrent with None->"None" | Some(i) -> string_of_int i));
begin match savedCurrent with
None -> selectSomethingIfPossible ()
| Some idx -> select idx true
end;
mainWindow#thaw ();
updateDetails (); (* Do we need this line? *)
in
let redisplay i =
let (r1, action, r2, status, path) = columnsOf i in
(*mainWindow#freeze ();*)
mainWindow#set_cell ~text:r1 i 0;
displayArrow i i action;
mainWindow#set_cell ~text:r2 i 2;
displayStatusIcon i status;
mainWindow#set_cell ~text:(transcodeFilename path) i 4;
if status = Failed then
mainWindow#set_cell
~text:(transcodeFilename path ^
" [failed: click on this line for details]") i 4;
(*mainWindow#thaw ();*)
if currentRow () = Some i then begin
updateDetails (); updateButtons ()
end
in
let fastRedisplay i =
let (r1, action, r2, status, path) = columnsOf i in
displayStatusIcon i status;
if status = Failed then
mainWindow#set_cell
~text:(transcodeFilename path ^
" [failed: click on this line for details]") i 4;
if currentRow () = Some i then updateDetails ();
in
let totalBytesToTransfer = ref Uutil.Filesize.zero in
let totalBytesTransferred = ref Uutil.Filesize.zero in
let t0 = ref 0. in
let t1 = ref 0. in
let lastFrac = ref 0. in
let oldWritten = ref 0. in
let writeRate = ref 0. in
let displayGlobalProgress v =
if v = 0. || abs_float (v -. !lastFrac) > 1. then begin
lastFrac := v;
progressBar#set_fraction (max 0. (min 1. (v /. 100.)))
end;
if v < 0.001 then
progressBar#set_text " "
else begin
let t = Unix.gettimeofday () in
let delta = t -. !t1 in
if delta >= 0.5 then begin
t1 := t;
let remTime =
if v >= 100. then "00:00 remaining" else
let t = truncate ((!t1 -. !t0) *. (100. -. v) /. v +. 0.5) in
Format.sprintf "%02d:%02d remaining" (t / 60) (t mod 60)
in
let written = !clientWritten +. !serverWritten in
let b = 0.64 ** delta in
writeRate :=
b *. !writeRate +.
(1. -. b) *. (written -. !oldWritten) /. delta;
oldWritten := written;
let rate = !writeRate (*!emitRate2 +. !receiveRate2*) in
let txt =
if rate > 99. then
Format.sprintf "%s (%s)" remTime (rate2str rate)
else
remTime
in
progressBar#set_text txt
end
end
in
let showGlobalProgress b =
(* Concatenate the new message *)
totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b;
let v =
(Uutil.Filesize.percentageOfTotalSize
!totalBytesTransferred !totalBytesToTransfer)
in
displayGlobalProgress v
in
let root1IsLocal = ref true in
let root2IsLocal = ref true in
let initGlobalProgress b =
let (root1,root2) = Globals.roots () in
root1IsLocal := fst root1 = Local;
root2IsLocal := fst root2 = Local;
totalBytesToTransfer := b;
totalBytesTransferred := Uutil.Filesize.zero;
t0 := Unix.gettimeofday (); t1 := !t0;
writeRate := 0.; oldWritten := !clientWritten +. !serverWritten;
displayGlobalProgress 0.
in
let showProgress i bytes dbg =
let i = Uutil.File.toLine i in
let item = !theState.(i) in
item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes;
let b = item.bytesTransferred in
let len = item.bytesToTransfer in
let newstatus =
if b = Uutil.Filesize.zero || len = Uutil.Filesize.zero then "start "
else if len = Uutil.Filesize.zero then
Printf.sprintf "%5s " (Uutil.Filesize.toString b)
else Util.percent2string (Uutil.Filesize.percentageOfTotalSize b len) in
let dbg = if Trace.enabled "progress" then dbg ^ "/" else "" in
let newstatus = dbg ^ newstatus in
let oldstatus = mainWindow#cell_text i 3 in
if oldstatus <> newstatus then mainWindow#set_cell ~text:newstatus i 3;
showGlobalProgress bytes;
gtk_sync false;
begin match item.ri.replicas with
Different diff ->
begin match diff.direction with
Replica1ToReplica2 ->
if !root2IsLocal then
clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes
else
serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes
| Replica2ToReplica1 ->
if !root1IsLocal then
clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes
else
serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes
| Conflict | Merge ->
(* Diff / merge *)
clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes
end
| _ ->
assert false
end
in
(* Install showProgress so that we get called back by low-level
file transfer stuff *)
Uutil.setProgressPrinter showProgress;
(* Apply new ignore patterns to the current state, expecting that the
number of reconitems will grow smaller. Adjust the display, being
careful to keep the cursor as near as possible to its position
before the new ignore patterns take effect. *)
let ignoreAndRedisplay () =
let lst = Array.to_list !theState in
(* FIX: we should actually test whether any prefix is now ignored *)
let keep sI = not (Globals.shouldIgnore sI.ri.path1) in
begin match currentRow () with
None ->
theState := Array.of_list (Safelist.filter keep lst);
current := IntSet.empty
| Some index ->
let i = ref index in
let l = ref [] in
Array.iteri
(fun j sI -> if keep sI then l := sI::!l
else if j < !i then decr i)
!theState;
theState := Array.of_list (Safelist.rev !l);
current :=
if !l = [] then IntSet.empty
else IntSet.singleton (min (!i) ((Array.length !theState) - 1))
end;
displayMain() in
let sortAndRedisplay () =
current := IntSet.empty;
let compareRIs = Sortri.compareReconItems() in
Array.stable_sort (fun si1 si2 -> compareRIs si1.ri si2.ri) !theState;
displayMain() in
(******************************************************************
Main detect-updates-and-reconcile logic
******************************************************************)
let commitUpdates () =
Trace.status "Updating synchronizer state";
let t = Trace.startTimer "Updating synchronizer state" in
gtk_sync true;
Update.commitUpdates();
Trace.showTimer t
in
let clearMainWindow () =
grDisactivateAll ();
make_busy toplevelWindow;
mainWindow#clear();
detailsWindow#buffer#set_text ""
in
let detectUpdatesAndReconcile () =
clearMainWindow ();
startStats ();
progressBarPulse := true;
sync_action := Some (fun () -> progressBar#pulse ());
let findUpdates () =
let t = Trace.startTimer "Checking for updates" in
Trace.status "Looking for changes";
let updates = Update.findUpdates () in
Trace.showTimer t;
updates in
let reconcile updates =
let t = Trace.startTimer "Reconciling" in
let reconRes = Recon.reconcileAll ~allowPartial:true updates in
Trace.showTimer t;
reconRes in
let (reconItemList, thereAreEqualUpdates, dangerousPaths) =
reconcile (findUpdates ()) in
if not !Update.foundArchives then commitUpdates ();
if reconItemList = [] then
if thereAreEqualUpdates then begin
if !Update.foundArchives then commitUpdates ();
Trace.status
"Replicas have been changed only in identical ways since last sync"
end else
Trace.status "Everything is up to date"
else
Trace.status "Check and/or adjust selected actions; then press Go";
theState :=
Array.of_list
(Safelist.map
(fun ri -> { ri = ri;
bytesTransferred = Uutil.Filesize.zero;
bytesToTransfer = Uutil.Filesize.zero;
whatHappened = None })
reconItemList);
current := IntSet.empty;
displayMain();
progressBarPulse := false; sync_action := None; displayGlobalProgress 0.;
stopStats ();
grSet grGo (Array.length !theState > 0);
grSet grRescan true;
make_interactive toplevelWindow;
if Prefs.read Globals.confirmBigDeletes then begin
if dangerousPaths <> [] then begin
Prefs.set Globals.batch false;
Util.warn (Uicommon.dangerousPathMsg dangerousPaths)
end;
end;
in
(*********************************************************************
Help menu
*********************************************************************)
let addDocSection (shortname, (name, docstr)) =
if shortname = "about" then
ignore (helpMenu#add_image_item
~stock:`ABOUT ~callback:(fun () -> documentation shortname)
name)
else if shortname <> "" && name <> "" then
ignore (helpMenu#add_item
~callback:(fun () -> documentation shortname)
name) in
Safelist.iter addDocSection Strings.docs;
(*********************************************************************
Ignore menu
*********************************************************************)
let addRegExpByPath pathfunc =
Util.StringSet.iter (fun pat -> Uicommon.addIgnorePattern pat)
(IntSet.fold
(fun i s -> Util.StringSet.add (pathfunc !theState.(i).ri.path1) s)
!current Util.StringSet.empty);
ignoreAndRedisplay ()
in
grAdd grAction
(ignoreMenu#add_item ~key:GdkKeysyms._i
~callback:(fun () -> getLock (fun () ->
addRegExpByPath Uicommon.ignorePath))
"Permanently Ignore This _Path");
grAdd grAction
(ignoreMenu#add_item ~key:GdkKeysyms._E
~callback:(fun () -> getLock (fun () ->
addRegExpByPath Uicommon.ignoreExt))
"Permanently Ignore Files with this _Extension");
grAdd grAction
(ignoreMenu#add_item ~key:GdkKeysyms._N
~callback:(fun () -> getLock (fun () ->
addRegExpByPath Uicommon.ignoreName))
"Permanently Ignore Files with this _Name (in any Dir)");
(*
grAdd grRescan
(ignoreMenu#add_item ~callback:
(fun () -> getLock ignoreDialog) "Edit ignore patterns");
*)
(*********************************************************************
Sort menu
*********************************************************************)
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortByName();
sortAndRedisplay()))
"Sort by _Name");
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortBySize();
sortAndRedisplay()))
"Sort by _Size");
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortNewFirst();
sortAndRedisplay()))
"Sort Ne_w Entries First");
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.restoreDefaultSettings();
sortAndRedisplay()))
"_Default Ordering");
(*********************************************************************
Main function : synchronize
*********************************************************************)
let synchronize () =
if Array.length !theState = 0 then
Trace.status "Nothing to synchronize"
else begin
grDisactivateAll ();
make_busy toplevelWindow;
Trace.status "Propagating changes";
Transport.logStart ();
let totalLength =
Array.fold_left
(fun l si ->
si.bytesTransferred <- Uutil.Filesize.zero;
let len =
if si.whatHappened = None then Common.riLength si.ri else
Uutil.Filesize.zero
in
si.bytesToTransfer <- len;
Uutil.Filesize.add l len)
Uutil.Filesize.zero !theState in
initGlobalProgress totalLength;
let t = Trace.startTimer "Propagating changes" in
let im = Array.length !theState in
let rec loop i actions pRiThisRound =
if i < im then begin
let theSI = !theState.(i) in
let textDetailed = ref None in
let action =
match theSI.whatHappened with
None ->
if not (pRiThisRound theSI.ri) then
return ()
else
catch (fun () ->
Transport.transportItem
theSI.ri (Uutil.File.ofLine i)
(fun title text ->
textDetailed := (Some text);
if Prefs.read Uicommon.confirmmerge then
twoBoxAdvanced
~parent:toplevelWindow
~title:title
~message:("Do you want to commit the changes to"
^ " the replicas ?")
~longtext:text
~advLabel:"View details..."
~astock:`YES
~bstock:`NO
else
true)
>>= (fun () ->
return Util.Succeeded))
(fun e ->
match e with
Util.Transient s ->
return (Util.Failed s)
| _ ->
fail e)
>>= (fun res ->
let rem =
Uutil.Filesize.sub
theSI.bytesToTransfer theSI.bytesTransferred
in
if rem <> Uutil.Filesize.zero then
showProgress (Uutil.File.ofLine i) rem "done";
theSI.whatHappened <- Some (res, !textDetailed);
fastRedisplay i;
(* JV (7/09): It does not seem that useful to me to scroll the display
to make the first unfinished item visible. The scrolling is way
too fast, and it makes it impossible to browse the list. *)
(*
sync_action :=
Some
(fun () ->
makeFirstUnfinishedVisible pRiThisRound;
sync_action := None);
*)
gtk_sync false;
return ())
| Some _ ->
return () (* Already processed this one (e.g. merged it) *)
in
loop (i + 1) (action :: actions) pRiThisRound
end else
actions
in
startStats ();
Lwt_unix.run
(let actions = loop 0 [] (fun ri -> not (Common.isDeletion ri)) in
Lwt_util.join actions);
Lwt_unix.run
(let actions = loop 0 [] Common.isDeletion in
Lwt_util.join actions);
Transport.logFinish ();
Trace.showTimer t;
commitUpdates ();
stopStats ();
let failureList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some (Util.Failed err, _) ->
(si, [err], "transport failure") :: l
| _ ->
l)
!theState []
in
let failureCount = List.length failureList in
let failures =
if failureCount = 0 then [] else
[Printf.sprintf "%d failure%s"
failureCount (if failureCount = 1 then "" else "s")]
in
let partialList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some (Util.Succeeded, _)
when partiallyProblematic si.ri &&
not (problematic si.ri) ->
let errs =
match si.ri.replicas with
Different diff -> diff.errors1 @ diff.errors2
| _ -> assert false
in
(si, errs,
"partial transfer (errors during update detection)") :: l
| _ ->
l)
!theState []
in
let partialCount = List.length partialList in
let partials =
if partialCount = 0 then [] else
[Printf.sprintf "%d partially transferred" partialCount]
in
let skippedList =
Array.fold_right
(fun si l ->
match si.ri.replicas with
Problem err ->
(si, [err], "error during update detection") :: l
| Different diff when diff.direction = Conflict ->
(si, [],
if diff.default_direction = Conflict then
"conflict"
else "skipped") :: l
| _ ->
l)
!theState []
in
let skippedCount = List.length skippedList in
let skipped =
if skippedCount = 0 then [] else
[Printf.sprintf "%d skipped" skippedCount]
in
Trace.status
(Printf.sprintf "Synchronization complete %s"
(String.concat ", " (failures @ partials @ skipped)));
displayGlobalProgress 0.;
grSet grRescan true;
make_interactive toplevelWindow;
let totalCount = failureCount + partialCount + skippedCount in
if totalCount > 0 then begin
let format n item sing plur =
match n with
0 -> []
| 1 -> [Format.sprintf "one %s%s" item sing]
| n -> [Format.sprintf "%d %s%s" n item plur]
in
let infos =
format failureCount "failure" "" "s" @
format partialCount "partially transferred director" "y" "ies" @
format skippedCount "skipped item" "" "s"
in
let message =
(if failureCount = 0 then "The synchronization was successful.\n\n"
else "") ^
"The replicas are not fully synchronized.\n" ^
(if totalCount < 2 then "There was" else "There were") ^
begin match infos with
[] -> assert false
| [x] -> " " ^ x
| l -> ":\n - " ^ String.concat ";\n - " l
end ^
"."
in
summaryBox ~parent:toplevelWindow
~title:"Synchronization summary" ~message ~f:
(fun t ->
let bullet = "\xe2\x80\xa2 " in
let layout = t#misc#pango_context#create_layout in
Pango.Layout.set_text layout bullet;
let (n, _) = Pango.Layout.get_pixel_size layout in
let path =
t#buffer#create_tag [`FONT_DESC (Lazy.force fontBold)] in
let description =
t#buffer#create_tag [`FONT_DESC (Lazy.force fontItalic)] in
let errorFirstLine =
t#buffer#create_tag [`LEFT_MARGIN (n); `INDENT (- n)] in
let errorNextLines =
t#buffer#create_tag [`LEFT_MARGIN (2 * n)] in
List.iter
(fun (si, errs, desc) ->
t#buffer#insert ~tags:[path]
(transcodeFilename (Path.toString si.ri.path1));
t#buffer#insert ~tags:[description]
(" \xe2\x80\x94 " ^ desc ^ "\n");
List.iter
(fun err ->
let errl =
Str.split (Str.regexp_string "\n") (transcode err) in
match errl with
[] ->
()
| f :: rem ->
t#buffer#insert ~tags:[errorFirstLine]
(bullet ^ f ^ "\n");
List.iter
(fun n ->
t#buffer#insert ~tags:[errorNextLines]
(n ^ "\n"))
rem)
errs)
(failureList @ partialList @ skippedList))
end
end in
(*********************************************************************
Quit button
*********************************************************************)
(* actionBar#insert_space ();
ignore (actionBar#insert_button ~text:"Quit"
~icon:((GMisc.image ~stock:`QUIT ())#coerce)
~tooltip:"Exit Unison"
~callback:safeExit ());
*)
(*********************************************************************
go button
*********************************************************************)
(* actionBar#insert_space ();*)
grAdd grGo
(actionBar#insert_button ~text:"Go"
(* tooltip:"Go with displayed actions" *)
~icon:((GMisc.image ~stock:`EXECUTE ())#coerce)
~tooltip:"Perform the synchronization"
~callback:(fun () ->
getLock synchronize) ());
(* Does not quite work: too slow, and Files.copy must be modifed to
support an interruption without error. *)
(*
ignore (actionBar#insert_button ~text:"Stop"
~icon:((GMisc.image ~stock:`STOP ())#coerce)
~tooltip:"Exit Unison"
~callback:Abort.all ());
*)
(*********************************************************************
Rescan button
*********************************************************************)
let updateFromProfile = ref (fun () -> ()) in
let loadProfile p reload =
debug (fun()-> Util.msg "Loading profile %s..." p);
Trace.status "Loading profile";
Uicommon.initPrefs p
(fun () -> if not reload then displayWaitMessage ())
getFirstRoot getSecondRoot termInteract;
!updateFromProfile ()
in
let reloadProfile () =
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;
updateDetails ();
if Prefs.read Globals.batch then begin
Prefs.set Globals.batch false; synchronize()
end
in
(* actionBar#insert_space ();*)
grAdd grRescan
(actionBar#insert_button ~text:"Rescan"
~icon:((GMisc.image ~stock:`REFRESH ())#coerce)
~tooltip:"Check for updates"
~callback: (fun () -> reloadProfile(); detectCmd()) ());
(*********************************************************************
Buttons for <--, M, -->, Skip
*********************************************************************)
let doActionOnRow f i =
let theSI = !theState.(i) in
begin match theSI.whatHappened, theSI.ri.replicas with
None, Different diff ->
f theSI.ri diff;
redisplay i
| _ ->
()
end
in
let updateCurrent () =
let n = mainWindow#rows in
(* This has quadratic complexity, thus we only do it when
the list is not too long... *)
if n < 300 then begin
current := IntSet.empty;
for i = 0 to n -1 do
if mainWindow#get_row_state i = `SELECTED then
current := IntSet.add i !current
done
end
in
let doAction f =
(* FIX: when the window does not have the focus, we are not notified
immediately from changes to the list of selected items. So, we
update our view of the current selection here. *)
updateCurrent ();
match currentRow () with
Some i ->
doActionOnRow f i;
nextInteresting ()
| None ->
(* FIX: this is quadratic when all items are selected.
We could trigger a redisplay instead, but it may be tricky
to preserve the set of selected rows, the focus row and the
scrollbar position.
The right fix is probably to move to a GTree.column_list. *)
let n = IntSet.cardinal !current in
if n > 0 then begin
if n > 20 then mainWindow#freeze ();
IntSet.iter (fun i -> doActionOnRow f i) !current;
if n > 20 then mainWindow#thaw ()
end
in
let leftAction _ =
doAction (fun _ diff -> diff.direction <- Replica2ToReplica1) in
let rightAction _ =
doAction (fun _ diff -> diff.direction <- Replica1ToReplica2) in
let questionAction _ = doAction (fun _ diff -> diff.direction <- Conflict) in
let mergeAction _ = doAction (fun _ diff -> diff.direction <- Merge) in
actionBar#insert_space ();
grAdd grAction
(actionBar#insert_button
(* ~icon:((GMisc.pixmap leftArrowBlack ())#coerce)*)
~icon:((GMisc.image ~stock:`GO_BACK ())#coerce)
~text:"Right to Left"
~tooltip:"Propagate selected items\n\
from the right replica to the left one"
~callback:leftAction ());
(* actionBar#insert_space ();*)
grAdd grAction
(actionBar#insert_button ~text:"Skip"
~icon:((GMisc.image ~stock:`NO ())#coerce)
~tooltip:"Skip selected items"
~callback:questionAction ());
(* actionBar#insert_space ();*)
grAdd grAction
(actionBar#insert_button
(* ~icon:((GMisc.pixmap rightArrowBlack ())#coerce)*)
~icon:((GMisc.image ~stock:`GO_FORWARD ())#coerce)
~text:"Left to Right"
~tooltip:"Propagate selected items\n\
from the left replica to the right one"
~callback:rightAction ());
(* actionBar#insert_space ();*)
grAdd grAction
(actionBar#insert_button
(* ~icon:((GMisc.pixmap mergeLogoBlack())#coerce)*)
~icon:((GMisc.image ~stock:`ADD ())#coerce)
~text:"Merge"
~tooltip:"Merge selected files"
~callback:mergeAction ());
(*********************************************************************
Diff / merge buttons
*********************************************************************)
let diffCmd () =
match currentRow () with
Some i ->
getLock (fun () ->
let item = !theState.(i) in
let len =
match item.ri.replicas with
Problem _ ->
Uutil.Filesize.zero
| Different diff ->
snd (if !root1IsLocal then diff.rc2 else diff.rc1).size
in
item.bytesTransferred <- Uutil.Filesize.zero;
item.bytesToTransfer <- len;
initGlobalProgress len;
startStats ();
Uicommon.showDiffs item.ri
(fun title text ->
messageBox ~title:(transcode title) (transcode text))
Trace.status (Uutil.File.ofLine i);
stopStats ();
displayGlobalProgress 0.;
fastRedisplay i)
| None ->
() in
actionBar#insert_space ();
grAdd grDiff (actionBar#insert_button ~text:"Diff"
~icon:((GMisc.image ~stock:`DIALOG_INFO ())#coerce)
~tooltip:"Compare the two files at each replica"
~callback:diffCmd ());
(*********************************************************************
Detail button
*********************************************************************)
(* actionBar#insert_space ();*)
grAdd grDetail (actionBar#insert_button ~text:"Details"
~icon:((GMisc.image ~stock:`INFO ())#coerce)
~tooltip:"Show detailed information about\n\
an item, when available"
~callback:showDetCommand ());
(*********************************************************************
Profile change button
*********************************************************************)
actionBar#insert_space ();
let profileChange _ =
match getProfile false with
None -> ()
| Some p -> clearMainWindow (); loadProfile p false; detectCmd ()
in
grAdd grRescan (actionBar#insert_button ~text:"Change Profile"
~icon:((GMisc.image ~stock:`OPEN ())#coerce)
~tooltip:"Select a different profile"
~callback:profileChange ());
(*********************************************************************
Keyboard commands
*********************************************************************)
ignore
(mainWindow#event#connect#key_press ~callback:
begin fun ev ->
let key = GdkEvent.Key.keyval ev in
if key = GdkKeysyms._Left then begin
leftAction (); GtkSignal.stop_emit (); true
end else if key = GdkKeysyms._Right then begin
rightAction (); GtkSignal.stop_emit (); true
end else
false
end);
(*********************************************************************
Action menu
*********************************************************************)
let buildActionMenu init =
let actionMenu = replace_submenu "_Actions" actionItem in
grAdd grRescan
(actionMenu#add_image_item
~callback:(fun _ -> mainWindow#select_all ())
~image:((GMisc.image ~stock:`SELECT_ALL ~icon_size:`MENU ())#coerce)
~modi:[`CONTROL] ~key:GdkKeysyms._A
"Select _All");
grAdd grRescan
(actionMenu#add_item
~callback:(fun _ -> mainWindow#unselect_all ())
~modi:[`SHIFT; `CONTROL] ~key:GdkKeysyms._A
"_Deselect All");
ignore (actionMenu#add_separator ());
let (loc1, loc2) =
if init then ("", "") else
let (root1,root2) = Globals.roots () in
(root2hostname root1, root2hostname root2)
in
let def_descr = "Left to Right" in
let descr =
if init || loc1 = loc2 then def_descr else
Printf.sprintf "from %s to %s" loc1 loc2 in
let left =
actionMenu#add_image_item ~key:GdkKeysyms._greater ~callback:rightAction
~image:((GMisc.image ~stock:`GO_FORWARD ~icon_size:`MENU ())#coerce)
~name:("Propagate " ^ def_descr) ("Propagate " ^ descr) in
grAdd grAction left;
left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater;
left#add_accelerator ~group:accel_group GdkKeysyms._period;
let def_descl = "Right to Left" in
let descl =
if init || loc1 = loc2 then def_descr else
Printf.sprintf "from %s to %s"
(Unicode.protect loc2) (Unicode.protect loc1) in
let right =
actionMenu#add_image_item ~key:GdkKeysyms._less ~callback:leftAction
~image:((GMisc.image ~stock:`GO_BACK ~icon_size:`MENU ())#coerce)
~name:("Propagate " ^ def_descl) ("Propagate " ^ descl) in
grAdd grAction right;
right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._less;
right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._comma;
grAdd grAction
(actionMenu#add_image_item ~key:GdkKeysyms._slash ~callback:questionAction
~image:((GMisc.image ~stock:`NO ~icon_size:`MENU ())#coerce)
"Do _Not Propagate Changes");
let merge =
actionMenu#add_image_item ~key:GdkKeysyms._m ~callback:mergeAction
~image:((GMisc.image ~stock:`ADD ~icon_size:`MENU ())#coerce)
"_Merge the Files" in
grAdd grAction merge;
(* merge#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._m; *)
(* Override actions *)
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Replica1ToReplica2 `Prefer))
"Resolve Conflicts in Favor of First Root");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Replica2ToReplica1 `Prefer))
"Resolve Conflicts in Favor of Second Root");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Newer `Prefer))
"Resolve Conflicts in Favor of Most Recently Modified");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Older `Prefer))
"Resolve Conflicts in Favor of Least Recently Modified");
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.setDirection ri `Newer `Force))
"Force Newer Files to Replace Older Ones");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.setDirection ri `Older `Force))
"Force Older Files to Replace Newer Ones");
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.revertToDefaultDirection ri))
"_Revert to Unison's Recommendations");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.setDirection ri `Merge `Force))
"Revert to the Merging Default, if Available");
(* Diff *)
ignore (actionMenu#add_separator ());
grAdd grDiff (actionMenu#add_image_item ~key:GdkKeysyms._d ~callback:diffCmd
~image:((GMisc.image ~stock:`DIALOG_INFO ~icon_size:`MENU ())#coerce)
"Show _Diffs");
(* Details *)
grAdd grDetail
(actionMenu#add_image_item ~key:GdkKeysyms._i ~callback:showDetCommand
~image:((GMisc.image ~stock:`INFO ~icon_size:`MENU ())#coerce)
"Detailed _Information")
in
buildActionMenu true;
(*********************************************************************
Synchronization menu
*********************************************************************)
grAdd grGo
(fileMenu#add_image_item ~key:GdkKeysyms._g
~image:(GMisc.image ~stock:`EXECUTE ~icon_size:`MENU () :> GObj.widget)
~callback:(fun () -> getLock synchronize)
"_Go");
grAdd grRescan
(fileMenu#add_image_item ~key:GdkKeysyms._r
~image:(GMisc.image ~stock:`REFRESH ~icon_size:`MENU () :> GObj.widget)
~callback:(fun () -> reloadProfile(); detectCmd())
"_Rescan");
grAdd grRescan
(fileMenu#add_item ~key:GdkKeysyms._a
~callback:(fun () ->
reloadProfile();
Prefs.set Globals.batch true;
detectCmd())
"_Detect Updates and Proceed (Without Waiting)");
grAdd grRescan
(fileMenu#add_item ~key:GdkKeysyms._f
~callback:(
fun () ->
let rec loop i acc =
if i >= Array.length (!theState) then acc else
let notok =
(match !theState.(i).whatHappened with
None-> true
| Some(Util.Failed _, _) -> true
| Some(Util.Succeeded, _) -> false)
|| match !theState.(i).ri.replicas with
Problem _ -> true
| Different diff -> diff.direction = Conflict in
if notok then loop (i+1) (i::acc)
else loop (i+1) (acc) in
let failedindices = loop 0 [] in
let failedpaths =
Safelist.map (fun i -> !theState.(i).ri.path1) failedindices in
debug (fun()-> Util.msg "Rescaning with paths = %s\n"
(String.concat ", " (Safelist.map
(fun p -> "'"^(Path.toString p)^"'")
failedpaths)));
let paths = Prefs.read Globals.paths in
let confirmBigDeletes = Prefs.read Globals.confirmBigDeletes in
Prefs.set Globals.paths failedpaths;
Prefs.set Globals.confirmBigDeletes false;
detectCmd();
Prefs.set Globals.paths paths;
Prefs.set Globals.confirmBigDeletes confirmBigDeletes)
"Re_check Unsynchronized Items");
ignore (fileMenu#add_separator ());
grAdd grRescan
(fileMenu#add_image_item ~key:GdkKeysyms._p
~callback:(fun _ ->
match getProfile false with
None -> ()
| Some(p) -> clearMainWindow (); loadProfile p false; detectCmd ())
~image:(GMisc.image ~stock:`OPEN ~icon_size:`MENU () :> GObj.widget)
"Change _Profile...");
let fastProf name key =
grAdd grRescan
(fileMenu#add_item ~key:key
~callback:(fun _ ->
if System.file_exists (Prefs.profilePathname name) then begin
Trace.status ("Loading profile " ^ name);
loadProfile name false; detectCmd ()
end else
Trace.status ("Profile " ^ name ^ " not found"))
("Select profile " ^ name)) in
let fastKeysyms =
[| GdkKeysyms._0; GdkKeysyms._1; GdkKeysyms._2; GdkKeysyms._3;
GdkKeysyms._4; GdkKeysyms._5; GdkKeysyms._6; GdkKeysyms._7;
GdkKeysyms._8; GdkKeysyms._9 |] in
Array.iteri
(fun i v -> match v with
None -> ()
| Some(profile, info) ->
fastProf profile fastKeysyms.(i))
profileKeymap;
ignore (fileMenu#add_separator ());
ignore (fileMenu#add_item
~callback:(fun _ -> statWin#show ()) "Show _Statistics");
ignore (fileMenu#add_separator ());
let quit =
fileMenu#add_image_item
~key:GdkKeysyms._q ~callback:safeExit
~image:((GMisc.image ~stock:`QUIT ~icon_size:`MENU ())#coerce)
"_Quit"
in
quit#add_accelerator ~group:accel_group ~modi:[`CONTROL] GdkKeysyms._q;
(*********************************************************************
Expert menu
*********************************************************************)
if Prefs.read Uicommon.expert then begin
let (expertMenu, _) = add_submenu "Expert" in
let addDebugToggle modname =
let cm =
expertMenu#add_check_item ~active:(Trace.enabled modname)
~callback:(fun b -> Trace.enable modname b)
("Debug '" ^ modname ^ "'") in
cm#set_show_toggle true in
addDebugToggle "all";
addDebugToggle "verbose";
addDebugToggle "update";
ignore (expertMenu#add_separator ());
ignore (expertMenu#add_item
~callback:(fun () ->
Printf.fprintf stderr "\nGC stats now:\n";
Gc.print_stat stderr;
Printf.fprintf stderr "\nAfter major collection:\n";
Gc.full_major(); Gc.print_stat stderr;
flush stderr)
"Show memory/GC stats")
end;
(*********************************************************************
Finish up
*********************************************************************)
grDisactivateAll ();
updateFromProfile :=
(fun () ->
displayNewProfileLabel ();
setMainWindowColumnHeaders (Uicommon.roots2string ());
buildActionMenu false);
ignore (toplevelWindow#event#connect#delete ~callback:
(fun _ -> safeExit (); true));
toplevelWindow#show ();
fun () ->
!updateFromProfile ();
mainWindow#misc#grab_focus ();
detectCmd ()
(*********************************************************************
STARTUP
*********************************************************************)
let start _ =
begin try
(* Initialize the GTK library *)
ignore (GMain.Main.init ());
Util.warnPrinter :=
Some (fun msg -> warnBox ~parent:(toplevelWindow ()) "Warning" msg);
GtkSignal.user_handler :=
(fun exn ->
match exn with
Util.Transient(s) | Util.Fatal(s) -> fatalError s
| exn -> fatalError (Uicommon.exn2string exn));
(* Ask the Remote module to call us back at regular intervals during
long network operations. *)
let rec tick () =
gtk_sync true;
Lwt_unix.sleep 0.05 >>= tick
in
ignore_result (tick ());
let detectCmd = createToplevelWindow() in
Uicommon.uiInit
fatalError
tryAgainOrQuit
displayWaitMessage
(fun () -> getProfile true)
getFirstRoot
getSecondRoot
termInteract;
scanProfiles();
detectCmd ();
(* Display the ui *)
(*JV: not useful, as Unison does not handle any signal
ignore (GMain.Timeout.add 500 (fun _ -> true));
(* Hack: this allows signals such as SIGINT to be
handled even when Gtk is waiting for events *)
*)
GMain.Main.main ()
with
Util.Transient(s) | Util.Fatal(s) -> fatalError s
| exn -> fatalError (Uicommon.exn2string exn)
end
end (* module Private *)
(*********************************************************************
UI SELECTION
*********************************************************************)
module Body : Uicommon.UI = struct
let start = function
Uicommon.Text -> Uitext.Body.start Uicommon.Text
| Uicommon.Graphic ->
let displayAvailable =
Util.osType = `Win32
||
try System.getenv "DISPLAY" <> "" with Not_found -> false
in
if displayAvailable then Private.start Uicommon.Graphic
else Uitext.Body.start Uicommon.Text
let defaultUi = Uicommon.Graphic
end (* module Body *)
unison-2.40.102/path.mli 0000644 0061316 0061316 00000002056 12025627377 015052 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/path.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Abstract type of relative pathnames *)
type 'a path
(* Pathname valid on both replicas (case insensitive in case
insensitive mode) *)
type t = [`Global] path
(* Pathname specialized to a replica (case sensitive on a case
sensitive filesystem) *)
type local = [`Local] path
val empty : 'a path
val length : t -> int
val isEmpty : local -> bool
val child : 'a path -> Name.t -> 'a path
val parent : local -> local
val finalName : t -> Name.t option
val deconstruct : 'a path -> (Name.t * 'a path) option
val deconstructRev : local -> (Name.t * local) option
val fromString : string -> 'a path
val toNames : t -> Name.t list
val toString : 'a path -> string
val toDebugString : local -> string
val addSuffixToFinalName : local -> string -> local
val addPrefixToFinalName : local -> string -> local
val compare : t -> t -> int
val followLink : local -> bool
val followPred : Pred.t
val forceLocal : t -> local
val makeGlobal : local -> t
unison-2.40.102/INSTALL.gtk2 0000644 0061316 0061316 00000003037 11361646373 015311 0 ustar bcpierce bcpierce We are happy to announce a new version of Unison with a user interface
based on Gtk 2.2, enabling display of filenames with any locale encoding.
Installation instructions follow:
-----------------------------
LINUX (and maybe other Unixes):
In order to use gtk2 with unison,
1) install glib, pango, gtk (version >2.2)
from http://www.gtk.org/
2) install lablgtk2 (version >20030423)
from http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html
3) install unison (version >2.9.36)
from http://www.cis.upenn.edu/~bcpierce/unison/
Simply type 'make'.
Makefile will detect the presence of lablgtk2 directory
$(OCAMLLIBDIR)/lablgtk2 (such as /usr/local/lib/ocaml/lablgtk2/)
and use UISTYLE=gtk2 by default. If absent, it falls back to
lablgtk with UISTYLE=gtk, then back to UISTYLE=text.
You can force the selection by
make UISTYLE=gtk2
or make UISTYLE=gtk
or make UISTYLE=text
4) setup your locale environment properly
for example, export LANG=zh_HK.BIG5-HKSCS
otherwise, you will get
Uncaught exception Glib.GError("Invalid byte sequence in conversion input")
5) enjoy unison with i18n!
-----------------------------
OS X:
1) Install gtk2 using fink:
sudo /sw/bin/fink install gtk+2
Then proceed from step 2 above.
In our tests, the linker generates lots of error messages, but appears
to build a working executable. Also, we have not yet been able to get
this build to work with 'STATIC=true'.
-----------------------------
WINDOWS:
(Anybody want to contribute instructions??)
unison-2.40.102/remote.mli 0000644 0061316 0061316 00000011006 11361646373 015403 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/remote.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
module Thread : sig
val unwindProtect : (unit -> 'a Lwt.t) -> (exn -> unit Lwt.t) -> 'a Lwt.t
end
(* Register a server function. The result is a function that takes a host
name as argument and either executes locally or else communicates with a
remote server, as appropriate. (Calling registerServerCmd also has the
side effect of registering the command under the given name, so that when
we are running as a server it can be looked up and executed when
requested by a remote client.) *)
val registerHostCmd :
string (* command name *)
-> ('a -> 'b Lwt.t) (* local command *)
-> ( string (* -> host *)
-> 'a (* arguments *)
-> 'b Lwt.t) (* -> (suspended) result *)
(* A variant of registerHostCmd, for constructing a remote command to be
applied to a particular root (host + fspath).
-
A naming convention: when a `root command' is built from a
corresponding `local command', we name the two functions
OnRoot and Local *)
val registerRootCmd :
string (* command name *)
-> ((Fspath.t * 'a) -> 'b Lwt.t) (* local command *)
-> ( Common.root (* -> root *)
-> 'a (* additional arguments *)
-> 'b Lwt.t) (* -> (suspended) result *)
(* Test whether a command exits on some root *)
val commandAvailable :
Common.root -> (* root *)
string -> (* command name *)
bool Lwt.t
(* Enter "server mode", reading and processing commands from a remote
client process until killed *)
val beAServer : unit -> unit
val waitOnPort : string option -> string -> unit
(* Whether the server should be killed when the client terminates *)
val killServer : bool Prefs.t
(* Establish a connection to the remote server (if any) corresponding
to the root and return the canonical name of the root *)
val canonizeRoot :
string -> Clroot.clroot -> (string -> string -> string) option ->
Common.root Lwt.t
(* Statistics *)
val emittedBytes : float ref
val receivedBytes : float ref
(* Establish a connection to the server.
First call openConnectionStart, then loop:
call openConnectionPrompt, if you get a prompt,
respond with openConnectionReply if desired.
After you get None from openConnectionPrompt,
call openConnectionEnd.
Call openConnectionCancel to abort the connection.
*)
type preconnection
val openConnectionStart : Clroot.clroot -> preconnection option
val openConnectionPrompt : preconnection -> string option
val openConnectionReply : preconnection -> string -> unit
val openConnectionEnd : preconnection -> unit
val openConnectionCancel : preconnection -> unit
(* return the canonical name of the root. The connection
to the root must have already been established by
the openConnection sequence. *)
val canonize : Clroot.clroot -> Common.root
(****)
type msgId = int
module MsgIdMap : Map.S with type key = msgId
val newMsgId : unit -> msgId
type connection
val connectionToRoot : Common.root -> connection
val registerServerCmd :
string -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t
val registerSpecialServerCmd :
string ->
('a ->
(Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) *
(Bytearray.t -> int -> 'a) ->
('b ->
(Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) *
(Bytearray.t -> int -> 'b) ->
(connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t
val defaultMarshalingFunctions :
('a ->
(Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) *
(Bytearray.t -> int -> 'b)
val intSize : int
val encodeInt : int -> Bytearray.t * int * int
val decodeInt : Bytearray.t -> int -> int
val registerRootCmdWithConnection :
string (* command name *)
-> (connection -> 'a -> 'b Lwt.t) (* local command *)
-> Common.root (* root on which the command is executed *)
-> Common.root (* other root *)
-> 'a (* additional arguments *)
-> 'b Lwt.t (* result *)
val streamingActivated : bool Prefs.t
val registerStreamCmd :
string ->
('a ->
(Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) *
(Bytearray.t -> int -> 'a) ->
(connection -> 'a -> unit) ->
connection -> (('a -> unit Lwt.t) -> 'b Lwt.t) -> 'b Lwt.t
unison-2.40.102/fileinfo.mli 0000644 0061316 0061316 00000001761 11361646373 015712 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fileinfo.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK]
val type2string : typ -> string
type t = { typ : typ; inode : int; desc : Props.t; osX : Osx.info}
val get : bool -> Fspath.t -> Path.local -> t
val set : Fspath.t -> Path.local ->
[`Set of Props.t | `Copy of Path.local | `Update of Props.t] ->
Props.t -> unit
val get' : System.fspath -> t
(* IF THIS CHANGES, MAKE SURE TO INCREMENT THE ARCHIVE VERSION NUMBER! *)
type stamp =
InodeStamp of int (* inode number, for Unix systems *)
| CtimeStamp of float (* creation time, for windows systems *)
val stamp : t -> stamp
val ressStamp : t -> Osx.ressStamp
(* Check whether a file is unchanged *)
val unchanged : Fspath.t -> Path.local -> t -> (t * bool * bool)
(****)
val init : bool -> unit
val allowSymlinks : [`True|`False|`Default] Prefs.t
val ignoreInodeNumbers : bool Prefs.t
unison-2.40.102/props.ml 0000644 0061316 0061316 00000063422 12025627377 015114 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/props.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
let debug = Util.debug "props"
module type S = sig
type t
val dummy : t
val hash : t -> int -> int
val similar : t -> t -> bool
val override : t -> t -> t
val strip : t -> t
val diff : t -> t -> t
val toString : t -> string
val syncedPartsToString : t -> string
val set : Fspath.t -> Path.local -> [`Set | `Update] -> t -> unit
val get : Unix.LargeFile.stats -> Osx.info -> t
val init : bool -> unit
end
(* Nb: the syncedPartsToString call is only used for archive dumping, for *)
(* debugging purposes. It could be deleted without losing functionality. *)
(**** Permissions ****)
module Perm : sig
include S
val fileDefault : t
val fileSafe : t
val dirDefault : t
val extract : t -> int
val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit
val validatePrefs : unit -> unit
val permMask : int Prefs.t
val dontChmod : bool Prefs.t
end = struct
(* We introduce a type, Perm.t, that holds a file's permissions along with *)
(* the operating system where the file resides. Different operating systems *)
(* have different permission systems, so we have to take the OS into account *)
(* when comparing and setting permissions. We also need an "impossible" *)
(* permission that to take care of a tricky special case in update *)
(* detection. It can be that the archive contains a directory that has *)
(* never been synchronized, although some of its children have been. In *)
(* this case, the directory's permissions have never been synchronized and *)
(* might be different on the two replicas. We use NullPerm for the *)
(* permissions of such an archive entry, and ensure (in similarPerms) that *)
(* NullPerm is never similar to any real permission. *)
(* NOTE: IF YOU CHANGE TYPE "PERM", THE ARCHIVE FORMAT CHANGES; INCREMENT *)
(* "UPDATE.ARCHIVEFORMAT" *)
type t = int * int
(* This allows us to export NullPerm while keeping the type perm abstract *)
let dummy = (0, 0)
let extract = fst
let unix_mask =
0o7777 (* All bits *)
let wind_mask =
0o200 (* -w------- : only the write bit can be changed in Windows *)
let permMask =
Prefs.createInt "perms"
(0o777 (* rwxrwxrwx *) + 0o1000 (* Sticky bit *))
"part of the permissions which is synchronized"
"The integer value of this preference is a mask indicating which \
permission bits should be synchronized. It is set by default to \
$0o1777$: all bits but the set-uid and set-gid bits are \
synchronised (synchronizing theses latter bits can be a security \
hazard). If you want to synchronize all bits, you can set the \
value of this preference to $-1$. If one of the replica is on \
a FAT [Windows] filesystem, you should consider using the \
{\tt fat} preference instead of this preference. If you need \
Unison not to set permissions at all, set the value of this \
preference to $0$ and set the preference {\tt dontchmod} to {\tt true}."
(* Os-specific local conventions on file permissions *)
let (fileDefault, dirDefault, fileSafe, dirSafe) =
match Util.osType with
`Win32 ->
debug
(fun() ->
Util.msg "Using windows defaults for file permissions");
((0o600, -1), (* rw------- *)
(0o700, -1), (* rwx------ *)
(0o600, -1), (* rw------- *)
(0o700, -1)) (* rwx------ *)
| `Unix ->
let umask =
let u = Unix.umask 0 in
ignore (Unix.umask u);
debug
(fun() ->
Util.msg "Umask: %s" (Printf.sprintf "%o" u));
(fun fp -> (lnot u) land fp) in
((umask 0o666, -1), (* rw-rw-rw- *)
(umask 0o777, -1), (* rwxrwxrwx *)
(umask 0o600, -1), (* rw------- *)
(umask 0o700, -1)) (* rwx------ *)
let hash (p, m) h = Uutil.hash2 (p land m) (Uutil.hash2 m h)
let perm2fileperm (p, m) = p
let fileperm2perm p = (p, Prefs.read permMask)
(* Are two perms similar (for update detection and recon) *)
let similar (p1, m1) (p2, m2) =
let m = Prefs.read permMask in
m1 land m = m && m2 land m = m &&
p1 land m = p2 land m
(* overrideCommonPermsIn p1 p2 : gives the perm that would result from *)
(* propagating p2 to p1. We expect the following invariants: similarPerms *)
(* (overrideCommonPermsIn p1 p2) p2 (whenever similarPerms p2 p2) and *)
(* hashPerm (overrideCommonPermsIn p1 p2) = hashPerm p2 *)
let override (p1, m1) (p2, m2) =
let m = Prefs.read permMask land m2 in
((p1 land (lnot m)) lor (p2 land m), m)
let strip (p, m) = (p, m land (Prefs.read permMask))
let diff (p, m) (p', m') = (p', (p lxor p') land m land m')
let toString =
function
(_, 0) -> "unknown permissions"
| (fp, _) when Prefs.read permMask = wind_mask ->
if fp land wind_mask <> 0 then "read-write" else "read-only"
| (fp, _) ->
let m = Prefs.read permMask in
let bit mb unknown off on =
if mb land m = 0 then
unknown
else if fp land mb <> 0 then
on
else
off
in
bit 0o4000 "" "-" "S" ^
bit 0o2000 "" "-" "s" ^
bit 0o1000 "?" "" "t" ^
bit 0o0400 "?" "-" "r" ^
bit 0o0200 "?" "-" "w" ^
bit 0o0100 "?" "-" "x" ^
bit 0o0040 "?" "-" "r" ^
bit 0o0020 "?" "-" "w" ^
bit 0o0010 "?" "-" "x" ^
bit 0o0004 "?" "-" "r" ^
bit 0o0002 "?" "-" "w" ^
bit 0o0001 "?" "-" "x"
let syncedPartsToString =
function
(_, 0) -> "unknown permissions"
| (fp, m) ->
let bit mb unknown off on =
if mb land m = 0 then
unknown
else if fp land mb <> 0 then
on
else
off
in
bit 0o4000 "" "-" "S" ^
bit 0o2000 "" "-" "s" ^
bit 0o1000 "?" "" "t" ^
bit 0o0400 "?" "-" "r" ^
bit 0o0200 "?" "-" "w" ^
bit 0o0100 "?" "-" "x" ^
bit 0o0040 "?" "-" "r" ^
bit 0o0020 "?" "-" "w" ^
bit 0o0010 "?" "-" "x" ^
bit 0o0004 "?" "-" "r" ^
bit 0o0002 "?" "-" "w" ^
bit 0o0001 "?" "-" "x"
let dontChmod =
Prefs.createBool "dontchmod"
false
"!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 "
^ " preference completely prevents Unison from ever calling chmod.")
let validatePrefs () =
if Prefs.read dontChmod && (Prefs.read permMask <> 0) then raise (Util.Fatal
"If the 'dontchmod' preference is set, the 'perms' preference should be 0")
let set fspath path kind (fp, mask) =
(* BCP: removed "|| kind <> `Update" on 10/2005, but reinserted it on 11/2008.
I'd removed it to make Dale Worley happy -- he wanted a way to make sure that
Unison would never call chmod, and setting prefs to 0 seemed like a reasonable
way to do this. But in fact it caused new files to be created with wrong prefs.
*)
if (mask <> 0 || kind = `Set) && (not (Prefs.read dontChmod)) then
Util.convertUnixErrorsToTransient
"setting permissions"
(fun () ->
let abspath = Fspath.concat fspath path in
debug
(fun() ->
Util.msg "Setting permissions for %s to %s (%s)\n"
(Fspath.toDebugString abspath) (toString (fileperm2perm fp))
(Printf.sprintf "%o/%o" fp mask));
try
Fs.chmod abspath fp
with Unix.Unix_error (Unix.EOPNOTSUPP, _, _) as e ->
try
Util.convertUnixErrorsToTransient "setting permissions"
(fun () -> raise e)
with Util.Transient msg ->
raise (Util.Transient
(msg ^
". You can use preference \"fat\",\
or else set preference \"perms\" to 0 and \
preference \"dontchmod\" to true to avoid this error")))
let get stats _ = (stats.Unix.LargeFile.st_perm, Prefs.read permMask)
let check fspath path stats (fp, mask) =
let fp' = stats.Unix.LargeFile.st_perm in
if fp land mask <> fp' land mask then
raise
(Util.Transient
(Format.sprintf
"Failed to set permissions of file %s to %s: \
the permissions was set to %s instead. \
The filesystem probably does not support all permission bits. \
If this is a FAT filesystem, you should set the \"fat\" option \
to true. \
Otherwise, you should probably set the \"perms\" option to 0o%o \
(or to 0 if you don't need to synchronize permissions)."
(Fspath.toPrintString (Fspath.concat fspath path))
(syncedPartsToString (fp, mask))
(syncedPartsToString (fp', mask))
((Prefs.read permMask) land (lnot (fp lxor fp')))))
let init someHostIsRunningWindows =
let mask = if someHostIsRunningWindows then wind_mask else unix_mask in
let oldMask = Prefs.read permMask in
let newMask = oldMask land mask in
debug
(fun() ->
Util.msg "Setting permission mask to %s (%s and %s)\n"
(Printf.sprintf "%o" newMask)
(Printf.sprintf "%o" oldMask)
(Printf.sprintf "%o" mask));
Prefs.set permMask newMask
end
(* ------------------------------------------------------------------------- *)
(* User and group ids *)
(* ------------------------------------------------------------------------- *)
let numericIds =
Prefs.createBool "numericids" false
"!don't map uid/gid values by user/group names"
"When this flag is set to \\verb|true|, groups and users are \
synchronized numerically, rather than by name. \n\
\n\
The special uid 0 and the special group 0 are never mapped via \
user/group names even if this preference is not set."
(* For backward compatibility *)
let _ = Prefs.alias numericIds "numericIds"
module Id (M : sig
val sync : bool Prefs.t
val kind : string
val to_num : string -> int
val toString : int -> string
val syncedPartsToString : int -> string
val set : Fspath.t -> int -> unit
val get : Unix.LargeFile.stats -> int
end) : S = struct
type t =
IdIgnored
| IdNamed of string
| IdNumeric of int
let dummy = IdIgnored
let hash id h =
Uutil.hash2
(match id with
IdIgnored -> -1
| IdNumeric i -> i
| IdNamed nm -> Uutil.hash nm)
h
let similar id id' =
not (Prefs.read M.sync)
||
(id <> IdIgnored && id' <> IdIgnored && id = id')
let override id id' = id'
let strip id = if Prefs.read M.sync then id else IdIgnored
let diff id id' = if similar id id' then IdIgnored else id'
let toString id =
match id with
IdIgnored -> ""
| IdNumeric i -> " " ^ M.kind ^ "=" ^ string_of_int i
| IdNamed n -> " " ^ M.kind ^ "=" ^ n
let syncedPartsToString = toString
let tbl = Hashtbl.create 17
let extern id =
match id with
IdIgnored -> -1
| IdNumeric i -> i
| IdNamed nm ->
try
Hashtbl.find tbl nm
with Not_found ->
let id =
try M.to_num nm with Not_found ->
raise (Util.Transient ("No " ^ M.kind ^ " " ^ nm))
in
if id = 0 then
raise (Util.Transient
(Printf.sprintf "Trying to map the non-root %s %s to %s 0"
M.kind nm M.kind));
Hashtbl.add tbl nm id;
id
let set fspath path kind id =
match extern id with
-1 ->
()
| id ->
Util.convertUnixErrorsToTransient
"setting file ownership"
(fun () ->
let abspath = Fspath.concat fspath path in
M.set abspath id)
let tbl = Hashtbl.create 17
let get stats _ =
if not (Prefs.read M.sync) then IdIgnored else
let id = M.get stats in
if id = 0 || Prefs.read numericIds then IdNumeric id else
try
Hashtbl.find tbl id
with Not_found ->
let id' = try IdNamed (M.toString id) with Not_found -> IdNumeric id in
Hashtbl.add tbl id id';
id'
let init someHostIsRunningWindows =
if someHostIsRunningWindows then
Prefs.set M.sync false;
end
module Uid = Id (struct
let sync =
Prefs.createBool "owner"
false "synchronize owner"
("When this flag is set to \\verb|true|, the owner attributes "
^ "of the files are synchronized. "
^ "Whether the owner names or the owner identifiers are synchronized"
^ "depends on the preference \\texttt{numerids}.")
let kind = "user"
let to_num nm = (Unix.getpwnam nm).Unix.pw_uid
let toString id = (Unix.getpwuid id).Unix.pw_name
let syncedPartsToString = toString
let set path id = Fs.chown path id (-1)
let get stats = stats.Unix.LargeFile.st_uid
end)
module Gid = Id (struct
let sync =
Prefs.createBool "group"
false "synchronize group attributes"
("When this flag is set to \\verb|true|, the group attributes "
^ "of the files are synchronized. "
^ "Whether the group names or the group identifiers are synchronized "
^ "depends on the preference \\texttt{numerids}.")
let kind = "group"
let to_num nm = (Unix.getgrnam nm).Unix.gr_gid
let toString id = (Unix.getgrgid id).Unix.gr_name
let syncedPartsToString = toString
let set path id = Fs.chown path (-1) id
let get stats = stats.Unix.LargeFile.st_gid
end)
(* ------------------------------------------------------------------------- *)
(* Modification time *)
(* ------------------------------------------------------------------------- *)
module Time : sig
include S
val same : t -> t -> bool
val extract : t -> float
val sync : bool Prefs.t
val replace : t -> float -> t
val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit
end = struct
let sync =
Prefs.createBool "times"
false "synchronize modification times"
"When this flag is set to \\verb|true|, \
file modification times (but not directory modtimes) are propagated."
type t = Synced of float | NotSynced of float
let dummy = NotSynced 0.
let extract t = match t with Synced v -> v | NotSynced v -> v
let minus_two = Int64.of_int (-2)
let approximate t = Int64.logand (Int64.of_float t) minus_two
let oneHour = Int64.of_int 3600
let minusOneHour = Int64.neg oneHour
let moduloOneHour t =
let v = Int64.rem t oneHour in
if v >= Int64.zero then v else Int64.add v oneHour
(* Accept one hour differences and one second differences *)
let possible_deltas =
[ -3601L; 3601L; -3600L; 3600L; -3599L; 3599L; -1L; 1L; 0L ]
let hash t h =
Uutil.hash2
(match t with
Synced _ -> 1 (* As we are ignoring one-second differences,
we cannot provide a more accurate hash. *)
| NotSynced _ -> 0)
h
(* Times have a two-second granularity on FAT filesystems. They are
approximated upward under Windows, downward under Linux...
Ignoring one-second changes also makes Unison more robust when
dealing with systems with sub-second granularity (we have no control
on how this is may be rounded). *)
let similar t t' =
not (Prefs.read sync)
||
match t, t' with
Synced v, Synced v' ->
List.mem (Int64.sub (Int64.of_float v) (Int64.of_float v'))
possible_deltas
| NotSynced _, NotSynced _ ->
true
| _ ->
false
let override t t' =
match t, t' with
_, Synced _ -> t'
| Synced v, _ -> NotSynced v
| _ -> t
let replace t v =
match t with
Synced _ -> t
| NotSynced _ -> NotSynced v
let strip t =
match t with
Synced v when not (Prefs.read sync) -> NotSynced v
| _ -> t
let diff t t' = if similar t t' then NotSynced (extract t') else t'
let toString t = Util.time2string (extract t)
let syncedPartsToString t = match t with
Synced _ -> Format.sprintf "%s (%f)" (toString t) (extract t)
| NotSynced _ -> ""
(* FIX: Probably there should be a check here that prevents us from ever *)
(* setting a file's modtime into the future. *)
let set fspath path kind t =
match t with
Synced v ->
Util.convertUnixErrorsToTransient
"setting modification time"
(fun () ->
let abspath = Fspath.concat fspath path in
if not (Fs.canSetTime abspath) then
begin
(* Nb. This workaround was proposed by Dmitry Bely, to
work around the fact that Unix.utimes fails on readonly
files under windows. I'm [bcp] a little bit uncomfortable
with it for two reasons: (1) if we crash in the middle,
the permissions might be left in a bad state, and (2) I
don't understand the Win32 permissions model enough to
know whether it will always work -- e.g., what if the
UID of the unison process is not the same as that of the
file itself (under Unix, this case would fail, but we
certainly don't want to make it WORLD-writable, even
briefly!). *)
let oldPerms =
(Fs.lstat abspath).Unix.LargeFile.st_perm in
Util.finalize
(fun()->
Fs.chmod abspath 0o600;
Fs.utimes abspath v v)
(fun()-> Fs.chmod abspath oldPerms)
end
else if false then begin
(* A special hack for Rasmus, who has a special situation that
requires the utimes-setting program to run 'setuid root'
(and we do not want all of Unison to run setuid, so we just
spin off an external utility to do it). *)
let time = Unix.localtime v in
let tstr = Printf.sprintf
"%4d%02d%02d%02d%02d.%02d"
(time.Unix.tm_year + 1900)
(time.Unix.tm_mon + 1)
time.Unix.tm_mday
time.Unix.tm_hour
time.Unix.tm_min
time.Unix.tm_sec in
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,_) = 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)
| _ ->
()
let get stats _ =
let v = stats.Unix.LargeFile.st_mtime in
if stats.Unix.LargeFile.st_kind = Unix.S_REG && Prefs.read sync then
Synced v
else
NotSynced v
let check fspath path stats t =
match t with
NotSynced _ ->
()
| Synced v ->
let t' = Synced (stats.Unix.LargeFile.st_mtime) in
if not (similar t t') then
raise
(Util.Transient
(Format.sprintf
"Failed to set modification time of file %s to %s: \
the time was set to %s instead"
(Fspath.toPrintString (Fspath.concat fspath path))
(syncedPartsToString t)
(syncedPartsToString t')))
(* When modification time are synchronized, we cannot update the
archive when they are changed due to daylight saving time. Thus,
we have to compare then using "similar". *)
let same p p' =
match p, p' with
Synced _, Synced _ ->
similar p p'
| _ ->
let delta = extract p -. extract p' in
delta = 0. || delta = 3600. || delta = -3600.
let init _ = ()
end
(* ------------------------------------------------------------------------- *)
(* Type and creator *)
(* ------------------------------------------------------------------------- *)
module TypeCreator : S = struct
type t = string option
let dummy = None
let hash t h = Uutil.hash2 (Uutil.hash t) h
let similar t t' =
not (Prefs.read Osx.rsrc) || t = t'
let override t t' = t'
let strip t = t
let diff t t' = if similar t t' then None else t'
let zeroes = "\000\000\000\000\000\000\000\000"
let toString t =
match t with
Some s when String.length s > 0 && s.[0] = 'F' &&
String.sub (s ^ zeroes) 1 8 <> zeroes ->
let s = s ^ zeroes in
" " ^ String.escaped (String.sub s 1 4) ^
" " ^ String.escaped (String.sub s 5 4)
| _ ->
""
let syncedPartsToString = toString
let set fspath path kind t =
match t with
None -> ()
| Some t -> Osx.setFileInfos fspath path t
let get stats info =
if
Prefs.read Osx.rsrc &&
(stats.Unix.LargeFile.st_kind = Unix.S_REG ||
stats.Unix.LargeFile.st_kind = Unix.S_DIR)
then
Some info.Osx.finfo
else
None
let init _ = ()
end
(* ------------------------------------------------------------------------- *)
(* Properties *)
(* ------------------------------------------------------------------------- *)
type t =
{ perm : Perm.t;
uid : Uid.t;
gid : Gid.t;
time : Time.t;
typeCreator : TypeCreator.t;
length : Uutil.Filesize.t }
let template perm =
{ perm = perm; uid = Uid.dummy; gid = Gid.dummy;
time = Time.dummy; typeCreator = TypeCreator.dummy;
length = Uutil.Filesize.dummy }
let dummy = template Perm.dummy
let hash p h =
Perm.hash p.perm
(Uid.hash p.uid
(Gid.hash p.gid
(Time.hash p.time
(TypeCreator.hash p.typeCreator h))))
let similar p p' =
Perm.similar p.perm p'.perm
&&
Uid.similar p.uid p'.uid
&&
Gid.similar p.gid p'.gid
&&
Time.similar p.time p'.time
&&
TypeCreator.similar p.typeCreator p'.typeCreator
let override p p' =
{ perm = Perm.override p.perm p'.perm;
uid = Uid.override p.uid p'.uid;
gid = Gid.override p.gid p'.gid;
time = Time.override p.time p'.time;
typeCreator = TypeCreator.override p.typeCreator p'.typeCreator;
length = p'.length }
let strip p =
{ perm = Perm.strip p.perm;
uid = Uid.strip p.uid;
gid = Gid.strip p.gid;
time = Time.strip p.time;
typeCreator = TypeCreator.strip p.typeCreator;
length = p.length }
let toString p =
Printf.sprintf
"modified on %s size %-9.f %s%s%s%s"
(Time.toString p.time)
(Uutil.Filesize.toFloat p.length)
(Perm.toString p.perm)
(Uid.toString p.uid)
(Gid.toString p.gid)
(TypeCreator.toString p.typeCreator)
let syncedPartsToString p =
let tm = Time.syncedPartsToString p.time in
Printf.sprintf
"%s%s size %-9.f %s%s%s%s"
(if tm = "" then "" else "modified at ")
tm
(Uutil.Filesize.toFloat p.length)
(Perm.syncedPartsToString p.perm)
(Uid.syncedPartsToString p.uid)
(Gid.syncedPartsToString p.gid)
(TypeCreator.syncedPartsToString p.typeCreator)
let diff p p' =
{ perm = Perm.diff p.perm p'.perm;
uid = Uid.diff p.uid p'.uid;
gid = Gid.diff p.gid p'.gid;
time = Time.diff p.time p'.time;
typeCreator = TypeCreator.diff p.typeCreator p'.typeCreator;
length = p'.length }
let get stats infos =
{ perm = Perm.get stats infos;
uid = Uid.get stats infos;
gid = Gid.get stats infos;
time = Time.get stats infos;
typeCreator = TypeCreator.get stats infos;
length =
if stats.Unix.LargeFile.st_kind = Unix.S_REG then
Uutil.Filesize.fromStats stats
else
Uutil.Filesize.zero }
let set fspath path kind p =
Uid.set fspath path kind p.uid;
Gid.set fspath path kind p.gid;
TypeCreator.set fspath path kind p.typeCreator;
Time.set fspath path kind p.time;
Perm.set fspath path kind p.perm
(* Paranoid checks *)
let check fspath path stats p =
Time.check fspath path stats p.time;
Perm.check fspath path stats p.perm
let init someHostIsRunningWindows =
Perm.init someHostIsRunningWindows;
Uid.init someHostIsRunningWindows;
Gid.init someHostIsRunningWindows;
Time.init someHostIsRunningWindows;
TypeCreator.init someHostIsRunningWindows
let fileDefault = template Perm.fileDefault
let fileSafe = template Perm.fileSafe
let dirDefault = template Perm.dirDefault
let same_time p p' = Time.same p.time p'.time
let length p = p.length
let setLength p l = {p with length=l}
let time p = Time.extract p.time
let setTime p t = {p with time = Time.replace p.time t}
let perms p = Perm.extract p.perm
let syncModtimes = Time.sync
let permMask = Perm.permMask
let dontChmod = Perm.dontChmod
let validatePrefs = Perm.validatePrefs
(* ------------------------------------------------------------------------- *)
(* Directory change stamps *)
(* ------------------------------------------------------------------------- *)
(* We are reusing the directory length to store a flag indicating that
the directory is unchanged *)
type dirChangedStamp = Uutil.Filesize.t
let freshDirStamp () =
let t =
(Unix.gettimeofday () +. sqrt 2. *. float (Unix.getpid ())) *. 1000.
in
Uutil.Filesize.ofFloat t
let changedDirStamp = Uutil.Filesize.zero
let setDirChangeFlag p stamp inode =
let stamp = Uutil.Filesize.add stamp (Uutil.Filesize.ofInt inode) in
(setLength p stamp, length p <> stamp)
let dirMarkedUnchanged p stamp inode =
let stamp = Uutil.Filesize.add stamp (Uutil.Filesize.ofInt inode) in
stamp <> changedDirStamp && length p = stamp
unison-2.40.102/checksum.ml 0000644 0061316 0061316 00000005327 11361646373 015552 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/checksum.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* The checksum (or fast fingerprinting) algorithm must be fast and has to *)
(* be called in a rolling fashion (i.e. we must be able to calculate a new *)
(* checksum when provided the current checksum, the outgoing character and *)
(* the incoming one). *)
(* Definition: cksum([c_n, c_{n-1}, ..., c_0]) = Sum c_i * 16381 ^ i *)
type t = int
type u = int array
(* [power v n] computes [v ^ n] *)
let rec power v n =
if n = 0 then 1 else
let v' = power v (n / 2) in
let v'' = v' * v' in
if n land 1 <> 0 then v * v'' else v''
(* Takes the block length and returns a pre-computed table for the function *)
(* roll: If [init l] => I, then I_n = n * 16381 ^ (l + 1), for 0 <= n < 256 *)
(* NB: 256 is the upper-bound of ASCII code returned by Char.code *)
let init l =
let p = power 16381 (l + 1) in
Array.init 256 (fun i -> (i * p) land 0x7fffffff)
(* Function [roll] computes fixed-length checksum from previous checksum *)
(* Roughly: given the pre-computed table, compute the new checksum from the *)
(* old one along with the outgoing and incoming characters, i.e., *)
(* - *)
(* [roll cksum([c_n, ..., c_0]) c_n c'] => cksum([c_{n-1}, ..., c_0, c']) *)
(* - *)
let roll init cksum cout cin =
let v = cksum + Char.code cin in
(v lsl 14 - (v + v + v) (* v * 16381 *)
- Array.unsafe_get init (Char.code cout)) land 0x7fffffff
(* Function [substring] computes checksum for a given substring in one batch *)
(* process: [substring s p l] => cksum([s_p, ..., s_{p + l - 1}]) *)
let substring s p l =
let cksum = ref 0 in
for i = p to p + l - 1 do
let v = !cksum + Char.code (String.unsafe_get s i) in
cksum := (v lsl 14 - (v + v + v)) (* v * 16381 *)
done;
!cksum land 0x7fffffff
unison-2.40.102/files.ml 0000644 0061316 0061316 00000131631 11361646373 015050 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/files.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Common
open Lwt
open Fileinfo
let debug = Trace.debug "files"
let debugverbose = Trace.debug "files+"
(* ------------------------------------------------------------ *)
let commitLogName = Util.fileInHomeDir "DANGER.README"
let writeCommitLog source target tempname =
let sourcename = Fspath.toDebugString source in
let targetname = Fspath.toDebugString target in
debug (fun() -> Util.msg "Writing commit log: renaming %s to %s via %s\n"
sourcename targetname tempname);
Util.convertUnixErrorsToFatal
"writing commit log"
(fun () ->
let c =
System.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl]
0o600 commitLogName in
Printf.fprintf c "Warning: the last run of %s terminated abnormally "
Uutil.myName;
Printf.fprintf c "while moving\n %s\nto\n %s\nvia\n %s\n\n"
sourcename targetname tempname;
Printf.fprintf c "Please check the state of these files immediately\n";
Printf.fprintf c "(and delete this notice when you've done so).\n";
close_out c)
let clearCommitLog () =
debug (fun() -> (Util.msg "Deleting commit log\n"));
Util.convertUnixErrorsToFatal
"clearing commit log"
(fun () -> System.unlink commitLogName)
let processCommitLog () =
if System.file_exists commitLogName then begin
raise(Util.Fatal(
Printf.sprintf
"Warning: the previous run of %s terminated in a dangerous state.
Please consult the file %s, delete it, and try again."
Uutil.myName
(System.fspathToPrintString commitLogName)))
end else
Lwt.return ()
let processCommitLogOnHost =
Remote.registerHostCmd "processCommitLog" processCommitLog
let processCommitLogs() =
Lwt_unix.run
(Globals.allHostsIter (fun h -> processCommitLogOnHost h ()))
(* ------------------------------------------------------------ *)
let deleteLocal (fspathTo, (pathTo, ui)) =
debug (fun () ->
Util.msg "deleteLocal [%s] (None, %s)\n"
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
let localPathTo = Update.translatePathLocal fspathTo pathTo in
(* Make sure the target is unchanged first *)
(* (There is an unavoidable race condition here.) *)
let prevArch = Update.checkNoUpdates fspathTo localPathTo ui in
Stasher.backup fspathTo localPathTo `AndRemove prevArch;
(* Archive update must be done last *)
Update.replaceArchiveLocal fspathTo localPathTo Update.NoArchive;
Lwt.return ()
let deleteOnRoot = Remote.registerRootCmd "delete" deleteLocal
let delete rootFrom pathFrom rootTo pathTo ui =
deleteOnRoot rootTo (pathTo, ui) >>= fun _ ->
Update.replaceArchive rootFrom pathFrom Update.NoArchive
(* ------------------------------------------------------------ *)
let fileUpdated ui =
match ui with
Updates (File (_, ContentsUpdated _), _) -> true
| _ -> false
let setPropLocal (fspath, (path, ui, newDesc, oldDesc)) =
(* [ui] provides the modtime while [newDesc] provides the other
file properties *)
let localPath = Update.translatePathLocal fspath path in
let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in
Fileinfo.set workingDir realPath (`Update oldDesc) newDesc;
if fileUpdated ui then Stasher.stashCurrentVersion fspath localPath None;
(* Archive update must be done last *)
Update.updateProps fspath localPath (Some newDesc) ui;
Lwt.return ()
let setPropOnRoot = Remote.registerRootCmd "setProp" setPropLocal
let updatePropsOnRoot =
Remote.registerRootCmd
"updateProps"
(fun (fspath, (path, propOpt, ui)) ->
let localPath = Update.translatePathLocal fspath path in
(* Archive update must be done first *)
Update.updateProps fspath localPath propOpt ui;
if fileUpdated ui then
Stasher.stashCurrentVersion fspath localPath None;
Lwt.return ())
let updateProps root path propOpt ui =
updatePropsOnRoot root (path, propOpt, ui)
(* FIX: we should check there has been no update before performing the
change *)
let setProp rootFrom pathFrom rootTo pathTo newDesc oldDesc uiFrom uiTo =
debug (fun() ->
Util.msg
"setProp %s %s %s\n %s %s %s\n"
(root2string rootFrom) (Path.toString pathFrom)
(Props.toString newDesc)
(root2string rootTo) (Path.toString pathTo)
(Props.toString oldDesc));
setPropOnRoot rootTo (pathTo, uiTo, newDesc, oldDesc) >>= fun _ ->
updateProps rootFrom pathFrom None uiFrom
(* ------------------------------------------------------------ *)
let mkdirOnRoot =
Remote.registerRootCmd
"mkdir"
(fun (fspath,(workingDir,path)) ->
let info = Fileinfo.get false workingDir path in
if info.Fileinfo.typ = `DIRECTORY then begin
begin try
(* Make sure the directory is writable *)
Fs.chmod (Fspath.concat workingDir path)
(Props.perms info.Fileinfo.desc lor 0o700)
with Unix.Unix_error _ -> () end;
Lwt.return (true, info.Fileinfo.desc)
end else begin
if info.Fileinfo.typ <> `ABSENT then
Os.delete workingDir path;
Os.createDir workingDir path Props.dirDefault;
Lwt.return (false, (Fileinfo.get false workingDir path).Fileinfo.desc)
end)
let setDirPropOnRoot =
Remote.registerRootCmd
"setDirProp"
(fun (_, (workingDir, path, initialDesc, newDesc)) ->
Fileinfo.set workingDir path (`Set initialDesc) newDesc;
Lwt.return ())
let makeSymlink =
Remote.registerRootCmd
"makeSymlink"
(fun (fspath, (workingDir, path, l)) ->
if Os.exists workingDir path then
Os.delete workingDir path;
Os.symlink workingDir path l;
Lwt.return ())
(* ------------------------------------------------------------ *)
let performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n"
(Path.toString pathFrom)
(Path.toString pathTo)
(Fspath.toDebugString workingDir)
(Fspath.toDebugString fspathTo));
let source = Fspath.concat workingDir pathFrom in
let target = Fspath.concat workingDir pathTo in
Util.convertUnixErrorsToTransient
(Printf.sprintf "renaming %s to %s"
(Fspath.toDebugString source) (Fspath.toDebugString target))
(fun () ->
debugverbose (fun() ->
Util.msg "calling Fileinfo.get from renameLocal\n");
let filetypeFrom =
(Fileinfo.get false source Path.empty).Fileinfo.typ in
debugverbose (fun() ->
Util.msg "back from Fileinfo.get from renameLocal\n");
if filetypeFrom = `ABSENT then raise (Util.Transient (Printf.sprintf
"Error while renaming %s to %s -- source file has disappeared!"
(Fspath.toPrintString source) (Fspath.toPrintString target)));
let filetypeTo = (Fileinfo.get false target Path.empty).Fileinfo.typ in
(* Windows and Unix operate differently if the target path of a
rename already exists: in Windows an exception is raised, in
Unix the file is clobbered. In both Windows and Unix, if
the target is an existing **directory**, an exception will
be raised. We want to avoid doing the move first, if possible,
because this opens a "window of danger" during which the contents of
the path is nothing. *)
let moveFirst =
match (filetypeFrom, filetypeTo) with
| (_, `ABSENT) -> false
| ((`FILE | `SYMLINK),
(`FILE | `SYMLINK)) -> Util.osType <> `Unix
| _ -> true (* Safe default *) in
if moveFirst then begin
debug (fun() -> Util.msg "rename: moveFirst=true\n");
let tmpPath = Os.tempPath workingDir pathTo in
let temp = Fspath.concat workingDir tmpPath in
let temp' = Fspath.toDebugString temp in
debug (fun() ->
Util.msg "moving %s to %s\n" (Fspath.toDebugString target) temp');
Stasher.backup fspathTo localPathTo `ByCopying prevArch;
writeCommitLog source target temp';
Util.finalize (fun() ->
(* If the first rename fails, the log can be removed: the
filesystem is in a consistent state *)
Os.rename "renameLocal(1)" target Path.empty temp Path.empty;
(* If the next renaming fails, we will be left with
DANGER.README file which will make any other
(similar) renaming fail in a cryptic way. So it
seems better to abort early by converting Unix errors
to Fatal ones (rather than Transient). *)
Util.convertUnixErrorsToFatal "renaming with commit log"
(fun () ->
debug (fun() -> Util.msg "rename %s to %s\n"
(Fspath.toDebugString source)
(Fspath.toDebugString target));
Os.rename "renameLocal(2)"
source Path.empty target Path.empty))
(fun _ -> clearCommitLog());
(* It is ok to leave a temporary file. So, the log can be
cleared before deleting it. *)
Os.delete temp Path.empty
end else begin
debug (fun() -> Util.msg "rename: moveFirst=false\n");
Stasher.backup fspathTo localPathTo `ByCopying prevArch;
Os.rename "renameLocal(3)" source Path.empty target Path.empty;
debug (fun() ->
if filetypeFrom = `FILE then
Util.msg
"Contents of %s after renaming = %s\n"
(Fspath.toDebugString target)
(Fingerprint.toString (Fingerprint.file target Path.empty)));
end)
(* FIX: maybe we should rename the destination before making any check ? *)
(* JV (6/09): the window is small again...
FIX: When this code was originally written, we assumed that the
checkNoUpdates would happen immediately before the rename, so that
the window of danger where other processes could invalidate the thing we
just checked was very small. But now that transport is multi-threaded,
this window of danger could get very long because other transfers are
saturating the link. It would be better, I think, to introduce a real
2PC protocol here, so that both sides would (locally and almost-atomically)
check that their assumptions had not been violated and then switch the
temp file into place, but remain able to roll back if something fails
either locally or on the other side. *)
let renameLocal
(fspathTo, (localPathTo, workingDir, pathFrom, pathTo, ui, archOpt)) =
(* Make sure the target is unchanged, then do the rename.
(Note that there is an unavoidable race condition here...) *)
let prevArch = Update.checkNoUpdates fspathTo localPathTo ui in
performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch;
begin match archOpt with
Some archTo -> Stasher.stashCurrentVersion fspathTo localPathTo None;
Update.iterFiles fspathTo localPathTo archTo
Xferhint.insertEntry;
(* Archive update must be done last *)
Update.replaceArchiveLocal fspathTo localPathTo archTo
| None -> ()
end;
Lwt.return ()
let renameOnHost = Remote.registerRootCmd "rename" renameLocal
let rename root localPath workingDir pathOld pathNew ui archOpt =
debug (fun() ->
Util.msg "rename(root=%s, pathOld=%s, pathNew=%s)\n"
(root2string root)
(Path.toString pathOld) (Path.toString pathNew));
renameOnHost root (localPath, workingDir, pathOld, pathNew, ui, archOpt)
(* ------------------------------------------------------------ *)
(* Calculate the target working directory and paths for the copy.
workingDir is an fspath naming the directory on the target
host where the copied file will actually live.
(In the case where pathTo names a symbolic link, this
will be the parent directory of the file that the
symlink points to, not the symlink itself. Note that
this fspath may be outside of the replica, or even
on a different volume.)
realPathTo is the name of the target file relative to workingDir.
(If pathTo names a symlink, this will be the name of
the file pointed to by the symlink, not the name of the
link itself.)
tempPathTo is a temporary file name in the workingDir. The file (or
directory structure) will first be copied here, then
"almost atomically" moved onto realPathTo. *)
let setupTargetPathsLocal (fspath, path) =
let localPath = Update.translatePathLocal fspath path in
let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in
let tempPath = Os.tempPath ~fresh:false workingDir realPath in
Lwt.return (workingDir, realPath, tempPath, localPath)
let setupTargetPaths =
Remote.registerRootCmd "setupTargetPaths" setupTargetPathsLocal
let rec createDirectories fspath localPath props =
match props with
[] ->
()
| desc :: rem ->
match Path.deconstructRev localPath with
None ->
assert false
| Some (_, parentPath) ->
createDirectories fspath parentPath rem;
try
let absolutePath = Fspath.concat fspath parentPath in
Fs.mkdir absolutePath (Props.perms desc)
(* The directory may have already been created
if there are several paths with the same prefix *)
with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
let setupTargetPathsAndCreateParentDirectoryLocal (fspath, (path, props)) =
let localPath = Update.translatePathLocal fspath path in
Util.convertUnixErrorsToTransient
"creating parent directories"
(fun () -> createDirectories fspath localPath props);
let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in
let tempPath = Os.tempPath ~fresh:false workingDir realPath in
Lwt.return (workingDir, realPath, tempPath, localPath)
let setupTargetPathsAndCreateParentDirectory =
Remote.registerRootCmd "setupTargetPathsAndCreateParentDirectory"
setupTargetPathsAndCreateParentDirectoryLocal
(* ------------------------------------------------------------ *)
let updateSourceArchiveLocal (fspathFrom, (localPathFrom, uiFrom, errPaths)) =
(* Archive update must be done first (before Stasher call) *)
let newArch = Update.updateArchive fspathFrom localPathFrom uiFrom in
(* We update the archive with what we were expected to copy *)
Update.replaceArchiveLocal fspathFrom localPathFrom newArch;
(* Then, we remove all pieces of which the copy failed *)
List.iter
(fun p ->
debug (fun () ->
Util.msg "Copy under %s/%s was aborted\n"
(Fspath.toDebugString fspathFrom) (Path.toString p));
Update.replaceArchiveLocal fspathFrom p Update.NoArchive)
errPaths;
Stasher.stashCurrentVersion fspathFrom localPathFrom None;
Lwt.return ()
let updateSourceArchive =
Remote.registerRootCmd "updateSourceArchive" updateSourceArchiveLocal
(* ------------------------------------------------------------ *)
let deleteSpuriousChild fspathTo pathTo nm =
(* FIX: maybe we should turn them into Unison temporary files? *)
let path = (Path.child pathTo nm) in
debug (fun() -> Util.msg "Deleting spurious file %s/%s\n"
(Fspath.toDebugString fspathTo) (Path.toString path));
Os.delete fspathTo path
let rec deleteSpuriousChildrenRec fspathTo pathTo archChildren children =
match archChildren, children with
archNm :: archRem, nm :: rem ->
let c = Name.compare archNm nm in
if c < 0 then
deleteSpuriousChildrenRec fspathTo pathTo archRem children
else if c = 0 then
deleteSpuriousChildrenRec fspathTo pathTo archChildren rem
else begin
deleteSpuriousChild fspathTo pathTo nm;
deleteSpuriousChildrenRec fspathTo pathTo archChildren rem
end
| [], nm :: rem ->
deleteSpuriousChild fspathTo pathTo nm;
deleteSpuriousChildrenRec fspathTo pathTo [] rem
| _, [] ->
()
let deleteSpuriousChildrenLocal (_, (fspathTo, pathTo, archChildren)) =
deleteSpuriousChildrenRec
fspathTo pathTo archChildren
(List.sort Name.compare (Os.childrenOf fspathTo pathTo));
Lwt.return ()
let deleteSpuriousChildren =
Remote.registerRootCmd "deleteSpuriousChildren" deleteSpuriousChildrenLocal
let rec normalizePropsRec propsFrom propsTo =
match propsFrom, propsTo with
d :: r, d' :: r' -> normalizePropsRec r r'
| _, [] -> propsFrom
| [], _ :: _ -> assert false
let normalizeProps propsFrom propsTo =
normalizePropsRec (Safelist.rev propsFrom) (Safelist.rev propsTo)
(* ------------------------------------------------------------ *)
let copyReg = Lwt_util.make_region 50
let copy
update
rootFrom pathFrom (* copy from here... *)
uiFrom (* (and then check that this updateItem still
describes the current state of the src replica) *)
propsFrom (* the properties of the parent directories, in
case we need to propagate them *)
rootTo pathTo (* ...to here *)
uiTo (* (but, before committing the copy, check that
this updateItem still describes the current
state of the target replica) *)
propsTo (* the properties of the parent directories *)
id = (* for progress display *)
debug (fun() ->
Util.msg
"copy %s %s ---> %s %s \n"
(root2string rootFrom) (Path.toString pathFrom)
(root2string rootTo) (Path.toString pathTo));
(* Calculate target paths *)
setupTargetPathsAndCreateParentDirectory rootTo
(pathTo, normalizeProps propsFrom propsTo)
>>= fun (workingDir, realPathTo, tempPathTo, localPathTo) ->
(* When in Unicode case-insensitive mode, we want to create files
with NFC normal-form filenames. *)
let realPathTo =
match update with
`Update _ ->
realPathTo
| `Copy ->
match Path.deconstructRev realPathTo with
None ->
assert false
| Some (name, parentPath) ->
Path.child parentPath (Name.normalize name)
in
(* Calculate source path *)
Update.translatePath rootFrom pathFrom >>= fun localPathFrom ->
let errors = ref [] in
(* Inner loop for recursive copy... *)
let rec copyRec pFrom (* Path to copy from *)
pTo (* (Temp) path to copy to *)
realPTo (* Path where this file will ultimately be placed
(needed by rsync, which uses the old contents
of this file to optimize transfer) *)
f = (* Source archive subtree for this path *)
debug (fun() ->
Util.msg "copyRec %s --> %s (really to %s)\n"
(Path.toString pFrom) (Path.toString pTo)
(Path.toString realPTo));
Lwt.catch
(fun () ->
match f with
Update.ArchiveFile (desc, dig, stamp, ress) ->
Lwt_util.run_in_region copyReg 1 (fun () ->
Abort.check id;
let stmp =
if Update.useFastChecking () then Some stamp else None in
Copy.file
rootFrom pFrom rootTo workingDir pTo realPTo
update desc dig stmp ress id
>>= fun info ->
let ress' = Osx.stamp info.Fileinfo.osX in
Lwt.return
(Update.ArchiveFile (Props.override info.Fileinfo.desc desc,
dig, Fileinfo.stamp info, ress'),
[]))
| Update.ArchiveSymlink l ->
Lwt_util.run_in_region copyReg 1 (fun () ->
debug (fun() -> Util.msg "Making symlink %s/%s -> %s\n"
(root2string rootTo) (Path.toString pTo) l);
Abort.check id;
makeSymlink rootTo (workingDir, pTo, l) >>= fun () ->
Lwt.return (f, []))
| Update.ArchiveDir (desc, children) ->
Lwt_util.run_in_region copyReg 1 (fun () ->
debug (fun() -> Util.msg "Creating directory %s/%s\n"
(root2string rootTo) (Path.toString pTo));
mkdirOnRoot rootTo (workingDir, pTo))
>>= fun (dirAlreadyExisting, initialDesc) ->
Abort.check id;
(* We start a thread for each child *)
let childThreads =
Update.NameMap.mapi
(fun name child ->
let nameTo = Name.normalize name in
copyRec (Path.child pFrom name)
(Path.child pTo nameTo)
(Path.child realPTo nameTo)
child)
children
in
(* We collect the thread results *)
Update.NameMap.fold
(fun nm childThr remThr ->
childThr >>= fun (arch, paths) ->
remThr >>= fun (children, pathl, error) ->
let childErr = arch = Update.NoArchive in
let children =
if childErr then children else
Update.NameMap.add nm arch children
in
Lwt.return (children, paths :: pathl, error || childErr))
childThreads
(Lwt.return (Update.NameMap.empty, [], false))
>>= fun (newChildren, pathl, childError) ->
begin if dirAlreadyExisting || childError then
let childNames =
Update.NameMap.fold (fun nm _ l -> nm :: l) newChildren [] in
deleteSpuriousChildren rootTo (workingDir, pTo, childNames)
else
Lwt.return ()
end >>= fun () ->
Lwt_util.run_in_region copyReg 1 (fun () ->
(* We use the actual file permissions so as to preserve
inherited bits *)
setDirPropOnRoot rootTo
(workingDir, pTo, initialDesc, desc)) >>= fun () ->
Lwt.return (Update.ArchiveDir (desc, newChildren),
List.flatten pathl)
| Update.NoArchive ->
assert false)
(fun e ->
match e with
Util.Transient _ ->
if not (Abort.testException e) then begin
Abort.file id;
errors := e :: !errors
end;
Lwt.return (Update.NoArchive, [pFrom])
| _ ->
Lwt.fail e)
in
(* Compute locally what we need to propagate *)
let rootLocal = List.hd (Globals.rootsInCanonicalOrder ()) in
let localArch =
Update.updateArchive (snd rootLocal) localPathFrom uiFrom in
copyRec localPathFrom tempPathTo realPathTo localArch
>>= fun (archTo, errPaths) ->
if archTo = Update.NoArchive then
(* We were not able to transfer anything *)
Lwt.fail (List.hd !errors)
else begin
(* Rename the files to their final location and then update the
archive on the destination replica *)
rename rootTo localPathTo workingDir tempPathTo realPathTo uiTo
(Some archTo) >>= fun () ->
(* Update the archive on the source replica
FIX: we could reuse localArch if rootFrom is the same as rootLocal *)
updateSourceArchive rootFrom (localPathFrom, uiFrom, errPaths) >>= fun () ->
(* Return the first error, if any *)
match Safelist.rev !errors with
e :: _ -> Lwt.fail e
| [] -> Lwt.return ()
end
(* ------------------------------------------------------------ *)
let (>>=) = Lwt.bind
let diffCmd =
Prefs.createString "diff" "diff -u CURRENT2 CURRENT1"
"!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 "
^ "is `\\verb|diff -u CURRENT2 CURRENT1|'. If the value of this preference contains the substrings "
^ "CURRENT1 and CURRENT2, these will be replaced by the names of the files to be "
^ "diffed. If not, the two filenames will be appended to the command. In both "
^ "cases, the filenames are suitably quoted.")
let tempName s = Os.tempFilePrefix ^ s
let rec diff root1 path1 ui1 root2 path2 ui2 showDiff id =
debug (fun () ->
Util.msg
"diff %s %s %s %s ...\n"
(root2string root1) (Path.toString path1)
(root2string root2) (Path.toString path2));
let displayDiff fspath1 fspath2 =
let cmd =
if Util.findsubstring "CURRENT1" (Prefs.read diffCmd) = None then
(Prefs.read diffCmd)
^ " " ^ (Fspath.quotes fspath1)
^ " " ^ (Fspath.quotes fspath2)
else
Util.replacesubstrings (Prefs.read diffCmd)
["CURRENT1", Fspath.quotes fspath1;
"CURRENT2", Fspath.quotes fspath2] in
let c = System.open_process_in
(if Util.osType = `Win32 && not Util.isCygwin then
(* BCP: Proposed by Karl M. to deal with the standard windows
command processor's weird treatment of spaces and quotes: *)
"\"" ^ cmd ^ "\""
else
cmd) in
showDiff cmd (External.readChannelTillEof c);
ignore (System.close_process_in c) in
let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in
match root1,root2 with
(Local,fspath1),(Local,fspath2) ->
Util.convertUnixErrorsToTransient
"diffing files"
(fun () ->
let path1 = Update.translatePathLocal fspath1 path1 in
let path2 = Update.translatePathLocal fspath2 path2 in
displayDiff
(Fspath.concat fspath1 path1) (Fspath.concat fspath2 path2))
| (Local,fspath1),(Remote host2,fspath2) ->
Util.convertUnixErrorsToTransient
"diffing files"
(fun () ->
let path1 = Update.translatePathLocal fspath1 path1 in
let (workingDir, realPath) = Fspath.findWorkingDir fspath1 path1 in
let tmppath =
Path.addSuffixToFinalName realPath (tempName "diff-") in
Os.delete workingDir tmppath;
Lwt_unix.run
(Update.translatePath root2 path2 >>= (fun path2 ->
Copy.file root2 path2 root1 workingDir tmppath realPath
`Copy (Props.setLength Props.fileSafe (Props.length desc2))
fp2 None ress2 id) >>= fun info ->
Lwt.return ());
displayDiff
(Fspath.concat workingDir realPath)
(Fspath.concat workingDir tmppath);
Os.delete workingDir tmppath)
| (Remote host1,fspath1),(Local,fspath2) ->
Util.convertUnixErrorsToTransient
"diffing files"
(fun () ->
let path2 = Update.translatePathLocal fspath2 path2 in
let (workingDir, realPath) = Fspath.findWorkingDir fspath2 path2 in
let tmppath =
Path.addSuffixToFinalName realPath "#unisondiff-" in
Lwt_unix.run
(Update.translatePath root1 path1 >>= (fun path1 ->
(* Note that we don't need the resource fork *)
Copy.file root1 path1 root2 workingDir tmppath realPath
`Copy (Props.setLength Props.fileSafe (Props.length desc1))
fp1 None ress1 id >>= fun info ->
Lwt.return ()));
displayDiff
(Fspath.concat workingDir tmppath)
(Fspath.concat workingDir realPath);
Os.delete workingDir tmppath)
| (Remote host1,fspath1),(Remote host2,fspath2) ->
assert false
(**********************************************************************)
(* Taken from ocamltk/jpf/fileselect.ml *)
let get_files_in_directory dir =
let dirh = System.opendir dir in
let files = ref [] in
begin try
while true do files := dirh.System.readdir () :: !files done
with End_of_file ->
dirh.System.closedir ()
end;
Sort.list (<) !files
let ls dir pattern =
Util.convertUnixErrorsToTransient
"listing files"
(fun () ->
let files = get_files_in_directory dir in
let re = Rx.glob pattern in
let rec filter l =
match l with
[] ->
[]
| hd :: tl ->
if Rx.match_string re hd then hd :: filter tl else filter tl
in
filter files)
(***********************************************************************
CALL OUT TO EXTERNAL MERGE PROGRAM
************************************************************************)
let formatMergeCmd p f1 f2 backup out1 out2 outarch =
if not (Globals.shouldMerge p) then
raise (Util.Transient ("'merge' preference not set for "^(Path.toString p)));
let raw =
try Globals.mergeCmdForPath p
with Not_found ->
raise (Util.Transient ("'merge' preference does not provide a command "
^ "template for " ^ (Path.toString p)))
in
let cooked = raw in
let cooked = Util.replacesubstring cooked "CURRENT1" f1 in
let cooked = Util.replacesubstring cooked "CURRENT2" f2 in
let cooked =
match backup with
None -> begin
let cooked = Util.replacesubstring cooked "CURRENTARCHOPT" "" in
match Util.findsubstring "CURRENTARCH" cooked with
None -> cooked
| Some _ -> raise (Util.Transient
("No archive found, but the 'merge' command "
^ "template expects one. (Consider enabling "
^ "'backupcurrent' for this file or using CURRENTARCHOPT "
^ "instead of CURRENTARCH.)"))
end
| Some(s) ->
let cooked = Util.replacesubstring cooked "CURRENTARCHOPT" s in
let cooked = Util.replacesubstring cooked "CURRENTARCH" s in
cooked in
let cooked = Util.replacesubstring cooked "NEW1" out1 in
let cooked = Util.replacesubstring cooked "NEW2" out2 in
let cooked = Util.replacesubstring cooked "NEWARCH" outarch in
let cooked = Util.replacesubstring cooked "NEW" out1 in
let cooked = Util.replacesubstring cooked "PATH" (Path.toString p) in
cooked
let copyBack fspathFrom pathFrom rootTo pathTo propsTo uiTo id =
setupTargetPaths rootTo pathTo
>>= (fun (workingDirForCopy, realPathTo, tempPathTo, localPathTo) ->
let info = Fileinfo.get false fspathFrom pathFrom in
let fp = Os.fingerprint fspathFrom pathFrom info in
let stamp = Osx.stamp info.Fileinfo.osX in
let newprops = Props.setLength propsTo (Props.length info.Fileinfo.desc) in
Copy.file
(Local, fspathFrom) pathFrom rootTo workingDirForCopy tempPathTo realPathTo
`Copy newprops fp None stamp id >>= fun info ->
rename rootTo localPathTo workingDirForCopy tempPathTo realPathTo
uiTo None)
let keeptempfilesaftermerge =
Prefs.createBool
"keeptempfilesaftermerge" false "*" ""
let showStatus = function
| Unix.WEXITED i -> Printf.sprintf "exited (%d)" i
| Unix.WSIGNALED i -> Printf.sprintf "killed with signal %d" i
| Unix.WSTOPPED i -> Printf.sprintf "stopped with signal %d" i
let merge root1 path1 ui1 root2 path2 ui2 id showMergeFn =
debug (fun () -> Util.msg "merge path %s between roots %s and %s\n"
(Path.toString path1) (root2string root1) (root2string root2));
(* The following assumes root1 is always local: switch them if needed to make this so *)
let (root1,path1,ui1,root2,path2,ui2) =
match root1 with
(Local,fspath1) -> (root1,path1,ui1,root2,path2,ui2)
| _ -> (root2,path2,ui2,root1,path1,ui1) in
let (localPath1, (workingDirForMerge, basep), fspath1) =
match root1 with
(Local,fspath1) ->
let localPath1 = Update.translatePathLocal fspath1 path1 in
(localPath1, Fspath.findWorkingDir fspath1 localPath1, fspath1)
| _ -> assert false in
(* We're going to be doing a lot of copying, so let's define a shorthand
that fixes most of the arguments to Copy.localfile *)
let copy l =
Safelist.iter
(fun (src,trg) ->
debug (fun () -> Util.msg "Copying %s to %s\n" (Path.toString src) (Path.toString trg));
Os.delete workingDirForMerge trg;
let info = Fileinfo.get false workingDirForMerge src in
Copy.localFile
workingDirForMerge src
workingDirForMerge trg trg
`Copy info.Fileinfo.desc
(Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) (Some id))
l in
let working1 = Path.addPrefixToFinalName basep (tempName "merge1-") in
let working2 = Path.addPrefixToFinalName basep (tempName "merge2-") in
let workingarch = Path.addPrefixToFinalName basep (tempName "mergearch-") in
let new1 = Path.addPrefixToFinalName basep (tempName "mergenew1-") in
let new2 = Path.addPrefixToFinalName basep (tempName "mergenew2-") in
let newarch = Path.addPrefixToFinalName basep (tempName "mergenewarch-") in
let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in
Util.convertUnixErrorsToTransient "merging files" (fun () ->
(* Install finalizer (below) in case we unwind the stack *)
Util.finalize (fun () ->
(* Make local copies of the two replicas *)
Os.delete workingDirForMerge working1;
Os.delete workingDirForMerge working2;
Os.delete workingDirForMerge workingarch;
Lwt_unix.run
(Copy.file
root1 localPath1 root1 workingDirForMerge working1 basep
`Copy desc1 fp1 None ress1 id >>= fun info ->
Lwt.return ());
Lwt_unix.run
(Update.translatePath root2 path2 >>= (fun path2 ->
Copy.file
root2 path2 root1 workingDirForMerge working2 basep
`Copy desc2 fp2 None ress2 id) >>= fun info ->
Lwt.return ());
(* retrieve the archive for this file, if any *)
let arch =
match ui1, ui2 with
| Updates (_, Previous (_,_,dig,_)), Updates (_, Previous (_,_,dig2,_)) ->
if dig = dig2 then
Stasher.getRecentVersion fspath1 localPath1 dig
else
assert false
| NoUpdates, Updates(_, Previous (_,_,dig,_))
| Updates(_, Previous (_,_,dig,_)), NoUpdates ->
Stasher.getRecentVersion fspath1 localPath1 dig
| Updates (_, New), Updates(_, New)
| Updates (_, New), NoUpdates
| NoUpdates, Updates (_, New) ->
debug (fun () -> Util.msg "File is new, no current version will be searched");
None
| _ -> assert false in
(* Make a local copy of the archive file (in case the merge program
overwrites it and the program crashes before the call to the Stasher). *)
begin
match arch with
Some fspath ->
let info = Fileinfo.get false fspath Path.empty in
Copy.localFile
fspath Path.empty
workingDirForMerge workingarch workingarch
`Copy
info.Fileinfo.desc
(Osx.ressLength info.Fileinfo.osX.Osx.ressInfo)
None
| None ->
()
end;
(* run the merge command *)
Os.delete workingDirForMerge new1;
Os.delete workingDirForMerge new2;
Os.delete workingDirForMerge newarch;
let info1 = Fileinfo.get false workingDirForMerge working1 in
(* FIX: Why split out the parts of the pair? Why is it not abstract anyway??? *)
let dig1 = Os.fingerprint workingDirForMerge working1 info1 in
let info2 = Fileinfo.get false workingDirForMerge working2 in
let dig2 = Os.fingerprint workingDirForMerge working2 info2 in
let cmd = formatMergeCmd
path1
(Fspath.quotes (Fspath.concat workingDirForMerge working1))
(Fspath.quotes (Fspath.concat workingDirForMerge working2))
(match arch with None -> None | Some f -> Some(Fspath.quotes f))
(Fspath.quotes (Fspath.concat workingDirForMerge new1))
(Fspath.quotes (Fspath.concat workingDirForMerge new2))
(Fspath.quotes (Fspath.concat workingDirForMerge newarch)) in
Trace.log (Printf.sprintf "Merge command: %s\n" cmd);
let returnValue, mergeResultLog =
Lwt_unix.run (External.runExternalProgram cmd) in
Trace.log (Printf.sprintf "Merge result (%s):\n%s\n"
(showStatus returnValue) mergeResultLog);
debug (fun () -> Util.msg "Merge result = %s\n"
(showStatus returnValue));
(* This query to the user probably belongs below, after we've gone through all the
logic that might raise exceptions in various conditions. But it has the side effect of
*displaying* the results of the merge (or putting them in a "details" area), so we don't
want to skip doing it if we raise one of these exceptions. Better might be to split out
the displaying from the querying... *)
if not
(showMergeFn
(Printf.sprintf "Results of merging %s" (Path.toString path1))
mergeResultLog) then
raise (Util.Transient ("Merge command canceled by the user"));
(* It's useful for now to be a bit verbose about what we're doing, but let's
keep it easy to switch this to debug-only in some later release... *)
let say f = f() in
(* Check which files got created by the merge command and do something appropriate
with them *)
debug (fun()-> Util.msg "New file 1 = %s\n" (Fspath.toDebugString (Fspath.concat workingDirForMerge new1)));
let new1exists = Fs.file_exists (Fspath.concat workingDirForMerge new1) in
let new2exists = Fs.file_exists (Fspath.concat workingDirForMerge new2) in
let newarchexists = Fs.file_exists (Fspath.concat workingDirForMerge newarch) in
if new1exists && new2exists then begin
if newarchexists then
say (fun () -> Util.msg "Three outputs detected \n")
else
say (fun () -> Util.msg "Two outputs detected \n");
let info1 = Fileinfo.get false workingDirForMerge new1 in
let info2 = Fileinfo.get false workingDirForMerge new2 in
let dig1' = Os.fingerprint workingDirForMerge new1 info1 in
let dig2' = Os.fingerprint workingDirForMerge new2 info2 in
if dig1'=dig2' then begin
debug (fun () -> Util.msg "Two outputs equal => update the archive\n");
copy [(new1,working1); (new2,working2); (new1,workingarch)];
end else
if returnValue = Unix.WEXITED 0 then begin
say (fun () -> (Util.msg "Two outputs not equal but merge command returned 0, so we will\n";
Util.msg "overwrite the other replica and the archive with the first output\n"));
copy [(new1,working1); (new1,working2); (new1,workingarch)];
end else begin
say (fun () -> (Util.msg "Two outputs not equal and the merge command exited with nonzero status, \n";
Util.msg "so we will copy back the new files but not update the archive\n"));
copy [(new1,working1); (new2,working2)];
end
end
else if new1exists && (not new2exists) && (not newarchexists) then begin
if returnValue = Unix.WEXITED 0 then begin
say (fun () -> Util.msg "One output detected \n");
copy [(new1,working1); (new1,working2); (new1,workingarch)];
end else begin
say (fun () -> Util.msg "One output detected but merge command returned nonzero exit status\n");
raise (Util.Transient "One output detected but merge command returned nonzero exit status\n")
end
end
else if (not new1exists) && new2exists && (not newarchexists) then begin
assert false
end
else if (not new1exists) && (not new2exists) && (not newarchexists) then begin
say (fun () -> Util.msg "No outputs detected \n");
let working1_still_exists = Fs.file_exists (Fspath.concat workingDirForMerge working1) in
let working2_still_exists = Fs.file_exists (Fspath.concat workingDirForMerge working2) in
if working1_still_exists && working2_still_exists then begin
say (fun () -> Util.msg "No output from merge cmd and both original files are still present\n");
let info1' = Fileinfo.get false workingDirForMerge working1 in
let dig1' = Os.fingerprint workingDirForMerge working1 info1' in
let info2' = Fileinfo.get false workingDirForMerge working2 in
let dig2' = Os.fingerprint workingDirForMerge working2 info2' in
if dig1 = dig1' && dig2 = dig2' then
raise (Util.Transient "Merge program didn't change either temp file");
if dig1' = dig2' then begin
say (fun () -> Util.msg "Merge program made files equal\n");
copy [(working1,workingarch)];
end else if dig2 = dig2' then begin
say (fun () -> Util.msg "Merge program changed just first input\n");
copy [(working1,working2);(working1,workingarch)]
end else if dig1 = dig1' then begin
say (fun () -> Util.msg "Merge program changed just second input\n");
copy [(working2,working1);(working2,workingarch)]
end else
if returnValue <> Unix.WEXITED 0 then
raise (Util.Transient ("Error: the merge function changed both of "
^ "its inputs but did not make them equal"))
else begin
say (fun () -> (Util.msg "Merge program changed both of its inputs in";
Util.msg "different ways, but returned zero.\n"));
(* Note that we assume the merge program knew what it was doing when it
returned 0 -- i.e., we assume a zero result means that the files are
"morally equal" and either can be replaced by the other; we therefore
choose one of them (#2) as the unique new result, so that we can update
Unison's archive and call the file 'in sync' again. *)
copy [(working2,working1);(working2,workingarch)];
end
end
else if working1_still_exists && (not working2_still_exists)
&& returnValue = Unix.WEXITED 0 then begin
say (fun () -> Util.msg "No outputs and second replica has been deleted \n");
copy [(working1,working2); (working1,workingarch)];
end
else if (not working1_still_exists) && working2_still_exists
&& returnValue = Unix.WEXITED 0 then begin
say (fun () -> Util.msg "No outputs and first replica has been deleted \n");
copy [(working2,working1); (working2,workingarch)];
end
else if returnValue = Unix.WEXITED 0 then begin
raise (Util.Transient ("Error: the merge program deleted both of its "
^ "inputs and generated no output!"))
end else begin
say (fun() -> Util.msg "The merge program exited with nonzero status and did not leave";
Util.msg " both files equal");
raise (Util.Transient ("Error: the merge program failed and did not leave"
^ " both files equal"))
end
end else begin
assert false
end;
Lwt_unix.run
(debug (fun () -> Util.msg "Committing results of merge\n");
copyBack workingDirForMerge working1 root1 path1 desc1 ui1 id >>= (fun () ->
copyBack workingDirForMerge working2 root2 path2 desc2 ui2 id >>= (fun () ->
let arch_fspath = Fspath.concat workingDirForMerge workingarch in
if Fs.file_exists arch_fspath then begin
debug (fun () -> Util.msg "Updating unison archives for %s to reflect results of merge\n"
(Path.toString path1));
if not (Stasher.shouldBackupCurrent path1) then
Util.msg "Warning: 'backupcurrent' is not set for path %s\n" (Path.toString path1);
Stasher.stashCurrentVersion workingDirForMerge localPath1 (Some workingarch);
let infoarch = Fileinfo.get false workingDirForMerge workingarch in
let dig = Os.fingerprint arch_fspath Path.empty infoarch in
debug (fun () -> Util.msg "New digest is %s\n" (Os.fullfingerprint_to_string dig));
let new_archive_entry =
Update.ArchiveFile
(Props.get (Fs.stat arch_fspath) infoarch.osX, dig,
Fileinfo.stamp (Fileinfo.get true arch_fspath Path.empty),
Osx.stamp infoarch.osX) in
Update.replaceArchive root1 path1 new_archive_entry >>= fun _ ->
Update.replaceArchive root2 path2 new_archive_entry >>= fun _ ->
Lwt.return ()
end else
(Lwt.return ()) )))) )
(fun _ ->
Util.ignoreTransientErrors
(fun () ->
if not (Prefs.read keeptempfilesaftermerge) then begin
Os.delete workingDirForMerge working1;
Os.delete workingDirForMerge working2;
Os.delete workingDirForMerge workingarch;
Os.delete workingDirForMerge new1;
Os.delete workingDirForMerge new2;
Os.delete workingDirForMerge newarch
end))
unison-2.40.102/fpcache.mli 0000644 0061316 0061316 00000001620 11361646373 015502 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fpcache.mli *)
(* Copyright 1999-2010, Benjamin C. Pierce (see COPYING for details) *)
(* Initialize the cache *)
val init : bool -> System.fspath -> unit
(* Close the cache file and clear the in-memory cache *)
val finish : unit -> unit
(* Get the fingerprint of a file, possibly from the cache *)
val fingerprint :
bool -> Fspath.t -> Path.local -> Fileinfo.t -> Os.fullfingerprint option ->
Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp
(* Add an entry to the cache *)
val save :
Path.local ->
Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp -> unit
(****)
val dataClearlyUnchanged :
bool -> Path.local -> Fileinfo.t -> Props.t -> Fileinfo.stamp -> bool
val ressClearlyUnchanged :
bool -> Fileinfo.t -> 'a Osx.ressInfo -> bool -> bool
(* Is that a file for which fast checking is disabled? *)
val excelFile : Path.local -> bool
unison-2.40.102/common.mli 0000644 0061316 0061316 00000012612 11361646373 015404 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/common.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(***************************************************************************)
(* COMMON TYPES USED BY ALL MODULES *)
(***************************************************************************)
type hostname = string
(* "Canonized" names of hosts *)
type host =
Local
| Remote of string
(* Roots for replicas (this is the type that is used by most of the code) *)
type root = host * Fspath.t
val root2string : root -> string
(* Give a printable hostname from a root (local prints as "local") *)
val root2hostname : root -> hostname
val compareRoots : root -> root -> int
val sortRoots : root list -> root list
(* Note, local roots come before remote roots *)
(* There are a number of functions in several modules that accept or return
lists containing one element for each path-to-be-synchronized specified
by the user using the -path option. This type constructor is used
instead of list, to help document their behavior -- in particular,
allowing us to write 'blah list list' as 'blah list oneperpath' in a few
places. *)
type 'a oneperpath = ONEPERPATH of 'a list
(*****************************************************************************)
(* COMMON TYPES USED BY UPDATE MODULE AND RECONCILER *)
(*****************************************************************************)
(* An updateItem describes the difference between the current state of the
filesystem below a given path and the state recorded in the archive below
that path. The other types are helpers. *)
type prevState =
Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp
| New
type contentschange =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp
type permchange = PropsSame | PropsUpdated
(* Variable name prefix: "ui" *)
type updateItem =
NoUpdates (* Path not changed *)
| Updates (* Path changed in this replica *)
of updateContent (* - new state *)
* prevState (* - summary of old state *)
| Error (* Error while detecting updates *)
of string (* - description of error *)
(* Variable name prefix: "uc" *)
and updateContent =
Absent (* Path refers to nothing *)
| File (* Path refers to an ordinary file *)
of Props.t (* - summary of current state *)
* contentschange (* - hint to transport agent *)
| Dir (* Path refers to a directory *)
of Props.t (* - summary of current state *)
* (Name.t * updateItem) list (* - children
MUST KEEP SORTED for recon *)
* permchange (* - did permissions change? *)
* bool (* - is the directory now empty? *)
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)
(*****************************************************************************)
(* COMMON TYPES SHARED BY RECONCILER AND TRANSPORT AGENT *)
(*****************************************************************************)
type status =
[ `Deleted
| `Modified
| `PropsChanged
| `Created
| `Unchanged ]
(* Variable name prefix: "rc" *)
type replicaContent =
{ typ : Fileinfo.typ;
status : status;
desc : Props.t; (* Properties (for the UI) *)
ui : updateItem;
size : int * Uutil.Filesize.t; (* Number of items and size *)
props : Props.t list } (* Parent properties *)
type direction =
Conflict
| Merge
| Replica1ToReplica2
| Replica2ToReplica1
val direction2string : direction -> string
type difference =
{ rc1 : replicaContent; (* - content of first replica *)
rc2 : replicaContent; (* - content of second replica *)
errors1 : string list; (* - deep errors in first replica *)
errors2 : string list; (* - deep errors in second replica *)
mutable direction : direction; (* - action to take (it's mutable so that
the user interface can change it) *)
default_direction : direction } (* - default action to take *)
(* Variable name prefix: "rplc" *)
type replicas =
Problem of string (* There was a problem during update detection *)
| Different of difference (* Replicas differ *)
(* Variable name prefix: "ri" *)
type reconItem = {path1 : Path.t; path2 : Path.t; replicas : replicas}
val ucLength : updateContent -> Uutil.Filesize.t
val uiLength : updateItem -> Uutil.Filesize.t
val riLength : reconItem -> Uutil.Filesize.t
val riFileType : reconItem -> string
val fileInfos :
updateItem -> updateItem ->
Props.t * Os.fullfingerprint * Osx.ressStamp *
Props.t * Os.fullfingerprint * Osx.ressStamp
(* True if the ri's type is Problem or if it is Different and the direction
is Conflict *)
val problematic : reconItem -> bool
(* True if the ri is problematic or if it has some deep errors in a
directory *)
val partiallyProblematic : reconItem -> bool
val isDeletion : reconItem -> bool
unison-2.40.102/uimacnew/ 0000755 0061316 0061316 00000000000 12050210657 015203 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/ImageAndTextCell.m 0000644 0061316 0061316 00000012344 11361646373 020513 0 ustar bcpierce bcpierce /*
ImageAndTextCell.m
Copyright (c) 2001-2004, Apple Computer, Inc., all rights reserved.
Author: Chuck Pisula
Milestones:
Initially created 3/1/01
Subclass of NSTextFieldCell which can display text and an image simultaneously.
*/
/*
IMPORTANT: This Apple software is supplied to you by Apple Computer, Inc. ("Apple") in
consideration of your agreement to the following terms, and your use, installation,
modification or redistribution of this Apple software constitutes acceptance of these
terms. If you do not agree with these terms, please do not use, install, modify or
redistribute this Apple software.
In consideration of your agreement to abide by the following terms, and subject to these
terms, Apple grants you a personal, non-exclusive license, under Apples copyrights in
this original Apple software (the "Apple Software"), to use, reproduce, modify and
redistribute the Apple Software, with or without modifications, in source and/or binary
forms; provided that if you redistribute the Apple Software in its entirety and without
modifications, you must retain this notice and the following text and disclaimers in all
such redistributions of the Apple Software. Neither the name, trademarks, service marks
or logos of Apple Computer, Inc. may be used to endorse or promote products derived from
the Apple Software without specific prior written permission from Apple. Except as expressly
stated in this notice, no other rights or licenses, express or implied, are granted by Apple
herein, including but not limited to any patent rights that may be infringed by your
derivative works or by other works in which the Apple Software may be incorporated.
The Apple Software is provided by Apple on an "AS IS" basis. APPLE MAKES NO WARRANTIES,
EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION THE IMPLIED WARRANTIES OF NON-INFRINGEMENT,
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, REGARDING THE APPLE SOFTWARE OR ITS
USE AND OPERATION ALONE OR IN COMBINATION WITH YOUR PRODUCTS.
IN NO EVENT SHALL APPLE BE LIABLE FOR ANY SPECIAL, INDIRECT, INCIDENTAL OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ARISING IN ANY WAY OUT OF THE USE,
REPRODUCTION, MODIFICATION AND/OR DISTRIBUTION OF THE APPLE SOFTWARE, HOWEVER CAUSED AND
WHETHER UNDER THEORY OF CONTRACT, TORT (INCLUDING NEGLIGENCE), STRICT LIABILITY OR
OTHERWISE, EVEN IF APPLE HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#import "ImageAndTextCell.h"
@implementation ImageAndTextCell
- (void)dealloc {
[image release];
image = nil;
[super dealloc];
}
- copyWithZone:(NSZone *)zone {
ImageAndTextCell *cell = (ImageAndTextCell *)[super copyWithZone:zone];
cell->image = [image retain];
return cell;
}
- (void)setImage:(NSImage *)anImage {
if (anImage != image) {
[image release];
image = [anImage retain];
}
}
- (NSImage *)image {
return image;
}
- (NSRect)imageFrameForCellFrame:(NSRect)cellFrame {
if (image != nil) {
NSRect imageFrame;
imageFrame.size = [image size];
imageFrame.origin = cellFrame.origin;
imageFrame.origin.x += 3;
imageFrame.origin.y += ceil((cellFrame.size.height - imageFrame.size.height) / 2);
return imageFrame;
}
else
return NSZeroRect;
}
- (void)editWithFrame:(NSRect)aRect inView:(NSView *)controlView editor:(NSText *)textObj delegate:(id)anObject event:(NSEvent *)theEvent {
NSRect textFrame, imageFrame;
NSDivideRect (aRect, &imageFrame, &textFrame, 3 + [image size].width, NSMinXEdge);
[super editWithFrame: textFrame inView: controlView editor:textObj delegate:anObject event: theEvent];
}
#if MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_5
typedef int NSInteger;
#endif
- (void)selectWithFrame:(NSRect)aRect inView:(NSView *)controlView editor:(NSText *)textObj delegate:(id)anObject start:(NSInteger)selStart length:(NSInteger)selLength {
NSRect textFrame, imageFrame;
NSDivideRect (aRect, &imageFrame, &textFrame, 3 + [image size].width, NSMinXEdge);
[super selectWithFrame: textFrame inView: controlView editor:textObj delegate:anObject start:selStart length:selLength];
}
- (void)drawWithFrame:(NSRect)cellFrame inView:(NSView *)controlView {
if (image != nil) {
NSSize imageSize;
NSRect imageFrame;
imageSize = [image size];
NSDivideRect(cellFrame, &imageFrame, &cellFrame, 3 + imageSize.width, NSMinXEdge);
if ([self drawsBackground]) {
[[self backgroundColor] set];
NSRectFill(imageFrame);
}
imageFrame.origin.x += 3;
imageFrame.size = imageSize;
if ([controlView isFlipped])
imageFrame.origin.y += ceil((cellFrame.size.height + imageFrame.size.height) / 2);
else
imageFrame.origin.y += ceil((cellFrame.size.height - imageFrame.size.height) / 2);
[image compositeToPoint:imageFrame.origin operation:NSCompositeSourceOver];
}
[super drawWithFrame:cellFrame inView:controlView];
}
- (NSSize)cellSize {
NSSize cellSize = [super cellSize];
cellSize.width += (image ? [image size].width : 0) + 3;
return cellSize;
}
@end
unison-2.40.102/uimacnew/ReconTableView.m 0000644 0061316 0061316 00000016133 11361646373 020252 0 ustar bcpierce bcpierce //
// ReconTableView.m
// Unison
//
// Created by Trevor Jim on Wed Aug 27 2003.
// Copyright (c) 2003. See file COPYING for details.
//
#import "ReconTableView.h"
#import "ReconItem.h"
#import "MyController.h"
@implementation NSOutlineView (_UnisonExtras)
- (NSArray *)selectedObjects
{
NSMutableArray *result = [NSMutableArray array];
NSIndexSet *set = [self selectedRowIndexes];
NSUInteger index = [set firstIndex];
while (index != NSNotFound) {
[result addObject:[self itemAtRow:index]];
index = [set indexGreaterThanIndex: index];
}
return result;
}
- (void)setSelectedObjects:(NSArray *)selectedObjects
{
NSMutableIndexSet *set = [NSMutableIndexSet indexSet];
int i = [selectedObjects count];
while (i--) {
int index = [self rowForItem:[selectedObjects objectAtIndex:i]];
if (index >= 0) [set addIndex:index];
}
[self selectRowIndexes:set byExtendingSelection:NO];
}
- (NSEnumerator *)selectedObjectEnumerator
{
return [[self selectedObjects] objectEnumerator];
}
- (int)rowCapacityWithoutScrolling
{
float bodyHeight = [self visibleRect].size.height;
bodyHeight -= [[self headerView] visibleRect].size.height;
return bodyHeight / ([self rowHeight] + 2.0);
}
- (BOOL)_canAcceptRowCountWithoutScrolling:(int)rows
{
return ([self numberOfRows] + rows) <= [self rowCapacityWithoutScrolling];
}
- (BOOL)_expandChildrenIfSpace:(id)parent level:(int)level
{
BOOL didExpand = NO;
id dataSource = [self dataSource];
int count = [dataSource outlineView:self numberOfChildrenOfItem:parent];
if (level == 0) {
if (count && ([self isItemExpanded:parent] || [self _canAcceptRowCountWithoutScrolling:count])) {
[self expandItem:parent expandChildren:NO];
didExpand = YES;
}
} else {
// try expanding each of our children. If all expand, then return YES,
// indicating that it may be worth trying the next level
int i;
for (i=0; i < count; i++) {
id child = [dataSource outlineView:self child:i ofItem:parent];
didExpand = [self _expandChildrenIfSpace:child level:level-1] || didExpand;
}
}
return didExpand;
}
- (void)expandChildrenIfSpace
{
int level = 1;
while ([self _expandChildrenIfSpace:nil level:level]) level++;
}
@end
@implementation ReconTableView
- (BOOL)editable
{
return editable;
}
- (void)setEditable:(BOOL)x
{
editable = x;
}
- (BOOL)validateItem:(IBAction *) action
{
if (action == @selector(selectAll:)
|| action == @selector(selectConflicts:)
|| action == @selector(copyLR:)
|| action == @selector(copyRL:)
|| action == @selector(leaveAlone:)
|| action == @selector(forceNewer:)
|| action == @selector(forceOlder:)
|| action == @selector(revert:)
|| action == @selector(ignorePath:)
|| action == @selector(ignoreExt:)
|| action == @selector(ignoreName:))
return editable;
else if (action == @selector(merge:)) {
if (!editable) return NO;
else return [self canDiffSelection];
}
else if (action == @selector(showDiff:)) {
if ((!editable) || (!([self numberOfSelectedRows]==1)))
return NO;
else return [self canDiffSelection];
}
else return YES;
}
- (BOOL)validateMenuItem:(NSMenuItem *)menuItem
{
return [self validateItem:[menuItem action]];
}
- (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem
{
return [self validateItem:[toolbarItem action]];
}
- (void)doIgnore:(unichar)c
{
NSEnumerator *e = [self selectedObjectEnumerator];
ReconItem *item, *last = nil;
while (item = [e nextObject]) {
[item doIgnore:c];
last = item;
}
if (last) { // something was selected
MyController* controller = (MyController*) [self dataSource];
last = [controller updateForIgnore:last];
[self selectRowIndexes:[NSIndexSet indexSetWithIndex:[self rowForItem:last]] byExtendingSelection:NO];
[self reloadData];
}
}
- (IBAction)ignorePath:(id)sender
{
[self doIgnore:'I'];
}
- (IBAction)ignoreExt:(id)sender
{
[self doIgnore:'E'];
}
- (IBAction)ignoreName:(id)sender
{
[self doIgnore:'N'];
}
- (void)doAction:(unichar)c
{
int numSelected = 0;
NSEnumerator *e = [self selectedObjectEnumerator];
ReconItem *item, *last = nil;
while (item = [e nextObject]) {
numSelected++;
[item doAction:c];
last = item;
}
if (numSelected>0) {
int nextRow = [self rowForItem:last] + 1;
if (numSelected == 1 && [self numberOfRows] > nextRow && c!='d') {
// Move to next row, unless already at last row, or if more than one row selected
[self selectRowIndexes:[NSIndexSet indexSetWithIndex:nextRow] byExtendingSelection:NO];
[self scrollRowToVisible:nextRow];
}
[self reloadData];
}
}
- (IBAction)copyLR:(id)sender
{
[self doAction:'>'];
}
- (IBAction)copyRL:(id)sender
{
[self doAction:'<'];
}
- (IBAction)leaveAlone:(id)sender
{
[self doAction:'/'];
}
- (IBAction)forceOlder:(id)sender
{
[self doAction:'-'];
}
- (IBAction)forceNewer:(id)sender
{
[self doAction:'+'];
}
- (IBAction)selectConflicts:(id)sender
{
[self deselectAll:self];
MyController* controller = (MyController*) [self dataSource];
NSMutableArray *reconItems = [controller reconItems];
int i = 0;
for (; i < [reconItems count]; i++) {
ReconItem *item = [reconItems objectAtIndex:i];
if ([item isConflict])
[self selectRowIndexes:[NSIndexSet indexSetWithIndex:[self rowForItem:item]] byExtendingSelection:YES];
}
}
- (IBAction)revert:(id)sender
{
[self doAction:'R'];
}
- (IBAction)merge:(id)sender
{
[self doAction:'m'];
}
- (IBAction)showDiff:(id)sender
{
[self doAction:'d'];
}
/* There are menu commands for these, but we add some shortcuts so you don't
have to press the Command key */
- (void)keyDown:(NSEvent *)event
{
/* some keys return zero-length strings */
if ([[event characters] length] == 0) {
[super keyDown:event];
return;
}
/* actions are disabled when when menu items are */
if (!editable) {
[super keyDown:event];
return;
}
unichar c = [[event characters] characterAtIndex:0];
switch (c) {
case '>':
case NSRightArrowFunctionKey:
[self doAction:'>'];
break;
case '<':
case NSLeftArrowFunctionKey:
[self doAction:'<'];
break;
case '?':
case '/':
[self doAction:'/'];
break;
default:
[super keyDown:event];
break;
}
}
- (BOOL)canDiffSelection
{
BOOL canDiff = YES;
NSEnumerator *e = [self selectedObjectEnumerator];
ReconItem *item;
while (item = [e nextObject]) {
if (![item canDiff]) canDiff= NO;
}
return canDiff;
}
/* Override default highlight colour because it's hard to see the
conflict/resolution icons */
- (id)_highlightColorForCell:(NSCell *)cell
{
if(([[self window] firstResponder] == self) &&
[[self window] isMainWindow] &&
[[self window] isKeyWindow])
return [NSColor colorWithCalibratedRed:0.7 green:0.75 blue:0.8 alpha:1.0];
else return [NSColor colorWithCalibratedRed:0.8 green:0.8 blue:0.8 alpha:1.0];
}
@end
unison-2.40.102/uimacnew/toolbar/ 0000755 0061316 0061316 00000000000 12050210657 016645 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/toolbar/right.tif 0000644 0061316 0061316 00000012562 11361646373 020510 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ [ [ [ [ [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` ` ` ` ` ` ` ` ` ` ` \ m я ؔ p hG , fu ؔ t a d d d d d e e d d d d d d d a u Ւ ͌ q ( b a رz ؓ g i i i i i i g l l i i i i i i i g ؔ X E Ň ӑ t l m m m m m q }V 9' ^ t p m m m m m k t Ґ | A T9 ѐ ƈ p q q q q q q w X Q8 l x s q q q q p Lj Ց Ć K3 ] ƈ ԑ s u u x } } } b jH v { u u u s Ւ ˋ V t ʊ ӑ x y | _ Y= Y= Y= ]@ F0 ( Z ~ | x x ӑ ͍ p ̌ Ґ { | bC 5$ i { ҏ Ў ώ ҏ ~ Ň eE ;) m ~ я Ґ x Ґ Ґ Ć Æ g bC cC cC gF M4 . a Lj Å Æ Ў ӑ t ^ ֓ Ў Lj Lj ͌ ͌ ͌ ֒ n |U Ć ˋ
ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ ć Ň Ň Ň Ň Ň ͌ h
eE Џ ƈ Ć Ň Ň Ň Ƈ Ć ˋ ۖ M5 Dד Џ ɉ ȉ lj lj lj lj lj Ύ l K4 x ԑ ˋ Lj lj lj lj lj lj ɉ Ў ד ? h ڕ ʊ ʊ ʊ ʊ ʊ ʊ ȉ я Ў ʊ ʊ ʊ ʊ ʊ ʊ ʊ ە f ( dݗ Ў o Ƈ ώ ̌ ̌ ̌ ̌ ̌ ͌ ͌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ώ Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ў Ў Ў Ў Ў ώ Џ ؔ Ƈ [ x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ܖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./right.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:56:45 unison-2.40.102/uimacnew/toolbar/rescan.tif 0000644 0061316 0061316 00000012610 11361646373 020640 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ ] ^ ^ ] [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` d d Z vQ vQ Z d d ` _ \ m я ؔ p hG , fu ؔ t a d e j qM 1"
2" qM j e d a u Ւ ͌ q ( b a رz ؓ g i j l J2 K3 l j i g ؔ X E Ň ӑ t l m s N6 1" 1! O6 s m k t Ґ | A T9 ѐ ƈ p q v W T: m v v l S9 Y v q p Lj Ց Ć K3 ] ƈ ԑ s u z 7& V; ~ w u u x ~ S9 ;( z u s Ւ ˋ W t ʊ ӑ x { q
t { y y y x } y x ~ w ӑ ͍ p ̌ Ґ { h 7& | | | | X I2
>* nK ~ ҏ Ў ώ ҏ ~ k 8&
s b я Ґ x Ґ Ґ Ć z |
ȉ _ jI ʊ Æ Ў ӑ t ^ ֓ Ў Lj
ʊ ?, _A я ƈ
͌ [> 7& Lj Æ ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ Ć ͌ h aB ͌ Lj Ć Ć ȉ ?+ r ˋ Ć Ƈ Ć ˋ ۖ M5 Dד Џ ȉ ȉ ȉ Ґ eE 8& v ͌ lj Lj ʊ lj ʊ Lj lj ɉ Ў ד ? h ڕ ʊ ̌ я fE n Ӑ ʊ ʊ ʊ ̋ ʊ ʊ ە f ( dݗ Ў o Ƈ ώ ̌ ד m I2 q ԑ ̌ ̌ ̌ ̌ ̌ ώ Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ ֓ ד Ć z lj ώ Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ӑ Ւ я ώ Ў ώ Џ ؔ Ƈ [ x ݗ ) NҐ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ( O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /] ۖ ޘ
a kI _A ^@ ^A _A jH ` ߘ ۖ \ , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 2" { # 11 33 33 27" &hV; ]
ʫu ῂ ￃ t ]
W; ! &h 26 33 33 ..
)) &&
! 3 * 2 ( 1 : :2 tL R ../final-smallerfiles/rescan.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:04 22:31:24 unison-2.40.102/uimacnew/toolbar/left.tif 0000644 0061316 0061316 00000012562 11361646373 020325 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ [ [ [ [ [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` ` ` ` ` ` ` ` ` ` ` \ m я ؔ p hG , fu ؔ t a d d d d d d d d e d d d d d a u Ւ ͌ q ( b a رz ؓ g i i i i i i i j n i h i i i i i g ؔ X E Ň ӑ t l m m m m m n s n [> I2 q m m m m m k t Ґ | A T9 ѐ ƈ p q q q q q v w zS % 6$ w q q q q q q p Lj Ց Ć K3 ] ƈ ԑ s u u u x | c :' @+ } } } | u u s Ւ ˋ W t ʊ ӑ x y y q Q8 ]@ Y= Y= Y= gF w y x ӑ ͍ p ̌ Ґ { } | cD
y } { ҏ Ў ώ ҏ ~ ~ jI
| ~ я Ґ x Ґ Ґ Ć ɉ y Z> " gG cC cC bC qM Æ Ў ӑ t ^ ֓ Ў Lj Ƈ ͌ r D/ H1 ד ͌ ͌ ͌ ˋ
ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ ć Ň Ň Ć Ć ̋ ͌ e 0 ?+ Ň Ň Ň Ň Ň Ň Ƈ Ć ˋ ۖ M5 Dד Џ ɉ ȉ lj lj lj lj Lj ȉ я ʊ vQ _@ ͌ lj lj lj lj lj lj ɉ Ў ד ? h ڕ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ̋ ԑ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ە f ( dݗ Ў o Ƈ ώ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ͍ ̌ ̌ ̌ ̌ ̌ ώ Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ў Ў Ў Ў Ў ώ Џ ؔ Ƈ [ x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ܖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./left.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:55:51 unison-2.40.102/uimacnew/toolbar/diff.tif 0000644 0061316 0061316 00000012562 11361646373 020303 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X Z _ a ` ] [ [ [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ d [ cD S9 ^@ W e a ` ` ` ` \ m я ؔ p hG , fu ؔ t a j eE
R8 h e d d d d a u Ւ ͌ q ( b a رz ؓ g n mJ 8& Z= C. R8 n i i i i i g ؔ X E Ň ӑ t m k iH u t v X ` p m m m m k t Ґ | A T9 ѐ ƈ p v X / x r q q { O6 dE x q q q q q p Lj Ց Ć K3 ] ƈ ԑ s { vQ L4 } u u u | qM U; | u u u u u s Ւ ˋ W t ʊ ӑ x } ^ 0! y y y S9 kJ y y y y y x ӑ ͍ p ̌ Ґ { } { sO
Æ a
r | | | | | { ҏ Ў ώ ҏ ~
] =* fF J3
f Ň ~ я Ґ x Ґ Ґ Ć Lj \ j ȉ Æ Ў ӑ t ^ ֓ Ў Lj ˋ b yS ] ~ t p ̌ ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ ć Ň Ň Ć Lj ͌ ώ ȉ ώ r u ύ Ć Ň Ƈ Ć ˋ ۖ M5 Dד Џ ɉ ȉ lj lj lj lj lj lj lj lj Lj Ӑ r
z ώ Lj ɉ Ў ד ? h ڕ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ֒ n
Ґ ە f ( dݗ Ў o Ƈ ώ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ٔ l
>+ ȉ ʊ o ύ ݗ $ ` \ ޘ d ̌ Ґ ֓ t ˋ Ґ e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ў Ў Ў Ў Ў ώ Ў ߙ ȉ Z x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ܖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./diff.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:25 21:56:38 unison-2.40.102/uimacnew/toolbar/add.tif 0000644 0061316 0061316 00000012560 11361646373 020121 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ [ [ [ [ [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` ` ` a d d a ` ` ` ` \ m я ؔ p hG , fu ؔ t a d d d d h pM , , oL h d d d d a u Ւ ͌ q ( b a رz ؓ g i i i i i o cD bC o i i i i i g ؔ X E Ň ӑ t l m m m m m s jH iG s m m m m m k t Ґ | A T9 ѐ ƈ p q q q q q q w nK mJ w q q q q q q p Lj Ց Ć K3 ] ƈ ԑ s u u y { { { wR vQ { { { y u u s Ւ ˋ W t ʊ ӑ x y z \ tO tO tO zS M4 L4 zS tO tO tO ] z y x ӑ ͍ p ̌ Ґ { | 2" 6% | { ҏ Ў ώ ҏ ~ 3# 7%
~ я Ґ x Ґ Ґ Ć c |U }U }U Z R8 R8 Z }U }U |U d Æ Ў ӑ t ^ ֓ Ў Lj ȉ ˋ ˋ ˋ ֓ \ [ ֓ ˋ ˋ ˋ ȉ ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ ć Ň Ň Ň Ň Ň ώ Y X ώ Ň Ň Ň Ň Ň Ň Ƈ Ć ˋ ۖ M5 Dד Џ ɉ ȉ lj lj lj lj lj Ґ Z Z Ґ lj lj lj lj lj lj ɉ Ў ד ? h ڕ ʊ ʊ ʊ ʊ ʊ ֒ Y X ֒ ʊ ʊ ʊ ʊ ʊ ە f ( dݗ Ў o Ƈ ώ ̌ ̌ ̌ ̌ ԑ l C. C. l ԑ ̌ ̌ ̌ ̌ ώ Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ я ד ד я Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ў Ў Ў Ў Ў ώ Џ ؔ Ƈ [ x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ܖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : "2 \L R ./add.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:55:37 unison-2.40.102/uimacnew/toolbar/skip.tif 0000644 0061316 0061316 00000012562 11361646373 020341 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ [ [ [ [ [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` ` ` a c c a ` ` ` ` \ m я ؔ p hG , fu ؔ t a d d d h j b X X b j h d d d a u Ւ ͌ q ( b a رz ؓ g i i i o \ A- B- \ o i i i g ؔ X E Ň ӑ t l m m s lI
mJ s m m k t Ґ | A T9 ѐ ƈ p q q w xR yR w q q p Lj Ց Ć K3 ] ƈ ԑ s u w n qM h h pM o w u s Ւ ˋ W t ʊ ӑ x y _A p | | o bC y x ӑ ͍ p ̌ Ґ { } } & \ { | | { Ň _ ) { ҏ Ў ώ ҏ ~ s p ^
[ d } я Ґ x Ґ Ґ Ć Æ n
@, ƈ Å l
V; Ć Æ Ў ӑ t ^ ֓ Ў Lj
s r y
͍ tP ( Æ ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ Ć Ň ʊ ʊ ȉ Ć Ň Ň Ň Ň Ň ƈ ̌ A- o ͍ Ƈ Ć ˋ ۖ M5 Dד Џ ɉ ȉ lj lj lj lj lj lj lj lj lj lj Lj ~
mK Ւ Lj ɉ Ў ד ? h ڕ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ Ў t Ň ̋ ە f ( dݗ Ў o Ƈ ώ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ Ґ ύ Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ў Ў Ў Ў Ў ώ Џ ؔ Ƈ [ x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ܖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./skip.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:57:11 unison-2.40.102/uimacnew/toolbar/go.tif 0000644 0061316 0061316 00000012560 11361646373 017776 0 ustar bcpierce bcpierce MM * & / HN ` \ q ^ s _ u ] t [ q W k D T # , G 9 G ji Z p X k n u ] r U j Y o 1 > h 3q c | r ^ v ] u 0 " * T l y l ( 2 Q " S w t u v v u t w O
1 } ~ ~ } - { ̕ g , 7 h ' 1 c ٭ # F T h M ` B S h I [ " m J \ N b . 9 | Q d C T S h S g U j
Y o W l K ^ Y o 6 C P c V k $ - L _ E k d ~ A ( 1 f # , a ~ .
* P p o L ' 1 P c { d { ~ % M 0 h ] s \ q \ q \ r g - "&5 B~ 0 ;| # 11 33 33 27" +%iV i
˨
T h (&i 27 33 33 ..
)) &&
3 ( 1 : "2 \L R ./go.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:54:39 unison-2.40.102/uimacnew/toolbar/restart.tif 0000644 0061316 0061316 00000012564 11361646373 021061 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ ] ^ ^ ] [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` d d Z vQ vQ Z d d ` _ \ m я ؔ p hG , fu ؔ t a d e j qM 1"
2" qM j e d a u Ւ ͌ q ( b a رz ؓ g i j l J2 K3 l j i g ؔ X E Ň ӑ t l m s N6 1" 1! O6 s m k t Ґ | A T9 ѐ ƈ p q v W T: m v v l S9 Y v q p Lj Ց Ć K3 ] ƈ ԑ s u z 7& V; ~ w u u x ~ S9 ;( z u s Ւ ˋ W t ʊ ӑ w x | ~ x y y y { r r { x ӑ ͍ p ̌ Ґ } rO H1 W; \ | | | | 4# j { ҏ Ў ώ ҏ [
p 5$ m ~ я Ґ x Ґ Ґ Ć ʊ ^@ \ ȉ
{
{ Æ Ў ӑ t ^ ֓ Ў Lj Ć Æ - T: ͌
ƈ я \? C. ʋ
ƈ ̌ ד [ Q7 ۖ ̋ Å Ƈ Ć ͌ m 5$ ȉ Ć Ć Lj ͌ _A j ̌ Ć Ƈ Ć ˋ ۖ M5 Dד Џ ɉ ȉ Lj ʊ Å ʋ Lj lj ͌ v 8&
fF Ґ Ȉ lj ɉ Ў ד ? h ڕ ʊ ʊ ̌ ʊ ʊ ʊ Ӑ l gG я ̋ ʊ ە f ( dݗ Ў o Ƈ ώ ̌ ̌ ̌ ̌ ̌ ԑ p J3 o ד ̌ ώ Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ ώ Lj z Ć ה ֓ Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў ώ я Ւ Ӑ Ў ώ Џ ؔ Ƈ [ x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ܖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : &2 `L R ./restart.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:56:31 unison-2.40.102/uimacnew/toolbar/quit.tif 0000644 0061316 0061316 00000012562 11361646373 020355 0 ustar bcpierce bcpierce MM * /0 H _` qq ss tu rt pq jk ST +, G FG j np jk qr hj mo <= h 3 z| tv tv 0 ** T 12 Q !" S O
1 - ~ 77 h 01 d vx uw ## F rt pr B fh wx uw [\ {} } ~ bc ^_ E "# $$ A 01 f +, a -
* P L 01 P z{ z{ $% M 0 rs pq pr qr ~ - "& AB~ :;| # 11 33 33 27 *+%i ii
gh ((&i 27 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./quit.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:56:18 unison-2.40.102/uimacnew/toolbar/merge.tif 0000644 0061316 0061316 00000012562 11361646373 020472 0 ustar bcpierce bcpierce MM * & FO6 ^@ _A aB `A ]@ Y= E0 $ F :' hjI \? Z= qM ^ f g a xR _A W< Z> 1" f 2rN eF tP z ٔ ߘ ۖ ۖ ޘ ܗ [ `B `B
0 " R_ nL } ֓ n c ^ ^ c n Ւ ƈ {U oL ( O Qc \ ӑ ڕ } ` zS wQ xR yS yS xR wQ zT ` } ؔ ڕ i Y M /j d ה Ґ n X X [ [ [ [ [ [ [ [ X X o я ܖ p Y , }V ʘi я Ґ l \ ` ` ` ` ` ` ` ` ` ` ` ` \ m я ؔ p hG , fu ؔ t b d d d d d d d d d d d d d d a u Ւ ͌ q ( b a رz ؓ g h n j i i i i i i i i i i j n i g ؔ X E Ň ӑ t q T9 R8 l t n m m m m m m n s p aC B- n t Ґ | A T9 ѐ ƈ p x G1 rN u w r q q q u w X + ) v q Lj Ց Ć K3 ] ƈ ԑ { R8 2" ^ | x w } g A, 3# | Æ ԑ ˋ W t ʊ ד s X= ^A ( H2 n u Y= ]@ X< ` ٔ ͍ p ̌ ٔ e
U: ޘ Ў ώ ٔ g
V; ݘ Ґ x Ґ ֓ y bC hH , Q7 v ~ cC
fF bC d Ւ ӑ t ^ ֓ ώ ʊ ̌ ٕ \? :( l ̌ Lj Ň ͍ v M5 9' Ւ ͍ ̌ ̋ ד \ Q7 ۖ ̋ Å ƈ Џ T9 & ^ ʊ ͌ Ň Ć Ć Ć ˋ j 7% /! ̌ ƈ Ć ˋ ۖ N5 Dד Џ ȉ Џ kI jI Ň Ӑ ȉ Lj lj lj lj lj Lj ȉ Џ ͌ ~V U: ˋ Ɋ Ў ד @ h ڕ ɉ ӑ ͌ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ʊ ˋ ԑ ˋ ͌ ۖ f ( dݗ Ў o Ň Џ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ ̌ Ў Lj o ύ ݗ $ ` \ ޘ d ̌ Ґ Ґ Ό e ߙ W , ۖ y Z Ć ؔ Џ ώ Ў Ў Ў Ў Ў Ў ώ Џ ؔ Ƈ [ x ݗ ) Nӑ ܖ { rN j Ґ ۖ ֓ Ӑ Ґ Ґ Ӑ ֒ ۖ ӑ l rN y ݗ ˋ J ' O ޘ ɉ Z fF \ w Ć ͌ ͌ Ň x ] fF X ȉ ߘ K /^ ۖ ޘ
a kI _A ^@ ^@ _A jH ` ߘ ۖ ] , "&6% }i ד ޘ ӑ ʊ ʊ ӑ ޘ ؔ g 0! { # 11 33 33 27" &hV; ]
ʫu ῃ ￂ t ^
U: &h 26 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./merge.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:56:07 unison-2.40.102/uimacnew/toolbar/save.tif 0000644 0061316 0061316 00000012562 11361646373 020331 0 ustar bcpierce bcpierce MM * /0 H _` qq ss tu rt pq jk ST +, G FG j np jk qr hj mo <= h 3 z| tv tv 0 ** T 12 Q !" S O
1 - ~ 77 h 01 d ce ce ## F ## #$ B fh [\ ! !! z| xz } {| %& %& bc
^_ E /0 00 A 01 f +, a -
* P L 01 P z{ z{ $% M 0 rs pq pr qr ~ - "& AB~ :;| # 11 33 33 27 *+%i ii
gh ((&i 27 33 33 ..
)) &&
3 ( 1 : $2 ^L R ./save.tif % % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:03:24 23:57:01 unison-2.40.102/uimacnew/ImageAndTextCell.h 0000644 0061316 0061316 00000000535 11361646373 020505 0 ustar bcpierce bcpierce //
// ImageAndTextCell.h
//
// Copyright (c) 2001-2002, Apple. All rights reserved.
//
#import
@interface ImageAndTextCell : NSTextFieldCell {
@private
NSImage *image;
}
- (void)setImage:(NSImage *)anImage;
- (NSImage *)image;
- (void)drawWithFrame:(NSRect)cellFrame inView:(NSView *)controlView;
- (NSSize)cellSize;
@end
unison-2.40.102/uimacnew/ReconTableView.h 0000644 0061316 0061316 00000002237 11361646373 020245 0 ustar bcpierce bcpierce //
// ReconTableView.h
//
// NSTableView extended to handle additional keyboard events for the reconcile window.
// The keyDown: method is redefined.
//
// Created by Trevor Jim on Wed Aug 27 2003.
// Copyright (c) 2003, licensed under GNU GPL.
//
#import
@interface ReconTableView : NSOutlineView {
BOOL editable;
}
- (BOOL)editable;
- (void)setEditable:(BOOL)x;
- (BOOL)validateItem:(IBAction *) action;
- (BOOL)validateMenuItem:(NSMenuItem *)menuItem;
- (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem;
- (IBAction)ignorePath:(id)sender;
- (IBAction)ignoreExt:(id)sender;
- (IBAction)ignoreName:(id)sender;
- (IBAction)copyLR:(id)sender;
- (IBAction)copyRL:(id)sender;
- (IBAction)leaveAlone:(id)sender;
- (IBAction)forceOlder:(id)sender;
- (IBAction)forceNewer:(id)sender;
- (IBAction)selectConflicts:(id)sender;
- (IBAction)revert:(id)sender;
- (IBAction)merge:(id)sender;
- (IBAction)showDiff:(id)sender;
- (BOOL)canDiffSelection;
@end
@interface NSOutlineView (_UnisonExtras)
- (NSArray *)selectedObjects;
- (NSEnumerator *)selectedObjectEnumerator;
- (void)setSelectedObjects:(NSArray *)selection;
- (void)expandChildrenIfSpace;
@end
unison-2.40.102/uimacnew/TrevorsUnison.icns 0000644 0061316 0061316 00000057744 11361646373 020756 0 ustar bcpierce bcpierce icns _it32 !! !! ## ## !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# "##! !##! #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "#1Z ւZ1#" "#1ZZ1#" ## ## #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### ##J# #J## "#c# #c#" !##! !##! !### ##ד#! !#c#! !#c#! #V## ##V# #0c#! !#p0# "#ʔ0#! !#0#" !#0#! !#0ʕ#! #V0#! !#0V# ##0##! !##0ʖ## !#c#! !#c#! #Ic#cI# ##֖c=#=c֚## !#pp#! #### !#cc#! #### !#II#! "##" ##Ȼ## !#<<#! "#bb#" ##||## #### !####! !####! !##||##! !##bb##! ##<ȩ<## "####" !##<<##! "##VԟV##" !#bb#! !#II#! !"#VǏǕV#"! !#0VV0#! !"#"! !#! ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,ޙ, ,ޙ, +כ+ +כ+ +ҝ+ +ҝ+ }} }} +̟+ +̟+ *M M* *MՃM* ҆ ҇ } } { { y y w w t t r r p p n n l l j j g g e e c c a a _+ +_ M]2 2]M KZD DZK CXQ QX? ;W0 0W; ,TG GT, "R/ 2R" GPM" "MPG 9NE" "EN9 *L;" "@L* GJA" "AJG 8HE, ,EH8 &F<+ +
#include
#include
#include
#include
#import
#include
#include
/*
CMF, April 2007: Alternate strategy for solving UI crashes based on
http://alan.petitepomme.net/cwn/2005.03.08.html#9:
1) Run OCaml in a separate thread from the Cocoa main run loop.
2) Handle all calls to OCaml as callbacks -- have an OCaml thread
hang in C-land and use mutexes and conditions to pass control from the
C calling thread to the OCaml callback thread.
Value Conversion Done in Bridge Thread:
Value creation/conversion (like calls to caml_named_value or caml_copy_string)
or access calls (like Field) need to occur in the OCaml thread. We do this by
passing C args for conversion to the bridgeThreadWait() thread.
Example of vulnerability:
Field(caml_reconItems,j) could dereference caml_reconItems
when the GC (running independently in an OCaml thread) could be moving it.
*/
pthread_mutex_t init_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t init_cond = PTHREAD_COND_INITIALIZER;
static BOOL doneInit = NO;
pthread_mutex_t global_call_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t global_call_cond = PTHREAD_COND_INITIALIZER;
pthread_mutex_t global_res_lock = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t global_res_cond = PTHREAD_COND_INITIALIZER;
@implementation Bridge
static Bridge *_instance = NULL;
const char **the_argv;
- (void)_ocamlStartup:(id)ignore
{
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
pthread_mutex_lock(&init_lock);
/* Initialize ocaml gc, etc. */
caml_startup((char **)the_argv); // cast to avoid warning, caml_startup assumes non-const,
// NSApplicationMain assumes const
// Register these with the collector
// NSLog(@"*** _ocamlStartup - back from startup; signalling! (%d)", pthread_self());
doneInit = TRUE;
pthread_cond_signal(&init_cond);
pthread_mutex_unlock(&init_lock);
// now start the callback thread
// NSLog(@"*** _ocamlStartup - calling callbackThreadCreate (%d)", pthread_self());
value *f = caml_named_value("callbackThreadCreate");
(void)caml_callback_exn(*f,Val_unit);
[pool release];
}
+ (void)startup:(const char **)argv
{
if (_instance) return;
_instance = [[Bridge alloc] init];
[[NSExceptionHandler defaultExceptionHandler] setDelegate:_instance];
[[NSExceptionHandler defaultExceptionHandler] setExceptionHandlingMask:
(NSLogUncaughtExceptionMask | NSLogTopLevelExceptionMask)];
// Init OCaml in another thread and wait for it to be ready
pthread_mutex_lock(&init_lock);
the_argv = argv;
[NSThread detachNewThreadSelector:@selector(_ocamlStartup:)
toTarget:_instance withObject:nil];
// NSLog(@"*** waiting for completion of caml_init");
while (!doneInit) pthread_cond_wait(&init_cond, &init_lock);
pthread_mutex_unlock(&init_lock);
// NSLog(@"*** caml_init complete!");
}
#if MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_5
typedef unsigned int NSUInteger;
#endif
- (BOOL)exceptionHandler:(NSExceptionHandler *)sender shouldLogException:(NSException *)exception mask:(NSUInteger)aMask
{
// if (![[exception name] isEqual:@"OCamlException"]) return YES;
NSString *msg = [NSString stringWithFormat:@"Uncaught exception: %@", [exception reason]];
msg = [[msg componentsSeparatedByString:@"\n"] componentsJoinedByString:@" "];
NSLog(@"%@", msg);
NSRunAlertPanel(@"Fatal error", msg, @"Exit", nil, nil);
exit(1);
return FALSE;
}
@end
// CallState struct is allocated on the C thread stack and then handed
// to the OCaml callback thread to perform value conversion and issue the call
typedef struct {
enum { SafeCall, OldCall, FieldAccess } opCode;
// New style calls
const char *argTypes;
va_list args;
// Field access
value *valueP;
long fieldIndex;
char fieldType;
// Return values
char *exception;
void *retV;
BOOL _autorelease;
// for old style (unsafe) calls
value call, a1, a2, a3, ret;
int argCount;
} CallState;
static CallState *_CallState = NULL;
static CallState *_RetState = NULL;
// Our OCaml callback server thread -- waits for call then makes them
// Called from thread spawned from OCaml
CAMLprim value bridgeThreadWait(value ignore)
{
CAMLparam0();
CAMLlocal1 (args);
args = caml_alloc_tuple(3);
// NSLog(@"*** bridgeThreadWait init! (%d) Taking lock...", pthread_self());
while (TRUE) {
// unblock ocaml while we wait for work
caml_enter_blocking_section();
pthread_mutex_lock(&global_call_lock);
while (!_CallState) pthread_cond_wait(&global_call_cond, &global_call_lock);
// pick up our work and free up the call lock for other threads
CallState *cs = _CallState;
_CallState = NULL;
pthread_mutex_unlock(&global_call_lock);
// NSLog(@"*** bridgeThreadWait: have call -- leaving caml_blocking_section");
// we have a call to do -- get the ocaml lock
caml_leave_blocking_section();
// NSLog(@"*** bridgeThreadWait: doing call");
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
char retType = 'v';
value e = Val_unit;
if (cs->opCode == SafeCall) {
int i;
char *fname = va_arg(cs->args, char *);
value *f = caml_named_value(fname);
// varargs with C-based args -- convert them to OCaml values based on type code string
const char *p = cs->argTypes;
retType = *p++;
int argCount = 0;
for(; *p != '\0'; p++) {
const char *str;
switch (*p) {
case 's':
str = va_arg(cs->args, const char *);
Store_field (args, argCount, caml_copy_string(str));
break;
case 'S':
str = [va_arg(cs->args, NSString *) UTF8String];
Store_field (args, argCount, caml_copy_string(str));
break;
case 'i':
Store_field (args, argCount, Val_long(va_arg(cs->args, long)));
break;
case '@':
Store_field (args, argCount, [va_arg(cs->args, OCamlValue *) value]);
break;
default:
NSCAssert1(0, @"Unknown input type '%c'", *p);
break;
}
argCount++;
NSCAssert(argCount <= 3, @"More than 3 arguments");
}
// Call OCaml -- TODO: add support for > 3 args
if (argCount == 3) e = caml_callback3_exn(*f,Field(args,0),Field(args,1),Field(args,2));
else if (argCount == 2) e = caml_callback2_exn(*f,Field(args,0),Field(args,1));
else if (argCount == 1) e = caml_callback_exn(*f,Field(args,0));
else e = caml_callback_exn(*f,Val_unit);
for (i = 0; i < argCount; i++) Store_field (args, i, Val_unit);
} else if (cs->opCode == OldCall) {
// old style (unsafe) version where OCaml values were passed directly from C thread
if (cs->argCount == 3) e = caml_callback3_exn(cs->call,cs->a1,cs->a2,cs->a3);
else if (cs->argCount == 2) e = caml_callback2_exn(cs->call,cs->a1,cs->a2);
else e = caml_callback_exn(cs->call,cs->a1);
retType = 'v';
} else if (cs->opCode == FieldAccess) {
long index = cs->fieldIndex;
e = (index == -1) ? Val_long(Wosize_val(*cs->valueP)) : Field(*cs->valueP, index);
retType = cs->fieldType;
}
// Process return value
cs->_autorelease = FALSE;
cs->ret = e; // OCaml return type -- unsafe...
if (!Is_exception_result(e)) {
switch (retType) {
case 'S':
*((NSString **)&cs->retV) = (e == Val_unit) ? NULL : [[NSString alloc] initWithUTF8String:String_val(e)];
cs->_autorelease = TRUE;
break;
case 'N':
if (Is_long (e)) {
*((NSNumber **)&cs->retV) = [[NSNumber alloc] initWithLong:Long_val(e)];
} else {
*((NSNumber **)&cs->retV) = [[NSNumber alloc] initWithDouble:Double_val(e)];
}
cs->_autorelease = TRUE;
break;
case '@':
*((NSObject **)&cs->retV) = (e == Val_unit) ? NULL : [[OCamlValue alloc] initWithValue:e];
cs->_autorelease = TRUE;
break;
case 'i':
*((long *)&cs->retV) = Long_val(e);
break;
case 'x':
break;
default:
NSCAssert1(0, @"Unknown return type '%c'", retType);
break;
}
}
if (Is_exception_result(e)) {
// get exception string -- it will get thrown back in the calling thread
value *f = caml_named_value("unisonExnInfo");
// We leak memory here...
cs->exception = strdup(String_val(caml_callback(*f,Extract_exception(e))));
}
[pool release];
// NSLog(@"*** bridgeThreadWait: returning");
// we're done, signal back
pthread_mutex_lock(&global_res_lock);
_RetState = cs;
pthread_cond_signal(&global_res_cond);
pthread_mutex_unlock(&global_res_lock);
}
// Never get here...
CAMLreturn (Val_unit);
}
void *_passCall(CallState *cs)
{
pthread_mutex_lock(&global_call_lock);
_CallState = cs;
// signal so call can happen on other thread
pthread_mutex_lock(&global_res_lock);
pthread_cond_signal(&global_call_cond);
pthread_mutex_unlock(&global_call_lock);
// NSLog(@"*** _passCall (%d) -- performing signal and waiting", pthread_self());
// wait until done -- make sure the result is for our call
while (_RetState != cs) pthread_cond_wait(&global_res_cond, &global_res_lock);
_RetState = NULL;
pthread_mutex_unlock(&global_res_lock);
// NSLog(@"*** doCallback -- back with result");
if (cs->exception) {
@throw [NSException exceptionWithName:@"OCamlException"
reason:[NSString stringWithUTF8String:cs->exception]
userInfo:nil];
}
if (cs->_autorelease) [((id)cs->retV) autorelease];
return cs->retV;
}
void *ocamlCall(const char *argTypes, ...)
{
CallState cs;
cs.opCode = SafeCall;
cs.exception = NULL;
cs.argTypes = argTypes;
va_start(cs.args, argTypes);
void * res = _passCall(&cs);
va_end(cs.args);
return res;
}
void *getField(value *vP, long index, char type)
{
CallState cs;
cs.opCode = FieldAccess;
cs.valueP = vP;
cs.fieldIndex = index;
cs.fieldType = type;
cs.exception = NULL;
return _passCall(&cs);
}
@implementation OCamlValue
- initWithValue:(long)v
{
[super init];
_v = v;
caml_register_global_root((value *)&_v);
return self;
}
- (long)count
{
return (long)getField((value *) &_v, -1, 'i');
}
- (void *)getField:(long)i withType:(char)t
{
return getField((value *)&_v, i, t);
}
- (long)value
{
// Unsafe to use!
return _v;
}
- (void)dealloc
{
_v = Val_unit;
caml_remove_global_root((value *)&_v);
[super dealloc];
}
@end
// Legacy OCaml call API -- no longer needed
#if 0
extern value doCallback (value c, int argcount, value v1, value v2, value v3, BOOL exitOnException);
extern value Callback_checkexn(value c,value v);
extern value Callback2_checkexn(value c,value v1,value v2);
extern value Callback3_checkexn(value c,value v1,value v2,value v3);
void reportExn(const char *msg) {
NSString *s = [NSString stringWithFormat:@"Uncaught exception: %s", msg];
s = [[s componentsSeparatedByString:@"\n"] componentsJoinedByString:@" "];
NSLog(@"%@",s);
NSRunAlertPanel(@"Fatal error",s,@"Exit",nil,nil);
}
// FIXME! Claim is that value conversion must also happen in the OCaml thread...
value doCallback (value c, int argcount, value v1, value v2, value v3, BOOL exitOnException) {
// NSLog(@"*** doCallback: (%d) -- trying to acquire global lock", pthread_self());
CallState cs;
cs.opCode = OldCall;
cs.exception = NULL;
cs.call = c;
cs.a1 = v1;
cs.a2 = v2;
cs.a3 = v3;
cs.argCount = argcount;
@try {
return _passCall(&cs);
} @catch (NSException *ex) {
if (exitOnException) {
reportExn(cs.exception);
exit(1);
}
@throw ex;
}
}
value Callback_checkexn(value c,value v) {
return doCallback(c, 1, v, 0, 0, TRUE);
}
value Callback2_checkexn(value c,value v1,value v2) {
return doCallback(c, 2, v1, v2, 0, TRUE);
}
value Callback3_checkexn(value c,value v1,value v2,value v3) {
return doCallback(c, 3, v1, v2, v3, TRUE);
}
#endif
unison-2.40.102/uimacnew/Growl.framework/ 0000755 0061316 0061316 00000000000 12050210657 020271 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Headers 0000777 0061316 0061316 00000000000 12050210657 026314 2Versions/Current/Headers ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Resources 0000777 0061316 0061316 00000000000 12050210657 027312 2Versions/Current/Resources ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Growl 0000777 0061316 0061316 00000000000 12050210657 025552 2Versions/Current/Growl ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Versions/ 0000755 0061316 0061316 00000000000 12050210657 022101 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Versions/Current 0000777 0061316 0061316 00000000000 12050210657 023546 2A ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Versions/A/ 0000755 0061316 0061316 00000000000 12050210657 022261 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Versions/A/Headers/ 0000755 0061316 0061316 00000000000 12050210657 023634 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Versions/A/Headers/GrowlDefines.h 0000644 0061316 0061316 00000032551 11361646373 026417 0 ustar bcpierce bcpierce //
// GrowlDefines.h
//
#ifndef _GROWLDEFINES_H
#define _GROWLDEFINES_H
#ifdef __OBJC__
#define XSTR(x) (@x)
#define STRING NSString *
#else
#define XSTR CFSTR
#define STRING CFStringRef
#endif
/*! @header GrowlDefines.h
* @abstract Defines all the notification keys.
* @discussion Defines all the keys used for registration with Growl and for
* Growl notifications.
*
* Most applications should use the functions or methods of Growl.framework
* instead of posting notifications such as those described here.
* @updated 2004-01-25
*/
// UserInfo Keys for Registration
#pragma mark UserInfo Keys for Registration
/*! @group Registration userInfo keys */
/* @abstract Keys for the userInfo dictionary of a GROWL_APP_REGISTRATION distributed notification.
* @discussion The values of these keys describe the application and the
* notifications it may post.
*
* Your application must register with Growl before it can post Growl
* notifications (and have them not be ignored). However, as of Growl 0.6,
* posting GROWL_APP_REGISTRATION notifications directly is no longer the
* preferred way to register your application. Your application should instead
* use Growl.framework's delegate system.
* See +[GrowlApplicationBridge setGrowlDelegate:] or Growl_SetDelegate for
* more information.
*/
/*! @defined GROWL_APP_NAME
* @abstract The name of your application.
* @discussion The name of your application. This should remain stable between
* different versions and incarnations of your application.
* For example, "SurfWriter" is a good app name, whereas "SurfWriter 2.0" and
* "SurfWriter Lite" are not.
*/
#define GROWL_APP_NAME XSTR("ApplicationName")
/*! @defined GROWL_APP_ICON
* @abstract The image data for your application's icon.
* @discussion Image data representing your application's icon. This may be
* superimposed on a notification icon as a badge, used as the notification
* icon when a notification-specific icon is not supplied, or ignored
* altogether, depending on the display. Must be in a format supported by
* NSImage, such as TIFF, PNG, GIF, JPEG, BMP, PICT, or PDF.
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_APP_ICON XSTR("ApplicationIcon")
/*! @defined GROWL_NOTIFICATIONS_DEFAULT
* @abstract The array of notifications to turn on by default.
* @discussion These are the names of the notifications that should be enabled
* by default when your application registers for the first time. If your
* application reregisters, Growl will look here for any new notification
* names found in GROWL_NOTIFICATIONS_ALL, but ignore any others.
*/
#define GROWL_NOTIFICATIONS_DEFAULT XSTR("DefaultNotifications")
/*! @defined GROWL_NOTIFICATIONS_ALL
* @abstract The array of all notifications your application can send.
* @discussion These are the names of all of the notifications that your
* application may post. See GROWL_NOTIFICATION_NAME for a discussion of good
* notification names.
*/
#define GROWL_NOTIFICATIONS_ALL XSTR("AllNotifications")
/*! @defined GROWL_TICKET_VERSION
* @abstract The version of your registration ticket.
* @discussion Include this key in a ticket plist file that you put in your
* application bundle for auto-discovery. The current ticket version is 1.
*/
#define GROWL_TICKET_VERSION XSTR("TicketVersion")
// UserInfo Keys for Notifications
#pragma mark UserInfo Keys for Notifications
/*! @group Notification userInfo keys */
/* @abstract Keys for the userInfo dictionary of a GROWL_NOTIFICATION distributed notification.
* @discussion The values of these keys describe the content of a Growl
* notification.
*
* Not all of these keys are supported by all displays. Only the name, title,
* and description of a notification are universal. Most of the built-in
* displays do support all of these keys, and most other visual displays
* probably will also. But, as of 0.6, the Log, MailMe, and Speech displays
* support only textual data.
*/
/*! @defined GROWL_NOTIFICATION_NAME
* @abstract The name of the notification.
* @discussion The name of the notification. This should be human-readable, as
* it's shown in the prefpane, in the list of notifications your application
* supports. */
#define GROWL_NOTIFICATION_NAME XSTR("NotificationName")
/*! @defined GROWL_NOTIFICATION_TITLE
* @abstract The title to display in the notification.
* @discussion The title of the notification. Should be very brief.
* The title usually says what happened, e.g. "Download complete".
*/
#define GROWL_NOTIFICATION_TITLE XSTR("NotificationTitle")
/*! @defined GROWL_NOTIFICATION_DESCRIPTION
* @abstract The description to display in the notification.
* @discussion The description should be longer and more verbose than the title.
* The description usually tells the subject of the action,
* e.g. "Growl-0.6.dmg downloaded in 5.02 minutes".
*/
#define GROWL_NOTIFICATION_DESCRIPTION XSTR("NotificationDescription")
/*! @defined GROWL_NOTIFICATION_ICON
* @discussion Image data for the notification icon. Must be in a format
* supported by NSImage, such as TIFF, PNG, GIF, JPEG, BMP, PICT, or PDF.
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_NOTIFICATION_ICON XSTR("NotificationIcon")
/*! @defined GROWL_NOTIFICATION_APP_ICON
* @discussion Image data for the application icon, in case GROWL_APP_ICON does
* not apply for some reason. Must be in a format supported by NSImage, such
* as TIFF, PNG, GIF, JPEG, BMP, PICT, or PDF.
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_NOTIFICATION_APP_ICON XSTR("NotificationAppIcon")
/*! @defined GROWL_NOTIFICATION_PRIORITY
* @discussion The priority of the notification as an integer number from
* -2 to +2 (+2 being highest).
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_NOTIFICATION_PRIORITY XSTR("NotificationPriority")
/*! @defined GROWL_NOTIFICATION_STICKY
* @discussion A Boolean number controlling whether the notification is sticky.
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_NOTIFICATION_STICKY XSTR("NotificationSticky")
/*! @defined GROWL_NOTIFICATION_CLICK_CONTEXT
* @abstract Identifies which notification was clicked.
* @discussion An identifier for the notification for clicking purposes.
*
* This will be passed back to the application when the notification is
* clicked. It must be plist-encodable (a data, dictionary, array, number, or
* string object), and it should be unique for each notification you post.
* A good click context would be a UUID string returned by NSProcessInfo or
* CFUUID.
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_NOTIFICATION_CLICK_CONTEXT XSTR("NotificationClickContext")
/*! @defined GROWL_DISPLAY_PLUGIN
* @discussion The name of a display plugin which should be used for this notification.
* Optional. If this key is not set or the specified display plugin does not
* exist, the display plugin stored in the application ticket is used. This key
* allows applications to use different default display plugins for their
* notifications. The user can still override those settings in the preference
* pane.
*/
#define GROWL_DISPLAY_PLUGIN XSTR("NotificationDisplayPlugin")
/*! @defined GROWL_NOTIFICATION_IDENTIFIER
* @abstract An identifier for the notification for coalescing purposes.
* Notifications with the same identifier fall into the same class; only
* the last notification of a class is displayed on the screen. If a
* notification of the same class is currently being displayed, it is
* replaced by this notification.
*
* Optional. Not supported by all display plugins.
*/
#define GROWL_NOTIFICATION_IDENTIFIER XSTR("GrowlNotificationIdentifier")
/*! @defined GROWL_APP_PID
* @abstract The process identifier of the process which sends this
* notification. If this field is set, the application will only receive
* clicked and timed out notifications which originate from this process.
*
* Optional.
*/
#define GROWL_APP_PID XSTR("ApplicationPID")
// Notifications
#pragma mark Notifications
/*! @group Notification names */
/* @abstract Names of distributed notifications used by Growl.
* @discussion These are notifications used by applications (directly or
* indirectly) to interact with Growl, and by Growl for interaction between
* its components.
*
* Most of these should no longer be used in Growl 0.6 and later, in favor of
* Growl.framework's GrowlApplicationBridge APIs.
*/
/*! @defined GROWL_APP_REGISTRATION
* @abstract The distributed notification for registering your application.
* @discussion This is the name of the distributed notification that can be
* used to register applications with Growl.
*
* The userInfo dictionary for this notification can contain these keys:
*
* - GROWL_APP_NAME
* - GROWL_APP_ICON
* - GROWL_NOTIFICATIONS_ALL
* - GROWL_NOTIFICATIONS_DEFAULT
*
*
* No longer recommended as of Growl 0.6. An alternate method of registering
* is to use Growl.framework's delegate system.
* See +[GrowlApplicationBridge setGrowlDelegate:] or Growl_SetDelegate for
* more information.
*/
#define GROWL_APP_REGISTRATION XSTR("GrowlApplicationRegistrationNotification")
/*! @defined GROWL_APP_REGISTRATION_CONF
* @abstract The distributed notification for confirming registration.
* @discussion The name of the distributed notification sent to confirm the
* registration. Used by the Growl preference pane. Your application probably
* does not need to use this notification.
*/
#define GROWL_APP_REGISTRATION_CONF XSTR("GrowlApplicationRegistrationConfirmationNotification")
/*! @defined GROWL_NOTIFICATION
* @abstract The distributed notification for Growl notifications.
* @discussion This is what it all comes down to. This is the name of the
* distributed notification that your application posts to actually send a
* Growl notification.
*
* The userInfo dictionary for this notification can contain these keys:
*
* - GROWL_NOTIFICATION_NAME (required)
* - GROWL_NOTIFICATION_TITLE (required)
* - GROWL_NOTIFICATION_DESCRIPTION (required)
* - GROWL_NOTIFICATION_ICON
* - GROWL_NOTIFICATION_APP_ICON
* - GROWL_NOTIFICATION_PRIORITY
* - GROWL_NOTIFICATION_STICKY
* - GROWL_NOTIFICATION_CLICK_CONTEXT
* - GROWL_APP_NAME (required)
*
*
* No longer recommended as of Growl 0.6. Three alternate methods of posting
* notifications are +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:],
* Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext, and
* Growl_PostNotification.
*/
#define GROWL_NOTIFICATION XSTR("GrowlNotification")
/*! @defined GROWL_SHUTDOWN
* @abstract The distributed notification name that tells Growl to shutdown.
* @discussion The Growl preference pane posts this notification when the
* "Stop Growl" button is clicked.
*/
#define GROWL_SHUTDOWN XSTR("GrowlShutdown")
/*! @defined GROWL_PING
* @abstract A distributed notification to check whether Growl is running.
* @discussion This is used by the Growl preference pane. If it receives a
* GROWL_PONG, the preference pane takes this to mean that Growl is running.
*/
#define GROWL_PING XSTR("Honey, Mind Taking Out The Trash")
/*! @defined GROWL_PONG
* @abstract The distributed notification sent in reply to GROWL_PING.
* @discussion GrowlHelperApp posts this in reply to GROWL_PING.
*/
#define GROWL_PONG XSTR("What Do You Want From Me, Woman")
/*! @defined GROWL_IS_READY
* @abstract The distributed notification sent when Growl starts up.
* @discussion GrowlHelperApp posts this when it has begin listening on all of
* its sources for new notifications. GrowlApplicationBridge (in
* Growl.framework), upon receiving this notification, reregisters using the
* registration dictionary supplied by its delegate.
*/
#define GROWL_IS_READY XSTR("Lend Me Some Sugar; I Am Your Neighbor!")
/*! @defined GROWL_NOTIFICATION_CLICKED
* @abstract The distributed notification sent when a supported notification is clicked.
* @discussion When a Growl notification with a click context is clicked on by
* the user, Growl posts this distributed notification.
* The GrowlApplicationBridge responds to this notification by calling a
* callback in its delegate.
*/
#define GROWL_NOTIFICATION_CLICKED XSTR("GrowlClicked!")
#define GROWL_NOTIFICATION_TIMED_OUT XSTR("GrowlTimedOut!")
/*! @group Other symbols */
/* Symbols which don't fit into any of the other categories. */
/*! @defined GROWL_KEY_CLICKED_CONTEXT
* @abstract Used internally as the key for the clickedContext passed over DNC.
* @discussion This key is used in GROWL_NOTIFICATION_CLICKED, and contains the
* click context that was supplied in the original notification.
*/
#define GROWL_KEY_CLICKED_CONTEXT XSTR("ClickedContext")
/*! @defined GROWL_REG_DICT_EXTENSION
* @abstract The filename extension for registration dictionaries.
* @discussion The GrowlApplicationBridge in Growl.framework registers with
* Growl by creating a file with the extension of .(GROWL_REG_DICT_EXTENSION)
* and opening it in the GrowlHelperApp. This happens whether or not Growl is
* running; if it was stopped, it quits immediately without listening for
* notifications.
*/
#define GROWL_REG_DICT_EXTENSION XSTR("growlRegDict")
#endif //ndef _GROWLDEFINES_H
unison-2.40.102/uimacnew/Growl.framework/Versions/A/Headers/GrowlApplicationBridge-Carbon.h 0000644 0061316 0061316 00000101103 11361646373 031612 0 ustar bcpierce bcpierce //
// GrowlApplicationBridge-Carbon.h
// Growl
//
// Created by Mac-arena the Bored Zo on Wed Jun 18 2004.
// Based on GrowlApplicationBridge.h by Evan Schoenberg.
// This source code is in the public domain. You may freely link it into any
// program.
//
#ifndef _GROWLAPPLICATIONBRIDGE_CARBON_H_
#define _GROWLAPPLICATIONBRIDGE_CARBON_H_
#include
#include
/*! @header GrowlApplicationBridge-Carbon.h
* @abstract Declares an API that Carbon applications can use to interact with Growl.
* @discussion GrowlApplicationBridge uses a delegate to provide information //XXX
* to Growl (such as your application's name and what notifications it may
* post) and to provide information to your application (such as that Growl
* is listening for notifications or that a notification has been clicked).
*
* You can set the Growldelegate with Growl_SetDelegate and find out the
* current delegate with Growl_GetDelegate. See struct Growl_Delegate for more
* information about the delegate.
*/
__BEGIN_DECLS
/*! @struct Growl_Delegate
* @abstract Delegate to supply GrowlApplicationBridge with information and respond to events.
* @discussion The Growl delegate provides your interface to
* GrowlApplicationBridge. When GrowlApplicationBridge needs information about
* your application, it looks for it in the delegate; when Growl or the user
* does something that you might be interested in, GrowlApplicationBridge
* looks for a callback in the delegate and calls it if present
* (meaning, if it is not NULL).
* XXX on all of that
* @field size The size of the delegate structure.
* @field applicationName The name of your application.
* @field registrationDictionary A dictionary describing your application and the notifications it can send out.
* @field applicationIconData Your application's icon.
* @field growlInstallationWindowTitle The title of the installation window.
* @field growlInstallationInformation Text to display in the installation window.
* @field growlUpdateWindowTitle The title of the update window.
* @field growlUpdateInformation Text to display in the update window.
* @field referenceCount A count of owners of the delegate.
* @field retain Called when GrowlApplicationBridge receives this delegate.
* @field release Called when GrowlApplicationBridge no longer needs this delegate.
* @field growlIsReady Called when GrowlHelperApp is listening for notifications.
* @field growlNotificationWasClicked Called when a Growl notification is clicked.
* @field growlNotificationTimedOut Called when a Growl notification timed out.
*/
struct Growl_Delegate {
/* @discussion This should be sizeof(struct Growl_Delegate).
*/
size_t size;
/*All of these attributes are optional.
*Optional attributes can be NULL; required attributes that
* are NULL cause setting the Growl delegate to fail.
*XXX - move optional/required status into the discussion for each field
*/
/* This name is used both internally and in the Growl preferences.
*
* This should remain stable between different versions and incarnations of
* your application.
* For example, "SurfWriter" is a good app name, whereas "SurfWriter 2.0" and
* "SurfWriter Lite" are not.
*
* This can be NULL if it is provided elsewhere, namely in an
* auto-discoverable plist file in your app bundle
* (XXX refer to more information on that) or in registrationDictionary.
*/
CFStringRef applicationName;
/*
* Must contain at least these keys:
* GROWL_NOTIFICATIONS_ALL (CFArray):
* Contains the names of all notifications your application may post.
*
* Can also contain these keys:
* GROWL_NOTIFICATIONS_DEFAULT (CFArray):
* Names of notifications that should be enabled by default.
* If omitted, GROWL_NOTIFICATIONS_ALL will be used.
* GROWL_APP_NAME (CFString):
* Same as the applicationName member of this structure.
* If both are present, the applicationName member shall prevail.
* If this key is present, you may omit applicationName (set it to NULL).
* GROWL_APP_ICON (CFData):
* Same as the iconData member of this structure.
* If both are present, the iconData member shall prevail.
* If this key is present, you may omit iconData (set it to NULL).
*
* If you change the contents of this dictionary after setting the delegate,
* be sure to call Growl_Reregister.
*
* This can be NULL if you have an auto-discoverable plist file in your app
* bundle. (XXX refer to more information on that)
*/
CFDictionaryRef registrationDictionary;
/* The data can be in any format supported by NSImage. As of
* Mac OS X 10.3, this includes the .icns, TIFF, JPEG, GIF, PNG, PDF, and
* PICT formats.
*
* If this is not supplied, Growl will look up your application's icon by
* its application name.
*/
CFDataRef applicationIconData;
/* Installer display attributes
*
* These four attributes are used by the Growl installer, if this framework
* supports it.
* For any of these being NULL, a localised default will be
* supplied.
*/
/* If this is NULL, Growl will use a default,
* localized title.
*
* Only used if you're using Growl-WithInstaller.framework. Otherwise,
* this member is ignored.
*/
CFStringRef growlInstallationWindowTitle;
/* This information may be as long or short as desired (the
* window will be sized to fit it). If Growl is not installed, it will
* be displayed to the user as an explanation of what Growl is and what
* it can do in your application.
* It should probably note that no download is required to install.
*
* If this is NULL, Growl will use a default, localized
* explanation.
*
* Only used if you're using Growl-WithInstaller.framework. Otherwise,
* this member is ignored.
*/
CFStringRef growlInstallationInformation;
/* If this is NULL, Growl will use a default,
* localized title.
*
* Only used if you're using Growl-WithInstaller.framework. Otherwise,
* this member is ignored.
*/
CFStringRef growlUpdateWindowTitle;
/* This information may be as long or short as desired (the
* window will be sized to fit it). If an older version of Growl is
* installed, it will be displayed to the user as an explanation that an
* updated version of Growl is included in your application and
* no download is required.
*
* If this is NULL, Growl will use a default, localized
* explanation.
*
* Only used if you're using Growl-WithInstaller.framework. Otherwise,
* this member is ignored.
*/
CFStringRef growlUpdateInformation;
/* This member is provided for use by your retain and release
* callbacks (see below).
*
* GrowlApplicationBridge never directly uses this member. Instead, it
* calls your retain callback (if non-NULL) and your release
* callback (if non-NULL).
*/
unsigned referenceCount;
//Functions. Currently all of these are optional (any of them can be NULL).
/* When you call Growl_SetDelegate(newDelegate), it will call
* oldDelegate->release(oldDelegate), and then it will call
* newDelegate->retain(newDelegate), and the return value from retain
* is what will be set as the delegate.
* (This means that this member works like CFRetain and -[NSObject retain].)
* This member is optional (it can be NULL).
* For a delegate allocated with malloc, this member would be
* NULL.
* @result A delegate to which GrowlApplicationBridge holds a reference.
*/
void *(*retain)(void *);
/* When you call Growl_SetDelegate(newDelegate), it will call
* oldDelegate->release(oldDelegate), and then it will call
* newDelegate->retain(newDelegate), and the return value from retain
* is what will be set as the delegate.
* (This means that this member works like CFRelease and
* -[NSObject release].)
* This member is optional (it can be NULL).
* For a delegate allocated with malloc, this member might be
* free(3).
*/
void (*release)(void *);
/* Informs the delegate that Growl (specifically, the GrowlHelperApp) was
* launched successfully (or was already running). The application can
* take actions with the knowledge that Growl is installed and functional.
*/
void (*growlIsReady)(void);
/* Informs the delegate that a Growl notification was clicked. It is only
* sent for notifications sent with a non-NULL clickContext,
* so if you want to receive a message when a notification is clicked,
* clickContext must not be NULL when calling
* Growl_PostNotification or
* Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext.
*/
void (*growlNotificationWasClicked)(CFPropertyListRef clickContext);
/* Informs the delegate that a Growl notification timed out. It is only
* sent for notifications sent with a non-NULL clickContext,
* so if you want to receive a message when a notification is clicked,
* clickContext must not be NULL when calling
* Growl_PostNotification or
* Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext.
*/
void (*growlNotificationTimedOut)(CFPropertyListRef clickContext);
};
/*! @struct Growl_Notification
* @abstract Structure describing a Growl notification.
* @discussion XXX
* @field size The size of the notification structure.
* @field name Identifies the notification.
* @field title Short synopsis of the notification.
* @field description Additional text.
* @field iconData An icon for the notification.
* @field priority An indicator of the notification's importance.
* @field reserved Bits reserved for future usage.
* @field isSticky Requests that a notification stay on-screen until dismissed explicitly.
* @field clickContext An identifier to be passed to your click callback when a notification is clicked.
* @field clickCallback A callback to call when the notification is clicked.
*/
struct Growl_Notification {
/* This should be sizeof(struct Growl_Notification).
*/
size_t size;
/* The notification name distinguishes one type of
* notification from another. The name should be human-readable, as it
* will be displayed in the Growl preference pane.
*
* The name is used in the GROWL_NOTIFICATIONS_ALL and
* GROWL_NOTIFICATIONS_DEFAULT arrays in the registration dictionary, and
* in this member of the Growl_Notification structure.
*/
CFStringRef name;
/* A notification's title describes the notification briefly.
* It should be easy to read quickly by the user.
*/
CFStringRef title;
/* The description supplements the title with more
* information. It is usually longer and sometimes involves a list of
* subjects. For example, for a 'Download complete' notification, the
* description might have one filename per line. GrowlMail in Growl 0.6
* uses a description of '%d new mail(s)' (formatted with the number of
* messages).
*/
CFStringRef description;
/* The notification icon usually indicates either what
* happened (it may have the same icon as e.g. a toolbar item that
* started the process that led to the notification), or what it happened
* to (e.g. a document icon).
*
* The icon data is optional, so it can be NULL. In that
* case, the application icon is used alone. Not all displays support
* icons.
*
* The data can be in any format supported by NSImage. As of Mac OS X
* 10.3, this includes the .icns, TIFF, JPEG, GIF, PNG, PDF, and PICT form
* ats.
*/
CFDataRef iconData;
/* Priority is new in Growl 0.6, and is represented as a
* signed integer from -2 to +2. 0 is Normal priority, -2 is Very Low
* priority, and +2 is Very High priority.
*
* Not all displays support priority. If you do not wish to assign a
* priority to your notification, assign 0.
*/
signed int priority;
/* These bits are not used in Growl 0.6. Set them to 0.
*/
unsigned reserved: 31;
/* When the sticky bit is clear, in most displays,
* notifications disappear after a certain amount of time. Sticky
* notifications, however, remain on-screen until the user dismisses them
* explicitly, usually by clicking them.
*
* Sticky notifications were introduced in Growl 0.6. Most notifications
* should not be sticky. Not all displays support sticky notifications,
* and the user may choose in Growl's preference pane to force the
* notification to be sticky or non-sticky, in which case the sticky bit
* in the notification will be ignored.
*/
unsigned isSticky: 1;
/* If this is not NULL, and your click callback
* is not NULL either, this will be passed to the callback
* when your notification is clicked by the user.
*
* Click feedback was introduced in Growl 0.6, and it is optional. Not
* all displays support click feedback.
*/
CFPropertyListRef clickContext;
/* If this is not NULL, it will be called instead
* of the Growl delegate's click callback when clickContext is
* non-NULL and the notification is clicked on by the user.
*
* Click feedback was introduced in Growl 0.6, and it is optional. Not
* all displays support click feedback.
*
* The per-notification click callback is not yet supported as of Growl
* 0.7.
*/
void (*clickCallback)(CFPropertyListRef clickContext);
};
#pragma mark -
#pragma mark Easy initialisers
/*! @defined InitGrowlDelegate
* @abstract Callable macro. Initializes a Growl delegate structure to defaults.
* @discussion Call with a pointer to a struct Growl_Delegate. All of the
* members of the structure will be set to 0 or NULL, except for
* size (which will be set to sizeof(struct Growl_Delegate)) and
* referenceCount (which will be set to 1).
*/
#define InitGrowlDelegate(delegate) \
do { \
if (delegate) { \
(delegate)->size = sizeof(struct Growl_Delegate); \
(delegate)->applicationName = NULL; \
(delegate)->registrationDictionary = NULL; \
(delegate)->applicationIconData = NULL; \
(delegate)->growlInstallationWindowTitle = NULL; \
(delegate)->growlInstallationInformation = NULL; \
(delegate)->growlUpdateWindowTitle = NULL; \
(delegate)->growlUpdateInformation = NULL; \
(delegate)->referenceCount = 1U; \
(delegate)->retain = NULL; \
(delegate)->release = NULL; \
(delegate)->growlIsReady = NULL; \
(delegate)->growlNotificationWasClicked = NULL; \
(delegate)->growlNotificationTimedOut = NULL; \
} \
} while(0)
/*! @defined InitGrowlNotification
* @abstract Callable macro. Initializes a Growl notification structure to defaults.
* @discussion Call with a pointer to a struct Growl_Notification. All of
* the members of the structure will be set to 0 or NULL, except
* for size (which will be set to
* sizeof(struct Growl_Notification)).
*/
#define InitGrowlNotification(notification) \
do { \
if (notification) { \
(notification)->size = sizeof(struct Growl_Notification); \
(notification)->name = NULL; \
(notification)->title = NULL; \
(notification)->description = NULL; \
(notification)->iconData = NULL; \
(notification)->priority = 0; \
(notification)->reserved = 0U; \
(notification)->isSticky = false; \
(notification)->clickContext = NULL; \
} \
} while(0)
#pragma mark -
#pragma mark Public API
// @functiongroup Managing the Growl delegate
/*! @function Growl_SetDelegate
* @abstract Replaces the current Growl delegate with a new one, or removes
* the Growl delegate.
* @param newDelegate
* @result Returns false and does nothing else if a pointer that was passed in
* is unsatisfactory (because it is non-NULL, but at least one
* required member of it is NULL). Otherwise, sets or unsets the
* delegate and returns true.
* @discussion When newDelegate is non-NULL, sets
* the delegate to newDelegate. When it is NULL,
* the current delegate will be unset, and no delegate will be in place.
*
* It is legal for newDelegate to be the current delegate;
* nothing will happen, and Growl_SetDelegate will return true. It is also
* legal for it to be NULL, as described above; again, it will
* return true.
*
* If there was a delegate in place before the call, Growl_SetDelegate will
* call the old delegate's release member if it was non-NULL. If
* newDelegate is non-NULL, Growl_SetDelegate will
* call newDelegate->retain, and set the delegate to its return
* value.
*
* If you are using Growl-WithInstaller.framework, and an older version of
* Growl is installed on the user's system, the user will automatically be
* prompted to update.
*
* GrowlApplicationBridge currently does not copy this structure, nor does it
* retain any of the CF objects in the structure (it regards the structure as
* a container that retains the objects when they are added and releases them
* when they are removed or the structure is destroyed). Also,
* GrowlApplicationBridge currently does not modify any member of the
* structure, except possibly the referenceCount by calling the retain and
* release members.
*/
Boolean Growl_SetDelegate(struct Growl_Delegate *newDelegate);
/*! @function Growl_GetDelegate
* @abstract Returns the current Growl delegate, if any.
* @result The current Growl delegate.
* @discussion Returns the last pointer passed into Growl_SetDelegate, or
* NULL if no such call has been made.
*
* This function follows standard Core Foundation reference-counting rules.
* Because it is a Get function, not a Copy function, it will not retain the
* delegate on your behalf. You are responsible for retaining and releasing
* the delegate as needed.
*/
struct Growl_Delegate *Growl_GetDelegate(void);
#pragma mark -
// @functiongroup Posting Growl notifications
/*! @function Growl_PostNotification
* @abstract Posts a Growl notification.
* @param notification The notification to post.
* @discussion This is the preferred means for sending a Growl notification.
* The notification name and at least one of the title and description are
* required (all three are preferred). All other parameters may be
* NULL (or 0 or false as appropriate) to accept default values.
*
* If using the Growl-WithInstaller framework, if Growl is not installed the
* user will be prompted to install Growl.
* If the user cancels, this function will have no effect until the next
* application session, at which time when it is called the user will be
* prompted again. The user is also given the option to not be prompted again.
* If the user does choose to install Growl, the requested notification will
* be displayed once Growl is installed and running.
*/
void Growl_PostNotification(const struct Growl_Notification *notification);
/*! @function Growl_PostNotificationWithDictionary
* @abstract Notifies using a userInfo dictionary suitable for passing to
* CFDistributedNotificationCenter.
* @param userInfo The dictionary to notify with.
* @discussion Before Growl 0.6, your application would have posted
* notifications using CFDistributedNotificationCenter by creating a userInfo
* dictionary with the notification data. This had the advantage of allowing
* you to add other data to the dictionary for programs besides Growl that
* might be listening.
*
* This function allows you to use such dictionaries without being restricted
* to using CFDistributedNotificationCenter. The keys for this dictionary
* can be found in GrowlDefines.h.
*/
void Growl_PostNotificationWithDictionary(CFDictionaryRef userInfo);
/*! @function Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext
* @abstract Posts a Growl notification using parameter values.
* @param title The title of the notification.
* @param description The description of the notification.
* @param notificationName The name of the notification as listed in the
* registration dictionary.
* @param iconData Data representing a notification icon. Can be NULL.
* @param priority The priority of the notification (-2 to +2, with -2
* being Very Low and +2 being Very High).
* @param isSticky If true, requests that this notification wait for a
* response from the user.
* @param clickContext An object to pass to the clickCallback, if any. Can
* be NULL, in which case the clickCallback is not called.
* @discussion Creates a temporary Growl_Notification, fills it out with the
* supplied information, and calls Growl_PostNotification on it.
* See struct Growl_Notification and Growl_PostNotification for more
* information.
*
* The icon data can be in any format supported by NSImage. As of Mac OS X
* 10.3, this includes the .icns, TIFF, JPEG, GIF, PNG, PDF, and PICT formats.
*/
void Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext(
/*inhale*/
CFStringRef title,
CFStringRef description,
CFStringRef notificationName,
CFDataRef iconData,
signed int priority,
Boolean isSticky,
CFPropertyListRef clickContext);
#pragma mark -
// @functiongroup Registering
/*! @function Growl_RegisterWithDictionary
* @abstract Register your application with Growl without setting a delegate.
* @discussion When you call this function with a dictionary,
* GrowlApplicationBridge registers your application using that dictionary.
* If you pass NULL, GrowlApplicationBridge will ask the delegate
* (if there is one) for a dictionary, and if that doesn't work, it will look
* in your application's bundle for an auto-discoverable plist.
* (XXX refer to more information on that)
*
* If you pass a dictionary to this function, it must include the
* GROWL_APP_NAME key, unless a delegate is set.
*
* This function is mainly an alternative to the delegate system introduced
* with Growl 0.6. Without a delegate, you cannot receive callbacks such as
* growlIsReady (since they are sent to the delegate). You can,
* however, set a delegate after registering without one.
*
* This function was introduced in Growl.framework 0.7.
* @result false if registration failed (e.g. if Growl isn't installed).
*/
Boolean Growl_RegisterWithDictionary(CFDictionaryRef regDict);
/*! @function Growl_Reregister
* @abstract Updates your registration with Growl.
* @discussion If your application changes the contents of the
* GROWL_NOTIFICATIONS_ALL key in the registrationDictionary member of the
* Growl delegate, or if it changes the value of that member, or if it
* changes the contents of its auto-discoverable plist, call this function
* to have Growl update its registration information for your application.
*
* Otherwise, this function does not normally need to be called. If you're
* using a delegate, your application will be registered when you set the
* delegate if both the delegate and its registrationDictionary member are
* non-NULL.
*
* This function is now implemented using
* Growl_RegisterWithDictionary.
*/
void Growl_Reregister(void);
#pragma mark -
/*! @function Growl_SetWillRegisterWhenGrowlIsReady
* @abstract Tells GrowlApplicationBridge to register with Growl when Growl
* launches (or not).
* @discussion When Growl has started listening for notifications, it posts a
* GROWL_IS_READY notification on the Distributed Notification
* Center. GrowlApplicationBridge listens for this notification, using it to
* perform various tasks (such as calling your delegate's
* growlIsReady callback, if it has one). If this function is
* called with true, one of those tasks will be to reregister
* with Growl (in the manner of Growl_Reregister).
*
* This attribute is automatically set back to false
* (the default) after every GROWL_IS_READY notification.
* @param flag true if you want GrowlApplicationBridge to register with
* Growl when next it is ready; false if not.
*/
void Growl_SetWillRegisterWhenGrowlIsReady(Boolean flag);
/*! @function Growl_WillRegisterWhenGrowlIsReady
* @abstract Reports whether GrowlApplicationBridge will register with Growl
* when Growl next launches.
* @result true if GrowlApplicationBridge will register with
* Growl when next it posts GROWL_IS_READY; false if not.
*/
Boolean Growl_WillRegisterWhenGrowlIsReady(void);
#pragma mark -
// @functiongroup Obtaining registration dictionaries
/*! @function Growl_CopyRegistrationDictionaryFromDelegate
* @abstract Asks the delegate for a registration dictionary.
* @discussion If no delegate is set, or if the delegate's
* registrationDictionary member is NULL, this
* function returns NULL.
*
* This function does not attempt to clean up the dictionary in any way - for
* example, if it is missing the GROWL_APP_NAME key, the result
* will be missing it too. Use
* Growl_CreateRegistrationDictionaryByFillingInDictionary: or
* Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys
* to try to fill in missing keys.
*
* This function was introduced in Growl.framework 0.7.
* @result A registration dictionary.
*/
CFDictionaryRef Growl_CopyRegistrationDictionaryFromDelegate(void);
/*! @function Growl_CopyRegistrationDictionaryFromBundle
* @abstract Looks in a bundle for a registration dictionary.
* @discussion This function looks in a bundle for an auto-discoverable
* registration dictionary file using CFBundleCopyResourceURL.
* If it finds one, it loads the file using CFPropertyList and
* returns the result.
*
* If you pass NULL as the bundle, the main bundle is examined.
*
* This function does not attempt to clean up the dictionary in any way - for
* example, if it is missing the GROWL_APP_NAME key, the result
* will be missing it too. Use
* Growl_CreateRegistrationDictionaryByFillingInDictionary: or
* Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys
* to try to fill in missing keys.
*
* This function was introduced in Growl.framework 0.7.
* @result A registration dictionary.
*/
CFDictionaryRef Growl_CopyRegistrationDictionaryFromBundle(CFBundleRef bundle);
/*! @function Growl_CreateBestRegistrationDictionary
* @abstract Obtains a registration dictionary, filled out to the best of
* GrowlApplicationBridge's knowledge.
* @discussion This function creates a registration dictionary as best
* GrowlApplicationBridge knows how.
*
* First, GrowlApplicationBridge examines the Growl delegate (if there is
* one) and gets the registration dictionary from that. If no such dictionary
* was obtained, GrowlApplicationBridge looks in your application's main
* bundle for an auto-discoverable registration dictionary file. If that
* doesn't exist either, this function returns NULL.
*
* Second, GrowlApplicationBridge calls
* Growl_CreateRegistrationDictionaryByFillingInDictionary with
* whatever dictionary was obtained. The result of that function is the
* result of this function.
*
* GrowlApplicationBridge uses this function when you call
* Growl_SetDelegate, or when you call
* Growl_RegisterWithDictionary with NULL.
*
* This function was introduced in Growl.framework 0.7.
* @result A registration dictionary.
*/
CFDictionaryRef Growl_CreateBestRegistrationDictionary(void);
#pragma mark -
// @functiongroup Filling in registration dictionaries
/*! @function Growl_CreateRegistrationDictionaryByFillingInDictionary
* @abstract Tries to fill in missing keys in a registration dictionary.
* @param regDict The dictionary to fill in.
* @result The dictionary with the keys filled in.
* @discussion This function examines the passed-in dictionary for missing keys,
* and tries to work out correct values for them. As of 0.7, it uses:
*
* Key Value
* --- -----
* GROWL_APP_NAME CFBundleExecutableName
* GROWL_APP_ICON The icon of the application.
* GROWL_APP_LOCATION The location of the application.
* GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL
*
* Keys are only filled in if missing; if a key is present in the dictionary,
* its value will not be changed.
*
* This function was introduced in Growl.framework 0.7.
*/
CFDictionaryRef Growl_CreateRegistrationDictionaryByFillingInDictionary(CFDictionaryRef regDict);
/*! @function Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys
* @abstract Tries to fill in missing keys in a registration dictionary.
* @param regDict The dictionary to fill in.
* @param keys The keys to fill in. If NULL, any missing keys are filled in.
* @result The dictionary with the keys filled in.
* @discussion This function examines the passed-in dictionary for missing keys,
* and tries to work out correct values for them. As of 0.7, it uses:
*
* Key Value
* --- -----
* GROWL_APP_NAME CFBundleExecutableName
* GROWL_APP_ICON The icon of the application.
* GROWL_APP_LOCATION The location of the application.
* GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL
*
* Only those keys that are listed in keys will be filled in.
* Other missing keys are ignored. Also, keys are only filled in if missing;
* if a key is present in the dictionary, its value will not be changed.
*
* This function was introduced in Growl.framework 0.7.
*/
CFDictionaryRef Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys(CFDictionaryRef regDict, CFSetRef keys);
#pragma mark -
// @functiongroup Querying Growl's status
/*! @function Growl_IsInstalled
* @abstract Determines whether the Growl prefpane and its helper app are
* installed.
* @result Returns true if Growl is installed, false otherwise.
*/
Boolean Growl_IsInstalled(void);
/*! @function Growl_IsRunning
* @abstract Cycles through the process list to find whether GrowlHelperApp
* is running.
* @result Returns true if Growl is running, false otherwise.
*/
Boolean Growl_IsRunning(void);
#pragma mark -
// @functiongroup Launching Growl
/*! @typedef GrowlLaunchCallback
* @abstract Callback to notify you that Growl is running.
* @param context The context pointer passed to Growl_LaunchIfInstalled.
* @discussion Growl_LaunchIfInstalled calls this callback function if Growl
* was already running or if it launched Growl successfully.
*/
typedef void (*GrowlLaunchCallback)(void *context);
/*! @function Growl_LaunchIfInstalled
* @abstract Launches GrowlHelperApp if it is not already running.
* @param callback A callback function which will be called if Growl was successfully
* launched or was already running. Can be NULL.
* @param context The context pointer to pass to the callback. Can be NULL.
* @result Returns true if Growl was successfully launched or was already
* running; returns false and does not call the callback otherwise.
* @discussion Returns true and calls the callback (if the callback is not
* NULL) if the Growl helper app began launching or was already
* running. Returns false and performs no other action if Growl could not be
* launched (e.g. because the Growl preference pane is not properly installed).
*
* If Growl_CreateBestRegistrationDictionary returns
* non-NULL, this function will register with Growl atomically.
*
* The callback should take a single argument; this is to allow applications
* to have context-relevant information passed back. It is perfectly
* acceptable for context to be NULL. The callback itself can be
* NULL if you don't want one.
*/
Boolean Growl_LaunchIfInstalled(GrowlLaunchCallback callback, void *context);
#pragma mark -
#pragma mark Constants
/*! @defined GROWL_PREFPANE_BUNDLE_IDENTIFIER
* @abstract The CFBundleIdentifier of the Growl preference pane bundle.
* @discussion GrowlApplicationBridge uses this to determine whether Growl is
* currently installed, by searching for the Growl preference pane. Your
* application probably does not need to use this macro itself.
*/
#ifndef GROWL_PREFPANE_BUNDLE_IDENTIFIER
#define GROWL_PREFPANE_BUNDLE_IDENTIFIER CFSTR("com.growl.prefpanel")
#endif
__END_DECLS
#endif /* _GROWLAPPLICATIONBRIDGE_CARBON_H_ */
unison-2.40.102/uimacnew/Growl.framework/Versions/A/Headers/GrowlApplicationBridge.h 0000644 0061316 0061316 00000063174 11361646373 030427 0 ustar bcpierce bcpierce //
// GrowlApplicationBridge.h
// Growl
//
// Created by Evan Schoenberg on Wed Jun 16 2004.
// Copyright 2004-2005 The Growl Project. All rights reserved.
//
/*!
* @header GrowlApplicationBridge.h
* @abstract Defines the GrowlApplicationBridge class.
* @discussion This header defines the GrowlApplicationBridge class as well as
* the GROWL_PREFPANE_BUNDLE_IDENTIFIER constant.
*/
#ifndef __GrowlApplicationBridge_h__
#define __GrowlApplicationBridge_h__
#import
#import "GrowlDefines.h"
//Forward declarations
@protocol GrowlApplicationBridgeDelegate;
/*!
* @defined GROWL_PREFPANE_BUNDLE_IDENTIFIER
* @discussion The bundle identifier for the Growl prefpane.
*/
#define GROWL_PREFPANE_BUNDLE_IDENTIFIER @"com.growl.prefpanel"
/*!
* @defined GROWL_PREFPANE_NAME
* @discussion The file name of the Growl prefpane.
*/
#define GROWL_PREFPANE_NAME @"Growl.prefPane"
//Internal notification when the user chooses not to install (to avoid continuing to cache notifications awaiting installation)
#define GROWL_USER_CHOSE_NOT_TO_INSTALL_NOTIFICATION @"User chose not to install"
//------------------------------------------------------------------------------
#pragma mark -
/*!
* @class GrowlApplicationBridge
* @abstract A class used to interface with Growl.
* @discussion This class provides a means to interface with Growl.
*
* Currently it provides a way to detect if Growl is installed and launch the
* GrowlHelperApp if it's not already running.
*/
@interface GrowlApplicationBridge : NSObject {
}
/*!
* @method isGrowlInstalled
* @abstract Detects whether Growl is installed.
* @discussion Determines if the Growl prefpane and its helper app are installed.
* @result Returns YES if Growl is installed, NO otherwise.
*/
+ (BOOL) isGrowlInstalled;
/*!
* @method isGrowlRunning
* @abstract Detects whether GrowlHelperApp is currently running.
* @discussion Cycles through the process list to find whether GrowlHelperApp is running and returns its findings.
* @result Returns YES if GrowlHelperApp is running, NO otherwise.
*/
+ (BOOL) isGrowlRunning;
#pragma mark -
/*!
* @method setGrowlDelegate:
* @abstract Set the object which will be responsible for providing and receiving Growl information.
* @discussion This must be called before using GrowlApplicationBridge.
*
* The methods in the GrowlApplicationBridgeDelegate protocol are required
* and return the basic information needed to register with Growl.
*
* The methods in the GrowlApplicationBridgeDelegate_InformalProtocol
* informal protocol are individually optional. They provide a greater
* degree of interaction between the application and growl such as informing
* the application when one of its Growl notifications is clicked by the user.
*
* The methods in the GrowlApplicationBridgeDelegate_Installation_InformalProtocol
* informal protocol are individually optional and are only applicable when
* using the Growl-WithInstaller.framework which allows for automated Growl
* installation.
*
* When this method is called, data will be collected from inDelegate, Growl
* will be launched if it is not already running, and the application will be
* registered with Growl.
*
* If using the Growl-WithInstaller framework, if Growl is already installed
* but this copy of the framework has an updated version of Growl, the user
* will be prompted to update automatically.
*
* @param inDelegate The delegate for the GrowlApplicationBridge. It must conform to the GrowlApplicationBridgeDelegate protocol.
*/
+ (void) setGrowlDelegate:(NSObject *)inDelegate;
/*!
* @method growlDelegate
* @abstract Return the object responsible for providing and receiving Growl information.
* @discussion See setGrowlDelegate: for details.
* @result The Growl delegate.
*/
+ (NSObject *) growlDelegate;
#pragma mark -
/*!
* @method notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:
* @abstract Send a Growl notification.
* @discussion This is the preferred means for sending a Growl notification.
* The notification name and at least one of the title and description are
* required (all three are preferred). All other parameters may be
* nil (or 0 or NO as appropriate) to accept default values.
*
* If using the Growl-WithInstaller framework, if Growl is not installed the
* user will be prompted to install Growl. If the user cancels, this method
* will have no effect until the next application session, at which time when
* it is called the user will be prompted again. The user is also given the
* option to not be prompted again. If the user does choose to install Growl,
* the requested notification will be displayed once Growl is installed and
* running.
*
* @param title The title of the notification displayed to the user.
* @param description The full description of the notification displayed to the user.
* @param notifName The internal name of the notification. Should be human-readable, as it will be displayed in the Growl preference pane.
* @param iconData NSData object to show with the notification as its icon. If nil, the application's icon will be used instead.
* @param priority The priority of the notification. The default value is 0; positive values are higher priority and negative values are lower priority. Not all Growl displays support priority.
* @param isSticky If YES, the notification will remain on screen until clicked. Not all Growl displays support sticky notifications.
* @param clickContext A context passed back to the Growl delegate if it implements -(void)growlNotificationWasClicked: and the notification is clicked. Not all display plugins support clicking. The clickContext must be plist-encodable (completely of NSString, NSArray, NSNumber, NSDictionary, and NSData types).
*/
+ (void) notifyWithTitle:(NSString *)title
description:(NSString *)description
notificationName:(NSString *)notifName
iconData:(NSData *)iconData
priority:(signed int)priority
isSticky:(BOOL)isSticky
clickContext:(id)clickContext;
/*!
* @method notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:identifier:
* @abstract Send a Growl notification.
* @discussion This is the preferred means for sending a Growl notification.
* The notification name and at least one of the title and description are
* required (all three are preferred). All other parameters may be
* nil (or 0 or NO as appropriate) to accept default values.
*
* If using the Growl-WithInstaller framework, if Growl is not installed the
* user will be prompted to install Growl. If the user cancels, this method
* will have no effect until the next application session, at which time when
* it is called the user will be prompted again. The user is also given the
* option to not be prompted again. If the user does choose to install Growl,
* the requested notification will be displayed once Growl is installed and
* running.
*
* @param title The title of the notification displayed to the user.
* @param description The full description of the notification displayed to the user.
* @param notifName The internal name of the notification. Should be human-readable, as it will be displayed in the Growl preference pane.
* @param iconData NSData object to show with the notification as its icon. If nil, the application's icon will be used instead.
* @param priority The priority of the notification. The default value is 0; positive values are higher priority and negative values are lower priority. Not all Growl displays support priority.
* @param isSticky If YES, the notification will remain on screen until clicked. Not all Growl displays support sticky notifications.
* @param clickContext A context passed back to the Growl delegate if it implements -(void)growlNotificationWasClicked: and the notification is clicked. Not all display plugins support clicking. The clickContext must be plist-encodable (completely of NSString, NSArray, NSNumber, NSDictionary, and NSData types).
* @param identifier An identifier for this notification. Notifications with equal identifiers are coalesced.
*/
+ (void) notifyWithTitle:(NSString *)title
description:(NSString *)description
notificationName:(NSString *)notifName
iconData:(NSData *)iconData
priority:(signed int)priority
isSticky:(BOOL)isSticky
clickContext:(id)clickContext
identifier:(NSString *)identifier;
/*! @method notifyWithDictionary:
* @abstract Notifies using a userInfo dictionary suitable for passing to
* NSDistributedNotificationCenter.
* @param userInfo The dictionary to notify with.
* @discussion Before Growl 0.6, your application would have posted
* notifications using NSDistributedNotificationCenter by
* creating a userInfo dictionary with the notification data. This had the
* advantage of allowing you to add other data to the dictionary for programs
* besides Growl that might be listening.
*
* This method allows you to use such dictionaries without being restricted
* to using NSDistributedNotificationCenter. The keys for this dictionary
* can be found in GrowlDefines.h.
*/
+ (void) notifyWithDictionary:(NSDictionary *)userInfo;
#pragma mark -
/*! @method registerWithDictionary:
* @abstract Register your application with Growl without setting a delegate.
* @discussion When you call this method with a dictionary,
* GrowlApplicationBridge registers your application using that dictionary.
* If you pass nil, GrowlApplicationBridge will ask the delegate
* (if there is one) for a dictionary, and if that doesn't work, it will look
* in your application's bundle for an auto-discoverable plist.
* (XXX refer to more information on that)
*
* If you pass a dictionary to this method, it must include the
* GROWL_APP_NAME key, unless a delegate is set.
*
* This method is mainly an alternative to the delegate system introduced
* with Growl 0.6. Without a delegate, you cannot receive callbacks such as
* -growlIsReady (since they are sent to the delegate). You can,
* however, set a delegate after registering without one.
*
* This method was introduced in Growl.framework 0.7.
*/
+ (BOOL) registerWithDictionary:(NSDictionary *)regDict;
/*! @method reregisterGrowlNotifications
* @abstract Reregister the notifications for this application.
* @discussion This method does not normally need to be called. If your
* application changes what notifications it is registering with Growl, call
* this method to have the Growl delegate's
* -registrationDictionaryForGrowl method called again and the
* Growl registration information updated.
*
* This method is now implemented using -registerWithDictionary:.
*/
+ (void) reregisterGrowlNotifications;
#pragma mark -
/*! @method setWillRegisterWhenGrowlIsReady:
* @abstract Tells GrowlApplicationBridge to register with Growl when Growl
* launches (or not).
* @discussion When Growl has started listening for notifications, it posts a
* GROWL_IS_READY notification on the Distributed Notification
* Center. GrowlApplicationBridge listens for this notification, using it to
* perform various tasks (such as calling your delegate's
* -growlIsReady method, if it has one). If this method is
* called with YES, one of those tasks will be to reregister
* with Growl (in the manner of -reregisterGrowlNotifications).
*
* This attribute is automatically set back to NO (the default)
* after every GROWL_IS_READY notification.
* @param flag YES if you want GrowlApplicationBridge to register with
* Growl when next it is ready; NO if not.
*/
+ (void) setWillRegisterWhenGrowlIsReady:(BOOL)flag;
/*! @method willRegisterWhenGrowlIsReady
* @abstract Reports whether GrowlApplicationBridge will register with Growl
* when Growl next launches.
* @result YES if GrowlApplicationBridge will register with Growl
* when next it posts GROWL_IS_READY; NO if not.
*/
+ (BOOL) willRegisterWhenGrowlIsReady;
#pragma mark -
/*! @method registrationDictionaryFromDelegate
* @abstract Asks the delegate for a registration dictionary.
* @discussion If no delegate is set, or if the delegate's
* -registrationDictionaryForGrowl method returns
* nil, this method returns nil.
*
* This method does not attempt to clean up the dictionary in any way - for
* example, if it is missing the GROWL_APP_NAME key, the result
* will be missing it too. Use +[GrowlApplicationBridge
* registrationDictionaryByFillingInDictionary:] or
* +[GrowlApplicationBridge
* registrationDictionaryByFillingInDictionary:restrictToKeys:] to try
* to fill in missing keys.
*
* This method was introduced in Growl.framework 0.7.
* @result A registration dictionary.
*/
+ (NSDictionary *) registrationDictionaryFromDelegate;
/*! @method registrationDictionaryFromBundle:
* @abstract Looks in a bundle for a registration dictionary.
* @discussion This method looks in a bundle for an auto-discoverable
* registration dictionary file using -[NSBundle
* pathForResource:ofType:]. If it finds one, it loads the file using
* +[NSDictionary dictionaryWithContentsOfFile:] and returns the
* result.
*
* If you pass nil as the bundle, the main bundle is examined.
*
* This method does not attempt to clean up the dictionary in any way - for
* example, if it is missing the GROWL_APP_NAME key, the result
* will be missing it too. Use +[GrowlApplicationBridge
* registrationDictionaryByFillingInDictionary:] or
* +[GrowlApplicationBridge
* registrationDictionaryByFillingInDictionary:restrictToKeys:] to try
* to fill in missing keys.
*
* This method was introduced in Growl.framework 0.7.
* @result A registration dictionary.
*/
+ (NSDictionary *) registrationDictionaryFromBundle:(NSBundle *)bundle;
/*! @method bestRegistrationDictionary
* @abstract Obtains a registration dictionary, filled out to the best of
* GrowlApplicationBridge's knowledge.
* @discussion This method creates a registration dictionary as best
* GrowlApplicationBridge knows how.
*
* First, GrowlApplicationBridge contacts the Growl delegate (if there is
* one) and gets the registration dictionary from that. If no such dictionary
* was obtained, GrowlApplicationBridge looks in your application's main
* bundle for an auto-discoverable registration dictionary file. If that
* doesn't exist either, this method returns nil.
*
* Second, GrowlApplicationBridge calls
* +registrationDictionaryByFillingInDictionary: with whatever
* dictionary was obtained. The result of that method is the result of this
* method.
*
* GrowlApplicationBridge uses this method when you call
* +setGrowlDelegate:, or when you call
* +registerWithDictionary: with nil.
*
* This method was introduced in Growl.framework 0.7.
* @result A registration dictionary.
*/
+ (NSDictionary *) bestRegistrationDictionary;
#pragma mark -
/*! @method registrationDictionaryByFillingInDictionary:
* @abstract Tries to fill in missing keys in a registration dictionary.
* @discussion This method examines the passed-in dictionary for missing keys,
* and tries to work out correct values for them. As of 0.7, it uses:
*
* Key Value
* --- -----
* GROWL_APP_NAME CFBundleExecutableName
* GROWL_APP_ICON The icon of the application.
* GROWL_APP_LOCATION The location of the application.
* GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL
*
* Keys are only filled in if missing; if a key is present in the dictionary,
* its value will not be changed.
*
* This method was introduced in Growl.framework 0.7.
* @param regDict The dictionary to fill in.
* @result The dictionary with the keys filled in. This is an autoreleased
* copy of regDict.
*/
+ (NSDictionary *) registrationDictionaryByFillingInDictionary:(NSDictionary *)regDict;
/*! @method registrationDictionaryByFillingInDictionary:restrictToKeys:
* @abstract Tries to fill in missing keys in a registration dictionary.
* @discussion This method examines the passed-in dictionary for missing keys,
* and tries to work out correct values for them. As of 0.7, it uses:
*
* Key Value
* --- -----
* GROWL_APP_NAME CFBundleExecutableName
* GROWL_APP_ICON The icon of the application.
* GROWL_APP_LOCATION The location of the application.
* GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL
*
* Only those keys that are listed in keys will be filled in.
* Other missing keys are ignored. Also, keys are only filled in if missing;
* if a key is present in the dictionary, its value will not be changed.
*
* This method was introduced in Growl.framework 0.7.
* @param regDict The dictionary to fill in.
* @param keys The keys to fill in. If nil, any missing keys are filled in.
* @result The dictionary with the keys filled in. This is an autoreleased
* copy of regDict.
*/
+ (NSDictionary *) registrationDictionaryByFillingInDictionary:(NSDictionary *)regDict restrictToKeys:(NSSet *)keys;
@end
//------------------------------------------------------------------------------
#pragma mark -
/*!
* @protocol GrowlApplicationBridgeDelegate
* @abstract Required protocol for the Growl delegate.
* @discussion The methods in this protocol are required and are called
* automatically as needed by GrowlApplicationBridge. See
* +[GrowlApplicationBridge setGrowlDelegate:].
* See also GrowlApplicationBridgeDelegate_InformalProtocol.
*/
@protocol GrowlApplicationBridgeDelegate
// -registrationDictionaryForGrowl has moved to the informal protocol as of 0.7.
@end
//------------------------------------------------------------------------------
#pragma mark -
/*!
* @category NSObject(GrowlApplicationBridgeDelegate_InformalProtocol)
* @abstract Methods which may be optionally implemented by the GrowlDelegate.
* @discussion The methods in this informal protocol will only be called if implemented by the delegate.
*/
@interface NSObject (GrowlApplicationBridgeDelegate_InformalProtocol)
/*!
* @method registrationDictionaryForGrowl
* @abstract Return the dictionary used to register this application with Growl.
* @discussion The returned dictionary gives Growl the complete list of
* notifications this application will ever send, and it also specifies which
* notifications should be enabled by default. Each is specified by an array
* of NSString objects.
*
* For most applications, these two arrays can be the same (if all sent
* notifications should be displayed by default).
*
* The NSString objects of these arrays will correspond to the
* notificationName: parameter passed in
* +[GrowlApplicationBridge
* notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:] calls.
*
* The dictionary should have 2 key object pairs:
* key: GROWL_NOTIFICATIONS_ALL object: NSArray of NSString objects
* key: GROWL_NOTIFICATIONS_DEFAULT object: NSArray of NSString objects
*
* You do not need to implement this method if you have an auto-discoverable
* plist file in your app bundle. (XXX refer to more information on that)
*
* @result The NSDictionary to use for registration.
*/
- (NSDictionary *) registrationDictionaryForGrowl;
/*!
* @method applicationNameForGrowl
* @abstract Return the name of this application which will be used for Growl bookkeeping.
* @discussion This name is used both internally and in the Growl preferences.
*
* This should remain stable between different versions and incarnations of
* your application.
* For example, "SurfWriter" is a good app name, whereas "SurfWriter 2.0" and
* "SurfWriter Lite" are not.
*
* You do not need to implement this method if you are providing the
* application name elsewhere, meaning in an auto-discoverable plist file in
* your app bundle (XXX refer to more information on that) or in the result
* of -registrationDictionaryForGrowl.
*
* @result The name of the application using Growl.
*/
- (NSString *) applicationNameForGrowl;
/*!
* @method applicationIconDataForGrowl
* @abstract Return the NSData to treat as the application icon.
* @discussion The delegate may optionally return an NSData
* object to use as the application icon; if this is not implemented, the
* application's own icon is used. This is not generally needed.
* @result The NSData to treat as the application icon.
*/
- (NSData *) applicationIconDataForGrowl;
/*!
* @method growlIsReady
* @abstract Informs the delegate that Growl has launched.
* @discussion Informs the delegate that Growl (specifically, the
* GrowlHelperApp) was launched successfully or was already running. The
* application can take actions with the knowledge that Growl is installed and
* functional.
*/
- (void) growlIsReady;
/*!
* @method growlNotificationWasClicked:
* @abstract Informs the delegate that a Growl notification was clicked.
* @discussion Informs the delegate that a Growl notification was clicked. It
* is only sent for notifications sent with a non-nil
* clickContext, so if you want to receive a message when a notification is
* clicked, clickContext must not be nil when calling
* +[GrowlApplicationBridge notifyWithTitle: description:notificationName:iconData:priority:isSticky:clickContext:].
* @param clickContext The clickContext passed when displaying the notification originally via +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:].
*/
- (void) growlNotificationWasClicked:(id)clickContext;
/*!
* @method growlNotificationTimedOut:
* @abstract Informs the delegate that a Growl notification timed out.
* @discussion Informs the delegate that a Growl notification timed out. It
* is only sent for notifications sent with a non-nil
* clickContext, so if you want to receive a message when a notification is
* clicked, clickContext must not be nil when calling
* +[GrowlApplicationBridge notifyWithTitle: description:notificationName:iconData:priority:isSticky:clickContext:].
* @param clickContext The clickContext passed when displaying the notification originally via +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:].
*/
- (void) growlNotificationTimedOut:(id)clickContext;
@end
#pragma mark -
/*!
* @category NSObject(GrowlApplicationBridgeDelegate_Installation_InformalProtocol)
* @abstract Methods which may be optionally implemented by the Growl delegate when used with Growl-WithInstaller.framework.
* @discussion The methods in this informal protocol will only be called if
* implemented by the delegate. They allow greater control of the information
* presented to the user when installing or upgrading Growl from within your
* application when using Growl-WithInstaller.framework.
*/
@interface NSObject (GrowlApplicationBridgeDelegate_Installation_InformalProtocol)
/*!
* @method growlInstallationWindowTitle
* @abstract Return the title of the installation window.
* @discussion If not implemented, Growl will use a default, localized title.
* @result An NSString object to use as the title.
*/
- (NSString *)growlInstallationWindowTitle;
/*!
* @method growlUpdateWindowTitle
* @abstract Return the title of the upgrade window.
* @discussion If not implemented, Growl will use a default, localized title.
* @result An NSString object to use as the title.
*/
- (NSString *)growlUpdateWindowTitle;
/*!
* @method growlInstallationInformation
* @abstract Return the information to display when installing.
* @discussion This information may be as long or short as desired (the window
* will be sized to fit it). It will be displayed to the user as an
* explanation of what Growl is and what it can do in your application. It
* should probably note that no download is required to install.
*
* If this is not implemented, Growl will use a default, localized explanation.
* @result An NSAttributedString object to display.
*/
- (NSAttributedString *)growlInstallationInformation;
/*!
* @method growlUpdateInformation
* @abstract Return the information to display when upgrading.
* @discussion This information may be as long or short as desired (the window
* will be sized to fit it). It will be displayed to the user as an
* explanation that an updated version of Growl is included in your
* application and no download is required.
*
* If this is not implemented, Growl will use a default, localized explanation.
* @result An NSAttributedString object to display.
*/
- (NSAttributedString *)growlUpdateInformation;
@end
//private
@interface GrowlApplicationBridge (GrowlInstallationPrompt_private)
+ (void) _userChoseNotToInstallGrowl;
@end
#endif /* __GrowlApplicationBridge_h__ */
unison-2.40.102/uimacnew/Growl.framework/Versions/A/Headers/Growl.h 0000644 0061316 0061316 00000000202 11361646373 025105 0 ustar bcpierce bcpierce #include "GrowlDefines.h"
#ifdef __OBJC__
# include "GrowlApplicationBridge.h"
#endif
#include "GrowlApplicationBridge-Carbon.h"
unison-2.40.102/uimacnew/Growl.framework/Versions/A/Growl 0000755 0061316 0061316 00000420224 11361646373 023321 0 ustar bcpierce bcpierce x l __TEXT __text __TEXT O __picsymbol_stub__TEXT h4 h4 $__picsymbolstub1__TEXT h@ h@ __cstring __TEXT v@ )p v@ __literal4 __TEXT __const __TEXT __DATA __data __DATA __dyld __DATA __nl_symbol_ptr __DATA $ $ p __la_symbol_ptr __DATA @ @ w __const __DATA __bss __DATA , __OBJC __cat_cls_meth __OBJC , __cat_inst_meth __OBJC , t , __string_object __OBJC __cstring_object__OBJC __message_refs __OBJC __sel_fixup __OBJC ` ` __cls_refs __OBJC ` H ` __class __OBJC __meta_class __OBJC 8 8 __cls_meth __OBJC ` __inst_meth __OBJC ( \ ( __protocol __OBJC ( __category __OBJC ( __class_vars __OBJC __instance_vars __OBJC ( __module_info __OBJC P __symbols __OBJC L P L 8__LINKEDIT Hx Hx
X C @executable_path/../Frameworks/Growl.framework/Versions/A/Growl p C7q /System/Library/Frameworks/ApplicationServices.framework/Versions/A/ApplicationServices X C7q /System/Library/Frameworks/Carbon.framework/Versions/A/Carbon X C7q8! - /System/Library/Frameworks/AppKit.framework/Versions/C/AppKit ` C7q7 , /System/Library/Frameworks/Foundation.framework/Versions/C/Foundation 4 CF /usr/lib/libobjc.A.dylib 4 CF X /usr/lib/libSystem.B.dylib libobjc x d P N N ! o 0 ! 8 l < O |B }|}cx= l}| x= PN }cxK|B }h|=k k8}iN | !B < 8c],8 8K 8/ A < c}N!8! ` |N |B }= |9}N |< |{x (;0;0hcH O;ޗ, |zxw H O xH O< 4w cxH O |xxy H O}< x8cxH Oi H Oa/ y @ < < 8c8H O!? >? ;l:їD>_ } > > > H O< x<cxH O H N< Ɨ@< ex} 8爨9 CxH N< < HcH N< LH NP|~xrH N < T= 89xH N< \|}xXw H Ni/ A (< CxƗ`exx9 H NAH < Cxexdx8 H N!? xhH NPrH NT< Бh= 8x9H M< \|}xlopH M/ A (< DCxƗpexx9 H MH < Cxexdx8 H MhxH My< cxtxH Me <_ 8Bt8! b |N ;Z4;9:` ? y ;LH L
< |}x< ,cH K< 0H K逗 |exxH Kـ |}x< cH Kŀ < d<_ < = =_ 8B8ƅ9~)x9Jx 88 A < @H Ky |~xxH Ki/ A < < ~xh8Ɔ xH KE/ A < < ~xh8Ɔ xH K!/ A < < ~exh8Ɔ,xH J/ A < < ~Exh8Ɔ<xH J/ A H y H Jŀ ~xH J< < h|}x8ƆLxxH J xH J/ A L y H Jy< }{xlH Ji< < h|}x8Ɔ\xxH JI xH J=/ A < < }sxh8ƆlxH J< ~óxxpH J 8! x|H I|@ &||+xH G齡$A !B < LH I< |~x< PcH I< < T||x8xH I|}yA H< xXH Im/ A 0< x\H IU< < @|ex8ƃxH I9< < xT8H I!|}yA H< xXH I / A 0< x\H H< < @|ex8ƂxH H< xH H<_ 8B0aP | t/ A < < < c8T8 `H H|`yTA 8a @H H58a @H H
/ @ L< aTdH HU< < h8|}xH H=< PlxH H)8a @H GH T8a @H Gu|dx< 8cdH GH 8< < cH G< Pp< 8 8t9 H G8!@a $}c H F| h8! `|fxxcxxa|H >|a< }cx?l !? ? |+xă{0ȃ,H >< X< 8y(H >} h8! `|fxxcxxa|H >X|? ? < !;ކX;||x
/ A } H =? < ? ;tc`; H =< < \8v8 H =< c4H =< < 8vx8 H = | t/ A < x`H =u8 X8! P|N |< ||x< xpx8 H >z xH >exH >]8` H <_ 8B{b b h8! `A|N |B }H|A X< 8! Px8sH8 8 |H = X8! P|N ||y|B !@ < < 8cr8rH h> wy,/ @ < < 8cr8rH D / @ c / A < 8rpH =|~x/ @ < < 8cr8s H 7 H ;a @< 8 (8scx> H <: H =Unh8 a 8 xH x@ / A |#xH &|yxH <_ BS" A xH !||xH L 8 ; @xH &MxH &%x8 |ex#xH %/ ||x@ |wxH / @ < 8 8c[H eH / A cxH !|{xH ,xH %x|{x#xH %Q|}xxH "%x/ @ < x8c[H H @x8 @H '9/ @ < x8c[H 8 cx H $8 ` 8` `cA cxH $~9>8^; cx;^ x; }iD}bEH '= 8 8 HCx H $E8@ > `B8 @Cx ,>(^@ x;> ; @#xH #=U 8 $x8 \x ^ ^ H <_ 8B'8 8 8~ H "xH "||yA P; Cx8 xH "Q|cyA < |fx8 8DxH "< xx8cYH H ;8 8 HxH "/ 8 8 8 ^@ ;a @`x;x8 Hx $H xH !u||yA P; Cx8 xH !|cyA < |fx8 8DxH !Y< xx8cYH H 48 : ` x[ >?? ;9Dؐ^H !m||yA /A ; ~óx8 xH ! |cyA < |fx8 8DxH <_ ~xBQpb <_ BQtcxB FxH ]|}y@ < cxFx8E<8 H |}x< $xx8cYxxH / A HxH
H <xH ||y@ ~óx8 8 H H /A ?? ;9EK/ @0/ A ~cx8 8 PH q;8 8 \x;^0;~ H uU 8 x8 \Cx ^Вԓ~H -CxH ||x< 8cYxH Q/ A P; cx8 xH |cyA < |fx8 8ExH U< xx8cYH H d<` PH u|{yA < P~P d~ `8~ @H 5/||x@ h; / A / A D; 8~ 8 xH |cyA < |fx8 8DxH < 8cZH X hCx TH ||yA L; 8~ 8 xH |cyA < |fx8 8ExH e< 8cZxxH / A0cxH !8~0H |{yA L; 8~ 8 xH =|cyA < |fx8 8ExH < xx8cZ(H / @ |x8~ @H |{yA L; 8~ 8 xH |cyA < |fx8 8DxH < xx8cZ8H E/ @ |xx! a|N |AB |}x!@|#x|+x8 8 \;@xH 8 @\xH |~x< 8cTxH / A /wA 4< x8cTH H 8a @xEx8 gxK|~x/ A/w@ ; 8!xA|N |AB |#x!|{x;@ 8 @H i; |}xxxH U/ @ < dx8cTH / @ < x8cT$H H L; x8a @xK|dy@ <_ xBK b H |zxH < ex8cT4H X8!PCxA|N |}y|B |#x!|+x|3x;` @ < 8cSlH EH <_ xBJD xH ||y@ < x8cS|H H H / @ < x8cSH H xxFxx8 8 @9 Da DH -|{y@ D< x8cSH / A @ a D/ A / A x H H xH xH q x8! pcx|N |} D$&~ D$$腌 t } D$fu $i DžuZ:n D$} D$E$D Džu5J Ɖ$ V~ T$$ Nj~ D$4$ [^_]UVSk t | D$E$ m T$1} T$$軋 D$ q} D$| D$4$蛋 [^]UVS6k Bt Z| D$E$l fm T$| T$$P D$ | D$V| D$4$0 [^]UWVS,j }ƃs { D$| D$s $ t{ D$s $ӊ | D$~} $車 :k D$ t${ T$$藊 | D$} $ D$ t$ |$| T$$] s t{ D$<$B ƃs ,[^_]UWVS i A{ D$| $
l D$ !l D$){ D$$ډ
z D$$辉 D$ |$T$$菉 EC ED${ D$U$o 1l T$z T$$S Ƌ{ D$| $9 z T$$' D$z D$4$ qk |$z T$$ Ƌz D$4$ = vGz D$<$Ȉ )T$z D$4$諈 |$z T$$蕈 脈 t$z T$$x Ƌz D$4$d = vGz D$<$K )T$z D$4$. |$z T$$ ƍED$D$ ED$z D$| $
t D$ t$z D$$ć CED$t$Al $轇 UT$Ql $訇 { D$E$ z D$4$m D$ ,T$$D u 1ҋ$ẺЃEЄt,1EE E E D$ Ẻ$ 1 [^_]USf D$ ?x D$E$迆 []U\f xo ]US$Lf io t. D$ UT$ D$ h T$$ʆ $[]UWVS e }uh o u h D$h $2 & Pxu+@t h t$$ʆ xuh 뱍h uh Eh Ei Eč i Eȍ.i E̍>i EЍNi Eԍ^i pM؍ni tE4 EED$D$ d 04$r |GD$D$ 4$U EGEED$D$ 4$1 EwOWxE|EuMG EEEEEUE E t uM EEƉEuu ~i E}҃o H tpL@ DG ttDG D` D$l D$T$ ED$ED$d $蒄 Ɖ$v4$ |$ M $ E$ Ĭ [^_]UHE$ e UEE؋EE܋E EEEEE} UE EEԉ$/U0c EPl ]U c =l ]US c $l t@tD$r $諃 []UWVSLb uu
D$ cf D$sf D$4$舃 EЅua4$Ƀ ƅ D$ $U Džu
4$覃 lj4$諃 |$f $諂 <$艃 r D$ EЉ$ EԅuEЉ$P EԋEЉD$9 8<$͂ ƅt~$ E ED$ED$D$ D$ t$<$\ Ẻ4$ 4$ Et$D$EԉD$f $ E$Ȃ }̅uEԉD$f $Ɓ yẺ$Y 趂 9tj譂 $ NjẺ$4 $ ƋẺD$t$ |$EԉD$f $f 4$D <$< Ẻ$1 E Eԉ$ EЉ$ E ẼL[^_]UWVSL` Eu1 D$D$
$ E̋E uwc wc |$E $t |$Ủ$̀ u\i t,BuBt |$$? t$G ƅu ƅtt$|$Ẻ$F 4$* E u d U d EԉD$U $Ӏ EԉD$Ủ$( uxi t/B uBt!UԉT$$蘀 t$蠀 ƅu! Džt4$Q Ɖ<$茀 t t$EԉD$Ủ$膀 4$j E u d E d UЉT$E $ UЉT$Ẻ$h 0 Dž $U
tld EU D$ D$D$ ED$ED$
$* ƅt2D$UЉT$Ẻ$ 4$ UЉT$Ẻ$~ <${ E ud d t$U $* t?t$Ẻ$~ u,d D$Ủ$ tD$t$Ẻ$( ỦT$
$v~ ƋẺ$~ L[^_]UD$ E$UWVSPtT D$$r Džu V D$}T $q 1n [r W U
W T$D$|$ ED$D$ 3t 04$q Er -W T$D$|$ UT$D$ 4$q NjZ ttZ q D$ D$ ED$ aD$D$4$q D$ D$ |$ D$D$4$`q ƃZ VZ tM+q D$ UT$aD$4$p D$ |$D$4$p ƃZ E$Kq <$Cq $ Z <[^_]UWVS,O p T$$p ƃX X $q EE mT E؍}T E@ED$X $/p ƋE؉D$4$}p NjE܉D$4$lp $׃EE9E|X $pp ǃX X t$ ƃX ,[^_]US$N E E E ED$E$p tD$T $o E E$[]UVSpN E E ut$E$/p tD$AT $n 1t$p $n p[^]UWVD$ $n Ɖ<$^o ^_]UVS`M ut$ D$ D$pmet$ln ftT$S $%n 1t$cp $ n `[^]UWVƅu1D$ $Wn lj4$n ^_]UWVS VM uu &S D$6S $m + E$n D$ FS D$4$m lj4$Ln E ut$E$n t?E ED$t$$ wn ft%T$ED$VS $m E E$vn D$ D$ ED$ D$ D$ E$:n tD$ED$fS $l E$n D$E D$o $ n EE$m E$m Mu%D$ E$l Eu U o D$ o D$D$ o 04$m NjEt_D$M D$<$l E$l E ED$D$ 4$k ƉD$M D$<$l 4$l Et$ED$M D$<$ul E$Vl 1Ĝ [^_]UWVS J u }|$4$l E ED$ ED$D$ D$ D$ D$ D$ <$l tD$t$ Q $j E E܉D$D$E$Zl ftT$t$Q $j 1KE܉$l E܉$k D$E܋ D$Om $k ƋE܉$k E܉$k E$k 1Č [^_]UWVS I D$ D$ ED$l $j ƅu1$xlj4$j [^_]UWVS, MI Dž Dž ut"4$j 4$Xj Dž {E t
E $j k t$D$ 4$j D$ 1уL$t$$"j NjE u D$ O $h 1 E tU $i ,<$j |$$j Ɖ<$i u|$O ${h 1 PT$<$j u|$O M $i = ~ fDž$i fDž t$ D$T$$i f UD$H D$ $h EEȉu̍ uE $h fu$h Ѕu>D$ O $ T$mG T$$V ƋH D$]I $V D$ t$H T$$mV [^]UWVS,6 QH D$H $>V Ƌ%H D$H $$V ED$!H D$4$ V NjG D$H $U Ƌ H D$<$U D$H D$4$U E܋YH D$<$U DH D$$U D$F D$E$U D$H D$U܉$jU UH D$4$XU
uu> E1 G D$<$0U G D$H $U t$ UT$G T$$T ljD$F D$E$T D$EG D$U܉$T t uG D$E܉$T H E },[^_]T UWVS<+4 E +E D$E$`T ƍ}䋃F D$U$FT t$|$$/V ft/+E D$E$T t$ UT$D$< E ED$ D$ D$ D$ D$ E$[U ttFUT$D$< +Et D$F D$G $S < $S 1<[^_]UWVS|3 uE D$4$JS ; T$E T$$.S }|$4$T E ED$|$$ YT ftT$t$; $R UE$eT E E$;T D$ E D$~E D$4$R ƋE$-T E$T 1|[^_]UWVS,2 u: D$C D$4$CR Ǎ: D$C D$4$%R t!D$}D D$E$R ; D$C D$4$Q
u1yD D$$Q E]D D$D $Q UT$ |$uD T$$Q t4ED$ t$|$wT $=R
D T$$OQ 1,[^_]UWVS,0 uDC D$4$ Q Nj@C D$4$ Q Eu D$ D$E؉$L Dž > D$E؉$sL > T$$aL E}, E ? D$4$:L MEE\ff.Ev.wLf.w(
(W, .]wE EW, .w.vE.vM܋> D$E$K ƅ_u"E > E E؉E<[^_]K <[^_]UWVS + = D$E$XK p= T$$FK 0= D$4$0K $T$EUD$T$ M ul= D$<$ K ƅu [^_] Vv12@0:4O@8 O@8@0:4 v36@0:4@8@12@16@20i24c28@32 v40@0:4@8@12@16@20i24c28@32@36 v8@0:4 v12@0:4c8 @8@0:4 @16@0:4@8@12 @12@0:4@8 v12@0:4@8 c12@0:4@8 c8@0:4 registerApplicationWithDictionary: growlVersion writeToFile:atomically: dataFromPropertyList:format:errorDescription: stringByAppendingPathComponent: substringToIndex: length stringByAppendingPathExtension: globallyUniqueString stringByAppendingString: fileSystemRepresentation postNotificationName:object: growlIsReady performSelector:withObject: userInfo applicationIconDataForGrowl processName applicationNameForGrowl dictionaryWithDictionary: removeObjectForKey: dockDescription containsObject: bundlePath dictionaryWithContentsOfFile: pathForResource:ofType: mainBundle registrationDictionaryForGrowl isEqualToString: growlPrefPaneBundle postNotificationName:object:userInfo:deliverImmediately: postNotificationWithDictionary: setProtocolForProxy: rootProxy connectionWithRegisteredName:host: TIFFRepresentation isKindOfClass: objectForKey: class mutableCopy initWithBool: setObject:forKey: initWithObjectsAndKeys: initWithInt: growlNotificationTimedOut: release removeObserver:name:object: respondsToSelector: growlNotificationWasClicked: initWithFormat: alloc processIdentifier processInfo addObserver:selector:name:object: retain autorelease defaultCenter setGrowlDelegate: growlDelegate notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext: notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:identifier: notifyWithDictionary: isGrowlInstalled isGrowlRunning registerWithDictionary: reregisterGrowlNotifications setWillRegisterWhenGrowlIsReady: willRegisterWhenGrowlIsReady registrationDictionaryFromDelegate registrationDictionaryFromBundle: bestRegistrationDictionary registrationDictionaryByFillingInDictionary: registrationDictionaryByFillingInDictionary:restrictToKeys: _applicationNameForGrowlSearchingRegistrationDictionary: _applicationIconDataForGrowlSearchingRegistrationDictionary: _growlNotificationWasClicked: _growlNotificationTimedOut: _growlIsReady: _launchGrowlIfInstalledWithRegistrationDictionary: launchGrowlIfInstalled NSPropertyListSerialization NSNotificationCenter NSDictionary NSBundle GrowlPathUtil NSConnection NSImage NSMutableDictionary NSNumber NSString NSProcessInfo NSDistributedNotificationCenter /Users/chris/source_code/projects/growl-0.7.4/Framework/Source/GrowlApplicationBridge.m GrowlNotificationProtocol NSObject GrowlApplicationBridge GrowlApplicationBridge: Cannot register because the application name was not supplied and could not be determined %@ Lend Me Some Sugar; I Am Your Neighbor! GrowlClicked! %@-%d-%@ GrowlTimedOut! NotificationAppIcon NotificationName ApplicationPID ApplicationName NotificationTitle NotificationDescription NotificationIcon NotificationClickContext NotificationPriority NotificationSticky GrowlNotificationIdentifier GrowlApplicationBridgePathway GrowlApplicationBridge: exception while sending notification: %@ GrowlNotification com.Growl.GrowlHelperApp growlRegDict Growl Registration Ticket GrowlApplicationBridge: The bundle at %@ contains a registration dictionary, but it is not a valid property list. Please tell this application's developer. GrowlApplicationBridge: The Growl delegate did not supply a registration dictionary, and the app bundle at %@ does not have one. Please tell this application's developer. ApplicationIcon AppLocation file-data DefaultNotifications AllNotifications ClickedContext app GrowlHelperApp - GrowlApplicationBridge: Error writing registration dictionary at %@: %@ GrowlApplicationBridge: Registration dictionary follows
%@ GrowlApplicationBridge: Growl_PostNotification called with a NULL notification GrowlApplicationBridge: Growl_PostNotification called, but no delegate is in effect to supply an application name - either set a delegate, or use Growl_PostNotificationWithDictionary instead GrowlApplicationBridge: Growl_PostNotification called, but no application name was found in the delegate GrowlApplicationBridge: Delegate did not supply a registration dictionary, and the app bundle at %@ does not have one GrowlApplicationBridge: Got error reading property list at %@: %@ GrowlApplicationBridge: Delegate did not supply a registration dictionary, and it could not be loaded from %@ GrowlApplicationBridge: Registration dictionary file at %@ didn't contain a dictionary (dictionary type ID is '%@' whereas the file contained '%@'); description of object follows
%@ prefPane com.growl.prefpanel Callback Context GrowlApplicationBridge: Could not find the temporary directory path, therefore cannot register. / . GrowlApplicationBridge: Error writing registration dictionary to URL %@: %@ Growl.prefPane GrowlApplicationBridge: Growl_SetDelegate called, but no application name was found in the delegate _CFURLAliasData _CFURLStringType _CFURLString in copyCurrentProcessName in CFGrowlAdditions: Could not get process name because CopyProcessName returned %li in copyCurrentProcessURL in CFGrowlAdditions: Could not get application location, because GetProcessBundleLocation returned %li
in copyTemporaryFolderPath in CFGrowlAdditions: Could not locate temporary folder because FSFindFolder returned %li in copyDockDescriptionForURL in CFGrowlAdditions: Cannot copy Dock description for a NULL URL file in copyDockDescriptionForURL in CFGrowlAdditions: FSNewAlias for %@ returned %li in copyDockDescriptionForURL in CFGrowlAdditions: FSCopyAliasInfo for %@ returned %li in copyIconDataForURL in CFGrowlAdditions: could not get icon for %@: GetIconRefFromFileInfo returned %li
in copyIconDataForURL in CFGrowlAdditions: could not get icon for %@: IconRefToIconFamily returned %li
in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: parent directory URL is NULL (please tell the Growl developers)
in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: name of directory to create is NULL (please tell the Growl developers)
in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: could not create FSRef for parent directory at %@ (please tell the Growl developers)
PBCreateDirectoryUnicodeSync or PBMakeFSRefUnicodeSync returned %li; calling CFURLCreateFromFSRef CFURLCreateFromFSRef returned %@ in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: could not create directory '%@' in parent directory at %@: FSCreateDirectoryUnicode returned %li (please tell the Growl developers) (could not get path for source file: FSRefMakePath returned %li) in copyFork in CFGrowlAdditions: PBOpenForkSync (source: %s) returned %li in copyFork in CFGrowlAdditions: PBGetCatalogInfoSync (source: %s) returned %li PBMakeFSRefUnicodeSync (could not get path for destination directory: FSRefMakePath returned %li) (could not get filename for destination file: CFStringCreateWithCharactersNoCopy returned NULL) in copyFork in CFGrowlAdditions: %s (destination: %s/%@) returned %li PBCreateFileUnicodeSync in copyFork in CFGrowlAdditions: PBOpenForkSync (dest) returned %li (could not get path for dest file: FSRefMakePath returned %li) in copyFork in CFGrowlAdditions: PBOpenForkSync (destination: %s) returned %li in copyFork in CFGrowlAdditions: PBReadForkSync (source: %s) returned %li in copyFork in CFGrowlAdditions: PBWriteForkSync (destination: %s) returned %li in copyFork in CFGrowlAdditions: PBCloseForkSync (destination: %s) returned %li in copyFork in CFGrowlAdditions: PBCloseForkSync (source: %s) returned %li in createURLByCopyingFileFromURLToDirectoryURL in CFGrowlAdditions: CFURLGetFSRef failed with source URL %@ in createURLByCopyingFileFromURLToDirectoryURL in CFGrowlAdditions: CFURLGetFSRef failed with destination URL %@ PBIterateForksSync returned %li in GrowlCopyObjectSync in CFGrowlAdditions: PBIterateForksSync returned %li in createURLByCopyingFileFromURLToDirectoryURL in CFGrowlAdditions: CopyObjectSync returned %li for source URL %@ in createPropertyListFromURL in CFGrowlAdditions: cannot read from a NULL URL in createPropertyListFromURL in CFGrowlAdditions: could not create stream for reading from URL %@ in createPropertyListFromURL in CFGrowlAdditions: could not open stream for reading from URL %@ in createPropertyListFromURL in CFGrowlAdditions: could not read property list from URL %@ (error string: %@) @"NSData" @"NSString" @"NSDictionary" init initWithAllNotifications:defaultNotifications: dealloc setApplicationNameForGrowl: setApplicationIconDataForGrowl: registrationDictionary /Users/chris/source_code/projects/growl-0.7.4/Framework/Source/GrowlDelegate.m GrowlApplicationBridgeDelegate GrowlDelegate addObject: stringByDeletingPathExtension initWithCapacity: count directoryContentsAtPath: createDirectoryAtPath:attributes: objectAtIndex: bundleForClass: skipDescendents pathExtension enumeratorAtPath: compare:options: bundleIdentifier bundleWithPath: fileExistsAtPath: defaultManager nextObject objectEnumerator helperAppBundle growlSupportDir screenshotsDirectory nextScreenshotName NSMutableSet NSFileManager /Users/chris/source_code/projects/growl-0.7.4/Common/Source/GrowlPathUtil.m PreferencePanes Application Support/Growl Library/Application Support/Growl/Screenshots Screenshot %lu dictionaryWithCapacity: path fileExistsAtPath:isDirectory: intValue dataWithBytes:length: caseInsensitiveCompare: scheme fileURLWithPath: bytes aliasData fileURLWithAliasData: fileURLWithDockDescription: NSData /Users/chris/source_code/projects/growl-0.7.4/Common/Source/NSURLAdditions.m NSURL GrowlAdditions in +[NSURL(GrowlAdditions) fileURLWithAliasData:]: Could not allocate an alias handle from %u bytes of alias data (data follows) because PtrToHand returned %li
%@ in +[NSURL(GrowlAdditions) fileURLWithAliasData:]: Could not resolve alias (alias data follows) because FSResolveAlias returned %li - will try path
%@ in +[NSURL(GrowlAdditions) fileURLWithAliasData:]: FSCopyAliasInfo returned a nil path in -[NSURL(GrowlAdditions) dockDescription]: FSNewAlias for %@ returned %li v32@0:4{_NSRect={_NSPoint=ff}{_NSSize=ff}}8i24f28 {_NSSize=ff}16@0:4{_NSSize=ff}8 @16@0:4{_NSSize=ff}8 bestRepresentationForDevice: representations setSize: drawInRect:fromRect:operation:fraction: setImageInterpolation: currentContext setScalesWhenResized: size drawScaledInRect:operation:fraction: adjustSizeToDrawAtSize: bestRepresentationForSize: representationOfSize: NSGraphicsContext /Users/chris/source_code/projects/growl-0.7.4/Core/Source/GrowlImageAdditions.m GrowlImageAdditions $Ë $ ? G 8 H X o q p p ' 4p
Dp Pp `p tp p p p p p p q q 0q Lq lq @ q q q q r r Ts ds ps |s s s s s s s G t : q Tt N p t p du h p tp p p q q p `p p e q q u u Hv A v m v Ts ds ps |s s q w w s s p ' w w w _ Hx Lx Px K t : x s x c 4p
Dp Pp y y 4y Dy n y 8z s z ] p { { P h{ U { j ,| g | } } 8~ a ~ ~ I O ( E C N \ I O O H J k p t K q T M a _ h m |s s $ x w w q s s 4 P - V { t K 4y y y 0 T e ] < e [ e 8e h ,e e ,e g e ^ 0 e \ 4 d Mc b ؎ ` f $f Tf tf f f f f f k g g 0g Lg Xg tg g g g g g l hl Dl g g h ,h 8h k l Xh lh h h h h i $i 8i Hi Xi `i k li |i i i (k m m i i i m i j ,j O g ~ 9 M e ! B l , ? [ m x ( ? R k ( G V d x / > V f
,
=
[
t
$ 4 T g
, M U ] e s * 3 ? E S + : ) 7 " * . 4 >
& > F J R ` n p l X ^ n v z & 0 < I y " Z 9 } @ Z ` j m H 5 { |
H 8 ( ؑ ȑ x h X H 8 ( ؐ Ȑ x h X H 8 ( ( ؔ Ȕ x h X H 8 ( ؓ ȓ x h X H 8 ( ؒ Ȓ x h X x h X H 8 ( ؖ Ȗ x h X H 8 ( ؕ ȕ x h X H 8 8 ( ؗ ȗ x h X H | ~ } i h e f g e e P e g j k m n q r t u v w x y { | } ~ f o s h l z i p .objc_class_name_GrowlApplicationBridge .objc_class_name_GrowlDelegate .objc_class_name_GrowlPathUtil .objc_category_name_NSURL_GrowlAdditions .objc_category_name_NSImage_GrowlImageAdditions .objc_class_name_NSBundle .objc_class_name_NSConnection .objc_class_name_NSData .objc_class_name_NSDictionary .objc_class_name_NSDistributedNotificationCenter .objc_class_name_NSFileManager .objc_class_name_NSGraphicsContext .objc_class_name_NSImage .objc_class_name_NSMutableDictionary .objc_class_name_NSMutableSet .objc_class_name_NSNotificationCenter .objc_class_name_NSNumber .objc_class_name_NSObject .objc_class_name_NSProcessInfo .objc_class_name_NSPropertyListSerialization .objc_class_name_NSString .objc_class_name_NSURL .objc_class_name_Protocol _CFArrayAppendArray _CFArrayAppendValue _CFArrayCreate _CFArrayCreateMutable _CFArrayGetCount _CFArrayGetValueAtIndex _CFBundleCopyBundleURL _CFBundleCopyResourceURL _CFBundleCreate _CFBundleCreateBundlesFromDirectory _CFBundleGetIdentifier _CFBundleGetMainBundle _CFCopyTypeIDDescription _CFDataCreate _CFDictionaryContainsKey _CFDictionaryCreate _CFDictionaryCreateCopy _CFDictionaryCreateMutable _CFDictionaryCreateMutableCopy _CFDictionaryGetTypeID _CFDictionaryGetValue _CFDictionaryRemoveValue _CFDictionarySetValue _CFEqual _CFGetAllocator _CFGetTypeID _CFNotificationCenterAddObserver _CFNotificationCenterGetDistributedCenter _CFNotificationCenterPostNotification _CFNotificationCenterRemoveEveryObserver _CFNotificationCenterRemoveObserver _CFNumberCreate _CFPropertyListCreateFromStream _CFPropertyListWriteToStream _CFReadStreamClose _CFReadStreamCreateWithFile _CFReadStreamOpen _CFRelease _CFRetain _CFSetContainsValue _CFStringCompare _CFStringCreateByCombiningStrings _CFStringCreateWithCStringNoCopy _CFStringCreateWithCharactersNoCopy _CFStringCreateWithFormat _CFStringGetCharacters _CFStringGetLength _CFURLCopyFileSystemPath _CFURLCopyLastPathComponent _CFURLCopyScheme _CFURLCreateCopyAppendingPathComponent _CFURLCreateCopyDeletingLastPathComponent _CFURLCreateFromFSRef _CFURLCreateFromFileSystemRepresentation _CFURLCreateWithFileSystemPath _CFURLGetFSRef _CFUUIDCreate _CFUUIDCreateString _CFWriteStreamClose _CFWriteStreamCreateWithFile _CFWriteStreamOpen _CopyProcessName _DisposeHandle _FNNotify _FSCopyAliasInfo _FSFindFolder _FSNewAlias _FSPathMakeRef _FSRefMakePath _GetHandleSize _GetIconRefFromFileInfo _GetNextProcess _GetProcessBundleLocation _HLock _HUnlock _IconRefToIconFamily _LSOpenFromRefSpec _LSOpenFromURLSpec _NSEqualSizes _NSHomeDirectory _NSLog _NSSearchPathForDirectoriesInDomains _NSTemporaryDirectory _PBCloseForkSync _PBCreateDirectoryUnicodeSync _PBCreateFileUnicodeSync _PBGetCatalogInfoSync _PBIterateForksSync _PBMakeFSRefUnicodeSync _PBOpenForkSync _PBReadForkSync _PBWriteForkSync _ProcessInformationCopyDictionary _PtrToHand _ReleaseIconRef __NSAddHandler2 __NSExceptionObjectFromHandler2 __NSRemoveHandler2 ___CFConstantStringClassReference __setjmp _ceilf _floorf _free _getcwd _getpid _kCFAllocatorDefault _kCFAllocatorNull _kCFBundleIdentifierKey _kCFTypeArrayCallBacks _kCFTypeDictionaryKeyCallBacks _kCFTypeDictionaryValueCallBacks _malloc _memcpy _memset _objc_msgSend _objc_msgSendSuper _snprintf single module dyld__mh_dylib_header dyld_lazy_symbol_binding_entry_point dyld_func_lookup_pointer __dyld_func_lookup dyld_stub_binding_helper +[GrowlApplicationBridge launchGrowlIfInstalled] +[GrowlApplicationBridge _launchGrowlIfInstalledWithRegistrationDictionary:] +[GrowlApplicationBridge _growlIsReady:] +[GrowlApplicationBridge _growlNotificationTimedOut:] +[GrowlApplicationBridge _growlNotificationWasClicked:] +[GrowlApplicationBridge _applicationIconDataForGrowlSearchingRegistrationDictionary:] +[GrowlApplicationBridge _applicationNameForGrowlSearchingRegistrationDictionary:] +[GrowlApplicationBridge registrationDictionaryByFillingInDictionary:restrictToKeys:] +[GrowlApplicationBridge registrationDictionaryByFillingInDictionary:] +[GrowlApplicationBridge bestRegistrationDictionary] +[GrowlApplicationBridge registrationDictionaryFromBundle:] +[GrowlApplicationBridge registrationDictionaryFromDelegate] +[GrowlApplicationBridge willRegisterWhenGrowlIsReady] +[GrowlApplicationBridge setWillRegisterWhenGrowlIsReady:] +[GrowlApplicationBridge reregisterGrowlNotifications] +[GrowlApplicationBridge registerWithDictionary:] +[GrowlApplicationBridge isGrowlRunning] +[GrowlApplicationBridge isGrowlInstalled] +[GrowlApplicationBridge notifyWithDictionary:] +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:identifier:] +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:] +[GrowlApplicationBridge growlDelegate] +[GrowlApplicationBridge setGrowlDelegate:] _growlLaunched _appIconData _appName _delegate _registerWhenGrowlIsReady ___i686.get_pc_thunk.bx ___i686.get_pc_thunk.cx _targetsToNotifyArray _delegate _registerWhenGrowlIsReady _growlLaunched _registeredForClickCallbacks __copyAllPreferencePaneBundles __launchGrowlIfInstalledWithRegistrationDictionary __growlIsReady __growlNotificationWasClicked __growlNotificationTimedOut _Growl_CopyRegistrationDictionaryFromBundle _Growl_CopyRegistrationDictionaryFromDelegate _Growl_CreateBestRegistrationDictionary _Growl_CreateRegistrationDictionaryByFillingInDictionary _Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys _Growl_GetDelegate _Growl_IsInstalled _Growl_IsRunning _Growl_LaunchIfInstalled _Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext _Growl_PostNotification _Growl_PostNotificationWithDictionary _Growl_RegisterWithDictionary _Growl_Reregister _Growl_SetDelegate _Growl_SetWillRegisterWhenGrowlIsReady _Growl_WillRegisterWhenGrowlIsReady __CFURLAliasDataKey __CFURLStringTypeKey __CFURLStringKey _copyFork _copyCurrentProcessURL _copyIconDataForURL _copyCurrentProcessName _copyTemporaryFolderPath _createDockDescriptionForURL _copyCurrentProcessPath _copyIconDataForPath _copyTemporaryFolderURL _createPropertyListFromURL _createURLByCopyingFileFromURLToDirectoryURL _createURLByMakingDirectoryAtURLWithName -[GrowlDelegate setApplicationIconDataForGrowl:] -[GrowlDelegate applicationIconDataForGrowl] -[GrowlDelegate setApplicationNameForGrowl:] -[GrowlDelegate applicationNameForGrowl] -[GrowlDelegate registrationDictionaryForGrowl] -[GrowlDelegate dealloc] -[GrowlDelegate initWithAllNotifications:defaultNotifications:] +[GrowlPathUtil nextScreenshotName] +[GrowlPathUtil screenshotsDirectory] +[GrowlPathUtil growlSupportDir] +[GrowlPathUtil helperAppBundle] +[GrowlPathUtil growlPrefPaneBundle] _bundleIDComparisonFlags.94447 _prefPaneBundle _helperAppBundle -[NSURL(GrowlAdditions) dockDescription] -[NSURL(GrowlAdditions) aliasData] +[NSURL(GrowlAdditions) fileURLWithDockDescription:] +[NSURL(GrowlAdditions) fileURLWithAliasData:] -[NSImage(GrowlImageAdditions) representationOfSize:] -[NSImage(GrowlImageAdditions) bestRepresentationForSize:] -[NSImage(GrowlImageAdditions) adjustSizeToDrawAtSize:] -[NSImage(GrowlImageAdditions) drawScaledInRect:operation:fraction:] __mh_dylib_header unison-2.40.102/uimacnew/Growl.framework/Versions/A/Resources/ 0000755 0061316 0061316 00000000000 12050210657 024233 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/Growl.framework/Versions/A/Resources/Info.plist 0000644 0061316 0061316 00000001353 11361646373 026221 0 ustar bcpierce bcpierce
CFBundleDevelopmentRegion
English
CFBundleExecutable
Growl
CFBundleIdentifier
com.growl.growlframework
CFBundleInfoDictionaryVersion
6.0
CFBundlePackageType
FMWK
CFBundleShortVersionString
0.7.3
CFBundleSignature
GRRR
CFBundleVersion
0.7.3
NSPrincipalClass
GrowlApplicationBridge
unison-2.40.102/uimacnew/NotificationController.m 0000644 0061316 0061316 00000003325 11361646373 022072 0 ustar bcpierce bcpierce //
// NotificationController.m
// uimac
//
// Created by Alan Schmitt on 02/02/06.
// Copyright 2006, see file COPYING for details. All rights reserved.
//
#import "NotificationController.h"
#define NOTIFY_UPDATE @"Scan finished"
#define NOTIFY_SYNC @"Synchronization finished"
/* Show a simple notification */
static void simpleNotify(NSString *name, NSString *descFmt, NSString *profile);
@implementation NotificationController
- (void)awakeFromNib
{
[GrowlApplicationBridge setGrowlDelegate:self];
}
- (void)updateFinishedFor: (NSString *)profile
{
simpleNotify(NOTIFY_UPDATE,
@"Profile '%@' is finished scanning for updates",
profile);
}
- (void)syncFinishedFor: (NSString *)profile {
simpleNotify(NOTIFY_SYNC,
@"Profile '%@' is finished synchronizing",
profile);
}
- (NSDictionary *)registrationDictionaryForGrowl
{
NSArray* notifications = [NSArray arrayWithObjects:
NOTIFY_UPDATE,
NOTIFY_SYNC,
nil];
return [NSDictionary dictionaryWithObjectsAndKeys:
notifications, GROWL_NOTIFICATIONS_ALL,
notifications, GROWL_NOTIFICATIONS_DEFAULT,
nil];
}
- (NSString *)applicationNameForGrowl
{
return @"Unison";
}
@end
static void simpleNotify(NSString *name, NSString *descFmt, NSString *profile)
{
[GrowlApplicationBridge notifyWithTitle:name
description:[NSString stringWithFormat:descFmt, profile]
notificationName:name
iconData:nil
priority:0
isSticky:false
clickContext:nil];
} unison-2.40.102/uimacnew/Info.plist 0000644 0061316 0061316 00000002041 11361646373 017164 0 ustar bcpierce bcpierce
CFBundleName
Unison
CFBundleDevelopmentRegion
English
CFBundleExecutable
Unison
CFBundleIconFile
Unison.icns
CFBundleIdentifier
edu.upenn.cis.Unison
CFBundleInfoDictionaryVersion
6.0
CFBundlePackageType
APPL
CFBundleSignature
????
CFBundleShortVersionString
$(MARKETING_VERSION)
CFBundleGetInfoString
${MARKETING_VERSION}, ©1999-2007, licensed under GNU GPL.
NSHumanReadableCopyright
©1999-2010, licensed under GNU GPL v3.
NSMainNibFile
MainMenu
NSPrincipalClass
NSApplication
unison-2.40.102/uimacnew/MyController.m 0000644 0061316 0061316 00000100156 11361646373 020031 0 ustar bcpierce bcpierce /* Copyright (c) 2003, see file COPYING for details. */
#import "MyController.h"
#import "ProfileController.h"
#import "PreferencesController.h"
#import "NotificationController.h"
#import "ReconItem.h"
#import "ReconTableView.h"
#import "UnisonToolbar.h"
#import "ImageAndTextCell.h"
#import "ProgressCell.h"
#import "Bridge.h"
/* The following two define are a workaround for an incompatibility between
Ocaml 3.11.2 (and older) and the Mac OS X header files */
#define uint64 uint64_caml
#define int64 int64_caml
#define CAML_NAME_SPACE
#include
#include
#include
#include
@interface NSString (_UnisonUtil)
- (NSString *)trim;
@end
@implementation MyController
static MyController *me; // needed by reloadTable and displayStatus, below
static int unset = 0;
static int dontAsk = 1;
static int doAsk = 2;
// BCP (11/09): Added per Onne Gorter:
// if user closes main window, terminate app, instead of keeping an empty app around with no window
- (BOOL)applicationShouldTerminateAfterLastWindowClosed:(NSApplication *)theApplication {
return YES;
}
- (id)init
{
if (([super init])) {
/* Initialize locals */
me = self;
doneFirstDiff = NO;
/* By default, invite user to install cltool */
int pref = [[NSUserDefaults standardUserDefaults]
integerForKey:@"CheckCltool"];
if (pref==unset)
[[NSUserDefaults standardUserDefaults]
setInteger:doAsk forKey:@"CheckCltool"];
}
return self;
}
- (void)awakeFromNib
{
// Window positioning
NSRect screenFrame = [[mainWindow screen] visibleFrame];
[mainWindow cascadeTopLeftFromPoint:
NSMakePoint(screenFrame.origin.x,
screenFrame.origin.y+screenFrame.size.height)];
blankView = [[NSView alloc] init];
/* Double clicking in the profile list will open the profile */
[[profileController tableView] setTarget:self];
[[profileController tableView] setDoubleAction:@selector(openButton:)];
[tableView setAutoresizesOutlineColumn:NO];
// use combo-cell for path
[[tableView tableColumnWithIdentifier:@"path"] setDataCell:[[[ImageAndTextCell alloc] init] autorelease]];
// Custom progress cell
ProgressCell *progressCell = [[[ProgressCell alloc] init] autorelease];
[[tableView tableColumnWithIdentifier:@"percentTransferred"] setDataCell:progressCell];
/* Set up the version string in the about box. We use a custom
about box just because PRCS doesn't seem capable of getting the
version into the InfoPlist.strings file; otherwise we'd use the
standard about box. */
[versionText setStringValue:ocamlCall("S", "unisonGetVersion")];
/* Command-line processing */
OCamlValue *clprofile = (id)ocamlCall("@", "unisonInit0");
/* Add toolbar */
toolbar = [[[UnisonToolbar alloc]
initWithIdentifier: @"unisonToolbar" :self :tableView] autorelease];
[mainWindow setToolbar: toolbar];
[toolbar takeTableModeView:tableModeSelector];
[self initTableMode];
/* Set up the first window the user will see */
if (clprofile) {
/* A profile name was given on the command line */
NSString *profileName = [clprofile getField:0 withType:'S'];
[self profileSelected:profileName];
/* If invoked from terminal we need to bring the app to the front */
[NSApp activateIgnoringOtherApps:YES];
/* Start the connection */
[self connect:profileName];
}
else {
/* If invoked from terminal we need to bring the app to the front */
[NSApp activateIgnoringOtherApps:YES];
/* Bring up the dialog to choose a profile */
[self chooseProfiles];
}
[mainWindow display];
[mainWindow makeKeyAndOrderFront:nil];
/* unless user has clicked Don't ask me again, ask about cltool */
if ( ([[NSUserDefaults standardUserDefaults]
integerForKey:@"CheckCltool"]==doAsk) &&
(![[NSFileManager defaultManager]
fileExistsAtPath:@"/usr/bin/unison"]) )
[self raiseCltoolWindow:nil];
}
- (void)chooseProfiles
{
[mainWindow setContentView:blankView];
[self resizeWindowToSize:[chooseProfileView frame].size];
[mainWindow setContentMinSize:
NSMakeSize(NSWidth([[mainWindow contentView] frame]),150)];
[mainWindow setContentMaxSize:NSMakeSize(FLT_MAX, FLT_MAX)];
[mainWindow setContentView:chooseProfileView];
[toolbar setView:@"chooseProfileView"];
[mainWindow setTitle:@"Unison"];
// profiles get keyboard input
[mainWindow makeFirstResponder:[profileController tableView]];
[chooseProfileView display];
}
- (IBAction)createButton:(id)sender
{
[preferencesController reset];
[mainWindow setContentView:blankView];
[self resizeWindowToSize:[preferencesView frame].size];
[mainWindow setContentMinSize:
NSMakeSize(400,NSHeight([[mainWindow contentView] frame]))];
[mainWindow setContentMaxSize:
NSMakeSize(FLT_MAX,NSHeight([[mainWindow contentView] frame]))];
[mainWindow setContentView:preferencesView];
[toolbar setView:@"preferencesView"];
}
- (IBAction)saveProfileButton:(id)sender
{
if ([preferencesController validatePrefs]) {
// so the list contains the new profile
[profileController initProfiles];
[self chooseProfiles];
}
}
- (IBAction)cancelProfileButton:(id)sender
{
[self chooseProfiles];
}
/* Only valid once a profile has been selected */
- (NSString *)profile {
return myProfile;
}
- (void)profileSelected:(NSString *)aProfile
{
[aProfile retain];
[myProfile release];
myProfile = aProfile;
[mainWindow setTitle: [NSString stringWithFormat:@"Unison: %@", myProfile]];
}
- (IBAction)restartButton:(id)sender
{
[tableView setEditable:NO];
[self chooseProfiles];
}
- (IBAction)rescan:(id)sender
{
/* There is a delay between turning off the button and it
actually being disabled. Make sure we don't respond. */
if ([self validateItem:@selector(rescan:)]) {
waitingForPassword = NO;
[self afterOpen];
}
}
- (IBAction)openButton:(id)sender
{
NSString *profile = [profileController selected];
[self profileSelected:profile];
[self connect:profile];
return;
}
- (void)updateToolbar
{
[toolbar validateVisibleItems];
[tableModeSelector setEnabled:((syncable && !duringSync) || afterSync)];
// Why?
[updatesView setNeedsDisplay:YES];
}
- (void)updateTableViewWithReset:(BOOL)shouldResetSelection
{
[tableView reloadData];
if (shouldResetSelection) {
[tableView selectRowIndexes:[NSIndexSet indexSetWithIndex:0] byExtendingSelection:NO];
shouldResetSelection = NO;
}
[updatesView setNeedsDisplay:YES];
}
- (void)updateProgressBar:(NSNumber *)newProgress
{
// NSLog(@"Updating progress bar: %i - %i", (int)[newProgress doubleValue], (int)[progressBar doubleValue]);
[progressBar incrementBy:([newProgress doubleValue] - [progressBar doubleValue])];
}
- (void)updateTableViewSelection
{
int n = [tableView numberOfSelectedRows];
if (n == 1) [self displayDetails:[tableView itemAtRow:[tableView selectedRow]]];
else [self clearDetails];
}
- (void)outlineViewSelectionDidChange:(NSNotification *)note
{
[self updateTableViewSelection];
}
- (void)connect:(NSString *)profileName
{
// contact server, propagate prefs
NSLog(@"Connecting to %@...", profileName);
// Switch to ConnectingView
[mainWindow setContentView:blankView];
[self resizeWindowToSize:[updatesView frame].size];
[mainWindow setContentMinSize:NSMakeSize(150,150)];
[mainWindow setContentMaxSize:NSMakeSize(FLT_MAX, FLT_MAX)];
[mainWindow setContentView:ConnectingView];
[toolbar setView:@"connectingView"];
// Update (almost) immediately
[ConnectingView display];
syncable = NO;
afterSync = NO;
[self updateToolbar];
// will spawn thread on OCaml side and callback when complete
(void)ocamlCall("xS", "unisonInit1", profileName);
}
CAMLprim value unisonInit1Complete(value v)
{
id pool = [[NSAutoreleasePool alloc] init];
if (v == Val_unit) {
NSLog(@"Connected.");
[me->preconn release];
me->preconn = NULL;
[me performSelectorOnMainThread:@selector(afterOpen:) withObject:nil waitUntilDone:FALSE];
} else {
// prompting required
me->preconn = [[OCamlValue alloc] initWithValue:Field(v,0)]; // value of Some
[me performSelectorOnMainThread:@selector(unisonInit1Complete:) withObject:nil waitUntilDone:FALSE];
}
[pool release];
return Val_unit;
}
- (void)unisonInit1Complete:(id)ignore
{
@try {
OCamlValue *prompt = ocamlCall("@@", "openConnectionPrompt", preconn);
if (!prompt) {
// turns out, no prompt needed, but must finish opening connection
ocamlCall("x@", "openConnectionEnd", preconn);
NSLog(@"Connected.");
waitingForPassword = NO;
[self afterOpen];
return;
}
waitingForPassword = YES;
[self raisePasswordWindow:[prompt getField:0 withType:'S']];
} @catch (NSException *ex) {
NSRunAlertPanel(@"Connection Error", [ex description], @"OK", nil, nil);
[self chooseProfiles];
return;
}
NSLog(@"Connected.");
}
- (void)raisePasswordWindow:(NSString *)prompt
{
// FIX: some prompts don't ask for password, need to look at it
NSLog(@"Got the prompt: '%@'",prompt);
if ((long)ocamlCall("iS", "unisonPasswordMsg", prompt)) {
[passwordPrompt setStringValue:@"Please enter your password"];
[NSApp beginSheet:passwordWindow
modalForWindow:mainWindow
modalDelegate:nil
didEndSelector:nil
contextInfo:nil];
return;
}
if ((long)ocamlCall("iS", "unisonPassphraseMsg", prompt)) {
[passwordPrompt setStringValue:@"Please enter your passphrase"];
[NSApp beginSheet:passwordWindow
modalForWindow:mainWindow
modalDelegate:nil
didEndSelector:nil
contextInfo:nil];
return;
}
if ((long)ocamlCall("iS", "unisonAuthenticityMsg", prompt)) {
int i = NSRunAlertPanel(@"New host",prompt,@"Yes",@"No",nil);
if (i == NSAlertDefaultReturn) {
ocamlCall("x@s", "openConnectionReply", preconn, "yes");
prompt = ocamlCall("S@", "openConnectionPrompt", preconn);
if (!prompt) {
// all done with prompts, finish opening connection
ocamlCall("x@", "openConnectionEnd", preconn);
waitingForPassword = NO;
[self afterOpen];
return;
}
else {
[self raisePasswordWindow:[NSString
stringWithUTF8String:String_val(Field(prompt,0))]];
return;
}
}
if (i == NSAlertAlternateReturn) {
ocamlCall("x@", "openConnectionCancel", preconn);
return;
}
else {
NSLog(@"Unrecognized response '%d' from NSRunAlertPanel",i);
ocamlCall("x@", "openConnectionCancel", preconn);
return;
}
}
NSLog(@"Unrecognized message from ssh: %@",prompt);
ocamlCall("x@", "openConnectionCancel", preconn);
}
// The password window will invoke this when Enter occurs, b/c we
// are the delegate.
- (void)controlTextDidEndEditing:(NSNotification *)notification
{
NSNumber *reason = [[notification userInfo] objectForKey:@"NSTextMovement"];
int code = [reason intValue];
if (code == NSReturnTextMovement)
[self endPasswordWindow:self];
}
// Or, the Continue button will invoke this when clicked
- (IBAction)endPasswordWindow:(id)sender
{
[passwordWindow orderOut:self];
[NSApp endSheet:passwordWindow];
if ([sender isEqualTo:passwordCancelButton]) {
ocamlCall("x@", "openConnectionCancel", preconn);
[self chooseProfiles];
return;
}
NSString *password = [passwordText stringValue];
ocamlCall("x@S", "openConnectionReply", preconn, password);
OCamlValue *prompt = ocamlCall("@@", "openConnectionPrompt", preconn);
if (!prompt) {
// all done with prompts, finish opening connection
ocamlCall("x@", "openConnectionEnd", preconn);
waitingForPassword = NO;
[self afterOpen];
}
else {
[self raisePasswordWindow:[prompt getField:0 withType:'S']];
}
}
- (void)afterOpen:(id)ignore
{
[self afterOpen];
}
- (void)afterOpen
{
if (waitingForPassword) return;
// move to updates window after clearing it
[self updateReconItems:nil];
[progressBar setDoubleValue:0.0];
[progressBar stopAnimation:self];
// [self clearDetails];
[mainWindow setContentView:blankView];
[self resizeWindowToSize:[updatesView frame].size];
[mainWindow setContentMinSize:
NSMakeSize(NSWidth([[mainWindow contentView] frame]),200)];
[mainWindow setContentMaxSize:NSMakeSize(FLT_MAX, FLT_MAX)];
[mainWindow setContentView:updatesView];
[toolbar setView:@"updatesView"];
syncable = NO;
afterSync = NO;
[tableView deselectAll:self];
[self updateToolbar];
[self updateProgressBar:[NSNumber numberWithDouble:0.0]];
// this should depend on the number of reconitems, and is now done
// in updateReconItems:
// reconItems table gets keyboard input
//[mainWindow makeFirstResponder:tableView];
[tableView scrollRowToVisible:0];
[preconn release];
preconn = nil; // so old preconn can be garbage collected
// This will run in another thread spawned in OCaml and will return immediately
// We'll get a call back to unisonInit2Complete() when it is complete
ocamlCall("x", "unisonInit2");
}
- (void)afterUpdate:(id)retainedReconItems
{
// NSLog(@"In afterUpdate:...");
[self updateReconItems:retainedReconItems];
[retainedReconItems release];
[notificationController updateFinishedFor:[self profile]];
// label the left and right columns with the roots
NSString *leftHost = [(NSString *)ocamlCall("S", "unisonFirstRootString") trim];
NSString *rightHost = [(NSString *)ocamlCall("S", "unisonSecondRootString") trim];
/*
[[[tableView tableColumnWithIdentifier:@"left"] headerCell] setObjectValue:lefthost];
[[[tableView tableColumnWithIdentifier:@"right"] headerCell] setObjectValue:rightHost];
*/
[mainWindow setTitle: [NSString stringWithFormat:@"Unison: %@ (%@ <-> %@)",
[self profile], leftHost, rightHost]];
// initial sort
[tableView setSortDescriptors:[NSArray arrayWithObjects:
[[tableView tableColumnWithIdentifier:@"fileSizeString"] sortDescriptorPrototype],
[[tableView tableColumnWithIdentifier:@"path"] sortDescriptorPrototype],
nil]];
[self updateTableViewWithReset:([reconItems count] > 0)];
[self updateToolbar];
}
CAMLprim value unisonInit2Complete(value v)
{
id pool = [[NSAutoreleasePool alloc] init];
[me performSelectorOnMainThread:@selector(afterUpdate:) withObject:[[OCamlValue alloc] initWithValue:v] waitUntilDone:FALSE];
[pool release];
return Val_unit;
}
- (IBAction)syncButton:(id)sender
{
[tableView setEditable:NO];
syncable = NO;
duringSync = YES;
[self updateToolbar];
// This will run in another thread spawned in OCaml and will return immediately
// We'll get a call back to syncComplete() when it is complete
ocamlCall("x", "unisonSynchronize");
}
- (void)afterSync:(id)ignore
{
[notificationController syncFinishedFor:[self profile]];
duringSync = NO;
afterSync = YES;
[self updateToolbar];
int i;
for (i = 0; i < [reconItems count]; i++) {
[[reconItems objectAtIndex:i] resetProgress];
}
[self updateTableViewSelection];
[self updateTableViewWithReset:FALSE];
}
CAMLprim value syncComplete()
{
id pool = [[NSAutoreleasePool alloc] init];
[me performSelectorOnMainThread:@selector(afterSync:) withObject:nil waitUntilDone:FALSE];
[pool release];
return Val_unit;
}
// A function called from ocaml
- (void)reloadTable:(NSNumber *)i
{
// NSLog(@"*** ReloadTable: %i", [i intValue]);
[[reconItems objectAtIndex:[i intValue]] resetProgress];
[self updateTableViewWithReset:FALSE];
}
CAMLprim value reloadTable(value row)
{
id pool = [[NSAutoreleasePool alloc] init];
// NSLog(@"OCaml says... ReloadTable: %i", Int_val(row));
NSNumber *num = [[NSNumber alloc] initWithInt:Int_val(row)];
[me performSelectorOnMainThread:@selector(reloadTable:) withObject:num waitUntilDone:FALSE];
[num release];
[pool release];
return Val_unit;
}
- (int)outlineView:(NSOutlineView *)outlineView numberOfChildrenOfItem:(id)item {
if (item == nil) item = rootItem;
return [[item children] count];
}
- (BOOL)outlineView:(NSOutlineView *)outlineView isItemExpandable:(id)item {
return [item isKindOfClass:[ParentReconItem class]];
}
- (id)outlineView:(NSOutlineView *)outlineView child:(int)index ofItem:(id)item {
if (item == nil) item = rootItem;
return [[item children] objectAtIndex:index];
}
- (id)outlineView:(NSOutlineView *)outlineView objectValueForTableColumn:(NSTableColumn *)tableColumn byItem:(id)item {
NSString *identifier = [tableColumn identifier];
if (item == nil) item = rootItem;
if ([identifier isEqualToString:@"percentTransferred"] && (!duringSync && !afterSync)) return nil;
return [item valueForKey:identifier];
}
static NSDictionary *_SmallGreyAttributes = nil;
- (void)outlineView:(NSOutlineView *)outlineView willDisplayCell:(NSCell *)cell forTableColumn:(NSTableColumn *)tableColumn item:(id)item {
NSString *identifier = [tableColumn identifier];
if ([identifier isEqualToString:@"path"]) {
// The file icon
[(ImageAndTextCell*)cell setImage:[item fileIcon]];
// For parents, format the file count into the text
long fileCount = [item fileCount];
if (fileCount > 1) {
NSString *countString = [NSString stringWithFormat:@" (%ld files)", fileCount];
NSString *fullString = [(NSString *)[cell objectValue] stringByAppendingString:countString];
NSMutableAttributedString *as = [[NSMutableAttributedString alloc] initWithString:fullString];
if (!_SmallGreyAttributes) {
NSColor *txtColor = [NSColor grayColor];
NSFont *txtFont = [NSFont systemFontOfSize:9.0];
_SmallGreyAttributes = [[NSDictionary dictionaryWithObjectsAndKeys:txtFont,
NSFontAttributeName, txtColor, NSForegroundColorAttributeName, nil] retain];
}
[as setAttributes:_SmallGreyAttributes range:NSMakeRange([fullString length] - [countString length], [countString length])];
[cell setAttributedStringValue:as];
[as release];
}
} else if ([identifier isEqualToString:@"percentTransferred"]) {
[(ProgressCell*)cell setIcon:[item direction]];
[(ProgressCell*)cell setStatusString:[item progressString]];
[(ProgressCell*)cell setIsActive:[item isKindOfClass:[LeafReconItem class]]];
}
}
- (void)outlineView:(NSOutlineView *)outlineView
sortDescriptorsDidChange:(NSArray *)oldDescriptors {
NSArray *originalSelection = [outlineView selectedObjects];
// do we want to catch case of object changes to allow resort in same direction for progress / direction?
// Could check if our objects change and if the first item at the head of new and old were the same
[rootItem sortUsingDescriptors:[outlineView sortDescriptors]];
[outlineView reloadData];
[outlineView setSelectedObjects:originalSelection];
}
// Delegate methods
- (BOOL)outlineView:(NSOutlineView *)outlineView shouldEditTableColumn:(NSTableColumn *)tableColumn item:(id)item {
return NO;
}
- (NSMutableArray *)reconItems // used in ReconTableView only
{
return reconItems;
}
- (int)tableMode
{
return [tableModeSelector selectedSegment];
}
- (IBAction)tableModeChanged:(id)sender
{
[[NSUserDefaults standardUserDefaults] setInteger:[self tableMode]+1 forKey:@"TableLayout"];
[self updateForChangedItems];
}
- (void)initTableMode
{
int mode = [[NSUserDefaults standardUserDefaults] integerForKey:@"TableLayout"] - 1;
if (mode == -1) mode = 1;
[tableModeSelector setSelectedSegment:mode];
}
- (void)updateReconItems:(OCamlValue *)caml_reconItems
{
[reconItems release];
reconItems = [[NSMutableArray alloc] init];
long i, n =[caml_reconItems count];
for (i=0; i0) {
[tableView setEditable:YES];
// reconItems table gets keyboard input
[mainWindow makeFirstResponder:tableView];
syncable = YES;
}
else {
[tableView setEditable:NO];
afterSync = YES; // rescan should be enabled
// reconItems table no longer gets keyboard input
[mainWindow makeFirstResponder:nil];
}
[self updateToolbar];
}
- (id)updateForIgnore:(id)item
{
long j = (long)ocamlCall("ii", "unisonUpdateForIgnore", [reconItems indexOfObjectIdenticalTo:item]);
NSLog(@"Updating for ignore...");
[self updateReconItems:(OCamlValue *)ocamlCall("@", "unisonState")];
return [reconItems objectAtIndex:j];
}
// A function called from ocaml
CAMLprim value displayStatus(value s)
{
id pool = [[NSAutoreleasePool alloc] init];
NSString *str = [[NSString alloc] initWithUTF8String:String_val(s)];
// NSLog(@"displayStatus: %@", str);
[me performSelectorOnMainThread:@selector(statusTextSet:) withObject:str waitUntilDone:FALSE];
[str release];
[pool release];
return Val_unit;
}
- (void)statusTextSet:(NSString *)s {
/* filter out strings with # reconitems, and empty strings */
if (!NSEqualRanges([s rangeOfString:@"reconitems"],
NSMakeRange(NSNotFound,0))) return;
[statusText setStringValue:s];
}
// Called from ocaml to dislpay progress bar
CAMLprim value displayGlobalProgress(value p)
{
id pool = [[NSAutoreleasePool alloc] init];
NSNumber *num = [[NSNumber alloc] initWithDouble:Double_val(p)];
[me performSelectorOnMainThread:@selector(updateProgressBar:)
withObject:num waitUntilDone:FALSE];
[num release];
[pool release];
return Val_unit;
}
// Called from ocaml to display diff
CAMLprim value displayDiff(value s, value s2)
{
id pool = [[NSAutoreleasePool alloc] init];
[me performSelectorOnMainThread:@selector(diffViewTextSet:)
withObject:[NSArray arrayWithObjects:[NSString stringWithUTF8String:String_val(s)],
[NSString stringWithUTF8String:String_val(s2)], nil]
waitUntilDone:FALSE];
[pool release];
return Val_unit;
}
// Called from ocaml to display diff error messages
CAMLprim value displayDiffErr(value s)
{
id pool = [[NSAutoreleasePool alloc] init];
NSString * str = [NSString stringWithUTF8String:String_val(s)];
str = [[str componentsSeparatedByString:@"\n"] componentsJoinedByString:@" "];
[me->statusText performSelectorOnMainThread:@selector(setStringValue:)
withObject:str waitUntilDone:FALSE];
[pool release];
return Val_unit;
}
- (void)diffViewTextSet:(NSArray *)args
{
[self diffViewTextSet:[args objectAtIndex:0] bodyText:[args objectAtIndex:1]];
}
- (void)diffViewTextSet:(NSString *)title bodyText:(NSString *)body {
if ([body length]==0) return;
[diffWindow setTitle:title];
[diffView setFont:[NSFont fontWithName:@"Monaco" size:10]];
[diffView setString:body];
if (!doneFirstDiff) {
/* On first open, position the diff window to the right of
the main window, but without going off the mainwindow's screen */
float screenOriginX = [[mainWindow screen] visibleFrame].origin.x;
float screenWidth = [[mainWindow screen] visibleFrame].size.width;
float mainOriginX = [mainWindow frame].origin.x;
float mainOriginY = [mainWindow frame].origin.y;
float mainWidth = [mainWindow frame].size.width;
float mainHeight = [mainWindow frame].size.height;
float diffWidth = [diffWindow frame].size.width;
float diffX = mainOriginX+mainWidth;
float maxX = screenOriginX+screenWidth-diffWidth;
if (diffX > maxX) diffX = maxX;
float diffY = mainOriginY + mainHeight;
NSPoint diffOrigin = NSMakePoint(diffX,diffY);
[diffWindow cascadeTopLeftFromPoint:diffOrigin];
doneFirstDiff = YES;
}
[diffWindow orderFront:nil];
}
- (void)displayDetails:(ReconItem *)item
{
[detailsTextView setFont:[NSFont fontWithName:@"Monaco" size:10]];
NSString *text = [item details];
if (!text) text = @"";
[detailsTextView setString:text];
}
- (void)clearDetails
{
[detailsTextView setString:@""];
}
- (IBAction)raiseCltoolWindow:(id)sender
{
int pref = [[NSUserDefaults standardUserDefaults]
integerForKey:@"CheckCltool"];
if (pref==doAsk)
[cltoolPref setState:NSOffState];
else
[cltoolPref setState:NSOnState];
[self raiseWindow: cltoolWindow];
}
- (IBAction)cltoolYesButton:(id)sender;
{
if ([cltoolPref state]==NSOnState)
[[NSUserDefaults standardUserDefaults]
setInteger:dontAsk forKey:@"CheckCltool"];
else
[[NSUserDefaults standardUserDefaults]
setInteger:doAsk forKey:@"CheckCltool"];
[self installCommandLineTool:self];
[cltoolWindow close];
}
- (IBAction)cltoolNoButton:(id)sender;
{
if ([cltoolPref state]==NSOnState)
[[NSUserDefaults standardUserDefaults]
setInteger:dontAsk forKey:@"CheckCltool"];
else
[[NSUserDefaults standardUserDefaults]
setInteger:doAsk forKey:@"CheckCltool"];
[cltoolWindow close];
}
- (IBAction)raiseAboutWindow:(id)sender
{
[self raiseWindow: aboutWindow];
}
- (void)raiseWindow:(NSWindow *)theWindow
{
NSRect screenFrame = [[mainWindow screen] visibleFrame];
NSRect mainWindowFrame = [mainWindow frame];
NSRect theWindowFrame = [theWindow frame];
float winX = mainWindowFrame.origin.x +
(mainWindowFrame.size.width - theWindowFrame.size.width)/2;
float winY = mainWindowFrame.origin.y +
(mainWindowFrame.size.height + theWindowFrame.size.height)/2;
if (winXmaxX) winX=maxX;
float minY = screenFrame.origin.y+theWindowFrame.size.height;
if (winYmaxY) winY=maxY;
[theWindow cascadeTopLeftFromPoint:
NSMakePoint(winX,winY)];
[theWindow makeKeyAndOrderFront:nil];
}
- (IBAction)onlineHelp:(id)sender
{
[[NSWorkspace sharedWorkspace]
openURL:[NSURL URLWithString:@"http://www.cis.upenn.edu/~bcpierce/unison/docs.html"]];
}
/* from http://developer.apple.com/documentation/Security/Conceptual/authorization_concepts/index.html */
#include
#include
- (IBAction)installCommandLineTool:(id)sender
{
/* Install the command-line tool in /usr/bin/unison.
Requires root privilege, so we ask for it and
pass the task off to /bin/sh. */
OSStatus myStatus;
AuthorizationFlags myFlags = kAuthorizationFlagDefaults;
AuthorizationRef myAuthorizationRef;
myStatus = AuthorizationCreate(NULL, kAuthorizationEmptyEnvironment,
myFlags, &myAuthorizationRef);
if (myStatus != errAuthorizationSuccess) return;
{
AuthorizationItem myItems = {kAuthorizationRightExecute, 0,
NULL, 0};
AuthorizationRights myRights = {1, &myItems};
myFlags = kAuthorizationFlagDefaults |
kAuthorizationFlagInteractionAllowed |
kAuthorizationFlagPreAuthorize |
kAuthorizationFlagExtendRights;
myStatus =
AuthorizationCopyRights(myAuthorizationRef,&myRights,NULL,myFlags,NULL);
}
if (myStatus == errAuthorizationSuccess) {
NSBundle *bundle = [NSBundle mainBundle];
NSString *bundle_path = [bundle bundlePath];
NSString *exec_path =
[bundle_path stringByAppendingString:@"/Contents/MacOS/cltool"];
// Not sure why but this doesn't work:
// [bundle pathForResource:@"cltool" ofType:nil];
if (exec_path == nil) return;
char *args[] = { "-f", (char *)[exec_path UTF8String],
"/usr/bin/unison", NULL };
myFlags = kAuthorizationFlagDefaults;
myStatus = AuthorizationExecuteWithPrivileges
(myAuthorizationRef, "/bin/cp", myFlags, args,
NULL);
}
AuthorizationFree (myAuthorizationRef, kAuthorizationFlagDefaults);
/*
if (myStatus == errAuthorizationCanceled)
NSLog(@"The attempt was canceled\n");
else if (myStatus)
NSLog(@"There was an authorization error: %ld\n", myStatus);
*/
}
- (BOOL)validateItem:(IBAction *) action
{
if (action == @selector(syncButton:)) return syncable;
// FIXME Restarting during sync is disabled because it causes UI corruption
else if (action == @selector(restartButton:)) return !duringSync;
else if (action == @selector(rescan:)) return ((syncable && !duringSync) || afterSync);
else return YES;
}
- (BOOL)validateMenuItem:(NSMenuItem *)menuItem
{
return [self validateItem:[menuItem action]];
}
- (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem
{
return [self validateItem:[toolbarItem action]];
}
- (void)resizeWindowToSize:(NSSize)newSize
{
NSRect aFrame;
float newHeight = newSize.height+[self toolbarHeightForWindow:mainWindow];
float newWidth = newSize.width;
aFrame = [NSWindow contentRectForFrameRect:[mainWindow frame]
styleMask:[mainWindow styleMask]];
aFrame.origin.y += aFrame.size.height;
aFrame.origin.y -= newHeight;
aFrame.size.height = newHeight;
aFrame.size.width = newWidth;
aFrame = [NSWindow frameRectForContentRect:aFrame
styleMask:[mainWindow styleMask]];
[mainWindow setFrame:aFrame display:YES animate:YES];
}
- (float)toolbarHeightForWindow:(NSWindow *)window
{
NSToolbar *aToolbar;
float toolbarHeight = 0.0;
NSRect windowFrame;
aToolbar = [window toolbar];
if(aToolbar && [aToolbar isVisible])
{
windowFrame = [NSWindow contentRectForFrameRect:[window frame]
styleMask:[window styleMask]];
toolbarHeight = NSHeight(windowFrame)
- NSHeight([[window contentView] frame]);
}
return toolbarHeight;
}
CAMLprim value fatalError(value s)
{
NSString *str = [[NSString alloc] initWithUTF8String:String_val(s)];
[me performSelectorOnMainThread:@selector(fatalError:) withObject:str waitUntilDone:FALSE];
[str release];
return Val_unit;
}
- (void)fatalError:(NSString *)msg {
NSRunAlertPanel(@"Fatal error", msg, @"Exit", nil, nil);
exit(1);
}
@end
@implementation NSString (_UnisonUtil)
- (NSString *)trim
{
NSCharacterSet *ws = [NSCharacterSet whitespaceCharacterSet];
int len = [self length], i = len;
while (i && [ws characterIsMember:[self characterAtIndex:i-1]]) i--;
return (i == len) ? self : [self substringToIndex:i];
}
@end
unison-2.40.102/uimacnew/tableicons/ 0000755 0061316 0061316 00000000000 12050210657 017326 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/tableicons/Outline-Deep.png 0000644 0061316 0061316 00000000733 11361646373 022345 0 ustar bcpierce bcpierce PNG
IHDR $ pHYs gAMA cHRM n r I m? m 1 J QIDATxb?-@ `|ӿ@Y\BBb V â]ӧO @ 3b@ 1b Oz|ϟ _`S77ii , FBqp0ZA ) * j.^gff$ Fb͛7`aXYY > "^^^ @0 h 8D8H[[{.} HjN>qd
(0accHUUm 6 D|||T@,fv"g4| i]@ s%d IENDB` unison-2.40.102/uimacnew/tableicons/table-skip.tif 0000644 0061316 0061316 00000012164 11361646373 022105 0 ustar bcpierce bcpierce MM * . +) 83# =, : - ' crO m չ~ Ň ａ n yS :' u ;) ܗ ד ӑ Ґ я ҏ Ӑ ֒ ۖ Џ X< !c ޘ Ӑ я ד ۖ ֒ я ԑ ڕ ٔ я я ܗ } C s ۖ Ў Ւ ד uQ , f
4 " -# X]@ ύ ؓ Ў ֓ Ў
F zS ݘ Ў ד z E (^ ە Ў ؔ z Vܗ я Ւ + ` ٕ я ߙ ?+ iH ܖ я ܗ , u ?ӑ Ґ ד o ȉ ܗ ܖ ֓ & e ؔ Ӑ ͌ . t>* A, 2" v
2lK fF | ԑ я Ґ {T oL 0! { I2 Ґ я я я ߙ y jH ݗ я я Ւ Æ 2 f ڕ Ґ ٔ U * 4# Y[?
@ 6
( 1 : &2 `L R ./table-skip.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 17:06:46 unison-2.40.102/uimacnew/tableicons/table-mixed.tif 0000644 0061316 0061316 00000046120 11361646373 022244 0 ustar bcpierce bcpierce MM * 6 < 0 ( 1 2 4R HI ' i L$
'
'Adobe Photoshop Elements 2.0 2007:04:28 15:25:55
Adobe Photoshop Elements for Macintosh, version 2.0
adobe:docid:photoshop:e59d3026-f72e-11db-955e-fba283ce9e55
8BIM% 8BIM
com.apple.print.PageFormat.PMHorizontalRes
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMHorizontalRes
72
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PageFormat.PMOrientation
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMOrientation
1
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PageFormat.PMScaling
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMScaling
1
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PageFormat.PMVerticalRes
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMVerticalRes
72
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PageFormat.PMVerticalScaling
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMVerticalScaling
1
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.subTicket.paper_info_ticket
com.apple.print.PageFormat.PMAdjustedPageRect
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMAdjustedPageRect
0.0
0.0
734
576
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:37Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PageFormat.PMAdjustedPaperRect
com.apple.print.ticket.creator
com.apple.printingmanager
com.apple.print.ticket.itemArray
com.apple.print.PageFormat.PMAdjustedPaperRect
-18
-18
774
594
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:37Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PaperInfo.PMPaperName
com.apple.print.ticket.creator
com.apple.print.pm.PostScript
com.apple.print.ticket.itemArray
com.apple.print.PaperInfo.PMPaperName
na-letter
com.apple.print.ticket.client
com.apple.print.pm.PostScript
com.apple.print.ticket.modDate
2003-07-01T17:49:36Z
com.apple.print.ticket.stateFlag
1
com.apple.print.PaperInfo.PMUnadjustedPageRect
com.apple.print.ticket.creator
com.apple.print.pm.PostScript
com.apple.print.ticket.itemArray
com.apple.print.PaperInfo.PMUnadjustedPageRect
0.0
0.0
734
576
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PaperInfo.PMUnadjustedPaperRect
com.apple.print.ticket.creator
com.apple.print.pm.PostScript
com.apple.print.ticket.itemArray
com.apple.print.PaperInfo.PMUnadjustedPaperRect
-18
-18
774
594
com.apple.print.ticket.client
com.apple.printingmanager
com.apple.print.ticket.modDate
2007-04-28T22:24:34Z
com.apple.print.ticket.stateFlag
0
com.apple.print.PaperInfo.ppd.PMPaperName
com.apple.print.ticket.creator
com.apple.print.pm.PostScript
com.apple.print.ticket.itemArray
com.apple.print.PaperInfo.ppd.PMPaperName
US Letter
com.apple.print.ticket.client
com.apple.print.pm.PostScript
com.apple.print.ticket.modDate
2003-07-01T17:49:36Z
com.apple.print.ticket.stateFlag
1
com.apple.print.ticket.APIVersion
00.20
com.apple.print.ticket.privateLock
com.apple.print.ticket.type
com.apple.print.PaperInfoTicket
com.apple.print.ticket.APIVersion
00.20
com.apple.print.ticket.privateLock
com.apple.print.ticket.type
com.apple.print.PageFormatTicket
8BIM x H H @Rg( H H ( d h 8BIM H H 8BIM& ? 8BIM
Transparency 8BIM
T r a n s p a r e n c y 8BIM d 8BIM 8BIM
8BIM 8BIM 8BIM
8BIM'
8BIM H /ff lff /ff 2 Z 5 - 8BIM p 8BIM 8BIM 8BIM @ @ 8BIM 8BIM K 6 t a b l e - m i x e d 6 null boundsObjc Rct1 Top long Leftlong Btomlong Rghtlong 6 slicesVlLs Objc slice sliceIDlong groupIDlong originenum ESliceOrigin
autoGenerated Typeenum
ESliceType Img boundsObjc Rct1 Top long Leftlong Btomlong Rghtlong 6 urlTEXT nullTEXT MsgeTEXT altTagTEXT cellTextIsHTMLbool cellTextTEXT horzAlignenum ESliceHorzAlign default vertAlignenum ESliceVertAlign default bgColorTypeenum ESliceBGColorType None topOutsetlong
leftOutsetlong bottomOutsetlong rightOutsetlong 8BIM 8BIM 8BIM 6 f JFIF H H Adobe_CM Adobe d
6" ?
3 !1AQa"q2B#$Rb34rC%Scs5&DTdE£t6UeuF'Vfv7GWgw 5 !1AQaq"2B#R3$brCScs4%&5DTdEU6teuFVfv'7GWgw ? Ui{Ɖs JԺn'S~ [K鳐 ij R7Z&<&C83GVkE4qʱsuo [vY]L6Z78?lV3.ہu?p -w~s]m]W݁k[. $ms_@Ώףw&!$9Ji k`eyBC2iykZH } SUt tv*3?@ =g- \ ]Z0I'O9,fDz,qr93e]$Oj?Tʩ$ꤗʩ$ꤗʩ$ꤗʩ$8BIM! y A d o b e P h o t o s h o p E l e m e n t s A d o b e P h o t o s h o p E l e m e n t s 2 . 0 %
(
3% |7)H#N 5 9)" ! 7* z0# t1%!
5( ! *",/ '*/# !-$(#% t y ! !!f/$o "%d+ m! !!
!! 2%#% "^,"f! !
!! ! ! /$ #%2$ ! ! !
! s." m."x !
B
KH R@
I" ! )"3 7 /3*" 7) 2%
6' 7) G% M !# Z0%a " 6 unison-2.40.102/uimacnew/tableicons/Change_Unmodified.png 0000644 0061316 0061316 00000001260 11361646373 023377 0 ustar bcpierce bcpierce PNG
IHDR a gAMA OX2 tEXtSoftware Adobe ImageReadyqe< BIDATxb?% ( cL2_۷o@| xprrZ 984 33'/o.H @ ! (dafb`j >H*&&x"H @ b3P|K@@H䙘AH @ (! cg3@Y ^ *:
4_i T /@ n?& (] ? ӿT[@p~R/@M?@i/@9˺@ ?SLǏ xxx zϠt rP{>A -i]PVn $`,
/t+YLXa @F *[: IENDB` unison-2.40.102/uimacnew/tableicons/Change_Modified.png 0000644 0061316 0061316 00000001405 11361646373 023035 0 ustar bcpierce bcpierce PNG
IHDR a gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATxb?% )5 ԶLd^?/p$edIQ nAC}u@ c<X*v~ ?5lj? ﾱV 1h߿'SϿLt W< r ެv ߱y x x y x r r r r r v w w w w x Æ ҏ я я ܗ u
E wQ ӑ Ӑ Ґ Ґ Ґ Ґ Ґ ԑ ԑ ԑ ԑ ԑ ԑ ӑ ӑ ӑ ӑ ӑ Ґ я я я я Ւ ٕ L4 , ~V Ӑ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ӑ Ґ я я я я Ւ ڕ O6
- tO Ň я я я ܖ u
G @, }ٔ ԑ ݗ ^@ 9' y " ^ C. ] !
> 6
$ ( 1 : ,2 fL R ./table-right-blue.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 20:53:21 unison-2.40.102/uimacnew/tableicons/table-conflict.tif 0000644 0061316 0061316 00000012170 11361646373 022735 0 ustar bcpierce bcpierce MM * yz @A e ( " bd
| AC a 9 % WY -. N 9 * _` UV
/ * ef |~ DE o % GH m <= u # % " => f R 1 }~ % WX PR x
FG K RR R DE I 7 3
ln
ps
/0 \ 45 d ; *+ M # ## # 34 a " tv 6
" ( 1 : *2 dL R ./table-conflict.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 17:06:34 unison-2.40.102/uimacnew/tableicons/Outline-Flattened.png 0000644 0061316 0061316 00000000767 11361646373 023405 0 ustar bcpierce bcpierce PNG
IHDR $ pHYs gAMA cHRM n r I m? m 1 J mIDATxb?-@ xӿ@ ], E]]}'> ?~d$d@ 1
Oz|ϟ _`S77ii j _~= h 133cgg9 HL$U q@8-x(~_
,Y @D֭[A@(h899闀t Dګ ̲y\?f ^ "N.o(?$x0accƆ=QAG0N>] ݻS - v # ; bb1 [ ` [& IENDB` unison-2.40.102/uimacnew/tableicons/Change_PropsChanged.png 0000644 0061316 0061316 00000001437 11361646373 023677 0 ustar bcpierce bcpierce PNG
IHDR a gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATxb?% ( cԶLd^?/p$edIQ nAC}u@ c<X*;6/~k~g~ }cxh(#(_?"ea
a;o u@LL NY9 ʯX^| >`-ddda U VVG/>3y 20K3 1" [֒ Ց ֓
? z ד ؔ
E Kw aB fE ڕ ד ֒ :( 2" [ԑ p ޘ F0 [Ӑ } ۖ
E J2 ٕ Ւ ד bC s ڶ| ~ Ɋ ҏ я Ґ ޘ [ ) 3# [ٔ I2
p rN ] W ߘ
D 5f ݗ ҏ я ҏ ƈ | } k Lj Ӑ Ӑ ҏ я я я я ٔ ̌ ( g( V & cpM
? ͌ - iyS ܗ
D1! x֒ ד я я я я ҏ Ӑ Ց ~ Ň Ґ Ӑ ҏ я я я я ؔ ͌ ) i( V W% f ?+ ]͌ ] ܖ
D3" z֒ ד я я я я ҏ Ӑ ԑ ~ v ݹ ʊ я я Ґ ݗ ] * 3# [ޘ ' _ ͌ o g kI d ݗ
D 6i ݗ я я Ґ Lj } n fE ڕ ד ד <) 2" [ݘ - f wQ ݗ ޘ Y c ݗ
E L4 ڕ Ւ ד dC aC l
? 1" [ޘ . g ( o b ޗ
E Lw aB kI `A
2" \ݘ . h & l
N b ݗ
F oL kI K % W # C% W E 6
( 1 : &2 `L R ./table-merge.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 17:05:15 unison-2.40.102/uimacnew/tableicons/Change_Absent.png 0000644 0061316 0061316 00000001053 11361646373 022530 0 ustar bcpierce bcpierce PNG
IHDR a gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATxb?% ( cڹY\貔ziIFFƏLLLǁx!Pn/L;@ `1MJXXߢ ?~T{(А@꾁@ӥTUUbx;w2
0jaG ll *** ZZ $@pͫ7 7 h
///τ0l @uPu` 013 ( {!Al bB2u 2^/^`x-333(M0 r,
QLY9ᮓf {["P fco;KXP#@A gU o~U b@L,("@p3ecf< TrdPT˯' b q o wn?f~)0:1
822cE/28@ c .ߜ=e`Vo7#|lrvRk3-:a奍@1| \*J~=H @ $$` P&g >jP k2EWY7L@ 1R` X:R IENDB` unison-2.40.102/uimacnew/tableicons/table-error.tif 0000644 0061316 0061316 00000012206 11361646373 022265 0 ustar bcpierce bcpierce MM * < jl de '( 7 ? {} su '( : mo {} su XY {} }~ rs ce {} su oq ce } cd pr ab mo pr rs } su ac qs {}
su cd }~ |} gi ce {} ac () 9 ce {} 3 '' 7 WX _`
/ 6
$ ( 0 ( 1 : 82 rL R table3-smallerfiles/table-error.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:09 19:39:02 unison-2.40.102/uimacnew/tableicons/Change_Deleted.png 0000644 0061316 0061316 00000001447 11361646373 022671 0 ustar bcpierce bcpierce PNG
IHDR a gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATxb?% ( ct20033aea`SZ o=ؾ哰7Rka?b bA6?ȓQWn4MчϜop ;7,>aw^ ;xnj v@pp}˩s~gWQd```m oпTA 7?v`800|:xӮ(OO0 A d3 'A0ďA 5pr24V0[
& q scڜ l y×g MFPˏK@b Ky>HK~eP,g óI99 `2ϊ>xG _/_DJ
pB ק/y_Ma b acej3oNvA_~qel߾a;PSx )͍ Dqn0 F$Ԁ5 IENDB` unison-2.40.102/uimacnew/tableicons/table-left-green.tif 0000644 0061316 0061316 00000012172 11361646373 023166 0 ustar bcpierce bcpierce MM * 5
> N ) 3 Z 8 F w d | > M { $ B ߢ S h )Y p s +X n z $ D q g = L { + 6 [ 7 E w
@ O # ; 6
$ ( 1 : ,2 fL R ./table-left-green.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 20:53:31 unison-2.40.102/uimacnew/tableicons/Outline-Flat.png 0000644 0061316 0061316 00000001012 11361646373 022345 0 ustar bcpierce bcpierce PNG
IHDR $ pHYs gAMA cHRM n r I m? m 1 J IDATxb?-1@ 0 oq 3 LLL@XDDd @ ϟ?,;7ot&@8-/өSBȻ耑z accbC-`b?ff?XYY`3 pZ rFl.ǦX pZ r3g (p ]q r5(@A
L@8-xJbr ;xϞ=T "AA ?P*PRH011-`666 XD {{ѩӧ fCG2H@ R hn@ *?DN IENDB` unison-2.40.102/uimacnew/tableicons/table-left-blue.tif 0000644 0061316 0061316 00000012170 11361646373 023013 0 ustar bcpierce bcpierce MM *
8 \ D. ] :' y [> ݗ ԑ ٔ @, }
Eu ܗ я я ҏ Æ x w w w w v r r r r r x y x x y v ߦr W< ,L4 ٕ Ւ я я я я Ґ ӑ ӑ ӑ ӑ ӑ ԑ ԑ ԑ ԑ ԑ ԑ Ґ Ґ Ґ Ґ Ґ Ӑ ӑ wQ
-O6 ڕ Ւ я я я я Ґ Ӑ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ґ Ӑ ~V
Gu ܖ я я я Ň tO ^@ ݗ ԑ ٔ @, } " ^ 9' y !] C.
> 6
" ( 1 : *2 dL R ./table-left-blue.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 20:53:25 unison-2.40.102/uimacnew/tableicons/table-right-green.tif 0000644 0061316 0061316 00000012172 11361646373 023351 0 ustar bcpierce bcpierce MM * 5 > N
8 F w ) 3 Z > M { d | S h ݩ ߬ $ B s Y p ) z X n + q $ D = L { g 7 E w + 6 [ @ O
# ; 6
$ ( 1 : ,2 fL R ./table-right-green.tif H H ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org 2006:04:01 20:53:20 unison-2.40.102/uimacnew/Bridge.h 0000644 0061316 0061316 00000003027 11361646373 016566 0 ustar bcpierce bcpierce //
// Bridge.h
// uimac
//
// Created by Craig Federighi on 4/25/07.
// Copyright 2007 __MyCompanyName__. All rights reserved.
//
#import
/*
Bridge supports safe calling from C back to OCaml by using daemon threads
spawned from OCaml to make the actual calls and converting all argument / return values
in the OCaml thread (when in possession of the OCaml lock)
*/
@interface Bridge : NSObject {
}
+ (void)startup:(const char **)argv;
@end
/*
ocamlCall(sig, funcName, [args...]);
Call ocaml function (via safe thread handoff mechanism).
Args/return values are converted to/from C/OCaml according to the
supplied type signture string. Type codes are:
x - void (for return type)
i - long
s - char *
S - NSString *
N - NSNumber *
@ - OCamlValue (see below)
Examples:
long count = (long)ocamlCall("iS", "lengthOfString", @"Some String");
(void)ocamlCall("x", "someVoidOCamlFunction");
OCamlValue *v = (id)ocamlCall("@Si", "makeArray", @"Some String", 10);
NSString s = [v getField:0 withType:'S'];
*/
extern void *ocamlCall(const char *argTypes, ...);
// Wrapper/proxy for unconverted OCaml values
@interface OCamlValue : NSObject {
long _v;
}
- initWithValue:(long)v;
- (void *)getField:(long)i withType:(char)t;
// get value by position. See ocamlCall for list of type conversion codes
- (long)count;
// count of items in array
- (long)value;
// returns Ocaml value directly -- not safe to use except in direct callback from OCaml
// (i.e. in the OCaml thread)
@end
unison-2.40.102/uimacnew/NotificationController.h 0000644 0061316 0061316 00000001037 11361646373 022063 0 ustar bcpierce bcpierce //
// NotificationController.h
// uimac
//
// Created by Alan Schmitt on 02/02/06.
// Copyright 2006, see file COPYING for details. All rights reserved.
//
#import
#import
@interface NotificationController : NSObject
{
}
- (void)updateFinishedFor: (NSString *)profile;
- (void)syncFinishedFor: (NSString *)profile;
/* Implement the GrowlApplicationBridgeDelegate protocol */
- (NSDictionary *)registrationDictionaryForGrowl;
- (NSString *)applicationNameForGrowl;
@end
unison-2.40.102/uimacnew/ReconItem.m 0000644 0061316 0061316 00000043344 11361646373 017272 0 ustar bcpierce bcpierce #import "ReconItem.h"
#import "Bridge.h"
#import
@implementation ReconItem
- init {
[super init];
selected = NO; // NB only used/updated during sorts. Not a
// reliable indicator of whether item is selected
fileSize = -1.;
bytesTransferred = -1.;
return self;
}
- (void)dealloc
{
[path release];
[fullPath release];
// [direction release]; // assuming retained by cache, so not retained
// [directionSortString release]; // no retain/release necessary because is constant
[super dealloc];
}
- (ReconItem *)parent
{
return parent;
}
- (void)setParent:(ReconItem *)p
{
parent = p;
}
- (void)willChange
{
// propagate up parent chain
[parent willChange];
}
- (NSArray *)children
{
return nil;
}
- (BOOL)selected
{
return selected;
}
- (void)setSelected:(BOOL)x
{
selected = x;
}
- (NSString *)path
{
return path;
}
- (void)setPath:(NSString *)aPath
{
[path autorelease];
path = [aPath retain];
// invalidate
[fullPath autorelease];
fullPath = nil;
}
- (NSString *)fullPath
{
if (!fullPath) {
NSString *parentPath = [parent fullPath];
[self setFullPath:(([parentPath length] > 0) ? [parentPath stringByAppendingFormat:@"/%@", path] : path)];
}
return fullPath;
}
- (void)setFullPath:(NSString *)p
{
[fullPath autorelease];
fullPath = [p retain];
}
- (NSString *)left
{
return nil;
}
- (NSString *)right
{
return nil;
}
static NSMutableDictionary *_ChangeIconsByType = nil;
- (NSImage *)changeIconFor:(NSString *)type other:(NSString *)other
{
if (![type length]) {
if ([other isEqual:@"Created"]) {
type = @"Absent";
} else if ([other length]) {
type = @"Unmodified";
} else
return nil;
}
NSImage *result = [_ChangeIconsByType objectForKey:type];
if (!result) {
NSString *imageName = [NSString stringWithFormat:@"Change_%@.png", type];
result = [NSImage imageNamed:imageName];
if (!_ChangeIconsByType) _ChangeIconsByType = [[NSMutableDictionary alloc] init];
[_ChangeIconsByType setObject:result forKey:type];
}
return result;
}
- (NSImage *)leftIcon
{
return [self changeIconFor:[self left] other:[self right]];
}
- (NSImage *)rightIcon
{
return [self changeIconFor:[self right] other:[self left]];
}
- (double)computeFileSize
{
return 0.;
}
- (double)bytesTransferred
{
return 0.;
}
- (long)fileCount
{
return 1;
}
- (double)fileSize
{
if (fileSize == -1.) fileSize = [self computeFileSize];
return fileSize;
}
- (NSString *)formatFileSize:(double)size
{
if (size == 0) return @"--";
if (size < 1024) return @"< 1KB"; // return [NSString stringWithFormat:@"%i bytes", size];
size /= 1024;
if (size < 1024) return [NSString stringWithFormat:@"%i KB", (int)size];
size /= 1024;
if (size < 1024) return [NSString stringWithFormat:@"%1.1f MB", size];
size = size / 1024;
return [NSString stringWithFormat:@"%1.1f GB", size];
}
- (NSString *)fileSizeString
{
return [self formatFileSize:[self fileSize]];
}
- (NSString *)bytesTransferredString
{
return [self formatFileSize:[self bytesTransferred]];
}
- (NSNumber *)percentTransferred
{
double size = [self computeFileSize];
return (size > 0) ? [NSNumber numberWithDouble:([self bytesTransferred] / (size) * 100.0)]
: nil;
}
static NSMutableDictionary *_iconsByExtension = nil;
- (NSImage *)iconForExtension:(NSString *)extension
{
NSImage *icon = [_iconsByExtension objectForKey:extension];
if (!_iconsByExtension) _iconsByExtension = [[NSMutableDictionary alloc] init];
if (!icon) {
icon = [[NSWorkspace sharedWorkspace] iconForFileType:extension];
[icon setSize:NSMakeSize(16.0, 16.0)];
[_iconsByExtension setObject:icon forKey:extension];
}
return icon;
}
- (NSImage *)fileIcon
{
return [self iconForExtension:NSFileTypeForHFSTypeCode(kOpenFolderIcon)];
}
- (NSString *)dirString
{
return @"<-?->";
}
- (NSImage *)direction
{
if (direction) return direction;
NSString * dirString = [self dirString];
BOOL changedFromDefault = [self changedFromDefault];
if ([dirString isEqual:@"<-?->"]) {
if (changedFromDefault | resolved) {
direction = [NSImage imageNamed: @"table-skip.tif"];
directionSortString = @"3";
}
else {
direction = [NSImage imageNamed: @"table-conflict.tif"];
directionSortString = @"2";
}
}
else if ([dirString isEqual:@"---->"]) {
if (changedFromDefault) {
direction = [NSImage imageNamed: @"table-right-blue.tif"];
directionSortString = @"6";
}
else {
direction = [NSImage imageNamed: @"table-right-green.tif"];
directionSortString = @"8";
}
}
else if ([dirString isEqual:@"<----"]) {
if (changedFromDefault) {
direction = [NSImage imageNamed: @"table-left-blue.tif"];
directionSortString = @"5";
}
else {
direction = [NSImage imageNamed: @"table-left-green.tif"];
directionSortString = @"7";
}
}
else if ([dirString isEqual:@"<-M->"]) {
direction = [NSImage imageNamed: @"table-merge.tif"];
directionSortString = @"4";
}
else if ([dirString isEqual:@"<--->"]) {
direction = [NSImage imageNamed: @"table-mixed.tif"];
directionSortString = @"9";
}
else {
direction = [NSImage imageNamed: @"table-error.tif"];
directionSortString = @"1";
}
[direction retain];
return direction;
}
- (void)setDirection:(char *)d
{
[direction autorelease];
direction = nil;
}
- (void)doAction:(unichar)action
{
switch (action) {
case '>':
[self setDirection:"unisonRiSetRight"];
break;
case '<':
[self setDirection:"unisonRiSetLeft"];
break;
case '/':
[self setDirection:"unisonRiSetConflict"];
resolved = YES;
break;
case '-':
[self setDirection:"unisonRiForceOlder"];
break;
case '+':
[self setDirection:"unisonRiForceNewer"];
break;
case 'm':
[self setDirection:"unisonRiSetMerge"];
break;
case 'd':
[self showDiffs];
break;
case 'R':
[self revertDirection];
break;
default:
NSLog(@"ReconItem.doAction : unknown action");
break;
}
}
- (void)doIgnore:(unichar)action
{
switch (action) {
case 'I':
ocamlCall("xS", "unisonIgnorePath", [self fullPath]);
break;
case 'E':
ocamlCall("xS", "unisonIgnoreExt", [self path]);
break;
case 'N':
ocamlCall("xS", "unisonIgnoreName", [self path]);
break;
default:
NSLog(@"ReconItem.doIgnore : unknown ignore");
break;
}
}
/* Sorting functions. These have names equal to
column identifiers + "SortKey", and return NSStrings that
can be automatically sorted with their compare method */
- (NSString *) leftSortKey
{
return [self replicaSortKey:[self left]];
}
- (NSString *) rightSortKey
{
return [self replicaSortKey:[self right]];
}
- (NSString *) replicaSortKey:(NSString *)sortString
{
/* sort order for left and right replicas */
if ([sortString isEqualToString:@"Created"]) return @"1";
else if ([sortString isEqualToString:@"Deleted"]) return @"2";
else if ([sortString isEqualToString:@"Modified"]) return @"3";
else if ([sortString isEqualToString:@""]) return @"4";
else return @"5";
}
- (NSString *) directionSortKey
{
/* Since the direction indicators are unsortable images, use
directionSortString instead */
if ([directionSortString isEqual:@""])
[self direction];
return directionSortString;
}
- (NSString *) progressSortKey
{
/* Percentages, "done" and "" are sorted OK without help,
but "start " should be sorted after "" and before "0%" */
NSString * progressString = [self progress];
if ([progressString isEqualToString:@"start "]) progressString = @" ";
return progressString;
}
- (NSString *) pathSortKey
{
/* default alphanumeric sort is fine for paths */
return [self path];
}
- (NSString *)progress
{
return nil;
}
- (BOOL)transferInProgress
{
double soFar = [self bytesTransferred];
return (soFar > 0) && (soFar < [self fileSize]);
}
- (void)resetProgress
{
}
- (NSString *)progressString
{
NSString *progress = [self progress];
if ([progress length] == 0. || [progress hasSuffix:@"%"])
progress = [self transferInProgress] ? [self bytesTransferredString] : @"";
else if ([progress isEqual:@"done"]) progress = @"";
return progress;
}
- (NSString *)details
{
return nil;
}
- (NSString *)updateDetails
{
return [self details];
}
- (BOOL)isConflict
{
return NO;
}
- (BOOL)changedFromDefault
{
return NO;
}
- (void)revertDirection
{
[self willChange];
[direction release];
direction = nil;
resolved = NO;
}
- (BOOL)canDiff
{
return NO;
}
- (void)showDiffs
{
}
- (ReconItem *)collapseParentsWithSingleChildren:(BOOL)isRoot
{
return self;
}
@end
// --- Leaf items -- actually corresponding to ReconItems in OCaml
@implementation LeafReconItem
- initWithRiAndIndex:(OCamlValue *)v index:(long)i
{
[super init];
ri = [v retain];
index = i;
resolved = NO;
directionSortString = @"";
return self;
}
-(void)dealloc
{
[ri release];
[left release];
[right release];
[progress release];
[details release];
[super dealloc];
}
- (NSString *)path
{
if (!path) path = [(NSString *)ocamlCall("S@", "unisonRiToPath", ri) retain];
return path;
}
- (NSString *)left
{
if (!left) left = [(NSString *)ocamlCall("S@", "unisonRiToLeft", ri) retain];
return left;
}
- (NSString *)right
{
if (!right) right = [(NSString *)ocamlCall("S@", "unisonRiToRight", ri) retain];
return right;
}
- (double)computeFileSize
{
return [(NSNumber *)ocamlCall("N@", "unisonRiToFileSize", ri) doubleValue];
}
- (double)bytesTransferred
{
if (bytesTransferred == -1.) {
// need to force to fileSize if done, otherwise may not match up to 100%
bytesTransferred = ([[self progress] isEqual:@"done"]) ? [self fileSize]
: [(NSNumber*)ocamlCall("N@", "unisonRiToBytesTransferred", ri) doubleValue];
}
return bytesTransferred;
}
- (NSImage *)fileIcon
{
NSString *extension = [[self path] pathExtension];
if ([@"" isEqual:extension]) {
NSString *type = (NSString *)ocamlCall("S@", "unisonRiToFileType", ri);
extension = [type isEqual:@"dir"]
? NSFileTypeForHFSTypeCode(kGenericFolderIcon)
: NSFileTypeForHFSTypeCode(kGenericDocumentIcon);
}
return [self iconForExtension:extension];
}
- (NSString *)dirString
{
return (NSString *)ocamlCall("S@", "unisonRiToDirection", ri);
}
- (void)setDirection:(char *)d
{
[self willChange];
[super setDirection:d];
ocamlCall("x@", d, ri);
}
- (NSString *)progress
{
if (!progress) {
progress = [(NSString *)ocamlCall("S@", "unisonRiToProgress", ri) retain];
if ([progress isEqual:@"FAILED"]) [self updateDetails];
}
return progress;
}
- (void)resetProgress
{
// Get rid of the memoized progress because we expect it to change
[self willChange];
bytesTransferred = -1.;
[progress release];
// Force update now so we get the result while the OCaml thread is available
// [self progress];
// [self bytesTransferred];
progress = nil;
}
- (NSString *)details
{
if (details) return details;
return [self updateDetails];
}
- (NSString *)updateDetails
{
[details autorelease];
details = [(NSString *)ocamlCall("S@", "unisonRiToDetails", ri) retain];
return details;
}
- (BOOL)isConflict
{
return ((long)ocamlCall("i@", "unisonRiIsConflict", ri) ? YES : NO);
}
- (BOOL)changedFromDefault
{
return ((long)ocamlCall("i@", "changedFromDefault", ri) ? YES : NO);
}
- (void)revertDirection
{
ocamlCall("x@", "unisonRiRevert", ri);
[super revertDirection];
}
- (BOOL)canDiff
{
return ((long)ocamlCall("i@", "canDiff", ri) ? YES : NO);
}
- (void)showDiffs
{
ocamlCall("x@i", "runShowDiffs", ri, index);
}
@end
@interface NSImage (TintedImage)
- (NSImage *)tintedImageWithColor:(NSColor *) tint operation:(NSCompositingOperation) op;
@end
@implementation NSImage (TintedImage)
- (NSImage *)tintedImageWithColor:(NSColor *) tint operation:(NSCompositingOperation) op
{
NSSize size = [self size];
NSRect imageBounds = NSMakeRect(0, 0, size.width, size.height);
NSImage *newImage = [[NSImage alloc] initWithSize:size];
[newImage lockFocus];
[self compositeToPoint:NSZeroPoint operation:NSCompositeSourceOver];
[tint set];
NSRectFillUsingOperation(imageBounds, op);
[newImage unlockFocus];
return [newImage autorelease];
}
@end
// ---- Parent nodes in grouped items
@implementation ParentReconItem
- init
{
[super init];
_children = [[NSMutableArray alloc] init];
return self;
}
- initWithPath:(NSString *)aPath
{
[self init];
path = [aPath retain];
return self;
}
- (void)dealloc
{
[_children release];
[super dealloc];
}
- (NSArray *)children;
{
return _children;
}
- (void)addChild:(ReconItem *)item pathArray:(NSArray *)pathArray level:(int)level
{
NSString *element = [pathArray count] ? [pathArray objectAtIndex:level] : @"";
// if we're at the leaf of the path, then add the item
if (((0 == [pathArray count]) && (0 == level)) || (level == [pathArray count]-1)) {
[item setParent:self];
[item setPath:element];
[_children addObject:item];
return;
}
// find / add matching parent node
ReconItem *last = [_children lastObject];
if (last == nil || ![last isKindOfClass:[ParentReconItem class]] || ![[last path] isEqual:element]) {
last = [[ParentReconItem alloc] initWithPath:element];
[last setParent:self];
[_children addObject:last];
[last release];
}
[(ParentReconItem *)last addChild:item pathArray:pathArray level:level+1];
}
- (void)addChild:(ReconItem *)item nested:(BOOL)nested
{
[item setPath:nil]; // invalidate/reset
if (nested) {
[self addChild:item pathArray:[[item path] pathComponents] level:0];
} else {
[item setParent:self];
[_children addObject:item];
}
}
- (void)sortUsingDescriptors:(NSArray *)sortDescriptors
{
// sort our children
[_children sortUsingDescriptors:sortDescriptors];
// then have them sort theirs
int i = [_children count];
while (i--) {
id child = [_children objectAtIndex:i];
if ([child isKindOfClass:[ParentReconItem class]]) [child sortUsingDescriptors:sortDescriptors];
}
}
- (ReconItem *)collapseParentsWithSingleChildren:(BOOL)isRoot
{
// replace ourselves?
if (!isRoot && [_children count] == 1) {
ReconItem *child = [_children lastObject];
[child setPath:[path stringByAppendingFormat:@"/%@", [child path]]];
return [child collapseParentsWithSingleChildren:NO];
}
// recurse
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
ReconItem *replacement = [child collapseParentsWithSingleChildren:NO];
if (child != replacement) {
[_children replaceObjectAtIndex:i withObject:replacement];
[replacement setParent:self];
}
}
return self;
}
- (void)willChange
{
// invalidate child-based state
// Assuming caches / constant, so not retained / released
// [direction autorelease];
// [directionSortString autorelease];
direction = nil;
directionSortString = nil;
bytesTransferred = -1.;
// fileSize = -1;
// resolved = NO;
// propagate up parent chain
[parent willChange];
}
// Propagation methods
- (void)doAction:(unichar)action
{
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
[child doAction:action];
}
}
- (void)doIgnore:(unichar)action
{
// handle Path ignores at this level, name and extension at the child nodes
if (action == 'I') {
[super doIgnore:'I'];
} else {
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
[child doIgnore:action];
}
}
}
// Rollup methods
- (long)fileCount
{
if (fileCount == 0) {
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
fileCount += [child fileCount];
}
}
return fileCount;
}
- (double)computeFileSize
{
double size = 0;
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
size += [child fileSize];
}
return size;
}
- (double)bytesTransferred
{
if (bytesTransferred == -1.) {
bytesTransferred = 0.;
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
bytesTransferred += [child bytesTransferred];
}
}
return bytesTransferred;
}
- (NSString *)dirString
{
NSString *rollup = nil;
int i = [_children count];
while (i--) {
ReconItem *child = [_children objectAtIndex:i];
NSString *dirString = [child dirString];
if (!rollup || [dirString isEqual:rollup]) {
rollup = dirString;
} else {
// conflict
if ([dirString isEqual:@"---->"] || [dirString isEqual:@"<----"] || [dirString isEqual:@"<--->"]) {
if ([rollup isEqual:@"---->"] || [rollup isEqual:@"<----"] || [rollup isEqual:@"<--->"]) {
rollup = @"<--->";
}
} else {
rollup = @"<-?->";
}
}
}
// NSLog(@"dirString for %@: %@", path, rollup);
return rollup;
}
- (BOOL)hasConflictedChildren
{
NSString *dirString = [self dirString];
BOOL result = [dirString isEqual:@"<--->"] || [dirString isEqual:@"<-?->"];
// NSLog(@"hasConflictedChildren (%@): %@: %i", [self path], dirString, result);
return result;
}
static NSMutableDictionary *_parentImages = nil;
static NSColor *_veryLightGreyColor = nil;
- (NSImage *)direction
{
if (!_parentImages) {
_parentImages = [[NSMutableDictionary alloc] init];
_veryLightGreyColor = [[NSColor colorWithCalibratedRed:0.7 green:0.7 blue:0.7 alpha:1.0] retain];
}
NSImage *baseImage = [super direction];
NSImage *parentImage = [_parentImages objectForKey:baseImage];
if (!parentImage) {
// make parent images a grey version of the leaf images
parentImage = [baseImage tintedImageWithColor:_veryLightGreyColor operation:NSCompositeSourceIn];
[_parentImages setObject:parentImage forKey:baseImage];
}
return parentImage;
}
@end
unison-2.40.102/uimacnew/MyController.h 0000644 0061316 0061316 00000006037 11361646373 020027 0 ustar bcpierce bcpierce /* MyController */
/* Copyright (c) 2003, see file COPYING for details. */
#import
@class ProfileController, PreferencesController, NotificationController,
ReconItem, ParentReconItem, ReconTableView, UnisonToolbar, OCamlValue;
@interface MyController : NSObject
{
IBOutlet NSWindow *mainWindow;
UnisonToolbar *toolbar;
IBOutlet NSWindow *cltoolWindow;
IBOutlet NSButton *cltoolPref;
IBOutlet ProfileController *profileController;
IBOutlet NSView *chooseProfileView;
NSString *myProfile;
IBOutlet PreferencesController *preferencesController;
IBOutlet NSView *preferencesView;
IBOutlet NSView *updatesView;
IBOutlet NSView *ConnectingView;
NSView *blankView;
IBOutlet ReconTableView *tableView;
IBOutlet NSTextField *updatesText;
IBOutlet NSTextView *detailsTextView;
IBOutlet NSTextField *statusText;
IBOutlet NSWindow *passwordWindow;
IBOutlet NSTextField *passwordPrompt;
IBOutlet NSTextField *passwordText;
IBOutlet NSButton *passwordCancelButton;
BOOL waitingForPassword;
IBOutlet NSWindow *aboutWindow;
IBOutlet NSTextField *versionText;
IBOutlet NSProgressIndicator *progressBar;
IBOutlet NotificationController *notificationController;
BOOL syncable;
BOOL duringSync;
BOOL afterSync;
NSMutableArray *reconItems;
ParentReconItem *rootItem;
OCamlValue *preconn;
BOOL doneFirstDiff;
IBOutlet NSWindow *diffWindow;
IBOutlet NSTextView *diffView;
IBOutlet NSSegmentedControl *tableModeSelector;
}
- (id)init;
- (void)awakeFromNib;
- (void)chooseProfiles;
- (IBAction)createButton:(id)sender;
- (IBAction)saveProfileButton:(id)sender;
- (IBAction)cancelProfileButton:(id)sender;
- (NSString *)profile;
- (void)profileSelected:(NSString *)aProfile;
- (IBAction)restartButton:(id)sender;
- (IBAction)rescan:(id)sender;
- (IBAction)openButton:(id)sender;
- (void)connect:(NSString *)profileName;
- (void)raisePasswordWindow:(NSString *)prompt;
- (void)controlTextDidEndEditing:(NSNotification *)notification;
- (IBAction)endPasswordWindow:(id)sender;
- (void)afterOpen;
- (IBAction)syncButton:(id)sender;
- (IBAction)tableModeChanged:(id)sender;
- (void)initTableMode;
- (NSMutableArray *)reconItems;
- (void)updateForChangedItems;
- (void)updateReconItems:(OCamlValue *)items;
- (id)updateForIgnore:(id)i;
- (void)statusTextSet:(NSString *)s;
- (void)diffViewTextSet:(NSString *)title bodyText:(NSString *)body;
- (void)displayDetails:(ReconItem *)item;
- (void)clearDetails;
- (IBAction)raiseCltoolWindow:(id)sender;
- (IBAction)cltoolYesButton:(id)sender;
- (IBAction)cltoolNoButton:(id)sender;
- (IBAction)raiseAboutWindow:(id)sender;
- (IBAction)raiseWindow:(NSWindow *)theWindow;
- (IBAction)onlineHelp:(id)sender;
- (IBAction)installCommandLineTool:(id)sender;
- (BOOL)validateItem:(IBAction *) action;
- (BOOL)validateMenuItem:(NSMenuItem *)menuItem;
- (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem;
- (void)resizeWindowToSize:(NSSize)newSize;
- (float)toolbarHeightForWindow:(NSWindow *)window;
@end
unison-2.40.102/uimacnew/English.lproj/ 0000755 0061316 0061316 00000000000 12050210657 017721 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/English.lproj/MainMenu.nib/ 0000755 0061316 0061316 00000000000 12050210657 022201 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/English.lproj/MainMenu.nib/classes.nib 0000644 0061316 0061316 00000015035 11361646373 024350 0 ustar bcpierce bcpierce
IBClasses
CLASS
NSSegmentedControl
LANGUAGE
ObjC
SUPERCLASS
NSControl
CLASS
NSOutlineView
LANGUAGE
ObjC
SUPERCLASS
NSTableView
CLASS
ProfileTableView
LANGUAGE
ObjC
OUTLETS
myController
MyController
SUPERCLASS
NSTableView
CLASS
ProfileController
LANGUAGE
ObjC
OUTLETS
tableView
NSTableView
SUPERCLASS
NSObject
CLASS
NotificationController
LANGUAGE
ObjC
SUPERCLASS
NSObject
ACTIONS
anyEnter
id
localClick
id
remoteClick
id
CLASS
PreferencesController
LANGUAGE
ObjC
OUTLETS
firstRootText
NSTextField
localButtonCell
NSButtonCell
profileNameText
NSTextField
remoteButtonCell
NSButtonCell
secondRootHost
NSTextField
secondRootText
NSTextField
secondRootUser
NSTextField
SUPERCLASS
NSObject
ACTIONS
copyLR
id
copyRL
id
forceNewer
id
forceOlder
id
ignoreExt
id
ignoreName
id
ignorePath
id
leaveAlone
id
merge
id
revert
id
selectConflicts
id
showDiff
id
CLASS
FirstResponder
LANGUAGE
ObjC
SUPERCLASS
NSObject
CLASS
MessageProgressIndicator
LANGUAGE
ObjC
SUPERCLASS
NSProgressIndicator
ACTIONS
cancelProfileButton
id
cltoolNoButton
id
cltoolYesButton
id
createButton
id
endPasswordWindow
id
installCommandLineTool
id
onlineHelp
id
openButton
id
raiseAboutWindow
id
raiseCltoolWindow
id
raiseWindow
NSWindow
rescan
id
restartButton
id
saveProfileButton
id
syncButton
id
tableModeChanged
id
CLASS
MyController
LANGUAGE
ObjC
OUTLETS
ConnectingView
NSView
aboutWindow
NSWindow
chooseProfileView
NSView
cltoolPref
NSButton
cltoolWindow
NSWindow
detailsTextView
NSTextView
diffView
NSTextView
diffWindow
NSWindow
mainWindow
NSWindow
notificationController
NotificationController
passwordCancelButton
NSButton
passwordPrompt
NSTextField
passwordText
NSTextField
passwordWindow
NSWindow
preferencesController
PreferencesController
preferencesView
NSView
profileController
ProfileController
progressBar
NSProgressIndicator
statusText
NSTextField
tableModeSelector
NSSegmentedControl
tableView
ReconTableView
updatesText
NSTextField
updatesView
NSView
versionText
NSTextField
SUPERCLASS
NSObject
ACTIONS
copyLR
id
copyRL
id
forceNewer
id
forceOlder
id
ignoreExt
id
ignoreName
id
ignorePath
id
leaveAlone
id
merge
id
revert
id
selectConflicts
id
showDiff
id
CLASS
ReconTableView
LANGUAGE
ObjC
SUPERCLASS
NSOutlineView
IBVersion
1
unison-2.40.102/uimacnew/English.lproj/MainMenu.nib/keyedobjects.nib 0000644 0061316 0061316 00000133215 11361646373 025367 0 ustar bcpierce bcpierce bplist00
X$versionT$topY$archiverX$objects ]IB.objectdata_NSKeyedArchiver 1 5 9 @ C D H L &',-.1569<=>AF[m{|}~ \ !%,-.3UVWabistw~
#$*+.7:?@JKQRY^_fgmnqvw|}
!37>CKLTUZ[cdlmopqwx{~
$,-45=>FGHNOQYZabjks tvyz~
()./78<CDEJKPQVW\cdefknoV !"%&./78=HQRSW![^fgnors tuvwz{ 8 tuv
$%,-078ABEFMNVWY`aijtuvklqxy
! " % 1 2 3 6 ? @ D E F I J K P W X ` a c e f k l q | } ~ tuv
#
$
.
/
9
:
;
<
?
H
I
P
Q
R
S
X
Y
^
c
d
i
s
t
v
x
}
9
tuv
! % . / 6 7 : ; = > C H I N U Y Z [ \ # ( ) * 9 B C K ( T a h i j s | } ( ( (
B
'
!"#$%&'()*+,-./012345678 9:;<=>?@ABCDEFG.HIJKLMNOPQRSTUVWXYZ[\]^_`
4abcdefghijklmnopqrstuvwxyz{|}~
U$null
! " # $ % & ' ( ) * + , - . / 0VNSRootV$class]NSObjectsKeys_NSClassesValues_NSAccessibilityOidsValues]NSConnections[NSNamesKeys[NSFramework]NSClassesKeysZNSOidsKeys]NSNamesValues_NSAccessibilityConnectors]NSFontManager_NSVisibleWindows_NSObjectsValues_NSAccessibilityOidsKeysYNSNextOid\NSOidsValuesށ > 2 3 4[NSClassName 6 7 8YNS.string]NSApplication : ; < =X$classesZ$classname = > ?_NSMutableStringXNSStringXNSObject : ; A B B ?^NSCustomObject_IBCocoaFramework E F GZNS.objects : ; I J J K ?\NSMutableSetUNSSet E M NHM O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t u v w x y z { | } ~
"1dinrӀـ28=?DHW\^fjlnpuŁǁɁρځށ
#%CKM\`bŁǁȁՁց ]NSDestinationXNSSourceWNSLabel!
2 3 _PreferencesController _NSNextResponderWNSFrameVNSCellXNSvFlagsYNSEnabledXNSWindow[NSSuperview ZNSSubviews _{{134, 56}, {91, 22}} [NSCellFlags_NSBackgroundColorZNSContentsYNSSupport]NSControlView\NSCellFlags2_NSDrawsBackground[NSTextColorqA
@ P VNSSizeVNSNameXNSfFlags#@* \LucidaGrande : ; ߢ ?VNSFont WNSColor\NSColorSpace[NSColorName]NSCatalogNameVSystem_textBackgroundColor WNSWhiteB1 : ; ? YtextColor B0 : ; ?_NSTextFieldCell\NSActionCell : ; ?[NSTextFieldYNSControlVNSView[NSResponder^secondRootUser : ;
?_NSNibOutletConnector^NSNibConnector
0-#/ WNSTitle_NSKeyEquivModMaskZNSKeyEquiv]NSMnemonicLocYNSOnImage\NSMixedImageVNSMenu,% &*$ !"#$%[NSMenuItems_Install command-line tool 2()*+^NSResourceName)'(WNSImage_NSMenuCheckmark : ;/00 ?_NSCustomResource 2()*4)'+_NSMenuMixedState : ;788 ?ZNSMenuItem 2 3;.\MyController_raiseCltoolWindow: : ;?@@
?_NSNibControlConnector C
E!2-c GHIJ KL M NOPQ RSTUVWXO +_NSTextContainerYNSTVFlags\NSSharedData[NSDragTypes[NSFrameSizeYNSMaxSizeXNSMinizeZNSDelegate3bBK4 @`Aa3 \] ^ _ `abcdefgCW aCXNSCursorYNScvFlagsYNSDocViewYNSBGColor]NSNextKeyVieww4z{y 2Aw2 E Fopqrstuvwxyz56789:;<=>?_NeXT RTFD pasteboard type_Apple PDF pasteboard type_NSStringPboardType_Apple HTML pasteboard type_1NeXT Encapsulated PostScript v1.2 pasteboard type_ NeXT TIFF v4.0 pasteboard type_NSColor pasteboard type_Apple PICT pasteboard type_NSFilenamesPboardType_#CorePasteboardFlavorType 0x6D6F6F76_*NeXT Rich Text Format v1.0 pasteboard typeY{635, 41} CYNSTCFlagsZNSTextViewWNSWidth_NSLayoutManagerJ2#@ C N +_NSTextContainers]NSTextStorageYNSLMFlagsIGD >N +FE 6 7 Ӏ : ; ?_NSMutableAttributedString_NSAttributedString E MHQB : ; ?^NSMutableArrayWNSArray : ; ? : ;GG ? +WNSFlags_NSDefaultParagraphStyle_NSInsertionColor_NSSelectedAttributes_NSMarkedAttributes_NSLinkAttributes_ a] L U EWNS.keysTÀMNƀOR QP_selectedTextBackgroundColor πK0.66666669 S_selectedTextColor : ;آ ?\NSDictionary E߀TÀVWNXY\[NSUnderline YNSHotSpot\NSCursorType[Z
W{8, -8} : ;\\ ? UNSRGBF0 0 1 +ZNSTabStops ^ : ; ?_NSParagraphStyle : ; ?_NSTextViewSharedData\{828, 1e+07}Y{634, 41} : ; ?VNSText_detailsTextView 0eh ,g&*f !"_!Revert to Unison's RecommendationWrevert:
0-jm ,kl&*fWRestartQr^restartButton: #$0oq ' ,p&*fTDiffYshowDiff: 0
2!s- 4 567 89:;< K 2=> ?@ABCDEF IJeK L WOPQAST_ NSDraggingSourceMaskForNonLocalYNSTvFlags_NSOriginalClassName\NSHeaderView_NSAllowsTypeSelect\NSCornerView_NSIntercellSpacingWidth_NSColumnAutoresizingStyle_NSIntercellSpacingHeight[NSGridColor_ NSDraggingSourceMaskForLocal^NSTableColumns[NSRowHeightv ux |#@ #@ w Atv#@2 ^ReconTableView[NSTableView ] ^ _ `XbZe[g0W^X0}4onsA}sZ{635, 391} K Vcd eWc0y{zAys ] ^ _ `XblemgFW^XF}4utxA}xY{635, 17} : ;uvv ?_NSTableHeaderView Xyz{WX}~ A} 9 K `IcWAA[NSHScrollerXNSsFlags_NSHeaderClipView\NSScrollAmts[NSVScroller]NSContentViewkr>|ymO A A vAkpvv_{{-26, 0}, {16, 17}} : ; ?]_NSCornerView E MH V 0^NSIsResizeable\NSHeaderCell\NSIdentifierZNSDataCell^NSResizingMask_NSSortDescriptorPrototypeZNSMinWidthZNSMaxWidth #@z #@; #@@ sTpath @ TPath #@& [headerColor _headerTextColor : ;Х ?_NSTableHeaderCell ^0 1@ s ހ#@( Q_controlBackgroundColor _controlTextColor UNSKeyZNSSelector[NSAscending [pathSortKeyXcompare: : ; ?_NSSortDescriptor : ; ?]NSTableColumn V 0 #@Q s^fileSizeString
TSize ^0 ـ s XfileSize V ! 0#@0 sXleftIcon &'Q< -K0.33333299 /01 234BBB5 WNSStyleWNSAlignWNSScaleZNSAnimates : ;899 ?[NSImageCell <= [leftSortKey VBCDEFGH0#@S( #@E #@Y s_percentTransferred N
VAction ^0 ـ s [\ _directionSortKey Vab cd 0sYrightIcon jQ> /01 234BBB5 st \rightSortKey y z YgridColor D0.5 : ; ?^NSClassSwapperYtableView
!- р( K ӁԀ_{{370, 317}, {83, 24}} B_NSSegmentImages_NSSelectedSegment Ѐ E MHĀȀ _NSSegmentItemImage_NSSegmentItemImageScaling_NSSegmentItemWidth_NSSegmentItemLabel_NSSegmentItemTagǀ#@8 2()*)'\Outline-Flat : ; ?]NSSegmentItem _NSSegmentItemSelectedǀ#@9UU` 2()*ŀ)'_Outline-FlattenedQO ǀ̀ 2()*π)'\Outline-DeepQD : ;Ԥ ?_NSSegmentedCell : ;ץ ?_NSSegmentedControl_tableModeSelector ܀0Ԁ ,ր׀&* !"[Ignore PathQi[ignorePath:
!ڀ- ۀ ܀ ݀ K ݀݁_{{22, 127}, {220, 17}} @ ߀@ U?.?.?[versionText
!-1 K 2 [NSExtension0,./- E M H %) " # $ % &'
B)*+-. 0
2YNSBoxType[NSTitleCell]NSTransparent\NSBorderTypeYNSOffsets_NSTitlePosition E M5H2 :; E M@HAB 2 FG 2 _{{11, 20}, {30, 17}} NO ARـ @ VFile:
X Q\controlColor 2 ^_. 2 _{{46, 18}, {427, 22}} B Ҁ _{{2, 2}, {493, 51}} : ;n ?_{{20, 129}, {497, 71}}V{0, 0} t Bv ZFirst root zM0 0.80000001 : ;|}} ?UNSBox " # $ % &'
B). 0
"! E MH E MH
N [NSProtoCellYNSNumRows^NSSelectedCell[NSCellClass_NSCellBackgroundColorZNSCellSizeYNSNumCols_NSIntercellSpacing]NSMatrixFlagsWNSCells
D( _{{12, 39}, {70, 38}} E MH B B_NSAlternateContents_NSPeriodicInterval^NSButtonFlags2_NSAlternateImage_NSKeyEquivalent_NSPeriodicDelay]NSButtonFlags H_tableModeChanged: 0@C ,AB&*4ZSelect AllQaZselectAll: 0EG ,F&*f_Propagate Older to Newer[forceOlder:
!I-V GHI LM NP T +JbKLQTUJ \] K^_ `beg 4II_{{0, 2}, {505, 14}} ـJI#@ M N +IPN >N +FO 6 7 Ӏ E MHāL + +_+ R S ETÀMNƀOR ETÀVNX\\{505, 1e+07}X{114, 0}XdiffView 0X[
,YZ&*$[Hide UnisonQhUhide:
0!-s]ZdataSource
!-_e 6 2 C"#$ & bcad `b_NSSecureTextField + ,- WR_{{20, 60}, {187, 22}} Ҁ _ Xdelegate :;0gi > ,h&*f_Propagate Newer to Older[forceNewer:
I! -k_preferencesController O! m_remoteButtonCell U!) o_profileNameText Z[0qt ^_ ,rs&*$[Quit UnisonQqZterminate: hi2!xv 2 3mw_ProfileController 4 567 89:;< K 2=> ?@pBCrst wJeKx z{PQp~{@ z~ | }y{#@1 _ProfileTableView ] ^ _ `beghz^h432x}xZ{306, 190} K Vd zh{}x ] ^ _ `begtz^t4<;~}~Y{306, 17} y z} 9 `wzpp&9>=1OA A A A }&5{{_{{307, 0}, {16, 17}} E MH V h #@r #@G` xXprofiles XProfiles - hـ x Հ0 ,&*$XShow All_unhideAllApplications: ! ^secondRootHost B![nextKeyView
!- L \NSWindowView\NSScreenRect]NSWindowTitleYNSWTFlags]NSWindowClass\NSWindowRect_NSWindowBacking_NSWindowStyleMaskYNSMinSize[NSViewClassہpx _{{194, 458}, {262, 266}} 6 7TView E M H
ۀ ݀_{{22, 152}, {220, 22}} # Ҁ VUnison T$ހ_LucidaGrande-Bold )* ۀ ݀_{{22, 20}, {224, 52}} 23
5 Ҁ @ oW C o p y r i g h t 1 9 9 9 - 2 0 0 6 .
T h i s s o f t w a r e i s l i c e n s e d u n d e r t h e G N U G e n e r a l P u b l i c L i c e n s e . : <#@$ > J @A CD ZNSEditableہ ݀ E FJqLtxuw69=:<_Apple PNG pasteboard type_{{20, 182}, {224, 64}} / 01 234BUBB5 2()*Z)' : ;\]] ?[NSImageView ab ۀ ݀_{{22, 101}, {224, 18}} jk Ҁ _Sync you very much! qހ]Optima-ItalicZ{262, 266}_{{0, 0}, {1920, 1178}}Z{213, 129}_{3.40282e+38, 3.40282e+38} : ;xyy ?_NSWindowTemplate[aboutWindow
~ !-e 2 3
0- ,&*$\About Unison_raiseAboutWindow: 0 ,À&*4UPasteQvVpaste: ! _localButtonCell 0 [localClick:
0-ʁ ,ˁ̀&*f_Synchronize allQg[syncButton: !
À!Ѐ- L# πցp( сׁ_{{0, 364}, {480, 360}} 6 7 E MՀHZ{480, 360}ZmainWindow ܀0ہ j ,܀&*f_Propagate Left to RightWcopyLR:
!߀- L# _{{163, 135}, {400, 229}} 6 7 + E MH _{{302, 12}, {84, 32}} @SYes 6 7 Ӏ : ; ?XNSButton ! _{{20, 188}, {383, 21}} N()Rـ ꀏ_7Would you like to install the Unison command-line tool? $ހ 34 _{{17, 36}, {145, 18}} ; =@ʁ _Don't ask me again DXNSSwitch IJ _{{218, 12}, {84, 32}} RS RNo 6 7 Ӏ \] _{{17, 60}, {366, 120}} Ndgـ @ _The command-line tool is a small program that can be installed in a standard place on your computer (/usr/bin/unison) so Unison can easily be found. If you want to be able to synchronize files on this computer by running Unison on a remote computer, you should probably install it.
If you don't install it now, you can do so later by choosing 'Install command-line tool' from the Unison menu.
_{{1, 9}, {400, 229}}\cltoolWindow
op0- tu b b_{{115, 12}, {98, 32}} {|}~ o
8 XContinue ހ YHelvetica 6 7 Ӏ 6 7 Ӏ_endPasswordWindow:
0 !-se ! ^secondRootText !
!
0-_cltoolYesButton: 0 ,&*fUMergeVmerge:
0-_cltoolNoButton: 0 ' , &*f_Propagate Right to LeftWcopyRL: ʀ0 " , !&*f[Leave AloneQ/[leaveAlone:
hـ!-x$\myController
߀!&-B K 2 z z}0'?}A/@ E MH(, z& )*
}&_{{17, 236}, {329, 25}} N 5ـ +(_,Please choose a profile or create a new one
z&-. }&_{{651, -524}, {84, 32}} 0/,TQuit 6 7 Ӏ E M Hpw{59 E M Hhx_{{1, 17}, {306, 190}} : ; # $ $ ?ZNSClipView & ' ( + , z . 0XNSTargetXNSActionYNSPercent86}7#?` _{{307, 17}, {15, 190}}\_doScroller: : ; 4 5 5 ?ZNSScroller & ' ( + :{z . >8:}7#? _{{-100, -100}, {113, 15}} E M BHt~_{{1, 0}, {306, 17}}_{{20, 20}, {323, 208}} : ; G H H ?\NSScrollViewZ{363, 281}_chooseProfileView M
O!D-J S T bEF b_{{14, 12}, {84, 32}} Z| \ ] MHIGDVCancel 6 7 Ӏ 6 7 Ӏ_passwordCancelButton
j!_-L\passwordText n
p!N-[ L t u w x y z {bXPOZYQ_{{2, 118}, {227, 128}}^PasswordWindow 6 7 E M H o M _DS b TU b_{{22, 90}, {183, 17}} N Rـ VS_Please enter your password
_{{1, 9}, {227, 128}}^passwordWindow 0]_ ,^&*4_Select Conflicts_selectConflicts: i
!v-a_profileController
!c- K 2 W W A0dAA/ E M H ek 6 2 C H W ZNSMaxValueYNSpiFlags\NSDrawMatrixcjg"Af@ ch_MessageProgressIndicator_NSProgressIndicator сi : ; Ԣ ?ZNSPSMatrix_{{18, 16}, {641, 20}} W clAc E M ߀HXa}w E M HAcIvpry| E M H0s_{{1, 17}, {635, 391}} & ' (XX + {W .X }}8qA7}#?ڮ _{{-30, 17}, {15, 391}} & ' (XX + {W .X
}}8sA7}#? _{{-100, -100}, {629, 15}} E M
HFx_{{1, 0}, {635, 17}}Z{637, 409} `
.W
OOk>xO Ak}33 E M
HO
3} E M
HC2_{{1, 1}, {635, 41}}
"[|W{4, -5} & '
%aa +
) {W .a
-ZNSCurValueww8~A7w#? _{{-30, 1}, {15, 45}} & '
% (aa +
3
4{W .a
-
8ww8A7w#?B` _{{-100, -100}, {87, 18}}_{{0, 418}, {637, 43}}_{{20, 44}, {637, 461}} : ;
=
>
> ?[NSSplitView
B
C
D W c Ac_{{20, 513}, {637, 13}} N
L3 gـ _Label Font TextZ{677, 546}[updatesView
W!-ZstatusText
Mp0-D
b0 \remoteClick:
f
h!- L
j
l'
n
o
pQ
q
rp_{{519, 382}, {505, 342}} 6 7 6 7 +
{
| E M
Hˁ K `
j
j
>?JJ E M
H
J E M
HIZ{505, 342}
B[W{1, -1} & '
% +
{ .
-87_{{-30, 1}, {15, 356}} & '
% ( +
.
-
887_{{1, 9}, {505, 342}}ZdiffWindow
0
,&*[Ignore NameQn[ignoreName:
!-ZcltoolPref
ŀ!- 2 3
Ȁ_NotificationController_notificationController
0
,&*_Ignore ExtensionQeZignoreExt:
݀!e-[progressBar 0
!s_outlineTableColumn
0
, Z&*$[Hide Others_hideOtherApplications:
!S-^passwordPrompt
0- ,À&*fVRescanWrescan: !߁_initialFirstResponder B !)
!ɀ- K 2 ʁ0ˁсʁӁ/ E M #H $ ( ) * ɀ ́- ʁ_{{315, 303}, {263, 19}} 2 3 $ Ҁ ρЁ̀]Connecting... ހZ{871, 577} 6 7^ConnectingView ih!vx] B G! ]firstRootText
L M0-ف P Q T,ہ܀&* !" W X_Unison Online HelpQ?[onlineHelp: E ] ^
j u_F9 X p
CZ: T
A(h0 $ L|
C
J c o
]
TU )
t$
bE! f
fG
n M
Ca~ # *
iB 4%ꀖp4x b}Uc,q&g ڀ-xԀs_
(́f*ف5#3e2}kہ߁怴 Ёɀʁ9F'~dS I) X@Հށj.+erNDw]9oۀvE$ځ 6 7 TEdit E M H| 39@] : ; ?
]NSIsSeparator\NSIsDisabled, &*$THelp E M H L ' T W "YNSSubmenu,ځ&* !" % & '^submenuAction:WActions E M ,H:#
ہgE eoj
, &*fXMainMenu E M EH ' # S,$&* E M VH p
Z#Xq c d ,&*$^Preferences...Q,
, &*$
, &*$\_NSAppleMenu ' ,4&* ' ,f&* ' ,Ձ&*VIgnore E M H
ԁ[_NSMainMenu : ; ? E ]
f
o0XB X n X T aa h M $
0 00 A X
j
a
0 s}$} Nk$S$&$ff4ہՀ}b&ہɁ(ځ$4cՁwwfcx
fbfD%́f_b$s$$4ssځ߁f,)ffՁ$&}bۀk4ہ4fcfЁwfs$ہ E ]
D
j u_F9 X p
CA
Z T:(h 0 $ L|
C
J
o ]c
)U T
t$
b!E f
fG
M n
Ca~ # *
iB 4%ꀖp4x b}Uc,&-qځg x
_Ԁs(個́fe*5ف3#k2ہ}߁ Ёɀ9'ʁF~d SI) X@ހՀ쀰j.+eDNrw]9oۀvE$ځ E ]
;
!"#$%&'( %
+,-./01 3456789:;< >?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ uabcdefghijklmnopqrstuvwxmz{|}~
B. !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJԁKLMNOPQRST UVWXYZ[\]^_`abcdefghijklmnopqrstuvPwxyz{|}~w_Text Field Cell (Unison)^Content View-3_Static Text (Profile name:)_Button Cell (Continue)_EStatic Text (Would you like to install the Unison command-line tool?)_ Table Column (fileSizeString)_Vertical Scroller-1_Static Text (File:)_Menu Item (About Unison)_Text Field Cell (User:)[Menu (Edit)_Text Field Cell-5_Table Header View-1_Text Field Cell-3^Content View-1_Text Field Cell-6_#Bordered Scroll View (Table View)-1YSeparator_-Text Field Cell (Please enter your password
)_Button Cell (Local)_Menu Item (Hide Others)_Image Cell (Unison)_Push Button (Quit)_Static Text (File:
)_Menu Item (Quit Unison)[Menu (Help)_$Menu Item (Propagate Newer to Older)_Menu Item (Paste)_Menu Item (Leave Alone)_Text Field Cell (File:)_Button Cell (Remote)_Image View (Unison)_ Profile Table View (Profiles)\Text Field-1_Secure Text Field_Static Text (Unison)_Menu Item (Ignore Path)_+Recon Table View (Path, Size, <, Action, >)_Text Field Cell-7_:Static Text (Please choose a profile or create a new one
)_Menu Item (Help)_Text Field Cell-8_Static Text (Connecting...)_Push Button (No)^Menu (Actions)[AboutWindow_Message Progress Indicator_,Round Segmented Control (Outline-Flat, O, D)_>Text Field Cell (Please choose a profile or create a new one
)_Vertical Scroller_ Menu Item (Unison Online Help)_Menu Item (Cut)_Static Text (The command-line tool is a small program that can be installed in a standard place on your computer (/usr/bin/unison) so Unison can easily be found. If you want to be able to synchronize files on this computer by running Unison on a remote computer, you should probably install it.
If you don't install it now, you can do so later by choosing 'Install command-line tool' from the Unison menu.
)_%Menu Item (Install command-line tool)_ Menu Item (Ignore Extension)ZSplit View[Separator-3_Table Column (profiles)YText View^Content View-2_Vertical Scroller-2_Text Field Cell-4\CltoolWindow_Button Cell (No)\Text Field-2_#Menu Item (Propagate Right to Left)_Push Button (Continue)_Text Field Cell-2_Text Field Cell (The command-line tool is a small program that can be installed in a standard place on your computer (/usr/bin/unison) so Unison can easily be found. If you want to be able to synchronize files on this computer by running Unison on a remote computer, you should probably install it.
If you don't install it now, you can do so later by choosing 'Install command-line tool' from the Unison menu.
)\Image Cell-1VWindow_PreferencesView_ Text Field Cell (Connecting...)_Horizontal Scroller_ Text Field Cell (Profile name:)_Push Button (Yes)_Menu Item (Synchronize all)_Button Cell (Cancel)_Menu Item (Rescan)_Table Header View_Text Field Cell-1_Menu Item (Edit)_)Static Text (Please enter your password
)_#Segmented Cell (Outline-Flat, O, D)_Menu Item (Preferences...)_Horizontal Scroller-3[Text View-1ZText Field_Table Column (path)_ Prototype Button Cell (Radio)_Menu Item (Hide Unison)VMatrix[Separator-1_%Text Field Cell (Sync you very much!)_Menu Item (Select All)_Text Field Cell (?.?.?)]Menu (Ignore)_Table Column (leftIcon)^Content View-4\Text Field-3_IText Field Cell (Would you like to install the Unison command-line tool?)_Table Column (rightIcon)_Text Field Cell-9_Menu Item (Restart)_Button Cell (Quit)_Text Field CellWWindow1_-Menu Item (Revert to Unison's Recommendation)_Menu Item (Merge)_Text Field Cell (File:
)_Menu Item (Ignore Name)_ Check Box (Don't ask me again)[Separator-2_!Bordered Scroll View (Table View)_Push Button (Cancel)oe S t a t i c T e x t ( C o p y r i g h t 1 9 9 9 - 2 0 0 6 .
T h i s s o f t w a r e i s l i c e n s e d u n d e r t h e G N U G e n e r a l P u b l i c L i c e n s e . )_Horizontal Scroller-1_Static Text (User:)_!Text Field Cell (Label Font Text)_Scroll View (Text View)_ Bordered Scroll View (Text View)[Application_!Static Text (Sync you very much!)_Menu Item (Unison)\File's Owner_ Menu Item (Select Conflicts)_Menu Item (Copy)_Menu Item (Diff)_Menu Item (Actions)_Static Text (Host:)_ Static Text (Label Font Text)oi T e x t F i e l d C e l l ( C o p y r i g h t 1 9 9 9 - 2 0 0 6 .
T h i s s o f t w a r e i s l i c e n s e d u n d e r t h e G N U G e n e r a l P u b l i c L i c e n s e . )_Vertical Scroller-3_#Menu Item (Propagate Left to Right)_Box (Second root)\Content View_Box (First root)_Horizontal Scroller-2_Button Cell (Yes)\Text Field-4_Menu Item (Ignore)_$Menu Item (Propagate Older to Newer)_!Table Column (percentTransferred)ZImage Cell]Menu (Unison)_Menu Item (Show All)_Static Text (?.?.?)_ Button Cell (Don't ask me again)_Text Field Cell (Host:) E ] h 0xe_s E ]" { &Oyf`t E ]) | ^_ v F9 m j aX T
T h0 ] d U i L X b
C Zc n [ T W }
t$ q y r zE Q u h p
M n
a _ Y B
ju e p
`CZ:A( o O c $ ~ t J|
V
]o \ {
)U
Sb! R f
f k l g wG s
C ~ f# P x *
i 4%ꀖDp4ށx C\}bcn- ځxԀs_
?jrfـف^2kہ2߀8ʁ9FӁ~dǁ XɁՁŀ1ځujŀeǁDNw]HE$ȁցlbUW,q&g
(f́\ρ*e5#3} =Ёɀ'S I)Հi@ހdM`.+Kprn9o"%
ہ#vځ E ] !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ÁāŁƁǁȁɁʁˁ́́ρЁсҁӁԁՁցׁفځہ܁݁ށ߁
X
!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~I4s6 =wn jm
./p^ o 23x,}0z {o
8q fCk
9uy-#j vg1*7 t+3& K:Jl$%r( |~5L "9'8A)! E MH E ] E ] : ; ?^NSIBObjectData " ' 1 : ? D R T f
)
5
A
O
Z
h
" . 0 2 ; E G U ^ g r y
"
%
(
+
.
1
4
7
:
=
@
C
F
I
L
O
R
U
X
[
^
a
d
g
j
m
p
s
v
y
|
#*3=FRTVXZ]^`b $8DMOQSUW\]_`qx %2:<>AJOdfhjlv,;LNPRTu}#0?ACEM_hm')+-/dv
*4BEHKNPSVXZ\_ajl7Xr#.6HJLNWYn
"19BGPUv~ "$9;=?A_lnz !#%-6;HNPW`kmox}
-/13579FILOs{ ):<>@B ( D _ k / 1 4 7 : < > @ B D O l n p r t v x U a j } ) + - / 1 3 ` o | $ & ( * , / 1 6 G I R T W l n p r t !!!!! ! ! ! !'!)!+!@!B!D!F!H!a!v!x!z!|!~!!!!!!!!!!!!!!""
""E"F"H"J"L"U"W"Y"["j""""""""""""""""""""""#####!###%#'#0#M#O#Q#S#U#W#Y#f#h#t#################$$&$($*$,$5$7$9$B$K$M$b$$$$$$$$$$$$$$$$$$$$% %%%%%%%"%?%A%C%E%G%I%K%h%j%k%|%~%%%%%%%%%%%%%%%%%&&&& & &,&.&0&2&4&7&8&:&<&Y&[&]&`&c&e&h&&&&&&&&&&&&&&&'''3'H']'p'r't'v'''''''''''''''((((((()(+(D(F(H(J(W(Y([(](j(l(u(~((((((((())))) ) )
)) ) )#)/)1)=)N)P)R)T)V)w)y){)})))))))))))))))))))***
**'*)*+*-*0*U*a*c*f*h*k*m*p*s*v************+++ + + +"+#+%+(+*+,+.+0+9+;+>+@+]+_+a+c+e+g+i+r+t+y+{+}++++++++++++++++++,,,,,,%,F,H,J,L,N,O,Q,S,k,,,,,,,,,,,,,- -----
--"-$-2-;-D-J-------------------------.$.0.:.I.U.m.x........................./ /5/K/`/o////////////////////0 000-06080A0J0W0000000000000000000011
11!1B1D1F1I1L1M1O1Q1h11111111111111111222
2
22222;2=2?2B2E2F2H2J2c2222222222222222223 3333
3 33335373:3=3>3@3B3Z3333333333333333334 4!4#4%4(4+4,4.404H4i4k4m4p4r4u4w44444444444444445 55
555!5*575I5V5X5[5^5555555555555555555555555556666666/6<6>6A6D6e6g6j6m6o6q6t666666666666666677 7 777>7A7C7F7I7L7O7R7U7W777777777777777777777888 8
888!8#8&8)8J8L8O8Q8S8U8X8Z8]8j8l8q8s8u8z8|8~88888888888888888889999999 9-9/9193969A9R9T9V9Y9\9999999999999999:::
: ::::: :*:,:/:2:S:U:X:Z:\:^:`:{:::::::::::::::::;;;$;&;(;+;.;O;Q;T;W;Y;[;];i;k;v;;;;;;;;;<<<< < <"<$<%<(<+<,>>> > >)>,>5>8>A>^>`>c>f>h>j>s>>>>>>>>>>>>>>>>>>>>>??&?(?+?-?0???P?R?T?V?Y?e?v?x?{?}????????@@$@.@:@<@?@B@D@I@L@O@R@U@X@s@|@~@@@@@@@@@@@@@@@@@@AAAAAA A A'A8A:A=AQArAtAvAyA|A}AAAAAAAAAAABBBBBBBBBBBBBBBBBBBC CCCC C C
C)CBCcCeChCiCvCxCzC}CCCCCCCCCCCCDD D DDDDD,D=D?DBDPD[DtDDDDDDDDDDDDDDEEEE
E
E.E0E3E5E7E9E;EHE\EiEkEnEqEEEEEEEEEEEEEEEEEEEEEFFFFF F F@FBFEFHFJFLFNF`FbFnFFFFFFFFFFFFFFFFFFFFFFGGGG$G&G)G+G6GAGNGPGSGVGwGyG|G~GGGGGGGGGGGGGGGHHHH
H
H(H1H3HHHJHLHOHRH[H]HhHkHnHqHtHwHHHHHHHHHHHHHHI IIIII I I)I4I=IZI]I_IbIeIfIiIIIIIIIIIIIJJ J"J%J(J+J,J/JGJ|JJJJJJJJJJJJJJJJJJJJKK:K=K?KAKDKGKIKLKOKXKZKwKzK|KKKKKKKKKKKKKMaMxMMMMMMMMMMMMMMNN N N#N&N)N+N.N3NOAODOeOgOjOlOnOpOrOxOOOOOOOOOOOOOOOOOOP PP P P#P&PGPIPLPOPQPSPUPaPcPoPPPPPPPPPPPPPPPPPPPPPPQQQQ
Q+Q.Q0Q3Q6Q9Q:Q=Q@QYQzQ|Q~QQQQQQQQQQQQQRR:R=R?RARDRGRIRLRQRZR\ReRgRrRuRxR{R~RRRRRRRRRRRRSS SSSSSS S&S?SLSUS`SkSSSSSSSSSSSSSSSTTT T-T8TLT]T_TbTdTgTTTTTTTTTTTTTTTTTUUUUU(U9U;U>U@UCUPUaUcUfUhUkUUUUUUUUUUUUUUUUUV VVV V V)V,V.V1V4V5V8VPVqVsVuVxVzV}VVVVVVVVVVVW WWWWW-W>W@WCWEWHW\WmWoWrWtWwWWWWWWWWWWWWWWWWXXX X X!X$X'X*X,X/X2X5X8XSXiXnXqXzXXXXXXXXXXXXXXXXXXXY YYYYYYYY/YTYVYXY[Y^Y`YcYeYnYYYYYYYYYYYYYYYZ ZZLZOZRZUZXZ[ZnZpZsZvZxZzZZZZZZZZZZZZZZZZ[[ [[[[[[ [%[<[i[l[o[r[u[x[z[}[[[[[[[[\\\\ \ \"\#\%\(\A\b\d\f\i\l\o\q\\\\\\\\\\\\\\\\\\\]]]]]] ]N]Q]T]W]Y]\]_]b]e]h]]]]]]]]]]]]]]]]]]^^^^ ^^^^^ ^"^)^,^/^2^;^=^@^C^N^[^]^`^h^^^^^^^^^^^^^^^___ _ _"_%_F_H_K_N_P_R_T_`_b_n__________________```%`'`*`-`/`1`3`F`H`S`d`f`i`k`n`z```````````````````aa a.a0a3a5a8aGaXaZa\a_abaaaaaaaaaaaaaaaaaaaaaab bbb*b-b0b3b6b9bm@mCmEmGmJmLmNmQmTmWmYm\m_mamdmfmimkmnmqmtmvmxm{m~mmmmmmmmmmmmmmmnnnnnnnnnoooo
o oooooo o o#o&o)o,o.o1o3o6o9ouRuxuuuuuv
v$v>vJvqvvvvvwww'w>wXwwwwwx x/x>xJxgxxxy y zz{{ {{2{<{K{a{u{{{{{{}}}}}}~~)~G~^~s~~~~ 5ALb
2ANɀ߀>RmԂ(KW{σ.?S`s %@CFIKNQTWY\_acfiloruwz}ʼnȉˉΉщԉډ݉ #&),/257:=?BEHKNQTWZ]`cehknqsvy|ŊȊˊ͊Њӊ֊ي܊ߊ
!$'*,/258:=@IL%(+.147:=@CFILORUX[^adgjmpsvy|čǍʍ͍ЍӍ֍ٍ܍ߍ !$'*-0369
IBFramework Version
677
IBLastKnownRelativeProjectPath
../uimacnew.xcodeproj
IBOldestOS
5
IBOpenObjects
198
29
197
423
2
307
402
IBSystem Version
9L30
targetFramework
IBCocoaFramework
unison-2.40.102/uimacnew/English.lproj/MainMenu.nib/objects.nib 0000644 0061316 0061316 00000047064 11361646373 024353 0 ustar bcpierce bcpierce streamtyped@NSIBObjectData NSObject NSCustomObject)@@NSMutableStringNSString+
NSApplicationir NSTextField NSControl)NSView) NSResponder NSBox* NSCustomView) @@@@ffffffffNSMutableArray NSArray NSMatrix> 'F& F&icc@ #iiii:::ffffi@@@@@ NSActionCellNSCellA F (D NSButtonCell?ii @@@@RemoteNSFont $[36c] L u c i d a G r a n d e f
c i: ssii@@@@@ Q @ User: Ąc@@ controlTextColor : 8[ [ ƪAq @ ó ˷textBackgroundColor textColorʆ :& & ƪ @ Host: ѷ Ȇ 8 ƪAq @ ó Էφ ƪ @ File: ַ Ȇ . ƪAq @ ó ٷφV Vj jff@@ccc ƪ Second root ̈́ L? W W ƪ @
Profile name: Ȇ j ƪAq @ ó φ NSView NSResponder G G ƪ
First root ̈́ L? . ƪAq @ ó φ3 3 ƪ @ File:
Ȇ
NSTableColumn)@fff@@ccleftIconNSTableHeaderCell ƪ <$ L u c i d a G r a n d e >headerTextColorʆ NSImageCell) iii @ NSClassSwapper*@#ReconTableView NSTableView=
NSClipView: NSScrollView NSSplitView MessageProgressIndicatorNSProgressIndicator b
NSPSMatrix[12f] ccddc d }
}
ƪ @Label Font Text$ L u c i d a G r a n d e
Ȇ " "NSView NSResponder NSTextViewTemplateNSViewTemplate. NSMutableSet NSSet I Apple HTML pasteboard typeApple PICT pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard type*NeXT Rich Text Format v1.0 pasteboard typeApple PDF pasteboard typeNSFilenamesPboardTypeNSStringPboardType NeXT TIFF v4.0 pasteboard typeNSColor pasteboard type#CorePasteboardFlavorType 0x6D6F6F76NeXT RTFD pasteboard type {) {)
NSTextView NSDictionary NSBackgroundColorselectedTextBackgroundColorNSColorselectedTextColorʆʵ{ z)< {) {)@@cccNSCursor
NSScroller - - ff: _doScroller: 3 W W Cr?ӯ }+ }+24ffffi ,} } 3 qv?ӯ 3 u u ?ӯ NSTableHeaderView 8 { {8 { { ::τcontrolBackgroundColor
_NSCornerView } }678> { { < { { @@@ff@@f::i:>ﻄpath A Path headerColorƪ@1 $ L u c i d a G r a n d e <Ȇ ﻄfileSizeStringFFF Size Fƪ@1 I <Ȇ ﻄpercentTransferred@GBg(Bd Action Fƪ@1 I <Ȇ ﻄ rightIcon > F @ gridColor ? ڒ
NSMenuItemNSMenu i@@@ Unison
]^
i@@IIi@@@@:i@ About Unison NSCustomResource)NSImageNSMenuCheckmarkefNSMenuMixedState ]^ۂ  dh ]^ Preferences..., dh ]^ Install command-line tool dh ]^ۂ  dh \]^ Hide Othersh dh ]^ Show All dh ]^ۂ  dh ]^ Quit Unisonq dh _NSAppleMenu Hide Unisonh dh ^B]_ Edit]~ Cutx dh }]~ Pastev dh ]~
Select Alla dh ]~ Select Conflicts dh Copyc dh ~]_ MainMenu] Unison dhsubmenuAction: ^] Edit dh ~] Actions dh _ Actions ] Propagate Left to Right> dh ] Propagate Right to Left< dh ] Propagate Newer to Older dh ] Propagate Older to Newer dh ] Leave Alone/ dh ] !Revert to Unison's Recommendation dh ] Merge dh ] Diff dh ] ۂ  dh ] Restartr dh ] Rescan dh ] Synchronize allg dh ] Ignore dh _ Ignore] Ignore Pathi dh ] Ignore Extensione dh ] Ignore Namen dh _NSMainMenu Help dh _ Help] Unison Online Help? dh ֩ J V V ?
NSTextView)NSBackgroundColor+NSColor.ʵ r V V 1NSImage. s NSBitmapImageRep
NSImageRep [2490c]MM * SSS_ ???T
#***???T
' ***???T
( ***???T
( ***???T
( ***???T
( ***???T
( ***???T
( ***@@@S
( *** ***
( ****** yyyooo [ H /
(***oooxxx *** < (
' Z U*** yyyooo " H 8 8pppyyy *** + ' <***
(oooooo 2 H G 1
U R S 3 d d ӯ 3 W W Cr?ӯ V V
^ ƪ@ @Unison,[44c] $ L u c i d a G r a n d e - B o l d φ 4 4 ƪ @X© Copyright 1999-2006.
This software is licensed under the GNU General Public License. φ NSImageView Apple PDF pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard type NeXT TIFF v4.0 pasteboard typeNSFilenamesPboardTypeApple PICT pasteboard typeApple PNG pasteboard type @ @ efUnison ƪ@ @?.?.?I φ
e ƪ@ @Sync you very much!$ O p t i m a - I t a l i c φ NSSecureTextField NSButton s b b 8Continue @ [28c] H e l v e t i c a
T T 8Cancel @ Z ƪ @ Please enter your password
Ȇ < ƪAq @ ó φ ﻄprofilesCs=B Profiles >ƪ@1 ProfileTableView
I I ƪ @,Please choose a profile or create a new one
Ȇ T T Quit @Ä k kNSView NSResponder 3 3 ~?ӯ 3 q q ُ}?ӯ ;) 2 2) 2 2++< ? 3 C C '(),
2 2 < 2 2 ׁ+,Y @ Ȇ ProfileControllerPreferencesController NSWindowTemplate
iiffffi@@@@@c
xpÄNSWindowView ffff ~NotificationControllerq^ ᢖ : . T T : Yes < @Ä : : ƪ @ 7Would you like to install the Unison command-line tool?, $ L u c i d a G r a n d e - B o l d @ Ȇ9: T T : No D @Ä :
#import
#include
#define BUFSIZE 1024
#define EXECPATH "/Contents/MacOS/Unison"
int main(int argc, char **argv) {
/* Look up the application by its bundle identifier, which is given
in the Info.plist file. This will continue to work even if the
user changes the name of the application, unlike
fullPathForApplication. */
FSRef fsref;
OSStatus status;
int len;
char buf[BUFSIZE];
status = LSFindApplicationForInfo(kLSUnknownCreator,CFSTR("edu.upenn.cis.Unison"),NULL,&fsref,NULL);
if (status) {
if (status == kLSApplicationNotFoundErr) {
fprintf(stderr,"Error: can't find the Unison application using the Launch Services database.\n");
fprintf(stderr,"Try launching Unison from the Finder, and then try this again.\n",status);
}
else fprintf(stderr,"Error: can't find Unison application (%ld).\n",status);
exit(1);
}
status = FSRefMakePath(&fsref,(UInt8 *)buf,BUFSIZE);
if (status) {
fprintf(stderr,"Error: problem building path to Unison application (%ld).\n",status);
exit(1);
}
len = strlen(buf);
if (len + strlen(EXECPATH) + 1 > BUFSIZE) {
fprintf(stderr,"Error: path to Unison application exceeds internal buffer size (%d).\n",BUFSIZE);
exit(1);
}
strcat(buf,EXECPATH);
/* It's important to pass the absolute path on to the GUI,
that's how it knows where to find the bundle, e.g., the
Info.plist file. */
argv[0] = buf;
// printf("The Unison executable is at %s\n",argv[0]);
// printf("Running...\n");
execv(argv[0],argv);
/* If we get here the execv has failed; print an error message to stderr */
perror("unison");
exit(1);
}
unison-2.40.102/uimacnew/ReconItem.h 0000644 0061316 0061316 00000003571 11361646373 017263 0 ustar bcpierce bcpierce /* ReconItem */
#import
@class OCamlValue;
@interface ReconItem : NSObject
{
ReconItem *parent;
NSString *path;
NSString *fullPath;
BOOL selected;
NSImage *direction;
NSString *directionSortString;
double fileSize;
double bytesTransferred;
BOOL resolved;
}
- (BOOL)selected;
- (void)setSelected:(BOOL)x;
- (NSString *)path;
- (NSString *)fullPath;
- (NSString *)left;
- (NSString *)right;
- (NSImage *)direction;
- (NSImage *)fileIcon;
- (long)fileCount;
- (double)fileSize;
- (NSString *)fileSizeString;
- (double)bytesTransferred;
- (NSString *)bytesTransferredString;
- (void)setDirection:(char *)d;
- (void) doAction:(unichar)action;
- (void) doIgnore:(unichar)action;
- (NSString *)progress;
- (NSString *)progressString;
- (void)resetProgress;
- (NSString *)details;
- (NSString *)updateDetails;
- (BOOL)isConflict;
- (BOOL)changedFromDefault;
- (void)revertDirection;
- (BOOL)canDiff;
- (void)showDiffs;
- (NSString *)leftSortKey;
- (NSString *)rightSortKey;
- (NSString *)replicaSortKey:(NSString *)sortString;
- (NSString *)directionSortKey;
- (NSString *)progressSortKey;
- (NSString *)pathSortKey;
- (NSArray *)children;
- (ReconItem *)collapseParentsWithSingleChildren:(BOOL)isRoot;
- (ReconItem *)parent;
- (void)setPath:(NSString *)aPath;
- (void)setFullPath:(NSString *)p;
- (void)setParent:(ReconItem *)p;
- (void)willChange;
@end
@interface LeafReconItem : ReconItem
{
NSString *left;
NSString *right;
NSString *progress;
NSString *details;
OCamlValue *ri; // an ocaml Common.reconItem
long index; // index in Ri list
}
- initWithRiAndIndex:(OCamlValue *)v index:(long)i;
@end
@interface ParentReconItem : ReconItem
{
NSMutableArray *_children;
long fileCount;
}
- (void)addChild:(ReconItem *)item nested:(BOOL)useNesting;
- (void)sortUsingDescriptors:(NSArray *)sortDescriptors;
- (BOOL)hasConflictedChildren;
@end
unison-2.40.102/uimacnew/Unison.icns 0000644 0061316 0061316 00000126066 11361646373 017363 0 ustar bcpierce bcpierce icns 6ics# H 8>|>|<<<<<<<<<<<<>|? 8>|>|<<<<<<<<<<<<>|? is32 f wi - ݙ ҿ :ߚ : | / 7 S U c U c U c U i U d ؇ סּ ̶ - Uc
?L 66$ fw hi - 3y m Nx vN %_ g/ / H됁 E Sꚁ ݹU ^ޚ ů\ cɚ d n w v ud} |dq ~`9CliB:Z Uh
`i eX
Qi
ZfNAAKd\ BJKF } - E.f q2C H'd k.E g9"P U 5g F*o c&B G)s i&A G+s i'C G -s c* C H! .s c, C H# /w d- !D L$ ,p i+ "E T+ 4KK2 'N U< !! 7Z K6" 2I C>2..1݉X K݅b =߂R `ӭr* =_lofH" y}z zwwf u҅u zxsq
uքw zwsf wՅw zwts {{s |xw Kz` ;kߍW Rz' :f ^߂6 Dm a6 Kq a6 Ks cތ- Kv cَ- Kw eґ- Kz gʒ- K| i- K l- K n- K p- K r% B~ toqqp~A [wpqqn
n`abaa
^abb] IWNOOLhwfco_MOMh d5: 6VN6:8M8 l ,12+ t N +< K4 b TD *n H{* i\ !jl[XXYfx2 IjuwqS( oU bm u/I ].s
t0I ] 0q t/I ] 0q ~5 X a1z TL2[+ K]%@^ b0S@ PH b i1Qm fH"f l1Qm sH"h l1Qm sH"h l1Qm sH"h l2Qm sH#h l2Qm sH$h l3Qm sH%h l4 Qm sH &h l4 Qm sH 'h l4 Pm sI 'h l4 Pm sI 'h l4 Pg kI (f p5 P{ }E (f n< 9 {1 .h cI KƯE ;j 3\ 9PSUO5 NV d9 *a 7[! MP SL @] WL @] MV1 )LV 3WP=/),8JX? .JVWUVO6 l8mk \ ( h 4
h 4 i 4
i 4 B ) y) / G e$ w 4 v 3 v 3 v 3 v 3 v 3 v 3 v 3 v 3 v 3 v 3 v 2 t# = fs Es n ; 7Y w * !2 cy$ +b¡p7
0=@A@6
ich# H > < ~ ? ? ? > < ~ ? ? ? ih32 |r m{yU own g}ҾtU
ouo i}tU owp g|t\ xo j}рtb un i}tU z|u w~yx qsM \vw [v3 Qo"
V. Gx, <z &` 3 I 3h J~ 2k J 2k J~ 2k J 2k J 2k J 2k J 2k J 2k J 2k J 2k J 2k J 2k J 2k J 2k H 2k H 2k H 3k K3 >l KS bd >o fyV -lf hqI kphjnkp+ O߃
ɼi )߄ ߄E Wݕs 'yݔ@ AݒZ Qݐi Uݍl%
K݉ a"
6r߅
ҊI3 Ew X)
7TubB$ #*)(
~z |}j ~}x z|{}
xu |y~̹x|j yv y~y~s ~xv
z~x}u xu y~x|j |x |z{} ~{yyM \yz ayЂo5 Xuуm" azq4 Uup. H}p .ug Xt$ @xm Zu' Dyo Wv' D{o Wx' ?|o Wx' ?~o Wz ?o U܀߸{ ?܂ܧo Uցٺ| ?ك֩o UЁҺ| ?҄q Uɀ˻} ?Ƀq U~ ;ðq U ;q U ;q U ;q U ;q U ;q U ;r U|} 7{~r Uquq3 Bput{r Tfjf[ igjitk DZ`]r{ wd^`]s` -NTOwf s|NTO|O tKEFEG|uw|x{BF@/ Vd2875la387?q ) '
('!(p& mM!o< ^`+q7 WY%q! :h=q 3 jW$r- Rf*
#3Ngg4 Ibkgc`_`^_dihU0 .795$
h8mk j v *ߵ v * u ) v * w +
v ) z - s x 3h < S~-
:n ~6 W( e ; c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 8 c 7 b = [= j J 3
d уd`\a@ ! J| < T !7 :W Ll Ro& J`% 9pʇJ !GrԱW. !;Unx_E* !/8:;;;94)
it32 ; ڕ nj _ ppqx rqm ovvo: qrtpf
orrp_ qoroH nssoc
qpsp_ nrqo_ qnrox nrspx qorpk nrro_ qnrp: orrpf rorpH orrpf qnrp_ nrspx rorpf nqrox qnqo: ntspk rotpc nrrpH qoro_ nsspx qosp_ nrrpx qorof nsrpc qpspc nqroH qoqp: ostpk rosp_ otvps qnrpH oroo Ersvp Wtq{q vp{o gun vp{ trm
[sn vow
noo
j}% \sn wot
pqr
lx> Ytn vos
oor prZ Zun nu wqw
wqj
in rV
yo
kx
dorY zp ng for`
zpnk hore
{pnn hoqh ypnp
ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ioql
|pns ipql
|pns ipql
|pns ipql
|pns ipql
|pns ipql
|pns ipql
|pns ipql
|pns ipql
|pns iprl
|pns iprl
|pns iprl
|pns iprl
|pns iprl
|pns iprl
|pns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|qns iprl
|pns iprf
{pns qnnx
)xsm~ {ml atyop ymm npc opxs{
mpd jpm tr~sT
_ror mvuB MuxmU qqq| zqwp tmm} {lqpx znly wmqp jsnpg _r~ tnu frnxuF |o!ԋootw|rntm|
}l rnoprt rqnnvmw
aq
̤| {z |ߗ{tM +zolz
ylޘ ޚoo
Msuޘ߁އ߀ޚrz1 lls \rwrvC }lk|
Vrupx= ymls 2xml} gpursU
{l lt
+zl k|
Nun lx>
apoߺ
nrR
nqq
pqb qor pqf
osp orf iooް mqa
^vl lxO Dxmx
wmz< &rsnߦגnpp" ]wlvvlwP -uro|ߜ }lss$
Dsrmzߔ۩{mqx< LtsmsݼtmsuK =nwolt ǭumoxq9 #WpxrmowzompxqW&
H`svrpoppqrqpooqrvtfL"
.CU_elgfjdYJ3
љ vj _ w}yx zym x}z}y: y|}xf
x}wlw|y_ z|zw}yH w}wlokw}yc
z|zmkw}y_ w}wh~hw}y_ y}zktzjw}yx w}wi}~iw}yx y}ylq}iw|yk w}wi}~iv|y_ y}zkp}iw}y: x}wi{{iw}yf z}zlq{iw}yH x}wi{|iw}yf y}zkp{iw}y_ w}xi|~iw}yx y}zlp|ix}yf w}wi|{hw|yx y}zlp|iw}y: w}wi|~iv}yk z}zlq|iw|yc w}wh{}hw}yH y|ylp{hw}y_ w}wi}iw}yx y}zkq}iw}y_ w}wh|{hw}yx y|zkp|hw}yf w}wiz|hw|yc y|zlpziw|yc w}vh{|hw|yH y}zkp{hv}y: x}wi}}iw|yk z}zlr}iw}z_ w}wj|~kv}xs y}zkp|iw|yH w}vk{oky|w Ez|yntՁlv}x _{{xmu܈ku|z |z|njjr}x i|{ymr ބiu|z} {{zmznq{x
_z{{nu
߈kv|yw
ny|ym~
wo|y% \z{|px ܊mx}yv
rz|zn
݃p{z}> Z{{|sxnz}yv py|zp p{{y[ Z}|}q u}{v z{}yu
r{}zk
k|~t w||W
{{y u}z}
h|~wy}|Z z||w~zj j|z|~|b
z~zzn k||~~|g z|zp n|~은|h z~zt
m|쟂|l
zzu n|졄|l
zzw n|좆|l
zzw n|꤈|l
zzw n|ꥊ|l
zzw n|꧌|l
zzw n{|l
zyw n{ꪐ|l
zyw n{ꬔ|l
zyw n{ꮕ|l
zyw n{鯘{l
z칗yw n{簙{l
z鹙yw n{屛{l
z纛yw nz㲟{l
z仞yw nz᳠{l
y㼠yw nz߳{l
yߑἢyw nzߐݴ{l
yݑyw nzܐ۶{l
yۑܽyw nzڐٷ{l
yّڽyw nzאַ{l
y֑yw nzՑ{l
y̒սyw nzҐѹ{l
yёҽyw nzϑ{l
yɒϽyw nz̹͐{l
y̑ͽxw nzɐɹ{l
yɑɽxw nzƐƺ{l
yƑƽxw nzÑ{l
yüxw nz{l
yxw ny{l
yxw ny{l
yxw ny{l
yxw nyķ{l
yÐxw nyƷ{l
yijőxw nyǵĈ{l
yŰƒxw nyɳƈ{l
yǮɒww nyʳƈ{l
yǪʓww nyͱȉzl
yɧ˓ww nyίʉzl
yʥ͓ww nyЮˊzl
y̢ϓww nyѬ̊zl
y͟Дww nyҪΊzl
y͛єww nyթЊzl
yЙӔww nyզъzl
yіՔww nyפъzl
yѓ֕ww nyآӊzl
yӐוww ny٠{}Ԋzl
yԍ}|ؕww ny۞x|zՊzl
xԊz|xٕww nyۛtxuzh
yԆuxtڕww twݚotpڐxz
)zӀrtpەv ~vޛkpkޘv
a|wnpkܔwr {vޞflhݫv vֻkklhܑyc rxܣdifu~z{ vޝcieًyf lxح_ebڎv {z`eddσzT
azҷ^_`Z߮y{ vؽ`_`_d}|B
M{~`[][_ٍv^ yyކV]YoԺy
ynTXQܾ~w |vܽXWXQެv ~v߃LTSOzxx wsMTKvz yvݛFOK\ݥzx j{vߍGOI؇xi _zNHI Cbި{v|
fywDHIGT~|F xd?E!=_໋xw{zyw|ߒBCE=tߪv u6@ 8Nթzwwxy{| zxww}ԁ9=@7vz
dy=9:
5:ֶ ܭ\/:7IȀ|P (xh*5 3)?Ё́Ӧf/.5(tv
|vߥ%/ +!1\{sN'%./-.ۍwr
M{|L (& "&( )*("!'(by1 u! ! ݒvv ^z~L Yݻz}C
u t}
Xy|f tx}=
}v4 ?Ӈvv 2~v u
iw|s zzW
vU `ȃvw
)uC OՍt O{w5 Dޘv}<
bxy5
@ޢxyT
oyz:
Cyyc
uwzS Zޣyyg
qzyg
uڠxzi jww& *ϔvyb
_|vV
_佉v}P D}v~8
<۩}v}< &uzwχ5 9住xys ^}v}ύ> >͝|v{Q -wzwץ_+ +_ʤvzw$
DxzvϪoG' #Envy|<
Lv{vz˥scULECBFP_nëzvzzN =r|xvzބʳ|vx}s: "Xs|{vw}xvy}tX%
Hbv{yxyz yyxxyz}xfL"
.EVbfnki kleZJ3
ў }j _ x m ^: f
G E_ WEH H Fq
[ H_ E C_ X Ex H Fx W Hx G D_ Z G: H Ef [ HH E Ff X E_ J Fx \ Jf H Ex [ H: F Dx X Fq H FH W H_ F Dx X F_ F Ex Y Ff F Iq Y Fq H GH [ H: G Ex Z G_ G C Z FH ~F Z~ EV D _S 9} p -~ mW < T $q
_W
;z
tM
d% _W >{
uI
VD ]U :y sC G_ ]G oz |/
6n
pS nY
; b~
kR n\ 9 bm oR nf
: bo pS ni : bs rR nm : bw
sS nn
: by sS on
: bz sS on
: cz sS on
: cz sT on
; cz sT on
; dz sT on
; dz sT on
; dz sU pn
; ez sU pn
< ez sU pn
< ez sU pn
< ez sV pn
< ez sV pn
< ez sV qn
= fz sV qn
= fz sV qn
= fz sW qn
=fz sW qn
=fz sW qn
=fz sW qn
=fz sXqn
>gz sXqn
>gz sXrn
>gz sXrn
>gz sYrn
>gz sYrn
>gz sYrn
>hz sYrn
>hz sYrn
?hz sYrn
?hz sY rn
? hz sZ rn
? hz sZ rn
? iz sZ rn
? iz sZ rn
? iz sZ sn
@ iz sZ sn
@ iz sZ sn
@ iz sZ sn
@ iz sZ sn
@ iz s[ sn
@ iz s[ sn
@ iz s[ sn
@ iz s[ sn
@ iz s[ sn
@ iz s[ tq
A iz s[ tk
@ iz z] o~
-6 j ` h
d* kv h T x og vq - j th pw s D }Y
f| M w 0E
O. t^ F >
B 7 i Q ` Px x f} }p Z j{/ yk c}" U fw. /K J ;ub T f
Tzo: o}
fy Ces{}~zp^3 +R +I "& (+' X
m su
Q5 A1 h mz a2
O|qU6 1Ro}Q >tvbN0(H_sx< #[wxpha[UQPQLHJNT\dmv~w[&
Kd{}hO"
/HYdjrnqi^M5
t8mk @
Yb H f
31 3{F( f2 ;ZkK, #@`=!
6Ur}bC& %Dd\3 0l% 8, /l% 7* /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /l% 7) /p% 7) /% =) /& V) .( {( -U p( - Td' ,sK U& )` qD$ 'J M@! #D R;
>9 6 82
_f1 1W̗pXMFGH@;<! 2QplL- !=]wX9
+IhcD' 4RplN0 !Qdt͡tcP<* !2CUfuӵtfUB1! %4DUdq|í|qcTD4% &3AP]it|ƺ}ti]PA3% #.:FR]gpw~~xph]SG:.# '/9CLU^ekortuvvvwwwwwwvvvusplf_VMD90' #*29@EKNQSSTTTTTTTTTTSRPLHB;3,$
!%),-//0000000000//-*'#
unison-2.40.102/uimacnew/uimacnew.xcodeproj/ 0000755 0061316 0061316 00000000000 12050210657 021007 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/uimacnew.xcodeproj/project.pbxproj 0000644 0061316 0061316 00000126252 11361646373 024107 0 ustar bcpierce bcpierce // !$*UTF8*$!
{
archiveVersion = 1;
classes = {
};
objectVersion = 42;
objects = {
/* Begin PBXAggregateTarget section */
2A124E780DE1C48400524237 /* Create ExternalSettings */ = {
isa = PBXAggregateTarget;
buildConfigurationList = 2A124E7C0DE1C4A200524237 /* Build configuration list for PBXAggregateTarget "Create ExternalSettings" */;
buildPhases = (
2A124E7E0DE1C4BE00524237 /* Run Script (version, ocaml lib dir) */,
);
dependencies = (
);
name = "Create ExternalSettings";
productName = "Create ExternalSettings";
};
/* End PBXAggregateTarget section */
/* Begin PBXBuildFile section */
2A3C3F3309922A8000E404E9 /* Growl.framework in CopyFiles */ = {isa = PBXBuildFile; fileRef = 2A3C3F3209922A8000E404E9 /* Growl.framework */; };
2A3C3F7D09922D4900E404E9 /* NotificationController.m in Sources */ = {isa = PBXBuildFile; fileRef = 2A3C3F7B09922D4900E404E9 /* NotificationController.m */; };
2A3C3FAE0992323F00E404E9 /* Growl.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 2A3C3F3209922A8000E404E9 /* Growl.framework */; };
2E282CC80D9AE2B000439D01 /* unison-blob.o in Frameworks */ = {isa = PBXBuildFile; fileRef = 2E282CC70D9AE2B000439D01 /* unison-blob.o */; };
44042CB60BE4FC9B00A6BBB2 /* ProgressCell.m in Sources */ = {isa = PBXBuildFile; fileRef = 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */; };
44042D1B0BE52AED00A6BBB2 /* ProgressBarAdvanced.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */; };
44042D1C0BE52AEE00A6BBB2 /* ProgressBarBlue.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */; };
44042D1D0BE52AEE00A6BBB2 /* ProgressBarEndAdvanced.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */; };
44042D1E0BE52AEE00A6BBB2 /* ProgressBarEndBlue.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */; };
44042D1F0BE52AEE00A6BBB2 /* ProgressBarEndGray.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */; };
44042D200BE52AEE00A6BBB2 /* ProgressBarEndGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */; };
44042D210BE52AEE00A6BBB2 /* ProgressBarEndWhite.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */; };
44042D220BE52AEE00A6BBB2 /* ProgressBarGray.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */; };
44042D230BE52AEE00A6BBB2 /* ProgressBarGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */; };
44042D240BE52AEE00A6BBB2 /* ProgressBarLightGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */; };
44042D250BE52AEE00A6BBB2 /* ProgressBarWhite.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */; };
440EEAF30C03EC3D00ACAAB0 /* Change_Created.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */; };
440EEAF90C03F0B800ACAAB0 /* Change_Deleted.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */; };
440EEAFA0C03F0B800ACAAB0 /* Change_Modified.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */; };
440EEAFB0C03F0B800ACAAB0 /* Change_PropsChanged.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */; };
445A291B0BFA5B3300E4E641 /* Outline-Deep.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */; };
445A29270BFA5C1200E4E641 /* Outline-Flat.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A29260BFA5C1200E4E641 /* Outline-Flat.png */; };
445A29290BFA5C1B00E4E641 /* Outline-Flattened.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */; };
445A2A5E0BFAB6C300E4E641 /* ImageAndTextCell.m in Sources */ = {isa = PBXBuildFile; fileRef = 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */; };
449F03E10BE00DE9003F15C8 /* Bridge.m in Sources */ = {isa = PBXBuildFile; fileRef = 449F03DF0BE00DE9003F15C8 /* Bridge.m */; };
44A794A10BE16C380069680C /* ExceptionHandling.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 44A794A00BE16C380069680C /* ExceptionHandling.framework */; };
44A797F40BE3F9B70069680C /* table-mixed.tif in Resources */ = {isa = PBXBuildFile; fileRef = 44A797F10BE3F9B70069680C /* table-mixed.tif */; };
44F472B10C0DB735006428EF /* Change_Absent.png in Resources */ = {isa = PBXBuildFile; fileRef = 44F472AF0C0DB735006428EF /* Change_Absent.png */; };
44F472B20C0DB735006428EF /* Change_Unmodified.png in Resources */ = {isa = PBXBuildFile; fileRef = 44F472B00C0DB735006428EF /* Change_Unmodified.png */; };
69C625E60664EC3300B3C46A /* MainMenu.nib in Resources */ = {isa = PBXBuildFile; fileRef = 29B97318FDCFA39411CA2CEA /* MainMenu.nib */; };
69C625E70664EC3300B3C46A /* InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */; };
69C625E80664EC3300B3C46A /* Unison.icns in Resources */ = {isa = PBXBuildFile; fileRef = 69C625CA0664E94E00B3C46A /* Unison.icns */; };
69C625EA0664EC3300B3C46A /* main.m in Sources */ = {isa = PBXBuildFile; fileRef = 29B97316FDCFA39411CA2CEA /* main.m */; settings = {ATTRIBUTES = (); }; };
69C625EB0664EC3300B3C46A /* MyController.m in Sources */ = {isa = PBXBuildFile; fileRef = 69660DC704F08CC100CF23A4 /* MyController.m */; };
69C625EC0664EC3300B3C46A /* ProfileController.m in Sources */ = {isa = PBXBuildFile; fileRef = 690F564504F11EC300CF23A4 /* ProfileController.m */; };
69C625ED0664EC3300B3C46A /* ReconItem.m in Sources */ = {isa = PBXBuildFile; fileRef = 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */; };
69C625EE0664EC3300B3C46A /* ReconTableView.m in Sources */ = {isa = PBXBuildFile; fileRef = 69BA7DA904FD695200CF23A4 /* ReconTableView.m */; };
69C625EF0664EC3300B3C46A /* PreferencesController.m in Sources */ = {isa = PBXBuildFile; fileRef = 697985CE050CFA2D00CF23A4 /* PreferencesController.m */; };
69C625F00664EC3300B3C46A /* ProfileTableView.m in Sources */ = {isa = PBXBuildFile; fileRef = 691CE181051BB44A00CF23A4 /* ProfileTableView.m */; };
69C625F20664EC3300B3C46A /* Cocoa.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */; };
69E407BA07EB95AA00D37AA1 /* Security.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 69E407B907EB95AA00D37AA1 /* Security.framework */; };
B518071C09D6652100B1B21F /* add.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071209D6652100B1B21F /* add.tif */; };
B518071D09D6652100B1B21F /* diff.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071309D6652100B1B21F /* diff.tif */; };
B518071E09D6652100B1B21F /* go.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071409D6652100B1B21F /* go.tif */; };
B518071F09D6652100B1B21F /* left.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071509D6652100B1B21F /* left.tif */; };
B518072009D6652100B1B21F /* merge.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071609D6652100B1B21F /* merge.tif */; };
B518072109D6652100B1B21F /* quit.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071709D6652100B1B21F /* quit.tif */; };
B518072209D6652100B1B21F /* restart.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071809D6652100B1B21F /* restart.tif */; };
B518072309D6652100B1B21F /* right.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071909D6652100B1B21F /* right.tif */; };
B518072409D6652100B1B21F /* save.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071A09D6652100B1B21F /* save.tif */; };
B518072509D6652100B1B21F /* skip.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071B09D6652100B1B21F /* skip.tif */; };
B554004109C4E5AA0089E1C3 /* UnisonToolbar.m in Sources */ = {isa = PBXBuildFile; fileRef = B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */; };
B5B44C1909DF61A4000DC7AF /* table-conflict.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1109DF61A4000DC7AF /* table-conflict.tif */; };
B5B44C1A09DF61A4000DC7AF /* table-error.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1209DF61A4000DC7AF /* table-error.tif */; };
B5B44C1B09DF61A4000DC7AF /* table-left-blue.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */; };
B5B44C1C09DF61A4000DC7AF /* table-left-green.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1409DF61A4000DC7AF /* table-left-green.tif */; };
B5B44C1D09DF61A4000DC7AF /* table-merge.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1509DF61A4000DC7AF /* table-merge.tif */; };
B5B44C1E09DF61A4000DC7AF /* table-right-blue.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */; };
B5B44C1F09DF61A4000DC7AF /* table-right-green.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1709DF61A4000DC7AF /* table-right-green.tif */; };
B5B44C2009DF61A4000DC7AF /* table-skip.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1809DF61A4000DC7AF /* table-skip.tif */; };
B5E03B3909E38B9E0058C7B9 /* rescan.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5E03B3809E38B9E0058C7B9 /* rescan.tif */; };
/* End PBXBuildFile section */
/* Begin PBXContainerItemProxy section */
2A124E7F0DE1C4E400524237 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 29B97313FDCFA39411CA2CEA /* Project object */;
proxyType = 1;
remoteGlobalIDString = 2A124E780DE1C48400524237;
remoteInfo = "Create ExternalSettings";
};
/* End PBXContainerItemProxy section */
/* Begin PBXCopyFilesBuildPhase section */
2A3C3F3709922AA600E404E9 /* CopyFiles */ = {
isa = PBXCopyFilesBuildPhase;
buildActionMask = 2147483647;
dstPath = "";
dstSubfolderSpec = 10;
files = (
2A3C3F3309922A8000E404E9 /* Growl.framework in CopyFiles */,
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXCopyFilesBuildPhase section */
/* Begin PBXFileReference section */
089C165DFE840E0CC02AAC07 /* English */ = {isa = PBXFileReference; fileEncoding = 10; lastKnownFileType = text.plist.strings; name = English; path = English.lproj/InfoPlist.strings; sourceTree = ""; };
1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = ""; };
29B97316FDCFA39411CA2CEA /* main.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = main.m; sourceTree = ""; };
29B97319FDCFA39411CA2CEA /* English */ = {isa = PBXFileReference; lastKnownFileType = wrapper.nib; name = English; path = English.lproj/MainMenu.nib; sourceTree = ""; };
2A3C3F3209922A8000E404E9 /* Growl.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; path = Growl.framework; sourceTree = ""; };
2A3C3F7A09922D4900E404E9 /* NotificationController.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = NotificationController.h; sourceTree = ""; };
2A3C3F7B09922D4900E404E9 /* NotificationController.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = NotificationController.m; sourceTree = ""; };
2E282CC70D9AE2B000439D01 /* unison-blob.o */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.objfile"; name = "unison-blob.o"; path = "../unison-blob.o"; sourceTree = SOURCE_ROOT; };
2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = ExternalSettings.xcconfig; sourceTree = ""; };
44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProgressCell.h; sourceTree = ""; };
44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProgressCell.m; sourceTree = ""; };
44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarAdvanced.png; path = progressicons/ProgressBarAdvanced.png; sourceTree = ""; };
44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarBlue.png; path = progressicons/ProgressBarBlue.png; sourceTree = ""; };
44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndAdvanced.png; path = progressicons/ProgressBarEndAdvanced.png; sourceTree = ""; };
44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndBlue.png; path = progressicons/ProgressBarEndBlue.png; sourceTree = ""; };
44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGray.png; path = progressicons/ProgressBarEndGray.png; sourceTree = ""; };
44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGreen.png; path = progressicons/ProgressBarEndGreen.png; sourceTree = ""; };
44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndWhite.png; path = progressicons/ProgressBarEndWhite.png; sourceTree = ""; };
44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGray.png; path = progressicons/ProgressBarGray.png; sourceTree = ""; };
44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGreen.png; path = progressicons/ProgressBarGreen.png; sourceTree = ""; };
44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarLightGreen.png; path = progressicons/ProgressBarLightGreen.png; sourceTree = ""; };
44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarWhite.png; path = progressicons/ProgressBarWhite.png; sourceTree = ""; };
440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Created.png; sourceTree = ""; };
440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Deleted.png; sourceTree = ""; };
440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Modified.png; sourceTree = ""; };
440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_PropsChanged.png; sourceTree = ""; };
445A291A0BFA5B3300E4E641 /* Outline-Deep.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Deep.png"; sourceTree = ""; };
445A29260BFA5C1200E4E641 /* Outline-Flat.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flat.png"; sourceTree = ""; };
445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flattened.png"; sourceTree = ""; };
445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ImageAndTextCell.h; sourceTree = ""; };
445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ImageAndTextCell.m; sourceTree = ""; };
449F03DE0BE00DE9003F15C8 /* Bridge.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Bridge.h; sourceTree = ""; };
449F03DF0BE00DE9003F15C8 /* Bridge.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = Bridge.m; sourceTree = ""; };
44A794A00BE16C380069680C /* ExceptionHandling.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ExceptionHandling.framework; path = /System/Library/Frameworks/ExceptionHandling.framework; sourceTree = ""; };
44A797F10BE3F9B70069680C /* table-mixed.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-mixed.tif"; sourceTree = ""; };
44F472AF0C0DB735006428EF /* Change_Absent.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Absent.png; sourceTree = ""; };
44F472B00C0DB735006428EF /* Change_Unmodified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Unmodified.png; sourceTree = ""; };
690F564404F11EC300CF23A4 /* ProfileController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileController.h; sourceTree = ""; };
690F564504F11EC300CF23A4 /* ProfileController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileController.m; sourceTree = ""; };
691CE180051BB44A00CF23A4 /* ProfileTableView.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileTableView.h; sourceTree = ""; };
691CE181051BB44A00CF23A4 /* ProfileTableView.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileTableView.m; sourceTree = ""; };
69660DC604F08CC100CF23A4 /* MyController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = MyController.h; sourceTree = ""; };
69660DC704F08CC100CF23A4 /* MyController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = MyController.m; sourceTree = ""; };
697985CD050CFA2D00CF23A4 /* PreferencesController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = PreferencesController.h; sourceTree = ""; };
697985CE050CFA2D00CF23A4 /* PreferencesController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = PreferencesController.m; sourceTree = ""; };
69BA7DA804FD695200CF23A4 /* ReconTableView.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ReconTableView.h; sourceTree = ""; };
69BA7DA904FD695200CF23A4 /* ReconTableView.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = ReconTableView.m; sourceTree = ""; };
69C625CA0664E94E00B3C46A /* Unison.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Unison.icns; sourceTree = ""; };
69C625F40664EC3300B3C46A /* Info.plist */ = {isa = PBXFileReference; lastKnownFileType = text.plist.xml; path = Info.plist; sourceTree = ""; };
69C625F50664EC3300B3C46A /* Unison.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Unison.app; sourceTree = BUILT_PRODUCTS_DIR; };
69D3C6F904F1CC3700CF23A4 /* ReconItem.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ReconItem.m; sourceTree = ""; };
69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ReconItem.h; sourceTree = ""; };
69E407B907EB95AA00D37AA1 /* Security.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Security.framework; path = /System/Library/Frameworks/Security.framework; sourceTree = ""; };
B518071209D6652100B1B21F /* add.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = add.tif; sourceTree = ""; };
B518071309D6652100B1B21F /* diff.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = diff.tif; sourceTree = ""; };
B518071409D6652100B1B21F /* go.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = go.tif; sourceTree = ""; };
B518071509D6652100B1B21F /* left.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = left.tif; sourceTree = ""; };
B518071609D6652100B1B21F /* merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = merge.tif; sourceTree = ""; };
B518071709D6652100B1B21F /* quit.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = quit.tif; sourceTree = ""; };
B518071809D6652100B1B21F /* restart.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = restart.tif; sourceTree = ""; };
B518071909D6652100B1B21F /* right.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = right.tif; sourceTree = ""; };
B518071A09D6652100B1B21F /* save.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = save.tif; sourceTree = ""; };
B518071B09D6652100B1B21F /* skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = skip.tif; sourceTree = ""; };
B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = UnisonToolbar.h; sourceTree = ""; };
B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = UnisonToolbar.m; sourceTree = ""; };
B5B44C1109DF61A4000DC7AF /* table-conflict.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-conflict.tif"; sourceTree = ""; };
B5B44C1209DF61A4000DC7AF /* table-error.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-error.tif"; sourceTree = ""; };
B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-blue.tif"; sourceTree = ""; };
B5B44C1409DF61A4000DC7AF /* table-left-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-green.tif"; sourceTree = ""; };
B5B44C1509DF61A4000DC7AF /* table-merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-merge.tif"; sourceTree = ""; };
B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-blue.tif"; sourceTree = ""; };
B5B44C1709DF61A4000DC7AF /* table-right-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-green.tif"; sourceTree = ""; };
B5B44C1809DF61A4000DC7AF /* table-skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-skip.tif"; sourceTree = ""; };
B5E03B3809E38B9E0058C7B9 /* rescan.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; name = rescan.tif; path = toolbar/rescan.tif; sourceTree = ""; };
/* End PBXFileReference section */
/* Begin PBXFrameworksBuildPhase section */
69C625F10664EC3300B3C46A /* Frameworks */ = {
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
69C625F20664EC3300B3C46A /* Cocoa.framework in Frameworks */,
69E407BA07EB95AA00D37AA1 /* Security.framework in Frameworks */,
2A3C3FAE0992323F00E404E9 /* Growl.framework in Frameworks */,
44A794A10BE16C380069680C /* ExceptionHandling.framework in Frameworks */,
2E282CC80D9AE2B000439D01 /* unison-blob.o in Frameworks */,
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXFrameworksBuildPhase section */
/* Begin PBXGroup section */
19C28FACFE9D520D11CA2CBB /* Products */ = {
isa = PBXGroup;
children = (
69C625F50664EC3300B3C46A /* Unison.app */,
);
name = Products;
sourceTree = "";
};
29B97314FDCFA39411CA2CEA /* uimac */ = {
isa = PBXGroup;
children = (
B5E03B3809E38B9E0058C7B9 /* rescan.tif */,
44042D0F0BE52AD700A6BBB2 /* progressicons */,
B5B44C1009DF61A4000DC7AF /* tableicons */,
B518071109D6652000B1B21F /* toolbar */,
44A795C90BE2B91B0069680C /* Classes */,
29B97315FDCFA39411CA2CEA /* Other Sources */,
29B97317FDCFA39411CA2CEA /* Resources */,
29B97323FDCFA39411CA2CEA /* Frameworks */,
19C28FACFE9D520D11CA2CBB /* Products */,
69C625F40664EC3300B3C46A /* Info.plist */,
2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */,
2E282CB80D9AE16300439D01 /* External objects */,
);
name = uimac;
sourceTree = "";
};
29B97315FDCFA39411CA2CEA /* Other Sources */ = {
isa = PBXGroup;
children = (
29B97316FDCFA39411CA2CEA /* main.m */,
);
name = "Other Sources";
sourceTree = "";
};
29B97317FDCFA39411CA2CEA /* Resources */ = {
isa = PBXGroup;
children = (
29B97318FDCFA39411CA2CEA /* MainMenu.nib */,
089C165CFE840E0CC02AAC07 /* InfoPlist.strings */,
69C625CA0664E94E00B3C46A /* Unison.icns */,
);
name = Resources;
sourceTree = "";
};
29B97323FDCFA39411CA2CEA /* Frameworks */ = {
isa = PBXGroup;
children = (
1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */,
44A794A00BE16C380069680C /* ExceptionHandling.framework */,
2A3C3F3209922A8000E404E9 /* Growl.framework */,
69E407B907EB95AA00D37AA1 /* Security.framework */,
);
name = Frameworks;
sourceTree = "";
};
2E282CB80D9AE16300439D01 /* External objects */ = {
isa = PBXGroup;
children = (
2E282CC70D9AE2B000439D01 /* unison-blob.o */,
);
name = "External objects";
sourceTree = "";
};
44042D0F0BE52AD700A6BBB2 /* progressicons */ = {
isa = PBXGroup;
children = (
44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */,
44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */,
44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */,
44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */,
44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */,
44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */,
44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */,
44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */,
44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */,
44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */,
44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */,
);
name = progressicons;
sourceTree = "";
};
44A795C90BE2B91B0069680C /* Classes */ = {
isa = PBXGroup;
children = (
69660DC604F08CC100CF23A4 /* MyController.h */,
69660DC704F08CC100CF23A4 /* MyController.m */,
2A3C3F7A09922D4900E404E9 /* NotificationController.h */,
2A3C3F7B09922D4900E404E9 /* NotificationController.m */,
69BA7DA804FD695200CF23A4 /* ReconTableView.h */,
69BA7DA904FD695200CF23A4 /* ReconTableView.m */,
69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */,
69D3C6F904F1CC3700CF23A4 /* ReconItem.m */,
445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */,
445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */,
44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */,
44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */,
690F564404F11EC300CF23A4 /* ProfileController.h */,
690F564504F11EC300CF23A4 /* ProfileController.m */,
697985CD050CFA2D00CF23A4 /* PreferencesController.h */,
697985CE050CFA2D00CF23A4 /* PreferencesController.m */,
691CE180051BB44A00CF23A4 /* ProfileTableView.h */,
691CE181051BB44A00CF23A4 /* ProfileTableView.m */,
B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */,
B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */,
449F03DE0BE00DE9003F15C8 /* Bridge.h */,
449F03DF0BE00DE9003F15C8 /* Bridge.m */,
);
name = Classes;
sourceTree = "";
};
B518071109D6652000B1B21F /* toolbar */ = {
isa = PBXGroup;
children = (
B518071209D6652100B1B21F /* add.tif */,
B518071309D6652100B1B21F /* diff.tif */,
B518071409D6652100B1B21F /* go.tif */,
B518071509D6652100B1B21F /* left.tif */,
B518071609D6652100B1B21F /* merge.tif */,
B518071709D6652100B1B21F /* quit.tif */,
B518071809D6652100B1B21F /* restart.tif */,
B518071909D6652100B1B21F /* right.tif */,
B518071A09D6652100B1B21F /* save.tif */,
B518071B09D6652100B1B21F /* skip.tif */,
);
path = toolbar;
sourceTree = "";
};
B5B44C1009DF61A4000DC7AF /* tableicons */ = {
isa = PBXGroup;
children = (
44F472AF0C0DB735006428EF /* Change_Absent.png */,
44F472B00C0DB735006428EF /* Change_Unmodified.png */,
440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */,
440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */,
440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */,
440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */,
44A797F10BE3F9B70069680C /* table-mixed.tif */,
B5B44C1109DF61A4000DC7AF /* table-conflict.tif */,
B5B44C1209DF61A4000DC7AF /* table-error.tif */,
B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */,
B5B44C1409DF61A4000DC7AF /* table-left-green.tif */,
B5B44C1509DF61A4000DC7AF /* table-merge.tif */,
B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */,
B5B44C1709DF61A4000DC7AF /* table-right-green.tif */,
B5B44C1809DF61A4000DC7AF /* table-skip.tif */,
445A291A0BFA5B3300E4E641 /* Outline-Deep.png */,
445A29260BFA5C1200E4E641 /* Outline-Flat.png */,
445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */,
);
path = tableicons;
sourceTree = "";
};
/* End PBXGroup section */
/* Begin PBXNativeTarget section */
69C625DD0664EC3300B3C46A /* uimac */ = {
isa = PBXNativeTarget;
buildConfigurationList = 2A3C3F280992245300E404E9 /* Build configuration list for PBXNativeTarget "uimac" */;
buildPhases = (
2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */,
69C625E50664EC3300B3C46A /* Resources */,
69C625E90664EC3300B3C46A /* Sources */,
69C625F10664EC3300B3C46A /* Frameworks */,
2A3C3F3709922AA600E404E9 /* CopyFiles */,
);
buildRules = (
);
dependencies = (
2A124E800DE1C4E400524237 /* PBXTargetDependency */,
);
name = uimac;
productInstallPath = "$(HOME)/Applications";
productName = uimac;
productReference = 69C625F50664EC3300B3C46A /* Unison.app */;
productType = "com.apple.product-type.application";
};
/* End PBXNativeTarget section */
/* Begin PBXProject section */
29B97313FDCFA39411CA2CEA /* Project object */ = {
isa = PBXProject;
buildConfigurationList = 2A3C3F2C0992245300E404E9 /* Build configuration list for PBXProject "uimacnew" */;
compatibilityVersion = "Xcode 2.4";
hasScannedForEncodings = 1;
mainGroup = 29B97314FDCFA39411CA2CEA /* uimac */;
projectDirPath = "";
projectRoot = "";
targets = (
69C625DD0664EC3300B3C46A /* uimac */,
2A124E780DE1C48400524237 /* Create ExternalSettings */,
);
};
/* End PBXProject section */
/* Begin PBXResourcesBuildPhase section */
69C625E50664EC3300B3C46A /* Resources */ = {
isa = PBXResourcesBuildPhase;
buildActionMask = 2147483647;
files = (
69C625E60664EC3300B3C46A /* MainMenu.nib in Resources */,
69C625E70664EC3300B3C46A /* InfoPlist.strings in Resources */,
69C625E80664EC3300B3C46A /* Unison.icns in Resources */,
B518071C09D6652100B1B21F /* add.tif in Resources */,
B518071D09D6652100B1B21F /* diff.tif in Resources */,
B518071E09D6652100B1B21F /* go.tif in Resources */,
B518071F09D6652100B1B21F /* left.tif in Resources */,
B518072009D6652100B1B21F /* merge.tif in Resources */,
B518072109D6652100B1B21F /* quit.tif in Resources */,
B518072209D6652100B1B21F /* restart.tif in Resources */,
B518072309D6652100B1B21F /* right.tif in Resources */,
B518072409D6652100B1B21F /* save.tif in Resources */,
B518072509D6652100B1B21F /* skip.tif in Resources */,
B5B44C1909DF61A4000DC7AF /* table-conflict.tif in Resources */,
B5B44C1A09DF61A4000DC7AF /* table-error.tif in Resources */,
B5B44C1B09DF61A4000DC7AF /* table-left-blue.tif in Resources */,
B5B44C1C09DF61A4000DC7AF /* table-left-green.tif in Resources */,
B5B44C1D09DF61A4000DC7AF /* table-merge.tif in Resources */,
B5B44C1E09DF61A4000DC7AF /* table-right-blue.tif in Resources */,
B5B44C1F09DF61A4000DC7AF /* table-right-green.tif in Resources */,
B5B44C2009DF61A4000DC7AF /* table-skip.tif in Resources */,
B5E03B3909E38B9E0058C7B9 /* rescan.tif in Resources */,
44A797F40BE3F9B70069680C /* table-mixed.tif in Resources */,
44042D1B0BE52AED00A6BBB2 /* ProgressBarAdvanced.png in Resources */,
44042D1C0BE52AEE00A6BBB2 /* ProgressBarBlue.png in Resources */,
44042D1D0BE52AEE00A6BBB2 /* ProgressBarEndAdvanced.png in Resources */,
44042D1E0BE52AEE00A6BBB2 /* ProgressBarEndBlue.png in Resources */,
44042D1F0BE52AEE00A6BBB2 /* ProgressBarEndGray.png in Resources */,
44042D200BE52AEE00A6BBB2 /* ProgressBarEndGreen.png in Resources */,
44042D210BE52AEE00A6BBB2 /* ProgressBarEndWhite.png in Resources */,
44042D220BE52AEE00A6BBB2 /* ProgressBarGray.png in Resources */,
44042D230BE52AEE00A6BBB2 /* ProgressBarGreen.png in Resources */,
44042D240BE52AEE00A6BBB2 /* ProgressBarLightGreen.png in Resources */,
44042D250BE52AEE00A6BBB2 /* ProgressBarWhite.png in Resources */,
445A291B0BFA5B3300E4E641 /* Outline-Deep.png in Resources */,
445A29270BFA5C1200E4E641 /* Outline-Flat.png in Resources */,
445A29290BFA5C1B00E4E641 /* Outline-Flattened.png in Resources */,
440EEAF30C03EC3D00ACAAB0 /* Change_Created.png in Resources */,
440EEAF90C03F0B800ACAAB0 /* Change_Deleted.png in Resources */,
440EEAFA0C03F0B800ACAAB0 /* Change_Modified.png in Resources */,
440EEAFB0C03F0B800ACAAB0 /* Change_PropsChanged.png in Resources */,
44F472B10C0DB735006428EF /* Change_Absent.png in Resources */,
44F472B20C0DB735006428EF /* Change_Unmodified.png in Resources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXResourcesBuildPhase section */
/* Begin PBXShellScriptBuildPhase section */
2A124E7E0DE1C4BE00524237 /* Run Script (version, ocaml lib dir) */ = {
isa = PBXShellScriptBuildPhase;
buildActionMask = 2147483647;
files = (
);
inputPaths = (
);
name = "Run Script (version, ocaml lib dir)";
outputPaths = (
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/sh;
shellScript = "if [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\nif [ ! -x ${PROJECT_DIR}/../Makefile.ProjectInfo ]; then\n if [ ! -x ${PROJECT_DIR}/../mkProjectInfo ]; then\n cd ${PROJECT_DIR}/..; ocamlc -o mkProjectInfo unix.cma str.cma mkProjectInfo.ml\n fi\n cd ${PROJECT_DIR}/..; ./mkProjectInfo > Makefile.ProjectInfo\nfi\nOCAMLLIBDIR=`ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\\\\\/\\\\//g' | tr -d '\\r'`\nsource ${PROJECT_DIR}/../Makefile.ProjectInfo\necho MARKETING_VERSION = $VERSION > ${PROJECT_DIR}/ExternalSettings.xcconfig\necho OCAMLLIBDIR = $OCAMLLIBDIR >> ${PROJECT_DIR}/ExternalSettings.xcconfig";
};
2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */ = {
isa = PBXShellScriptBuildPhase;
buildActionMask = 2147483647;
files = (
);
inputPaths = (
);
name = "Run Script (make unison-blob.o)";
outputPaths = (
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/sh;
shellScript = "echo \"Building unison-blob.o...\"\nif [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\ncd ${PROJECT_DIR}/..\nmake unison-blob.o\necho \"done\"";
};
/* End PBXShellScriptBuildPhase section */
/* Begin PBXSourcesBuildPhase section */
69C625E90664EC3300B3C46A /* Sources */ = {
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
69C625EA0664EC3300B3C46A /* main.m in Sources */,
69C625EB0664EC3300B3C46A /* MyController.m in Sources */,
69C625EC0664EC3300B3C46A /* ProfileController.m in Sources */,
69C625ED0664EC3300B3C46A /* ReconItem.m in Sources */,
69C625EE0664EC3300B3C46A /* ReconTableView.m in Sources */,
69C625EF0664EC3300B3C46A /* PreferencesController.m in Sources */,
69C625F00664EC3300B3C46A /* ProfileTableView.m in Sources */,
2A3C3F7D09922D4900E404E9 /* NotificationController.m in Sources */,
B554004109C4E5AA0089E1C3 /* UnisonToolbar.m in Sources */,
449F03E10BE00DE9003F15C8 /* Bridge.m in Sources */,
44042CB60BE4FC9B00A6BBB2 /* ProgressCell.m in Sources */,
445A2A5E0BFAB6C300E4E641 /* ImageAndTextCell.m in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
/* End PBXSourcesBuildPhase section */
/* Begin PBXTargetDependency section */
2A124E800DE1C4E400524237 /* PBXTargetDependency */ = {
isa = PBXTargetDependency;
target = 2A124E780DE1C48400524237 /* Create ExternalSettings */;
targetProxy = 2A124E7F0DE1C4E400524237 /* PBXContainerItemProxy */;
};
/* End PBXTargetDependency section */
/* Begin PBXVariantGroup section */
089C165CFE840E0CC02AAC07 /* InfoPlist.strings */ = {
isa = PBXVariantGroup;
children = (
089C165DFE840E0CC02AAC07 /* English */,
);
name = InfoPlist.strings;
sourceTree = "";
};
29B97318FDCFA39411CA2CEA /* MainMenu.nib */ = {
isa = PBXVariantGroup;
children = (
29B97319FDCFA39411CA2CEA /* English */,
);
name = MainMenu.nib;
sourceTree = "";
};
/* End PBXVariantGroup section */
/* Begin XCBuildConfiguration section */
2A124E790DE1C48400524237 /* Development */ = {
isa = XCBuildConfiguration;
buildSettings = {
COPY_PHASE_STRIP = NO;
GCC_DYNAMIC_NO_PIC = NO;
GCC_OPTIMIZATION_LEVEL = 0;
PRODUCT_NAME = "Create ExternalSettings";
};
name = Development;
};
2A124E7A0DE1C48400524237 /* Deployment */ = {
isa = XCBuildConfiguration;
buildSettings = {
COPY_PHASE_STRIP = YES;
DEBUG_INFORMATION_FORMAT = "dwarf-with-dsym";
GCC_ENABLE_FIX_AND_CONTINUE = NO;
PRODUCT_NAME = "Create ExternalSettings";
ZERO_LINK = NO;
};
name = Deployment;
};
2A124E7B0DE1C48400524237 /* Default */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = "Create ExternalSettings";
};
name = Default;
};
2A3C3F290992245300E404E9 /* Development */ = {
isa = XCBuildConfiguration;
buildSettings = {
COPY_PHASE_STRIP = NO;
FRAMEWORK_SEARCH_PATHS = (
"$(FRAMEWORK_SEARCH_PATHS)",
"$(SRCROOT)",
);
GCC_DYNAMIC_NO_PIC = NO;
GCC_ENABLE_FIX_AND_CONTINUE = YES;
GCC_ENABLE_OBJC_EXCEPTIONS = YES;
GCC_GENERATE_DEBUGGING_SYMBOLS = YES;
GCC_OPTIMIZATION_LEVEL = 0;
GCC_PRECOMPILE_PREFIX_HEADER = YES;
INFOPLIST_FILE = Info.plist;
INSTALL_PATH = "$(HOME)/Applications";
LIBRARY_SEARCH_PATHS = "";
NSZombieEnabled = YES;
OTHER_CFLAGS = "";
OTHER_LDFLAGS = (
"-L$(OCAMLLIBDIR)",
"-lunix",
"-lthreadsnat",
"-lstr",
"-lbigarray",
"-lasmrun",
);
PREBINDING = NO;
PRODUCT_NAME = Unison;
SECTORDER_FLAGS = "";
WARNING_CFLAGS = (
"-Wmost",
"-Wno-four-char-constants",
"-Wno-unknown-pragmas",
);
WRAPPER_EXTENSION = app;
ZERO_LINK = YES;
};
name = Development;
};
2A3C3F2A0992245300E404E9 /* Deployment */ = {
isa = XCBuildConfiguration;
buildSettings = {
COPY_PHASE_STRIP = YES;
FRAMEWORK_SEARCH_PATHS = (
"$(FRAMEWORK_SEARCH_PATHS)",
"$(SRCROOT)",
);
GCC_ENABLE_FIX_AND_CONTINUE = NO;
GCC_ENABLE_OBJC_EXCEPTIONS = YES;
GCC_PRECOMPILE_PREFIX_HEADER = YES;
GCC_WARN_FOUR_CHARACTER_CONSTANTS = YES;
INFOPLIST_FILE = Info.plist;
INSTALL_PATH = "$(HOME)/Applications";
LIBRARY_SEARCH_PATHS = "";
OTHER_CFLAGS = "";
OTHER_LDFLAGS = (
"-L$(OCAMLLIBDIR)",
"-lunix",
"-lthreadsnat",
"-lstr",
"-lbigarray",
"-lasmrun",
);
PREBINDING = NO;
PRODUCT_NAME = Unison;
SECTORDER_FLAGS = "";
WARNING_CFLAGS = (
"-Wmost",
"-Wno-four-char-constants",
"-Wno-unknown-pragmas",
);
WRAPPER_EXTENSION = app;
ZERO_LINK = NO;
};
name = Deployment;
};
2A3C3F2B0992245300E404E9 /* Default */ = {
isa = XCBuildConfiguration;
buildSettings = {
FRAMEWORK_SEARCH_PATHS = (
"$(FRAMEWORK_SEARCH_PATHS)",
"$(SRCROOT)",
);
GCC_ENABLE_OBJC_EXCEPTIONS = YES;
GCC_PRECOMPILE_PREFIX_HEADER = YES;
INFOPLIST_FILE = Info.plist;
INSTALL_PATH = "$(HOME)/Applications";
LIBRARY_SEARCH_PATHS = "";
OTHER_CFLAGS = "";
OTHER_LDFLAGS = (
"-L$(OCAMLLIBDIR)",
"-lunix",
"-lthreadsnat",
"-lstr",
"-lbigarray",
"-lasmrun",
);
PREBINDING = NO;
PRODUCT_NAME = Unison;
SECTORDER_FLAGS = "";
WARNING_CFLAGS = (
"-Wmost",
"-Wno-four-char-constants",
"-Wno-unknown-pragmas",
);
WRAPPER_EXTENSION = app;
ZERO_LINK = NO;
};
name = Default;
};
2A3C3F2D0992245300E404E9 /* Development */ = {
isa = XCBuildConfiguration;
baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */;
buildSettings = {
LIBRARY_SEARCH_PATHS = "";
SDKROOT = /Developer/SDKs/MacOSX10.5.sdk;
USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR;
};
name = Development;
};
2A3C3F2E0992245300E404E9 /* Deployment */ = {
isa = XCBuildConfiguration;
baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */;
buildSettings = {
LIBRARY_SEARCH_PATHS = "";
SDKROOT = /Developer/SDKs/MacOSX10.5.sdk;
USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR;
};
name = Deployment;
};
2A3C3F2F0992245300E404E9 /* Default */ = {
isa = XCBuildConfiguration;
baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */;
buildSettings = {
LIBRARY_SEARCH_PATHS = "";
SDKROOT = /Developer/SDKs/MacOSX10.5.sdk;
USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR;
};
name = Default;
};
/* End XCBuildConfiguration section */
/* Begin XCConfigurationList section */
2A124E7C0DE1C4A200524237 /* Build configuration list for PBXAggregateTarget "Create ExternalSettings" */ = {
isa = XCConfigurationList;
buildConfigurations = (
2A124E790DE1C48400524237 /* Development */,
2A124E7A0DE1C48400524237 /* Deployment */,
2A124E7B0DE1C48400524237 /* Default */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Default;
};
2A3C3F280992245300E404E9 /* Build configuration list for PBXNativeTarget "uimac" */ = {
isa = XCConfigurationList;
buildConfigurations = (
2A3C3F290992245300E404E9 /* Development */,
2A3C3F2A0992245300E404E9 /* Deployment */,
2A3C3F2B0992245300E404E9 /* Default */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Default;
};
2A3C3F2C0992245300E404E9 /* Build configuration list for PBXProject "uimacnew" */ = {
isa = XCConfigurationList;
buildConfigurations = (
2A3C3F2D0992245300E404E9 /* Development */,
2A3C3F2E0992245300E404E9 /* Deployment */,
2A3C3F2F0992245300E404E9 /* Default */,
);
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Default;
};
/* End XCConfigurationList section */
};
rootObject = 29B97313FDCFA39411CA2CEA /* Project object */;
}
unison-2.40.102/uimacnew/progressicons/ 0000755 0061316 0061316 00000000000 12050210657 020103 5 ustar bcpierce bcpierce unison-2.40.102/uimacnew/progressicons/ProgressBarWhite.png 0000644 0061316 0061316 00000000230 11361646373 024052 0 ustar bcpierce bcpierce PNG
IHDR ,@ gAMA OX2 tEXtSoftware Adobe ImageReadyqe< *IDATc8q,ϟQOΞpM{ 2yj fy IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarGreen.png 0000644 0061316 0061316 00000000227 11361646373 024040 0 ustar bcpierce bcpierce PNG
IHDR ,@ gAMA OX2 tEXtSoftware Adobe ImageReadyqe< )IDATcZgP8 gbf`rșH0 {)) IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarEndBlue.png 0000644 0061316 0061316 00000000175 11361646373 024320 0 ustar bcpierce bcpierce PNG
IHDR ,@ gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATcpz@ ? IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarEndAdvanced.png 0000644 0061316 0061316 00000000173 11361646373 025134 0 ustar bcpierce bcpierce PNG
IHDR gAMA OX2 tEXtSoftware Adobe ImageReadyqe<
IDATc`Pc P IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarEndGray.png 0000644 0061316 0061316 00000000173 11361646373 024331 0 ustar bcpierce bcpierce PNG
IHDR gAMA OX2 tEXtSoftware Adobe ImageReadyqe<
IDATc SXI IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarLightGreen.png 0000644 0061316 0061316 00000005424 11361646373 025034 0 ustar bcpierce bcpierce PNG
IHDR ,@ pHYs
OiCCPPhotoshop ICC profile xڝSgTS=BKKoR RB&*! J!QEEȠQ,
!{kּ> H3Q5 B .@
$p d!s# ~<<+" x M0 B\t8K @zB @F&S `cb P- `' { [! eD h; VE X0 fK9 - 0IWfH 0Q) { `##x FW<+* x<$9E[-qWW. (I+6aa@.y24 x6_-"bbϫp@ t~,/;m%h^ uf@ Wp~<5 j>{-]cK'Xt o(hw?G% fIq ^D$.Tʳ? D*A, `6B$BB
d r`)B(Ͱ *`/@ 4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH =r9\F; 2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB a AHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![
b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕ NWGw
Ljg(gwLӋT071oUX**|
J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k
u5&|v* =9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ
M=:.kDwn^Loy }/TmG X $ <5qo< /QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz %gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK 9.*6nl {/]py.,:@LN8A*%w%
y g"/6шC\* NH*Mz쑼5y$3,幄'L
Lݛ:v m2=:1qB!Mggfvˬen/ kY-
BTZ(*geWf͉9+̳ې7ᒶKW- X潬j9(xoʿܔĹdff-[n
ڴ
VE/(ۻCɾUUMfeI?m]Nmq# =TR+G w-
6
U#pDy
:v{ v g /jBFS[b[O>zG 499?rCd&ˮ/~јѡm| x31^Vww O| (hSЧc3- gAMA |Q cHRM z% u0 ` : o_F /IDATxbZgư
^!uC
U1h3 , IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarEndWhite.png 0000644 0061316 0061316 00000000175 11361646373 024511 0 ustar bcpierce bcpierce PNG
IHDR ,@ gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATc8q, uL{1 IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarEndGreen.png 0000644 0061316 0061316 00000000175 11361646373 024471 0 ustar bcpierce bcpierce PNG
IHDR ,@ gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATcZg@ /o mCk IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarBlue.png 0000644 0061316 0061316 00000000227 11361646373 023667 0 ustar bcpierce bcpierce PNG
IHDR ,@ gAMA OX2 tEXtSoftware Adobe ImageReadyqe< )IDATcpzǐ
_CO Qk2d @ (g+X IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarAdvanced.png 0000644 0061316 0061316 00000000216 11361646373 024503 0 ustar bcpierce bcpierce PNG
IHDR gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATc`PcR1Wbo?
n IENDB` unison-2.40.102/uimacnew/progressicons/ProgressBarGray.png 0000644 0061316 0061316 00000000210 11361646373 023672 0 ustar bcpierce bcpierce PNG
IHDR gAMA OX2 tEXtSoftware Adobe ImageReadyqe< IDATc°
0`ǰa=N `5{~ IENDB` unison-2.40.102/uimacnew/PreferencesController.m 0000644 0061316 0061316 00000005453 11361646373 021711 0 ustar bcpierce bcpierce #import "PreferencesController.h"
#import "Bridge.h"
@implementation PreferencesController
- (void)reset
{
[profileNameText setStringValue:@""];
[firstRootText setStringValue:@""];
[secondRootUser setStringValue:@""];
[secondRootHost setStringValue:@""];
[secondRootText setStringValue:@""];
[remoteButtonCell setState:NSOnState];
[localButtonCell setState:NSOffState];
[secondRootUser setSelectable:YES];
[secondRootUser setEditable:YES];
[secondRootHost setSelectable:YES];
[secondRootHost setEditable:YES];
}
- (BOOL)validatePrefs
{
NSString *profileName = [profileNameText stringValue];
if (profileName == nil | [profileName isEqualTo:@""]) {
// FIX: should check for already existing names too
NSRunAlertPanel(@"Error",@"You must enter a profile name",@"OK",nil,nil);
return NO;
}
NSString *firstRoot = [firstRootText stringValue];
if (firstRoot == nil | [firstRoot isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a first root",@"OK",nil,nil);
return NO;
}
NSString *secondRoot;
if ([remoteButtonCell state] == NSOnState) {
NSString *user = [secondRootUser stringValue];
if (user == nil | [user isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a user",@"OK",nil,nil);
return NO;
}
NSString *host = [secondRootHost stringValue];
if (host == nil | [host isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a host",@"OK",nil,nil);
return NO;
}
NSString *file = [secondRootText stringValue];
// OK for empty file, e.g., ssh://foo@bar/
secondRoot = [NSString stringWithFormat:@"ssh://%@@%@/%@",user,host,file];
}
else {
secondRoot = [secondRootText stringValue];
if (secondRoot == nil | [secondRoot isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a second root file",@"OK",nil,nil);
return NO;
}
}
ocamlCall("xSSS", "unisonProfileInit", profileName, firstRoot, secondRoot);
return YES;
}
/* The target when enter is pressed in any of the text fields */
// FIX: this is broken, it takes tab, mouse clicks, etc.
- (IBAction)anyEnter:(id)sender
{
NSLog(@"enter");
[self validatePrefs];
}
- (IBAction)localClick:(id)sender
{
NSLog(@"local");
[secondRootUser setStringValue:@""];
[secondRootHost setStringValue:@""];
[secondRootUser setSelectable:NO];
[secondRootUser setEditable:NO];
[secondRootHost setSelectable:NO];
[secondRootHost setEditable:NO];
}
- (IBAction)remoteClick:(id)sender
{
NSLog(@"remote");
[secondRootUser setSelectable:YES];
[secondRootUser setEditable:YES];
[secondRootHost setSelectable:YES];
[secondRootHost setEditable:YES];
}
@end
unison-2.40.102/uimacnew/ProgressCell.m 0000644 0061316 0061316 00000014535 11361646373 020011 0 ustar bcpierce bcpierce /******************************************************************************
* Copyright 2008 (see file COPYING for more information)
*
* Loosely based on TorrentCell from Transmission (.png files are from
* the original).
*****************************************************************************/
#import "ProgressCell.h"
#define BAR_HEIGHT 12.0
static NSImage *_ProgressWhite, *_ProgressBlue, *_ProgressGray, *_ProgressGreen,
*_ProgressAdvanced, *_ProgressEndWhite, *_ProgressEndBlue,
*_ProgressEndGray, *_ProgressEndGreen, *_ProgressLightGreen,
*_ProgressEndAdvanced, * _ErrorImage;
static NSSize ZeroSize;
@implementation ProgressCell
+ (void) initialize
{
NSSize startSize = NSMakeSize(100.0, BAR_HEIGHT);
ZeroSize = NSMakeSize(0.0, 0.0);
_ProgressWhite = [NSImage imageNamed: @"ProgressBarWhite.png"];
[_ProgressWhite setScalesWhenResized: YES];
_ProgressBlue = [NSImage imageNamed: @"ProgressBarBlue.png"];
[_ProgressBlue setScalesWhenResized: YES];
[_ProgressBlue setSize: startSize];
_ProgressGray = [NSImage imageNamed: @"ProgressBarGray.png"];
[_ProgressGray setScalesWhenResized: YES];
[_ProgressGray setSize: startSize];
_ProgressGreen = [NSImage imageNamed: @"ProgressBarGreen.png"];
[_ProgressGreen setScalesWhenResized: YES];
_ProgressLightGreen = [NSImage imageNamed: @"ProgressBarLightGreen.png"];
[_ProgressLightGreen setScalesWhenResized: YES];
_ProgressAdvanced = [NSImage imageNamed: @"ProgressBarAdvanced.png"];
[_ProgressAdvanced setScalesWhenResized: YES];
_ProgressEndWhite = [NSImage imageNamed: @"ProgressBarEndWhite.png"];
_ProgressEndBlue = [NSImage imageNamed: @"ProgressBarEndBlue.png"];
_ProgressEndGray = [NSImage imageNamed: @"ProgressBarEndGray.png"];
_ProgressEndGreen = [NSImage imageNamed: @"ProgressBarEndGreen.png"];
_ProgressEndAdvanced = [NSImage imageNamed: @"ProgressBarEndAdvanced.png"];
_ErrorImage = [[NSImage imageNamed: @"Error.tiff"] copy];
[_ErrorImage setFlipped: YES];
}
- (id)init
{
self = [super init];
_minVal = 0.0;
_maxVal = 100.0;
_isActive = YES;
return self;
}
// BCP: Removed (11/09) per Onne Gorter
// - (void)dealloc
// {
// [_icon release];
// [_statusString release];
// [super dealloc];
// }
- (void)setStatusString:(NSString *)string
{
// BCP: Removed (11/09) per Onne Gorter
// [_statusString autorelease];
// _statusString = [string retain];
// Added:
_statusString = string;
}
- (void)setIcon:(NSImage *)image
{
// BCP: Removed (11/09) per Onne Gorter
// [_icon autorelease];
// _icon = [image retain];
// Added:
_icon = image;
}
- (void)setIsActive:(BOOL)yn
{
_isActive = yn;
}
- (void)drawBarImage:(NSImage *)barImage width:(float)width point:(NSPoint)point
{
if (width <= 0.0)
return;
if ([barImage size].width < width)
[barImage setSize: NSMakeSize(width * 2.0, BAR_HEIGHT)];
[barImage compositeToPoint: point fromRect: NSMakeRect(0, 0, width, BAR_HEIGHT) operation: NSCompositeSourceOver];
}
- (void)drawBar:(float)width point:(NSPoint)point
{
id objectValue = [self objectValue];
if (!objectValue) return;
float value = [objectValue floatValue];
float progress = (value - _minVal)/ (_maxVal - _minVal);
width -= 2.0;
float completedWidth, remainingWidth = 0.0;
//bar images and widths
NSImage * barLeftEnd, * barRightEnd, * barComplete, * barRemaining;
if (progress >= 1.0) {
completedWidth = width;
barLeftEnd = _ProgressEndGreen;
barRightEnd = _ProgressEndGreen;
barComplete = _ProgressGreen;
barRemaining = _ProgressLightGreen;
}
else {
completedWidth = progress * width;
remainingWidth = width - completedWidth;
barLeftEnd = (remainingWidth == width) ? _ProgressEndWhite
: ((_isActive) ? _ProgressEndBlue : _ProgressEndGray);
barRightEnd = (completedWidth < width) ? _ProgressEndWhite
: ((_isActive) ? _ProgressEndBlue : _ProgressEndGray);
barComplete = _isActive ? _ProgressBlue : _ProgressGray;
barRemaining = _ProgressWhite;
}
[barLeftEnd compositeToPoint: point operation: NSCompositeSourceOver];
point.x += 1.0;
[self drawBarImage: barComplete width: completedWidth point: point];
point.x += completedWidth;
[self drawBarImage: barRemaining width: remainingWidth point: point];
point.x += remainingWidth;
[barRightEnd compositeToPoint: point operation: NSCompositeSourceOver];
}
- (void)drawWithFrame:(NSRect)cellFrame inView:(NSView *)view
{
NSPoint pen = cellFrame.origin;
const float PADDING = 3.0;
// progress bar
pen.y += PADDING + BAR_HEIGHT;
float mainWidth = cellFrame.size.width;
float barWidth = mainWidth;
[self drawBar: barWidth point: pen];
//icon
NSImage * image = _isError ? _ErrorImage : _icon;
if (image) {
NSSize imageSize = [image size];
NSRect imageFrame;
imageFrame.origin = cellFrame.origin;
imageFrame.size = imageSize;
imageFrame.origin.x += ceil((cellFrame.size.width - imageSize.width) / 2);
imageFrame.origin.y += [view isFlipped] ?
ceil((cellFrame.size.height + imageSize.height) / 2)
: ceil((cellFrame.size.height - imageSize.height) / 2);
[image compositeToPoint:imageFrame.origin operation:NSCompositeSourceOver];
}
// status string
if (_statusString) {
BOOL highlighted = [self isHighlighted] && [[self highlightColorWithFrame: cellFrame inView: view]
isEqual: [NSColor alternateSelectedControlColor]];
NSMutableParagraphStyle * paragraphStyle = [[NSParagraphStyle defaultParagraphStyle] mutableCopy];
[paragraphStyle setLineBreakMode: NSLineBreakByTruncatingTail];
NSDictionary * statusAttributes = [[NSDictionary alloc] initWithObjectsAndKeys:
highlighted ? [NSColor whiteColor] : [NSColor darkGrayColor], NSForegroundColorAttributeName,
[NSFont boldSystemFontOfSize: 9.0], NSFontAttributeName,
paragraphStyle, NSParagraphStyleAttributeName, nil];
[paragraphStyle release];
NSSize statusSize = [_statusString sizeWithAttributes: statusAttributes];
pen = cellFrame.origin;
pen.x += (cellFrame.size.width - statusSize.width) * 0.5;
pen.y += (cellFrame.size.height - statusSize.height) * 0.5;
[_statusString drawInRect: NSMakeRect(pen.x, pen.y, statusSize.width, statusSize.height)
withAttributes: statusAttributes];
[statusAttributes release];
}
}
@end
unison-2.40.102/uimacnew/Info.plist.template 0000644 0061316 0061316 00000002117 11361646373 021002 0 ustar bcpierce bcpierce
CFBundleName
Unison
CFBundleDevelopmentRegion
English
CFBundleExecutable
Unison
CFBundleIconFile
Unison.icns
CFBundleIdentifier
edu.upenn.cis.Unison
CFBundleInfoDictionaryVersion
6.0
CFBundlePackageType
APPL
CFBundleSignature
????
CFBundleVersion
@@VERSION@@
CFBundleShortVersionString
@@VERSION@@
CFBundleGetInfoString
@@VERSION@@. ©1999-2007, licensed under GNU GPL.
NSHumanReadableCopyright
©1999-2006, licensed under GNU GPL.
NSMainNibFile
MainMenu
NSPrincipalClass
NSApplication
unison-2.40.102/uimacnew/ProfileController.m 0000644 0061316 0061316 00000004424 11361646373 021045 0 ustar bcpierce bcpierce /* Copyright (c) 2003, see file COPYING for details. */
#import "ProfileController.h"
#import "Bridge.h"
@implementation ProfileController
NSString *unisonDirectory()
{
return (NSString *)ocamlCall("S", "unisonDirectory");
}
- (void)initProfiles
{
NSString *directory = unisonDirectory();
#if MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
NSArray *files = [[NSFileManager defaultManager] directoryContentsAtPath:directory];
#else
NSArray *files = [[NSFileManager defaultManager] contentsOfDirectoryAtPath:directory error:nil];
#endif
unsigned int count = [files count];
unsigned int i,j;
[profiles release];
profiles = [[NSMutableArray alloc] init];
defaultIndex = -1;
for (i = j = 0; i < count; i++) {
NSString *file = [files objectAtIndex:i];
if ([[file pathExtension] isEqualTo:@"prf"]) {
NSString *withoutExtension = [file stringByDeletingPathExtension];
[profiles insertObject:withoutExtension atIndex:j];
if ([@"default" isEqualTo:withoutExtension]) defaultIndex = j;
j++;
}
}
if (j > 0)
[tableView selectRowIndexes:[NSIndexSet indexSetWithIndex:0] byExtendingSelection:NO];
}
- (void)awakeFromNib
{
// start with the default profile selected
[self initProfiles];
if (defaultIndex >= 0)
[tableView selectRowIndexes:[NSIndexSet indexSetWithIndex:defaultIndex] byExtendingSelection:NO];
// on awake the scroll bar is inactive, but after adding profiles we might need it;
// reloadData makes it happen. Q: is setNeedsDisplay more efficient?
[tableView reloadData];
}
- (int)numberOfRowsInTableView:(NSTableView *)aTableView
{
if (!profiles) return 0;
else return [profiles count];
}
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex
{
if (rowIndex >= 0 && rowIndex < [profiles count])
return [profiles objectAtIndex:rowIndex];
else return @"[internal error!]";
}
- (NSString *)selected
{
int rowIndex = [tableView selectedRow];
if (rowIndex >= 0 && rowIndex < [profiles count])
return [profiles objectAtIndex:rowIndex];
else return @"[internal error!]";
}
- (NSTableView *)tableView
{
return tableView;
}
@end
unison-2.40.102/uimacnew/ProfileTableView.m 0000644 0061316 0061316 00000001601 11361646373 020576 0 ustar bcpierce bcpierce #import "MyController.h"
#import "ProfileTableView.h"
@implementation ProfileTableView
- (void)keyDown:(NSEvent *)event
{
/* some keys return zero-length strings */
if ([[event characters] length] == 0) {
[super keyDown:event];
return;
}
unichar c = [[event characters] characterAtIndex:0];
switch (c) {
case '\r':
[myController openButton:self];
break;
default:
[super keyDown:event];
break;
}
}
/* Override default highlight colour to match ReconTableView */
- (id)_highlightColorForCell:(NSCell *)cell
{
if(([[self window] firstResponder] == self) &&
[[self window] isMainWindow] &&
[[self window] isKeyWindow])
return [NSColor colorWithCalibratedRed:0.7 green:0.75 blue:0.8 alpha:1.0];
else return [NSColor colorWithCalibratedRed:0.8 green:0.8 blue:0.8 alpha:1.0];
}
@end
unison-2.40.102/uimacnew/PreferencesController.h 0000644 0061316 0061316 00000001044 11361646373 021674 0 ustar bcpierce bcpierce /* PreferencesController */
#import
@interface PreferencesController : NSObject
{
IBOutlet NSTextField *firstRootText;
IBOutlet NSButtonCell *localButtonCell;
IBOutlet NSTextField *profileNameText;
IBOutlet NSButtonCell *remoteButtonCell;
IBOutlet NSTextField *secondRootHost;
IBOutlet NSTextField *secondRootText;
IBOutlet NSTextField *secondRootUser;
}
- (IBAction)anyEnter:(id)sender;
- (IBAction)localClick:(id)sender;
- (IBAction)remoteClick:(id)sender;
- (BOOL)validatePrefs;
- (void)reset;
@end
unison-2.40.102/uimacnew/ProfileController.h 0000644 0061316 0061316 00000001143 11361646373 021033 0 ustar bcpierce bcpierce /* ProfileController */
/* Copyright (c) 2003, see file COPYING for details. */
#import
@interface ProfileController : NSObject
{
IBOutlet NSTableView *tableView;
NSMutableArray *profiles;
int defaultIndex; // -1 if no default, else the index in profiles of @"default"
}
- (void)initProfiles;
- (int)numberOfRowsInTableView:(NSTableView *)aTableView;
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex;
- (NSString *)selected;
- (NSTableView *)tableView; // allows MyController to set up firstResponder
@end
unison-2.40.102/uimacnew/ProgressCell.h 0000644 0061316 0061316 00000000561 11361646373 017776 0 ustar bcpierce bcpierce #import
@interface ProgressCell : NSCell
{
float _minVal, _maxVal; // defaults to 0.0, 100.0
BOOL _isActive;
BOOL _useFullView; // default: NO
BOOL _isError; // default: NO
NSImage *_icon;
NSString *_statusString;
}
- (void)setStatusString:(NSString *)string;
- (void)setIcon:(NSImage *)image;
- (void)setIsActive:(BOOL)yn;
@end
unison-2.40.102/uimacnew/ProfileTableView.h 0000644 0061316 0061316 00000000243 11361646373 020572 0 ustar bcpierce bcpierce /* ProfileTableView */
#import
@class MyController;
@interface ProfileTableView : NSTableView
{
IBOutlet MyController *myController;
}
@end
unison-2.40.102/uimacnew/UnisonToolbar.m 0000644 0061316 0061316 00000020100 11361646373 020164 0 ustar bcpierce bcpierce //
// UnisonToolbar.h
//
// Extended NSToolbar with several views
//
// Created by Ben Willmore on Sun March 12 2006.
// Copyright (c) 2006, licensed under GNU GPL.
//
#import "UnisonToolbar.h"
#import "MyController.h"
static NSString* QuitItemIdentifier = @"Quit";
static NSString* OpenItemIdentifier = @"Open";
static NSString* NewItemIdentifier = @"New";
static NSString* GoItemIdentifier = @"Go";
static NSString* CancelItemIdentifier = @"Cancel";
static NSString* SaveItemIdentifier = @"Save";
static NSString* RestartItemIdentifier = @"Restart";
static NSString* RescanItemIdentifier = @"Rescan";
static NSString* RToLItemIdentifier = @"RToL";
static NSString* MergeItemIdentifier = @"Merge";
static NSString* LToRItemIdentifier = @"LToR";
static NSString* SkipItemIdentifier = @"Skip";
static NSString* DiffItemIdentifier = @"Diff";
static NSString* TableModeIdentifier = @"TableMode";
@implementation UnisonToolbar
- initWithIdentifier:(NSString *) identifier :(MyController *) aController :(ReconTableView *) aTableView {
if ((self = [super initWithIdentifier: identifier])) {
[self setAllowsUserCustomization: NO];
[self setAutosavesConfiguration: NO];
[self setDelegate: self];
myController = aController;
tableView = aTableView;
currentView = @"";
}
return self;
}
- (void)takeTableModeView:(NSView *)view
{
tableModeView = [view retain];
[view setHidden:YES];
}
- (NSToolbarItem *) toolbar: (NSToolbar *)toolbar itemForItemIdentifier: (NSString *) itemIdent willBeInsertedIntoToolbar:(BOOL) willBeInserted {
NSToolbarItem *toolbarItem = [[[NSToolbarItem alloc] initWithItemIdentifier: itemIdent] autorelease];
if ([itemIdent isEqual: QuitItemIdentifier]) {
[toolbarItem setLabel: @"Quit"];
[toolbarItem setImage: [NSImage imageNamed: @"quit.tif"]];
[toolbarItem setTarget:NSApp];
[toolbarItem setAction:@selector(terminate:)];
}
else if ([itemIdent isEqual: OpenItemIdentifier]) {
[toolbarItem setLabel: @"Open"];
[toolbarItem setImage: [NSImage imageNamed: @"go.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(openButton:)];
}
else if ([itemIdent isEqual: NewItemIdentifier]) {
[toolbarItem setLabel: @"New"];
[toolbarItem setImage: [NSImage imageNamed: @"add.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(createButton:)];
}
else if ([itemIdent isEqual: CancelItemIdentifier]) {
[toolbarItem setLabel: @"Cancel"];
[toolbarItem setImage: [NSImage imageNamed: @"restart.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(chooseProfiles)];
}
else if ([itemIdent isEqual: SaveItemIdentifier]) {
[toolbarItem setLabel: @"Save"];
[toolbarItem setImage: [NSImage imageNamed: @"save.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(saveProfileButton:)];
}
else if ([itemIdent isEqual: GoItemIdentifier]) {
[toolbarItem setLabel: @"Go"];
[toolbarItem setImage: [NSImage imageNamed: @"go.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(syncButton:)];
}
else if ([itemIdent isEqual: RestartItemIdentifier]) {
[toolbarItem setLabel: @"Restart"];
[toolbarItem setImage: [NSImage imageNamed: @"restart.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(restartButton:)];
}
else if ([itemIdent isEqual: RescanItemIdentifier]) {
[toolbarItem setLabel: @"Rescan"];
[toolbarItem setImage: [NSImage imageNamed: @"rescan.tif"]];
[toolbarItem setTarget:myController];
[toolbarItem setAction:@selector(rescan:)];
}
else if ([itemIdent isEqual: RToLItemIdentifier]) {
[toolbarItem setLabel: @"Right to left"];
[toolbarItem setImage: [NSImage imageNamed: @"left.tif"]];
[toolbarItem setTarget:tableView];
[toolbarItem setAction:@selector(copyRL:)];
}
else if ([itemIdent isEqual: MergeItemIdentifier]) {
[toolbarItem setLabel: @"Merge"];
[toolbarItem setImage: [NSImage imageNamed: @"merge.tif"]];
[toolbarItem setTarget:tableView];
[toolbarItem setAction:@selector(merge:)];
}
else if ([itemIdent isEqual: LToRItemIdentifier]) {
[toolbarItem setLabel: @"Left to right"];
[toolbarItem setImage: [NSImage imageNamed: @"right.tif"]];
[toolbarItem setTarget:tableView];
[toolbarItem setAction:@selector(copyLR:)];
}
else if ([itemIdent isEqual: SkipItemIdentifier]) {
[toolbarItem setLabel: @"Skip"];
[toolbarItem setImage: [NSImage imageNamed: @"skip.tif"]];
[toolbarItem setTarget:tableView];
[toolbarItem setAction:@selector(leaveAlone:)];
}
else if ([itemIdent isEqual: DiffItemIdentifier]) {
[toolbarItem setLabel: @"Diff"];
[toolbarItem setImage: [NSImage imageNamed: @"diff.tif"]];
[toolbarItem setTarget:tableView];
[toolbarItem setAction:@selector(showDiff:)];
}
else if ([itemIdent isEqual: TableModeIdentifier]) {
[toolbarItem setLabel:@"Layout"];
[toolbarItem setToolTip:@"Switch table nesting"];
[tableModeView setHidden:NO];
[toolbarItem setView:tableModeView];
[toolbarItem setMinSize:NSMakeSize(NSWidth([tableModeView frame]),NSHeight([tableModeView frame])+10)];
[toolbarItem setMaxSize:NSMakeSize(NSWidth([tableModeView frame]),NSHeight([tableModeView frame])+10)];
}
return toolbarItem;
}
- (NSArray *) itemIdentifiersForView: (NSString *) whichView {
if ([whichView isEqual: @"chooseProfileView"]) {
return [NSArray arrayWithObjects: QuitItemIdentifier, NewItemIdentifier, OpenItemIdentifier, nil];
}
else if ([whichView isEqual: @"preferencesView"]) {
return [NSArray arrayWithObjects: QuitItemIdentifier, SaveItemIdentifier, CancelItemIdentifier, nil];
}
else if ([whichView isEqual: @"ConnectingView"]) {
return [NSArray arrayWithObjects: QuitItemIdentifier, nil];
}
else if ([whichView isEqual: @"updatesView"]) {
return [NSArray arrayWithObjects: QuitItemIdentifier,
RestartItemIdentifier,
NSToolbarSeparatorItemIdentifier,
GoItemIdentifier,
RescanItemIdentifier,
NSToolbarSeparatorItemIdentifier,
RToLItemIdentifier, MergeItemIdentifier, LToRItemIdentifier,
SkipItemIdentifier, NSToolbarSeparatorItemIdentifier,
DiffItemIdentifier,
TableModeIdentifier, nil];
}
else {
return [NSArray arrayWithObjects: QuitItemIdentifier, Nil];
}
}
- (NSArray *) toolbarDefaultItemIdentifiers: (NSToolbar *) toolbar {
return [NSArray arrayWithObjects: QuitItemIdentifier, NewItemIdentifier, OpenItemIdentifier, nil];
}
- (NSArray *) toolbarAllowedItemIdentifiers: (NSToolbar *) toolbar {
return [NSArray arrayWithObjects: QuitItemIdentifier, OpenItemIdentifier, NewItemIdentifier,
CancelItemIdentifier, SaveItemIdentifier,
GoItemIdentifier, RestartItemIdentifier, RescanItemIdentifier,
RToLItemIdentifier, MergeItemIdentifier, LToRItemIdentifier,
SkipItemIdentifier, DiffItemIdentifier,
NSToolbarSeparatorItemIdentifier, nil];
}
- (void) setView: (NSString *) whichView {
if ([whichView isEqual:currentView]) return;
currentView = whichView;
int i;
NSArray *identifiers;
NSString *oldIdentifier;
NSString *newIdentifier;
identifiers=[self itemIdentifiersForView:whichView];
for (i=0; i<[identifiers count]; i++) {
newIdentifier = [identifiers objectAtIndex:i];
if (i<[[self items] count]) {
oldIdentifier = [[[self items] objectAtIndex:i] itemIdentifier];
if ([newIdentifier isEqual: oldIdentifier] ) {
[[[self items] objectAtIndex:i] setEnabled:YES];
}
else {
[self removeItemAtIndex:i];
[self insertItemWithItemIdentifier:newIdentifier atIndex:i];
}
}
else {
[self insertItemWithItemIdentifier:newIdentifier atIndex:i];
}
}
while ([[self items] count] > [identifiers count]) {
[self removeItemAtIndex:[identifiers count]];
}
}
@end
unison-2.40.102/uimacnew/UnisonToolbar.h 0000644 0061316 0061316 00000001773 11361646373 020176 0 ustar bcpierce bcpierce //
// UnisonToolbar.h
//
// Extended NSToolbar with several views
//
// Created by Ben Willmore on Sun March 12 2006.
// Copyright (c) 2006, licensed under GNU GPL.
//
#import
@class ReconTableView, MyController;
@interface UnisonToolbar : NSToolbar
#if (MAC_OS_X_VERSION_MAX_ALLOWED >= 1060)
#endif
{
ReconTableView* tableView;
MyController* myController;
NSString* currentView;
NSView* tableModeView;
}
- initWithIdentifier:(NSString *) identifier :(MyController *) aController :(ReconTableView *) aTableView;
- (NSToolbarItem *) toolbar: (NSToolbar *)toolbar itemForItemIdentifier: (NSString *) itemIdent willBeInsertedIntoToolbar:(BOOL) willBeInserted;
- (NSArray *) itemIdentifiersForView: (NSString *) whichView;
- (NSArray *) toolbarDefaultItemIdentifiers: (NSToolbar *) toolbar;
- (NSArray *) toolbarAllowedItemIdentifiers: (NSToolbar *) toolbar;
- (void) setView: (NSString *) whichView;
- (void)takeTableModeView:(NSView *)view;
@end
unison-2.40.102/uimacnew/main.m 0000644 0061316 0061316 00000003205 11361646373 016321 0 ustar bcpierce bcpierce //
// main.m
// uimac
//
// Created by Trevor Jim on Sun Aug 17 2003.
// Copyright (c) 2003, see file COPYING for details.
//
#import
#import "Bridge.h"
int main(int argc, const char *argv[])
{
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
int i;
/* When you click-start or use the open command, the program is invoked with
a command-line arg of the form -psn_XXXXXXXXX. The XXXXXXXX is a "process
serial number" and it seems to be important for Carbon programs. We need
to get rid of it if it's there so the ocaml code won't exit. Note, the
extra arg is not added if the binary is invoked directly from the command
line without using the open command. */
if (argc == 2 && strncmp(argv[1],"-psn_",5) == 0) {
argc--;
argv[1] = NULL;
}
[Bridge startup:argv];
/* Check for invocations that don't start up the gui */
for (i=1; i $@
echo 'let myVersion = "'$(VERSION)'";;' >> $@
echo 'let myMajorVersion = "'$(MAJORVERSION)'";;' >> $@
clean::
$(RM) ubase/projectInfo.ml
####################################################################
### Unison objects and libraries
ifeq ($(UISTYLE),mac)
buildexecutable:: macexecutable
UIMACDIR=uimac
else
ifeq ($(UISTYLE),macnew)
buildexecutable:: macexecutable
UIMACDIR=uimacnew
else
ifeq ($(UISTYLE),macnew09)
buildexecutable:: macexecutable
UIMACDIR=uimacnew09
else
buildexecutable:: $(NAME)$(EXEC_EXT)
endif
endif
endif
MINOSXVERSION=10.5
# XCODEFLAGS=-sdk macosx$(MINOSXVERSION)
ifeq ($(OSARCH),osx)
CAMLFLAGS+=-ccopt -mmacosx-version-min=$(MINOSXVERSION)
endif
# NOTE: the OCAMLLIBDIR is not getting passed correctly?
# The two cases for cltool are needed because Xcode 2.1+
# builds in build/Default/, and earlier versions use build/
.PHONY: macexecutable
macexecutable:
# sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist
(cd $(UIMACDIR); xcodebuild $(XCODEFLAGS) OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build)
if [ -e $(UIMACDIR)/build/Default ]; then \
gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \
else \
gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Unison.app/Contents/MacOS/cltool -framework Carbon; \
fi
# OCaml objects for the bytecode version
# File extensions will be substituted for the native code version
OCAMLOBJS += \
ubase/rx.cmo \
\
unicode_tables.cmo unicode.cmo bytearray.cmo \
$(WINOBJS) system/system_generic.cmo \
system/$(SYSTEM)/system_impl.cmo \
system.cmo \
\
ubase/projectInfo.cmo ubase/myMap.cmo ubase/safelist.cmo \
ubase/uprintf.cmo ubase/util.cmo ubase/uarg.cmo \
ubase/prefs.cmo ubase/trace.cmo ubase/proplist.cmo \
\
lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo \
lwt/$(SYSTEM)/lwt_unix_impl.cmo lwt/lwt_unix.cmo \
\
uutil.cmo case.cmo pred.cmo \
fileutil.cmo name.cmo path.cmo fspath.cmo fs.cmo fingerprint.cmo \
abort.cmo osx.cmo external.cmo \
props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \
tree.cmo checksum.cmo terminal.cmo \
transfer.cmo xferhint.cmo remote.cmo globals.cmo \
fpcache.cmo update.cmo copy.cmo stasher.cmo \
files.cmo sortri.cmo recon.cmo transport.cmo \
strings.cmo uicommon.cmo uitext.cmo test.cmo
OCAMLOBJS+=main.cmo
# OCaml libraries for the bytecode version
# File extensions will be substituted for the native code version
OCAMLLIBS+=unix.cma str.cma bigarray.cma
COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT)
########################################################################
### User Interface setup
## Text UI
ifeq ($(UISTYLE), text)
OCAMLOBJS+=linktext.cmo
endif
## Old Mac UI
ifeq ($(UISTYLE),mac)
OCAMLOBJS+=uimacbridge.cmo
endif
## New Mac UI
ifeq ($(UISTYLE),macnew)
OCAMLOBJS+=uimacbridgenew.cmo
THREADS=true
OCAMLLIBS+=threads.cma
INCLFLAGS+=-thread
endif
## New Mac UI, 2009 version
ifeq ($(UISTYLE),macnew09)
OCAMLOBJS+=uimacbridgenew.cmo
THREADS=true
OCAMLLIBS+=threads.cma
INCLFLAGS+=-thread
endif
## Graphic UI
# Setup the lib directories
# Win32 system : this very Makefile must be used with GNU Make, so that we
# expect CygWin Bash to be used.
# The directory must be provided following one of the model below :
# - unix, relative ../../ocaml/lib/labltk
# - unix, absolute d:/home/foobar/ocaml/lib/labltk
# - dos, relative ..\\..\\ocaml\\lib\\labltk
# - dos, absolute d:\\home\\foobar\\ocaml\\lib\\labltk
# Patch to make a Windows GUI version come up with no
# console when click-started
# ifeq ($(OSARCH), win32)
# COBJS+=winmain.c
# CFLAGS+=-cclib /subsystem:windows
# endif
# Gtk GUI
ifeq ($(UISTYLE), gtk)
CAMLFLAGS+=-I +lablgtk
OCAMLOBJS+=pixmaps.cmo uigtk.cmo linkgtk.cmo
OCAMLLIBS+=lablgtk.cma
endif
# Gtk2 GUI
ifeq ($(UISTYLE), gtk2)
CAMLFLAGS+=-I +lablgtk2
OCAMLOBJS+=pixmaps.cmo uigtk2.cmo linkgtk2.cmo
OCAMLLIBS+=lablgtk.cma
endif
####################################################################
### Static build setup
ifeq ($(STATIC), true)
CFLAGS+=-cclib -static
endif
####################################################################
### Dependencies
# Include an automatically generated list of dependencies
include .depend
# Additional dependencied depending on the system
system.cmo fspath.cmo fs.cmo: system/$(SYSTEM)/system_impl.cmo
system.cmx fspath.cmx fs.cmx: system/$(SYSTEM)/system_impl.cmx
lwt/lwt_unix.cmo: lwt/$(SYSTEM)/lwt_unix_impl.cmo
lwt/lwt_unix.cmx: lwt/$(SYSTEM)/lwt_unix_impl.cmx
ifeq ($(OSARCH), OpenBSD)
ifeq ($(shell echo type ocamldot | ksh), file)
OCAMLDOT=true
endif
else
ifeq ($(shell echo type -t ocamldot | bash), file)
OCAMLDOT=true
endif
endif
ifeq ($(OSARCH), NetBSD)
OCAMLDOT=false
endif
# Rebuild dependencies (must be invoked manually)
.PHONY: depend
depend::
ocamldep $(INCLFLAGS) *.mli *.ml */*.ml */*.mli */*/*.ml */*/*.mli > .depend
ifdef OCAMLDOT
echo 'digraph G {' > dot.tmp
echo '{ rank = same; "Fileinfo"; "Props"; "Fspath"; "Os"; "Path"; }'\
>>dot.tmp
echo '{ rank = same; "Uitext"; "Uigtk"; }'>>dot.tmp
echo '{ rank = same; "Recon"; "Update"; "Transport"; "Files"; }'\
>>dot.tmp
echo '{ rank = same; "Tree"; "Safelist"; }'>>dot.tmp
echo '{ rank = same; "Uarg"; "Prefs"; }'>>dot.tmp
ocamldot .depend | tail -n +2 >> dot.tmp
-dot -Tps -o DEPENDENCIES.ps dot.tmp
endif
####################################################################
### Compilation boilerplate
ifeq ($(DEBUGGING), false)
ifneq ($(OSARCH), win32)
ifneq ($(OSARCH), osx)
# Strip the binary (does not work with MS compiler; might not work
# under OSX)
CFLAGS+=-cclib -Wl,-s
endif
endif
endif
ifeq ($(PROFILING), true)
OCAMLC=ocamlcp
else
OCAMLC=ocamlc
endif
OCAMLOPT=ocamlopt
ifeq ($(NATIVE), true)
## Set up for native code compilation
CAMLC=$(OCAMLOPT)
ifeq ($(PROFILING), true)
CAMLFLAGS+=-p
CLIBS+=-cclib -ldl
endif
CAMLOBJS=$(subst .cmo,.cmx, $(subst .cma,.cmxa, $(OCAMLOBJS)))
CAMLLIBS=$(subst .cma,.cmxa, $(OCAMLLIBS))
else
## Set up for bytecode compilation
CAMLC=$(OCAMLC)
CAMLFLAGS+=-custom
ifeq ($(DEBUGGING), true)
CAMLFLAGS+=-g
endif
CAMLOBJS=$(OCAMLOBJS)
CAMLLIBS=$(OCAMLLIBS)
endif
win32rc/unison.res: win32rc/unison.rc win32rc/U.ico
windres win32rc/unison.rc win32rc/unison.res
win32rc/unison.res.lib: win32rc/unison.res
windres win32rc/unison.res win32rc/unison.res.lib
%.ml: %.mll
-$(RM) $@
ocamllex $<
%.cmi : %.mli
@echo "$(CAMLC): $< ---> $@"
$(CAMLC) $(CAMLFLAGS) -c $(CWD)/$<
%.cmo: %.ml
@echo "$(OCAMLC): $< ---> $@"
$(OCAMLC) $(CAMLFLAGS) -c $(CWD)/$<
%.cmx: %.ml
@echo "$(OCAMLOPT): $< ---> $@"
$(OCAMLOPT) $(CAMLFLAGS) -c $(CWD)/$<
%.o %.obj: %.c
@echo "$(OCAMLOPT): $< ---> $@"
$(CAMLC) $(CAMLFLAGS) -ccopt $(OUTPUT_SEL)$(CWD)/$@ -c $(CWD)/$<
$(NAME)$(EXEC_EXT): $(CAMLOBJS) $(COBJS)
@echo Linking $@
$(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.
$(NAME)-blob.o: $(CAMLOBJS) $(COBJS)
@echo Linking $@
$(CAMLC) -dstartup -output-obj -verbose -cclib -keep_private_externs $(CAMLFLAGS) -o u-b.o $(CFLAGS) $(CAMLLIBS) $(CLIBS) $(CAMLOBJS)
$(LD) -r -keep_private_externs -o $@ u-b.o $(COBJS)
$(RM) u-b.o
# Original:
# $(NAME)-blob.o: $(CAMLOBJS) $(COBJS)
# @echo Linking $@
# $(CAMLC) -output-obj -verbose $(CAMLFLAGS) -o u-b.o $(CFLAGS) $(CAMLLIBS) $(CLIBS) $(CAMLOBJS)
# $(LD) -r -o $@ u-b.o $(COBJS)
# $(RM) u-b.o
%$(EXEC_EXT): %.ml
$(OCAMLC) -verbose -o $@ $^
######################################################################
### Misc
clean::
-$(RM) -r *.cmi *.cmo *.cmx *.cma *.cmxa TAGS tags
-$(RM) -r *.o core gmon.out *~ .*~
-$(RM) -r *.obj *.lib *.exp
-$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp
-$(RM) system/*.cm[iox] system/*.{o,obj} system/win/*~
-$(RM) system/generic/*.cm[iox] system/generic/*.{o,obj} system/generic/*~
-$(RM) system/win/*.cm[iox] system/win/*.{o,obj} system/win/*~
.PHONY: paths
paths:
@echo PATH = $(PATH)
@echo OCAMLLIBDIR = $(OCAMLLIBDIR)
unison-2.40.102/uicommon.mli 0000644 0061316 0061316 00000007162 11361646373 015746 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/uicommon.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Kinds of UI *)
type interface =
Text
| Graphic
(* The interface of a concrete UI implementation *)
module type UI =
sig
val start : interface -> unit
val defaultUi : interface
end
(* User preference: when true, ask fewer questions *)
val auto : bool Prefs.t
(* User preference: How tall to make the main window in the GTK ui *)
val mainWindowHeight : int Prefs.t
(* User preference: Expert mode *)
val expert : bool Prefs.t
(* User preference: Whether to display 'contacting server' message *)
val contactquietly : bool Prefs.t
(* User preference: The 'contacting server' message itself *)
val contactingServerMsg : unit -> string
(* User preference: Descriptive label for this profile *)
val profileLabel : string Prefs.t
(* User preference: Synchronize repeatedly *)
val repeat : string Prefs.t
(* User preference: Try failing paths N times *)
val retry : int Prefs.t
(* User preference: confirmation before commiting merge results *)
val confirmmerge : bool Prefs.t
(* Format the information about current contents of a path in one replica (the second argument
is used as a separator) *)
val details2string : Common.reconItem -> string -> string
(* Format a path, eliding initial components that are the same as the
previous path *)
val displayPath : Path.t -> Path.t -> string
(* Format the names of the roots for display at the head of the
corresponding columns in the UI *)
val roots2string : unit -> string
(* Format a reconItem (and its status string) for display, eliding
initial components that are the same as the previous path *)
val reconItem2string : Path.t -> Common.reconItem -> string -> string
type action = AError | ASkip of bool | ALtoR of bool | ARtoL of bool | AMerge
(* Same as previous function, but returns a tuple of strings *)
val reconItem2stringList :
Path.t -> Common.reconItem -> string * action * string * string
(* Format an exception for display *)
val exn2string : exn -> string
(* Calculate and display differences for a file *)
val showDiffs :
Common.reconItem (* what path *)
-> (string->string->unit) (* how to display the (title and) result *)
-> (string->unit) (* how to display errors *)
-> Uutil.File.t (* id for transfer progress reports *)
-> unit
val dangerousPathMsg : Path.t list -> string
(* Utilities for adding ignore patterns *)
val ignorePath : Path.t -> string
val ignoreName : Path.t -> string
val ignoreExt : Path.t -> string
val addIgnorePattern : string -> unit
val usageMsg : string
val shortUsageMsg : string
val uiInit :
reportError:(string -> unit) ->
tryAgainOrQuit:(string -> bool) ->
displayWaitMessage:(unit -> unit) ->
getProfile:(unit -> string option) ->
getFirstRoot:(unit -> string option) ->
getSecondRoot:(unit -> string option) ->
termInteract:(string -> string -> string) option ->
unit
val initPrefs :
profileName:string ->
displayWaitMessage:(unit->unit) ->
getFirstRoot:(unit->string option) ->
getSecondRoot:(unit->string option) ->
termInteract:(string -> string -> string) option ->
unit
val validateAndFixupPrefs : unit -> unit Lwt.t
(* Exit codes *)
val perfectExit: int (* when everything's okay *)
val skippyExit: int (* when some items were skipped, but no failure occurred *)
val failedExit: int (* when there's some non-fatal failure *)
val fatalExit: int (* when fatal failure occurred *)
val exitCode: bool * bool -> int
(* (anySkipped?, anyFailure?) -> exit code *)
(* Initialization *)
val testFunction : (unit->unit) ref
unison-2.40.102/INSTALL 0000644 0061316 0061316 00000000125 11361646373 014436 0 ustar bcpierce bcpierce For installation instructions, see the the INSTALLATION section of the
user manual.
unison-2.40.102/update.mli 0000644 0061316 0061316 00000006226 11421046600 015362 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/update.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
module NameMap : MyMap.S with type key = Name.t
type archive =
ArchiveDir of Props.t * archive NameMap.t
| ArchiveFile of Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp
| ArchiveSymlink of string
| NoArchive
(* Calculate a canonical name for the set of roots to be synchronized. This
will be used in constructing the archive name for each root. Note, all
the roots in this canonical name will contain hostnames, even local
roots, so the roots are re-sorted. *)
val storeRootsName : unit -> unit
(* Retrieve the actual names of the roots *)
val getRootsName : unit -> string
(* Structures describing dirty files/dirs (1 per path given in the -path preference) *)
val findUpdates :
unit -> ((Path.local * Common.updateItem * Props.t list) *
(Path.local * Common.updateItem * Props.t list)) list
(* Take a tree of equal update contents and update the archive accordingly. *)
val markEqual :
(Name.t * Name.t, Common.updateContent * Common.updateContent) Tree.t -> unit
(* Get and update a part of an archive (the archive remains unchanged) *)
val updateArchive : Fspath.t -> Path.local -> Common.updateItem -> archive
(* Replace a part of an archive by another archive *)
val replaceArchive : Common.root -> Path.t -> archive -> unit Lwt.t
val replaceArchiveLocal : Fspath.t -> Path.local -> archive -> unit
(* Update only some permissions *)
val updateProps :
Fspath.t -> 'a Path.path -> Props.t option -> Common.updateItem -> unit
(* Check that no updates has taken place in a given place of the filesystem *)
(* Returns an archive mirroring the filesystem contents *)
val checkNoUpdates :
Fspath.t -> Path.local -> Common.updateItem -> archive
(* Turn off fastcheck for the given file on the next sync. *)
val markPossiblyUpdated : Fspath.t -> Path.local -> unit
(* Save to disk the archive updates *)
val commitUpdates : unit -> unit
(* In the user interface, it's helpful to know whether unison was started
with no archives. (Then we can display file status as 'unknown' rather
than 'new', which seems friendlier for new users.) This flag gets set
false by the crash recovery code when it determines that no archives were
present. *)
val foundArchives : bool ref
(* Unlock the archives, if they are locked. *)
val unlockArchives : unit -> unit Lwt.t
(* Translate a global path into a local path using the archive *)
val translatePath : Common.root -> Path.t -> Path.local Lwt.t
val translatePathLocal : Fspath.t -> Path.t -> Path.local
(* Are we checking fast, or carefully? *)
val useFastChecking : unit -> bool
(* Print the archive to the current formatter (see Format) *)
val showArchive: archive -> unit
(* Compute the size of an update *)
val updateSize : Path.t -> Common.updateItem -> int * Uutil.Filesize.t
(* Iterate on all files in an archive *)
val iterFiles :
Fspath.t -> Path.local -> archive ->
(Fspath.t -> Path.local -> Os.fullfingerprint -> unit) -> unit
(* (For breaking the dependency loop between update.ml and stasher.ml...) *)
val setStasherFun : (Fspath.t -> Path.local -> unit) -> unit
unison-2.40.102/CONTRIB 0000644 0061316 0061316 00000004215 11361646373 014434 0 ustar bcpierce bcpierce INFORMATION FOR CONTRIBUTORS
============================
Unison is a part-time project for its developers: we work on it
because we enjoy making something useful for us and for the community,
but we all have other jobs to do. If you like Unison and you want to
help us make it better, we'd be glad to have you on the team!
HOW YOU CAN HELP
----------------
There are lots of ways...
* Telling us how you like Unison, whether the installation went
smoothly, and what you use it for.
* Submitting bug reports (we're always glad to have these...)
* Submitting bug FIXES (... especially when accompanied by these! :-)
* Reading the code. One of Unison's main design goals is robustness.
Help us reach that goal by reading our code and seeing whether you
understand and believe it.
* Proposing ideas for new functionality.
* Undertaking serious development work.
See the file TODO.txt for a "wish list" of improvements that are waiting
for someone to take them on.
DOWNLOADING THE DEVELOPER SOURCES
---------------------------------
If you just want to read the code, then the source distribution has
everything you need.
If you want to do any serious hacking on Unison, you should begin by
grabbing a copy of the full distribution from here:
http://www.cis.upenn.edu/~bcpierce/unison/resources/developers-only
The tar file you'll find contains a mirror of our whole source tree
(including the sources for the documentation, various small tools,
working notes, etc.). It is copied every night from our central
repository, so it is not guaranteed to be consistent, working,
compilable, etc.
SUBMITTING CHANGES
------------------
If you've made a change that you're happy with and think ought to
become part of a future release of Unison, you can send it to us like
this:
cd
make submit
This will tar up the whole tree and mail it off to us, so that we can
play with it, compare it to what's in the repository, and easily
commit the changes.
FINDING YOUR WAY AROUND
-----------------------
See the file ROADMAP.txt for some suggestions on how to start reading
the sources.
unison-2.40.102/fpcache.ml 0000644 0061316 0061316 00000017645 11453636173 015346 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fpcache.ml *)
(* Copyright 1999-2010, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
let debug = Trace.debug "fpcache"
(* In-memory cache *)
module PathTbl =
Hashtbl.Make
(struct
type t = string
let equal (s1 : string) (s2 : string) = s1 = s2
let hash = Hashtbl.hash
end)
let tbl = PathTbl.create 101
(* Information for writing to the on-disk cache *)
type entry =
int * string * (Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp)
type state =
{ oc : out_channel;
mutable count : int;
mutable size : Uutil.Filesize.t;
mutable last : string;
mutable queue : entry list }
let state = ref None
(****)
(* Path compression and decompression (use delta from previous path for
compression) *)
let decompress st i path =
let l = String.length path in
let s = String.create (l + i) in
String.blit !st 0 s 0 i;
String.blit path 0 s i l;
st := s;
s
let compress state path =
let s = state.last in
let p = Path.toString path in
let l = min (String.length p) (String.length s) in
let i = ref 0 in
while !i < l && p.[!i] = s.[!i] do incr i done;
state.last <- p;
(!i, String.sub p !i (String.length p - !i))
(*****)
(* Read and write a chunk of file fingerprints from the cache *)
let read st ic =
(* I/O errors are dealt with at a higher level *)
let fp1 = Digest.input ic in
let fp2 = Digest.input ic in
let headerSize = Marshal.header_size in
let header = String.create headerSize in
really_input ic header 0 headerSize;
if fp1 <> Digest.string header then begin
debug (fun () -> Util.msg "bad header checksum\n");
raise End_of_file
end;
let dataSize = Marshal.data_size header 0 in
let s = String.create (headerSize + dataSize) in
String.blit header 0 s 0 headerSize;
really_input ic s headerSize dataSize;
if fp2 <> Digest.string s then begin
debug (fun () -> Util.msg "bad chunk checksum\n");
raise End_of_file
end;
let q : entry list = Marshal.from_string s 0 in
debug (fun () -> Util.msg "read chunk of %d files\n" (List.length q));
List.iter (fun (l, p, i) -> PathTbl.add tbl (decompress st l p) i) q
let closeOut st =
state := None;
try
close_out st.oc
with Sys_error error ->
debug (fun () -> Util.msg "error in closing cache file: %s\n" error)
let write state =
let q = Safelist.rev state.queue in
let s = Marshal.to_string q [Marshal.No_sharing] in
let fp1 = Digest.substring s 0 Marshal.header_size in
let fp2 = Digest.string s in
begin try
Digest.output state.oc fp1; Digest.output state.oc fp2;
output_string state.oc s; flush state.oc
with Sys_error error ->
debug (fun () -> Util.msg "error in writing to cache file: %s\n" error);
closeOut state
end;
state.count <- 0;
state.size <- Uutil.Filesize.zero;
state.queue <- []
(****)
(* Start and finish dealing with the cache *)
let finish () =
PathTbl.clear tbl;
match !state with
Some st -> if st.queue <> [] then write st;
closeOut st
| None -> ()
let magic = "Unison fingerprint cache format 2"
let init fastCheck fspath =
finish ();
if fastCheck then begin
begin try
debug (fun () -> Util.msg "opening cache file %s for input\n"
(System.fspathToDebugString fspath));
let ic = System.open_in_bin fspath in
begin try
let header = input_line ic in
if header <> magic then raise (Sys_error "wrong header");
let st = ref "" in
while true do read st ic done
with
Sys_error error ->
debug (fun () -> Util.msg "error in loading cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
| End_of_file ->
()
end;
begin try
close_in ic
with Sys_error error ->
debug (fun () -> Util.msg "error in closing cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
end;
with Sys_error error ->
debug (fun () -> Util.msg "could not open cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
end;
begin try
debug (fun () -> Util.msg "opening cache file %s for output\n"
(System.fspathToDebugString fspath));
let oc =
System.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fspath in
output_string oc magic; output_string oc "\n"; flush oc;
state :=
Some { oc = oc; count = 0; size = Uutil.Filesize.zero;
last = ""; queue = [] }
with Sys_error error ->
debug (fun () -> Util.msg "could not open cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
end
end
(****)
(* Enqueue a fingerprint to be written to disk. *)
let maxCount = 5000
let maxSize = Uutil.Filesize.ofInt (100 * 1024 * 1024)
let save path v =
match !state with
None ->
()
| Some state ->
let (desc, _, _, _) = v in
let l = Props.length desc in
state.size <- Uutil.Filesize.add state.size l;
state.count <- state.count + 1;
let (l, s) = compress state path in
state.queue <- (l, s, v) :: state.queue;
if state.count > maxCount || state.size > maxSize then write state
(****)
(* Check whether a fingerprint is in the in-memory cache and store it
to the on-disk cache in any case. *)
(* HACK: we disable fastcheck for Excel (and MPP) files, as Excel
sometimes modifies a file without updating the time stamp. *)
let excelFile path =
let s = Path.toString path in
Util.endswith s ".xls"
|| Util.endswith s ".mpp"
let dataClearlyUnchanged fastCheck path info desc stamp =
fastCheck
&&
Props.same_time info.Fileinfo.desc desc
&&
Props.length info.Fileinfo.desc = Props.length desc
&&
not (excelFile path)
&&
match stamp with
Fileinfo.InodeStamp inode ->
info.Fileinfo.inode = inode
| Fileinfo.CtimeStamp ctime ->
(* BCP [Apr 07]: This doesn't work -- ctimes are unreliable
under windows. :-(
info.Fileinfo.ctime = ctime *)
true
let ressClearlyUnchanged fastCheck info ress dataClearlyUnchanged =
fastCheck
&&
Osx.ressUnchanged ress info.Fileinfo.osX.Osx.ressInfo
None dataClearlyUnchanged
let clearlyUnchanged fastCheck path newInfo oldDesc oldStamp oldRess =
let du =
dataClearlyUnchanged fastCheck path newInfo oldDesc oldStamp
in
du && ressClearlyUnchanged fastCheck newInfo oldRess du
let fingerprint fastCheck currfspath path info optDig =
let res =
try
let (cachedDesc, cachedDig, cachedStamp, cachedRess) =
PathTbl.find tbl (Path.toString path) in
if
not (clearlyUnchanged
fastCheck path info cachedDesc cachedStamp cachedRess)
then
raise Not_found;
debug (fun () -> Util.msg "cache hit for path %s\n"
(Path.toDebugString path));
(info.Fileinfo.desc, cachedDig, Fileinfo.stamp info,
Fileinfo.ressStamp info)
with Not_found ->
if fastCheck then
debug (fun () -> Util.msg "cache miss for path %s\n"
(Path.toDebugString path));
let (info, dig) = Os.safeFingerprint currfspath path info optDig in
(info.Fileinfo.desc, dig, Fileinfo.stamp info, Fileinfo.ressStamp info)
in
save path res;
res
unison-2.40.102/test.mli 0000644 0061316 0061316 00000000250 11361646373 015066 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/test.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Internal self-tests *)
val test: unit -> unit
unison-2.40.102/lock.ml 0000644 0061316 0061316 00000003470 11361646373 014675 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/lock.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
let rename oldFile newFile =
begin try System.link oldFile newFile with Unix.Unix_error _ -> () end;
let res = try (System.stat oldFile).Unix.LargeFile.st_nlink = 2
with Unix.Unix_error _ -> false
in
System.unlink oldFile;
res
let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL]
let create name mode =
try
Unix.close (System.openfile name flags mode);
true
with Unix.Unix_error (Unix.EEXIST, _, _) ->
false
let rec unique name i mode =
let nm = System.fspathAddSuffixToFinalName name (string_of_int i) in
if create nm mode then nm else
(* highly unlikely *)
unique name (i + 1) mode
let acquire name =
Util.convertUnixErrorsToTransient
"Lock.acquire"
(fun () ->
match Util.osType with
`Unix -> (* O_EXCL is broken under NFS... *)
rename (unique name (Unix.getpid ()) 0o600) name
| _ ->
create name 0o600)
let release name = try System.unlink name with Unix.Unix_error _ -> ()
let is_locked name =
Util.convertUnixErrorsToTransient
"Lock.test"
(fun () -> System.file_exists name)
unison-2.40.102/fingerprint.ml 0000644 0061316 0061316 00000005673 11361646373 016303 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fingerprint.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* NOTE: IF YOU CHANGE TYPE "FINGERPRINT", THE ARCHIVE FORMAT CHANGES; *)
(* INCREMENT "UPDATE.ARCHIVEFORMAT" *)
type t = string
(* Assumes that (fspath, path) is a file and gives its ``digest '', that is *)
(* a short string of cryptographic quality representing it. *)
let file fspath path =
let f = Fspath.concat fspath path in
Util.convertUnixErrorsToTransient
("digesting " ^ Fspath.toPrintString f)
(fun () -> Fs.fingerprint f)
let maxLength = Uutil.Filesize.ofInt max_int
let subfile path offset len =
if len > maxLength then
raise (Util.Transient
(Format.sprintf "File '%s' too big for fingerprinting"
(Fspath.toPrintString path)));
Util.convertUnixErrorsToTransient
"digesting subfile"
(fun () ->
let inch = Fs.open_in_bin path in
begin try
LargeFile.seek_in inch offset;
let res = Digest.channel inch (Uutil.Filesize.toInt len) in
close_in inch;
res
with
End_of_file ->
close_in_noerr inch;
raise (Util.Transient
(Format.sprintf
"Error in digesting subfile '%s': truncated file"
(Fspath.toPrintString path)))
| e ->
close_in_noerr inch;
raise e
end)
let int2hexa quartet =
if quartet < 10 then
(char_of_int ((int_of_char '0') + quartet))
else char_of_int ((int_of_char 'a') + quartet - 10)
let hexaCode theChar =
let intCode = int_of_char theChar in
let first = intCode / 16 in
let second = intCode mod 16 in
(int2hexa first, int2hexa second)
let toString md5 =
let length = String.length md5 in
let string = String.create (length * 2) in
for i=0 to (length - 1) do
let c1, c2 = hexaCode (md5.[i]) in
string.[2*i] <- c1;
string.[2*i + 1] <- c2;
done;
string
let string = Digest.string
let dummy = ""
let hash d =
let l = String.length d in
if l = 0 then
1234577
else begin
assert (l >= 3);
Char.code (String.unsafe_get d 0) +
(Char.code (String.unsafe_get d 1) lsl 8) +
(Char.code (String.unsafe_get d 2) lsl 16)
end
let equal (d : string) d' = d = d'
unison-2.40.102/uimac/ 0000755 0061316 0061316 00000000000 12050210657 014471 5 ustar bcpierce bcpierce unison-2.40.102/uimac/English.lproj/ 0000755 0061316 0061316 00000000000 12050210657 017207 5 ustar bcpierce bcpierce unison-2.40.102/uimac/English.lproj/MainMenu.nib/ 0000755 0061316 0061316 00000000000 12050210657 021467 5 ustar bcpierce bcpierce unison-2.40.102/uimac/English.lproj/MainMenu.nib/classes.nib 0000644 0061316 0061316 00000006706 11361646373 023643 0 ustar bcpierce bcpierce {
IBClasses = (
{
ACTIONS = {
copyLR = id;
copyRL = id;
forceNewer = id;
forceOlder = id;
ignoreExt = id;
ignoreName = id;
ignorePath = id;
leaveAlone = id;
merge = id;
revert = id;
selectConflicts = id;
};
CLASS = FirstResponder;
LANGUAGE = ObjC;
SUPERCLASS = NSObject;
},
{
ACTIONS = {
cancelProfileButton = id;
createButton = id;
endPasswordWindow = id;
installCommandLineTool = id;
onlineHelp = id;
openButton = id;
raiseAboutWindow = id;
restartButton = id;
saveProfileButton = id;
syncButton = id;
};
CLASS = MyController;
LANGUAGE = ObjC;
OUTLETS = {
ConnectingView = NSView;
aboutWindow = NSWindow;
chooseProfileView = NSView;
detailsTextView = NSTextView;
mainWindow = NSWindow;
passwordCancelButton = NSButton;
passwordText = NSTextField;
passwordWindow = NSWindow;
preferencesController = PreferencesController;
preferencesView = NSView;
profileController = ProfileController;
statusText = NSTextField;
tableView = ReconTableView;
updatesText = NSTextField;
updatesView = NSView;
versionText = NSTextField;
};
SUPERCLASS = NSObject;
},
{
ACTIONS = {anyEnter = id; localClick = id; remoteClick = id; };
CLASS = PreferencesController;
LANGUAGE = ObjC;
OUTLETS = {
cancelButton = NSButton;
firstRootText = NSTextField;
localButtonCell = NSButtonCell;
profileNameText = NSTextField;
remoteButtonCell = NSButtonCell;
saveButton = NSButton;
secondRootHost = NSTextField;
secondRootText = NSTextField;
secondRootUser = NSTextField;
};
SUPERCLASS = NSObject;
},
{
CLASS = ProfileController;
LANGUAGE = ObjC;
OUTLETS = {tableView = NSTableView; };
SUPERCLASS = NSObject;
},
{
CLASS = ProfileTableView;
LANGUAGE = ObjC;
OUTLETS = {myController = MyController; };
SUPERCLASS = NSTableView;
},
{CLASS = ReconItem; LANGUAGE = ObjC; SUPERCLASS = NSObject; },
{
ACTIONS = {
copyLR = id;
copyRL = id;
forceNewer = id;
forceOlder = id;
ignoreExt = id;
ignoreName = id;
ignorePath = id;
leaveAlone = id;
merge = id;
revert = id;
selectConflicts = id;
};
CLASS = ReconTableView;
LANGUAGE = ObjC;
SUPERCLASS = NSTableView;
}
);
IBVersion = 1;
} unison-2.40.102/uimac/English.lproj/MainMenu.nib/info.nib 0000644 0061316 0061316 00000001750 11361646373 023133 0 ustar bcpierce bcpierce
IBDocumentLocation
318 45 509 310 0 0 1280 832
IBEditorPositions
197
450 391 383 326 0 0 1280 832
198
307 297 669 515 0 0 1280 832
29
72 209 280 44 0 0 1280 832
307
392 388 499 332 0 0 1280 832
423
450 391 383 326 0 0 1280 832
IBFramework Version
364.0
IBOpenObjects
423
198
29
402
234
21
307
197
IBSystem Version
7U16
unison-2.40.102/uimac/English.lproj/MainMenu.nib/objects.nib 0000644 0061316 0061316 00000037763 11361646373 023646 0 ustar bcpierce bcpierce typedstream@NSIBObjectData NSObject NSCustomObject)@@NSMutableStringNSString+
NSApplicationif
NSTableColumn)@fff@@ccprofilesCB=s脄NSTableHeaderCell NSTextFieldCell> NSActionCellNSCellAii @@@@ProfilesNSFont$[36c] L u c i d a G r a n d e f c i: c@@ NSColor ff>@@@SystemheaderTextColor 1@ $ L u c i d a G r a n d e
NSClassSwapper*@#ProfileTableView NSTableView= NSControl)NSView) NSResponder
NSClipView: NSScrollView Ⲓ NSCustomView) @@@@ffffffffNSMutableArray NSArray NSTextField
# ܁#, #,icc@ @ ?Welcome to Unison!
Please choose a profile or create a new one
controlColor?*controlTextColor:NSButton ! T T NSButtonCell? 8 Open Ƅ ssii@@@@@ @ [28c] H e l v e t i c a
ǒ T T ɡ 8 Quit ν @ ͅǒ! C C ɡ 8 New ӽ @ ͅ k k NSView NSResponder
NSScroller ӱ 3 ff: ?4 _doScroller: ܒ q q ?} NSTableHeaderView ޚ 2 2ޒ 2 2@@ccccontrolBackgroundColorÆ
_NSCornerView 3 <C C ےݒޒffffi
2 2 2 2 @@@ff@@f::i䄻 gridColor? @ Ć ǒ 횂
g g풅 @ Let's update some stuff!
Ć횂 ReconTableView P P Ƅᒄ P P P P Q left___ Left >1@ Ć direction222 Action 1@ Ć right___ Right headerColor膧1@ $ L u c i d a G r a n d e Ć progress<<< Progress 1@ Ć pathC) ȁ脞 Path 1@ Ć Z@ P P ܒ Q ?wq ܒ P P ?{] sa a 풅
쒄횂 NSTextTemplateƄNSViewTemplate. NSMutableSet NSSet I Apple PDF pasteboard typeApple PICT pasteboard typeNSStringPboardType*NeXT Rich Text Format v1.0 pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard typeApple HTML pasteboard typeNSFilenamesPboardType NeXT TIFF v4.0 pasteboard typeNSColor pasteboard typeNeXT RTFD pasteboard type#CorePasteboardFlavorType 0x6D6F6F76 _- _- NSText textColor H e l v e t i c a 誁-_ _- _- 脄NSCursorNSImage. s NSBitmapImageRep
NSImageRep[1218c]MM *
( R
'
' ܒ D D ܒ W W ?rC <a/ a/풅 =>
ǒ횂 U U 풅 ɡ 8 Restart ? @ ͅ횂
풅 @ Status
D Ć ْNSView NSResponder u u 풅 ɡ 8 Synchronize 콁 @ ͅ햄
NSMenuItemNSMenu ̔i@@@ Unison
NO
i@@IIi@@@@:i@ About Unison NSCustomResource)NSImageNSMenuCheckmarkWXNSMenuMixedState NOՂ UU VZ NO Preferences..., VZ NO Install command-line toolU VZ NOՂ UU VZ NO Hide Unisonh VZ NO Hide Othersh VZ MNOՂ UU VZ NO Quit Unisonq VZ _NSAppleMenu Show AllU VZ O MyControllerǒ NSBox*r
t w w @ File:
y Ćw .w ww qA @ U |textBackgroundColor23 3t G Grff@@ccc
First root ~Ćw ur NSMatrix> 'F& F& #iiii:::ffffi@@@@@ FD( ɡ Remote H VZ N Propagate Right to Left< VZ ΒN Propagate Older to NewerU VZ N Leave Alone/ VZ N !Revert to Unison's RecommendationU VZ N MergeU VZ N Ղ@ UU VZ N Restartr VZ N Synchronize allg VZ Propagate Newer to OlderU VZ ϖ]OjO ?햄P MainMenuN QU VZsubmenuAction: ON EditU VZ P EditN Cutx VZ N Copyc VZ N Pastev VZ N
Select Alla VZ N Select ConflictsU VZ N U VZ φN IgnoreU VZ P N Ignore Pathi VZ N Ignore Extensione VZ N Ignore Namen VZ N HelpU VZ P N Unison Online Help? VZ _NSMainMenuNSWindowTemplate
iiffffi@@@@@cp
px UNSWindowView @@ Unison,[44c] $ L u c i d a G r a n d e - B o l d ~2 4 4 @ X© Copyright 1999-2005.
This software is licensed under the GNU General Public License.$ L u c i d a G r a n d e
~2 NSImageView $Apple PDF pasteboard type NeXT TIFF v4.0 pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard typeNSFilenamesPboardTypeApple PICT pasteboard type @ @ NSImageCell) WXUnisoniii e @@ Sync you very much!$ O p t i m a - I t a l i c 0 ~2 @@ ?.?.?$ L u c i d a G r a n d e 4 ~2
ffff @ Ձ h hhpx UnisonNSWindowView8 @ Ձ R px PasswordWindowNSWindowView @ Ձ ϖ`OwtθPreferencesController0 햁 ȁ Ɩ$ ݁ ϖbO ځ ϖProfileController ϖ 閁 r ρ cO : ywiOr ߁ ϖ 閁 ҁ ϖ 햁 > D햁 O 얁 fO ϖ4Ƹ SO 햁 閁 Ձ ϖ r ϚD NSButton NSTableView NSTextField1j1111턙 updatesView>PasswordWindow
NSTableColumnrPreferencesView
NSTextField214 NSTextField3 NSMenuItem1
NSButtonCell1chooseProfileView NSView NSMenuItem9DE1NSTableColumn1 AboutWindow NSTextField ƄConnectingView Ȅ NSTextField]121 NSTextFieldwNSView NSButtonCell| NSTextField
NSScrollView1 NSTextField2 NSMenuItem3 NSMenu NSMenuItem10 NSMatrix1
NSScrollView1섙 NSButton1 NSTableView NSTextField4 NSTextField2 NSTextField1
NSTextField22:Window
NSScrollView2tNSBox2?
NSButton21q NSButton1
NSTextField23 NSTextField2 NSButton 鄘MainMenuƄNSButton 턙
NSMenuItem NSBox1΄ NSButton1D NSTextField1 File's Ownery NSTextField2 NSButton1ӄ NSButton2
NSTextView NSTextField3BC NSTextField NSTextField2
NSTableColumn0 NSTextField2op$:JNSNibControlConnector τNSNibConnectorj
terminate:fhideOtherApplications:chide:MunhideAllApplications: cut: paste:
selectAll: copy:NSNibOutletConnector ρo턙 updatesViewochooseProfileViewo
createButton:o openButton:?orestartButton:o:
mainWindowD tableViewD
dataSourceo updatesTextoDprofileControllero tableViewo
dataSourceo syncButton: oendPasswordWindow:o>passwordWindowo passwordText oendPasswordWindow:o detailsTextViewodelegate ignorePath:
ignoreExt: ignoreName: ҅copyLR: ՅcopyRL: selectConflicts: ݅revert: ΅ forceNewer: forceOlder: څ leaveAlone:oD
statusTextB profileNameTextBq cancelButtonB
saveButtonoBpreferencesControllerorpreferencesViewB|
firstRootTextB secondRootUserB secondRootHostB secondRootTextB remoteButtonCellB localButtonCell | nextKeyView| B remoteClick: B localClick:Ɓƭ osaveProfileButton:qocancelProfileButton:o passwordCancelButton odelegateo myControllero aboutWindowo4 versionTextSoraiseAboutWindow:o onlineHelp: o syncButton: ߅merge:o ƄConnectingView`oinstallCommandLineTool: o
restartButton @i r CځQ j 皁 x ` ρ lD I D j ܁R 罁 t BKy
oЁ0 4 Gf Ɓ ށ^ m\ ? yjā ݁ z s 縁 ҁ 綁 J
ҁ f i o nƁ p{ 8b ԁ u wB] Ӂ ȁ Ɓ | ց2 qH筁 tA}> q o M v O9~ ȁʁ ߁ $c Lr3 : ځ D0g |kwS8 ́ Ձ
皁 IBCocoaFramework unison-2.40.102/uimac/English.lproj/InfoPlist.strings 0000644 0061316 0061316 00000001022 11361646373 022540 0 ustar bcpierce bcpierce / * L o c a l i z e d v e r s i o n s o f I n f o . p l i s t k e y s * /
C F B u n d l e N a m e = " U n i s o n " ;
C F B u n d l e S h o r t V e r s i o n S t r i n g = " U n i s o n " ;
C F B u n d l e G e t I n f o S t r i n g = " U n i s o n , C o p y r i g h t 1 9 9 9 - 2 0 0 4 , l i c e n s e d u n d e r G N U G P L . " ;
N S H u m a n R e a d a b l e C o p y r i g h t = " C o p y r i g h t 1 9 9 9 - 2 0 0 4 , l i c e n s e d u n d e r G N U G P L . " ;
unison-2.40.102/uimac/cltool.c 0000644 0061316 0061316 00000004071 11361646373 016147 0 ustar bcpierce bcpierce /* cltool.c
This is a command-line tool for Mac OS X that looks up the unison
application, where ever it has been installed, and runs it. This
is intended to be installed in a standard place (e.g.,
/usr/bin/unison) to make it easy to invoke unison as a server, or
to use unison from the command line when it has been installed with
a GUI.
*/
#import
#import
#include
#define BUFSIZE 1024
#define EXECPATH "/Contents/MacOS/Unison"
int main(int argc, char **argv) {
/* Look up the application by its bundle identifier, which is given
in the Info.plist file. This will continue to work even if the
user changes the name of the application, unlike
fullPathForApplication. */
FSRef fsref;
OSStatus status;
int len;
char buf[BUFSIZE];
status = LSFindApplicationForInfo(kLSUnknownCreator,CFSTR("edu.upenn.cis.Unison"),NULL,&fsref,NULL);
if (status) {
if (status == kLSApplicationNotFoundErr) {
fprintf(stderr,"Error: can't find the Unison application using the Launch Services database.\n");
fprintf(stderr,"Try launching Unison from the Finder, and then try this again.\n",status);
}
else fprintf(stderr,"Error: can't find Unison application (%d).\n",status);
exit(1);
}
status = FSRefMakePath(&fsref,buf,BUFSIZE);
if (status) {
fprintf(stderr,"Error: problem building path to Unison application (%d).\n",status);
exit(1);
}
len = strlen(buf);
if (len + strlen(EXECPATH) + 1 > BUFSIZE) {
fprintf(stderr,"Error: path to Unison application exceeds internal buffer size (%d).\n",BUFSIZE);
exit(1);
}
strcat(buf,EXECPATH);
/* It's important to pass the absolute path on to the GUI,
that's how it knows where to find the bundle, e.g., the
Info.plist file. */
argv[0] = buf;
// printf("The Unison executable is at %s\n",argv[0]);
// printf("Running...\n");
execv(argv[0],argv);
/* If we get here the execv has failed; print an error message to stderr */
perror("unison");
exit(1);
}
unison-2.40.102/uimac/ReconItem.h 0000644 0061316 0061316 00000001144 11361646373 016543 0 ustar bcpierce bcpierce /* ReconItem */
#import
#define CAML_NAME_SPACE
#include
@interface ReconItem : NSObject
{
NSString *path;
NSString *left;
NSString *right;
NSString *direction;
NSString *progress;
NSString *details;
value ri; // an ocaml Common.reconItem
}
+ initWithRi:(value)ri;
- (NSString *) path;
- (NSString *) left;
- (NSString *) right;
- (NSString *) direction;
- (void) doAction:(unichar)action;
- (void) doIgnore:(unichar)action;
- (NSString *) progress;
- (void)resetProgress;
- (NSString *) details;
- (BOOL)isConflict;
- (void)revertDirection;
@end
unison-2.40.102/uimac/Unison.icns 0000644 0061316 0061316 00000116214 11361646373 016643 0 ustar bcpierce bcpierce icns ics# H 8>|>| | | | | | | 8>|>| | | | | | | is32 Ӏ Q ] sؒ c҉ S ` S ^ V _ V _ Z _ Z \ U )j h 't܀ӟ Zq Qr Cf \l Uk o t ]j bs Wx cx ^ф hԅ bǿ j o q wu su , {zGYUeGg gm0WX:
Q zN + XyV @y Cuspqs\ fdi_ 5L x7S h(Mc!V Z
3P 0 ~ J q F A q C C q B C q B C q B K s A 7U
< A $) s m
; g' D yVKKJi ̚ s8mk C 4 B2 eY f :N l[ >O n\ >O n\ >O n\ >N l] < L %
w
!" ICN# ?? ? ?? ? il32
` NU U < lx > jk 7 ^o CW rs q
O W ?L: Mmn FWs 6M) _} M< _~ M3 _~ M3 _~ M3 a M3 a M3 a M3 a M3 a M3 a M3 a L3 _w Z" WہU ݀ Jڀ㱋ikwހۄ F|߁f OՀ JnԈf UI{چc FJwրڼ[ UJWνzO KKRh|vfJ; 9HKJIHD kj g lmk lpr qjln dzxk deg gy~l xnoo # kxwp ?hi nq qi ?blhh ani Yhh H]mu ih ]wx Uil ^~m Uip ^f Ujs ^f Ujۻw `֔W Ulʺ| aʀ˛W Um cP Um cP Un fH Un~ fH Upmppi fvopnH UpV[[V} rXZ[YrD k>EEDLw -?EECX b<%(($O)())&M ]X $Kkka6| f 4 _ % f^} z `^. Aq3 U_mSSNNPUVf ^_hbQ Q\_`^^[* KB {Eo P 9 p#0n T D ! 'u N 8 k# 0m m
_ 6 3 _|c T {t m q~ o m{8 - z a {: * Uy c {; * Uy c {; * Uy c {; * Uy c {; * Uy c {; ) Uy c {; ) Uy c {; ) Uy c {; ) Uy c {; ) Uy f {; ) Uy n t! & y + b |O 3XwxmM _ ~g ## | _}3 N {u 0} }p ,~ r{r 4y q|O) 2c} x{kjkljcm s~~ l8mk $ & UU % OS % TU ) NV C ' v 6u % p " q # q # q # q # q # q # q # q # q # s # <
y^_b sR ~C
N8 cV ich# H 0 x ? ? ? ? 0 x ? ? ? ? ih32 ) ]N ff bq lvS [i fۀK [k bQ \j b~U \i cK `k? d~U _e j~W ?Py߅X F^z: LMQsL NP`~K KLZo KO` CZw 3Mg DYw 3Mg BYw .Mg BYw .Mg BYw .Mg BYw .Mg BYw .Mg BYw .Mg BYw .Mg BYw .Mg BYw .Mg BYy .Lg BYy .Lg BYy .Lg BYy .Lg BYy .Mg BYx .Lh BW 3Qd IUށL 'fX AO܂}4 VށH UKۂچ]KHKHUjۂ- Kl܃ƣu LUօ ׄZ GLtՄփՅ~ KUӑU GM^Ӑc MPgԍk: NQgӊhE UMQ\ـԂՀ\E
OMSo
۲vOA MMOTdȺhPI5 UOMLMPTVVWZYTMKIB BILMKMNNLLK. vu p wnq? sqt wiqr? wnqly wfkr? ti|ky xflr? ti{kw
xflr?
ti{ky wgns_ ti{kw zljv vl|ow fdq|kp \mj~mu failjh _eonji i_lm _hpn ]in 3fvp Zio feyp Xiq Ee}p Xiq Ecp Xis Ecp Xit Ecp Xiނv Ecށݡp Xiw EbԂr Xi͂Ͷy Eb̓r XiĶz Ebr Xi| Ear Xi} Ear Xj Ear Xj Ear Xj Ear Xj~xyw E`vyxt Xjqklkh E`glkru Xjf\^X fdtZ^\er Zf_MPJ}] :uTOPM_k Wbd;A@BF g~9A M w: ; JՊ* Etj6 it32 .p ib kkf Oh ljij? lki hhu|gj$ $njgik Ulgp~elU lftej
mhoՀck? kdyqgj
Ukgo~fk? Ule{oej jho{ekU ifxogj hfoekU iczofj lgq|elE Ulfzphi jgoҀclU Ukcynej Ulgq~flE kf{pej kho~clU jdxohj kgoek$ kc{ofk jho}dkU fifxphi jgocj lcznei jgq~fkU if{qei khnejf fleyohj kfq}ekU Uld|qdi fjksЄjlX Ujfyqjj? gkkjkb $liokh U`mzll gimj[ FJPbfsc` IRhnpif
JNPNPahvfXG KNNTgjye^ DNPPNPafteYID UNPPNVgn܇g^G :NPPNPaeweYJ
LNPPNXglg`I
?NPPNQeml`G JNPPM]dkcL ?NPcqn` HNPNWfi\ =MPPcqmi KNNXfii BOPcqmh NLXfik MPcqmh IJXfih KPcqmh LJXfih MPcqmh KJXeih MPcqmh KJXeih MPcqmh KJXeih MPcqmh KJXeih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPdqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfih MPcqmh KJXfij MPcqmh KJXgij MPcqmh KJXgij MPcqmh KJXgij MPcqmh KJXgij MPcqmh KJXgij MPcqlh KJYgij MObqng KJ[iii MNaq{gU KKakߏih MNamߎdh IOfpߏfh NN_kގik HVhfg NN]iݏwgi Kdhݐef LNZgfl ZjwfE NNWgfj fjitg JNTgvۏofj glfڐmi FMNbmُqfif jidّhh DNN]iڏ
wfjjc Uhjijڒfh :NNWgڐ jfgjjhkh kjgftڑzhU MNRevؑ
Õwjgfg
ffmْjj KPNakג
㺟 הdf GNNWgٔ הtg NOPdmՔהhk MPN[h֕ր Ճ֗|gb LNNQfrԿgi NPN^iԾ|gb KPNRflhj :OPLZhؾrhX JPPOcjfk DMPNUgplc JPPL\i|reU MPPOaiڸhZ
LNPNQejڶh_A
LPPNSgiڴidJ
MPPNVhmݲieN 5OPPNUhjiePD HNPPNUgjج߆ieQE LNPPNTehݪ{hbOG
MNPPNQbir٦ pi^MH MNPPNN\hmڢ
ƈkfYLH GMP
NVehrڝ ޜngaSIP DMP
NP[fjyՖԝwieYNKE .ONPPNNS_fhuŚuge]QLM: MNPNNR\ehpśohd\RNLM ANNPNNR[`dgpͺpgd_YQNMM= KNNPN RZacegkpuy}}wqlhebaZRNNMNJ ILOP ONRUX[^_`babfgeecba`_\YUQNOMK INPNP ON OPQTUTUTQPPNPNNMG :GLMNP OPNPPOPPNH/ UIJMNNMNP MNLID 3EJKKNLJMONMLHBD in tuf _s uw ? tuu twwvwsH Htwwux UuwxicvwtU uwvnwus
uwxiQObwws? twwcOiwws
UtwwiNQcwwu? UuwvcVgSiwus twwiKvNbvwtU swwcKzLjwws twwhL{LbwwvU uwwcN{Kiwvs uwwjMwNavwt\ UuwveLwMixws uwxiJ{LbwwtU UtwwbLzIjwvs UuwxiNyNbwwt\ twwdMzNjwvs twwiJzMbwwtU twwcLxJjxws twwhLzLbwwtH txwdLxLixut twwjLxObwwtU 3uwwdLvLjxwt uwxiK{Lbwxw uwwcLyJiwvt twxjLwOawxtU swwdLwMjwuu twwiKwMbwws3 3uwwcLyJjxws twwiLxNawwvU UtwvcLzMhxvt ftwwjQzWbuwtc UtwwdNyMjwws? pwxkNlnLlwvo HvxwdT}Oiwws emyua\Tgwwp rysUXOjxvd
^_boyw^TKhxwl ]ftyqUoOiwvm \bcbcoyxbWRjxwgY
^abetyqTqWdxwi Wacoywd[ Ukzwh^U UaccbfuyqU`bxxkW Nacnwybueixvi`U [bccbgvyqWr`wxl^ U`ccbcsxjymnym] ^accajww]]qxq`
Q`cbbpyl}opxmU
`bcbgwwbdtwj Qabcqyotrwt ^bbhvxehuvr U`cqyputws ``hvyhkwvt `cqysyuws ]`hvzlnxvs ^cqyu{wws ]`hv{mqzvs _cqywzws [`hu|qt{vs _cqyx{ws [`hu|tx|vs _cpy{څ}ws [`hu}w{~us _cpy}ڈws [`hu{~us _cpyڋws [`ht~ȁus _cpyڍws [`htȄus _cpyܐws [`htɇus _cpyܓws [`htʋus _cpyڕws [`htʍus _cpyڙws [`htʒus _cpyڛws [`htʕts _cpy؞ws [`htʖts _cpyաws [`htəts _cpyԢws [`hsɜts _cpyҦws [`hsȟts _coyލЧws [`hsߏƢts _coyڍΩws [`hsŦts _coy̭ws [`hs؏ũts _coyӍʯws [`hrӏëts _coyύȱws [`hrЏ®ts _coyˍųws [`hȑts _coyŏôws [`hrɿts _coyčws [`hrďĽts _coyws [`hrts _coyws [`hrts _coyws [`hrts _coyws [`hrts _coyws [`hr ts _coy§ws [`hröġts _coyéws [`hrƵƢss _coyŪws [`hqɴɣss _coy ƫws [`hq˴ˤss _coyÜɭws [`hqͳ̥ss _coyĘˮws [`hqϲϦss _coyē˯ws [`hqѰѧss _coyŏ̰ws [`hqկӨss _coyŋαws [`hq֩sq _coyƆ~|ϲws [`hpج|z֩sq _coyƂw|vгws [`hp۫w{|u٩sq _coy}rvpѵws [`hpݪquvo۫sq _coywmqlҶws [`hpߨlpqjݬsq _coyrhmf~Ӷwq [`hpglmdެsq _coynbg`wҷvs [`ip`fg_sq _cnzl]b]m˿xr [`jrZbZst acmzmW]Z`Ԃqa [`mt~T]Trr acmvjQXWQnr ZcqyjQXOps `blunJRH|rt ]frڹTPRIoq abksvCNGZ~qi ]qqDMNLFpw `bjqpu hs`>HFDڄp\ `bgq9@C9Vڈps lrr9@C7<;,wypu swpG2<1Uҹvr ZacmvV(6 7/2zpum rsnb(6%krs Ybbkrr. !3~ptso
Upsrsl ,.- or Nabgq #'
(7Бtpqtssru
rrutpp{k!(' .qU `cdp}7 &귔tpqpwT [tt ^cbmta Nֱ Ӆ& np Xabgq J֨p7 (}r UacbovL C\monpm[9 irt acbir ڂpj ]aceqz? hqs Uacblr ߂pj ^ccdpuT yrt N`cbir ={qc `cbcos qq Ubcbfqxg uo ]ccbjrK d{p` acbcms. Tԅsg
[acbdqt1 KߌsjW
`ccbers/ Rrna
accbfqvC ]spb P`ccbgqs\ wےrpcU ]bccbfqt퇭 !̉spcU ]bccbfqqC VrnbY
^accbdnrz (xrka_ ]bccbbkrvq
-tpha] _`ccbbfor{y- 7͙wqne`d Yac bcjptڤj*
4mŚ~roib_U E`acbekpr}ؤvN, ,Qyߺ}qpkc`aN ]acbbejprxƵߺxqojeb`] Zabcbdimnqx߃IJxqnmhdbaaQ [`bc
bbejlnoqux}~zuronliebbaa\ \`bcbbdfhjkllmppoonmmlkjifdbbcb_] ]acbc efeccbaa`] N_`bbcbcbba[? UZ^``aab ac`abab`^]U 3U\^]`_`a`ab`_][[U xn vvf _s u|}w? uwu tpgvH Hx~zx Uuu ewU vc=q~s uw eu? vk uu Utv gv? Uvi vu xv$ hwU um !vs tv evU uj v~u uu" hu\ Uvj us uw evU Uvk !x}u Uuu fv\ vi !u~s tv fwU vm "wu tv fvH vi w~t xv& gxU ful %ut ux ew vk x~t xu$ fxU ui !t~u vx evf fvk !wu tt fvU Uvh ut wv|s" a}wc Uvk #t}u? pz|& *~xo Hv~c v|s uy|Y k{u xP $yzd uy{{a ts wyz}@ vzm vzz{z{c qxt ?xz{z}; mv owz{{` szwf Uyzz{z}{1 ^yu kz{{c pzzU uyzz{z~|' Ryv jxz{}| !}|y wyzz{zO }|w mxz{{|w xzU uyz{zL /y? fy{z|w yx vy{zL +}w gzz|w yy vyzL +}v xz|w yy uyzL +}w xz|w yy wyzL *}w wz|w yy uyzM +}w wz|w yy uyzM +}w wz|w yy uyzM +}w wz|w yy uyzM +}w wz|w yy uyzN *}w wz|w yy uyzN *}w wz|w yw uyzN *}w wz|w
yw uyzN *}w wz|w
yw uyzN *}w wz|w yw uyzN *}w wz|w yw uyzO *}w wz|w yw uyzO *}w wz|w yw uyzO *}w wz|w yw uyzO *}w wz|w yw uyzO *}w wz|w yw uyzO )}w wz|w yw uyzO *}w wz|w yw uyzO )}w wz|w yw uyzP *|w wz|w yw uyzO )|w wz|w yw uyzP *|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP *|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w yw uyzP )|w wz|w
yw uyzP )|w wz{w yw uyzP )|w wz{w
yw uyzP (|w wz{w yw uyzP (|w wz{w yw uyzP (|u wz{w yw uyz~Q (|u wz{w yw uyz~Q (|u wz{w yw uyz~Q (|u wz{w yw uyz~Q (|u wz{w yw uyz~Q (|u wz{w zw uyz~S (|u w{|w wy uyz~M #|v wz|w l|a uy{}6 ;}u wz{{ X}r py{x Q~s x{{}- -~w ux~k W|q w{z}@ p|x xzH `}w x{{~P Dx v~p j{\ v{z~` eu ry~. rz w{{}q v}u sxX yv uyz{{ vum rz] =~v nz{z~G pyuo Upv~}X X|r by{{b Y||wwsrurruy|s5 m{U wz{|s Xp|~~zjJ (|w tz{{}4 %LV[`XI Z~p px{{~b r{ Ux{z 9}x wz{z\ k|j wyzz|v 8~w Uwz{{~Z k|j vzz{ >}w bxz{zg uzc vz{{z~H [t fzz{z|y /|z? vzz{z~l w|s ?xz{|z` jx syz{~O ^xm xzz{{|~G W{w ?yzz{z|{E X~zw ]xzz{z|~L X{yf ryzz{z{}[ e{xs uz{g mzyt vxzz{{z~v6 Fy~{zu uyzz{}{^ d}|zzu
syzz{{z|wI Qy{{yx nyz{zz|}pJ Oq~|z{xs \xxz{}sR Su}z{zyb uyz{z|yiQ Rky}z{{zu jyz
{{z{~~xl]G+
#FZlx~}{z{{yyf uxyz{ |~|xtpkjk lj[WZjlqw{~|z{yxv swyz{z{z{{||}~} ~~~}||{{z{zzxx uwyxz{z{z{z{zz{zz{z{yxxt bsxz{zzyzyu_ Uwuxwyz xzxyywxxvuf fssuxvuv wxwxusf t8mk @ ",
I o w n u s l s j u n s r m t o u t u ;' I N= AB Z# :9 lt ) = 2a > J Tm rr 4s =0) { // something was selected
i = [[self dataSource] updateForIgnore:i];
[self selectRow:i byExtendingSelection:NO];
[self reloadData];
}
}
- (IBAction)ignorePath:(id)sender
{
[self doIgnore:'I'];
}
- (IBAction)ignoreExt:(id)sender
{
[self doIgnore:'E'];
}
- (IBAction)ignoreName:(id)sender
{
[self doIgnore:'N'];
}
- (void)doAction:(unichar)c
{
NSEnumerator *e = [self selectedRowEnumerator];
NSNumber *n = [e nextObject];
int numSelected = 0;
int i = -1;
for (; n != nil; n = [e nextObject]) {
numSelected++;
i = [n intValue];
NSMutableArray *reconItems = [[self dataSource] reconItems];
[[reconItems objectAtIndex:i] doAction:c];
}
if (numSelected>0) {
if (numSelected == 1 && [self numberOfRows] > i+1) {
// Move to next row, unless already at last row, or if more than one row selected
[self selectRow:i+1 byExtendingSelection:NO];
[self scrollRowToVisible:i+1];
}
else [self reloadData];
}
}
- (IBAction)copyLR:(id)sender
{
[self doAction:'>'];
}
- (IBAction)copyRL:(id)sender
{
[self doAction:'<'];
}
- (IBAction)leaveAlone:(id)sender
{
[self doAction:'/'];
}
- (IBAction)forceOlder:(id)sender
{
[self doAction:'-'];
}
- (IBAction)forceNewer:(id)sender
{
[self doAction:'+'];
}
- (IBAction)selectConflicts:(id)sender
{
[self deselectAll:self];
NSMutableArray *reconItems = [[self dataSource] reconItems];
int i = 0;
for (; i < [reconItems count]; i++) {
if ([[reconItems objectAtIndex:i] isConflict])
[self selectRow:i byExtendingSelection:YES];
}
}
- (IBAction)revert:(id)sender
{
NSMutableArray *reconItems = [[self dataSource] reconItems];
NSEnumerator *e = [self selectedRowEnumerator];
NSNumber *n = [e nextObject];
int i;
for (; n != nil; n = [e nextObject]) {
i = [n intValue];
[[reconItems objectAtIndex:i] revertDirection];
}
[self reloadData];
}
- (IBAction)merge:(id)sender
{
[self doAction:'m'];
}
/* There are menu commands for these, but we add some shortcuts so you don't
have to press the Command key */
- (void)keyDown:(NSEvent *)event
{
unichar c = [[event characters] characterAtIndex:0];
switch (c) {
case '>':
case NSRightArrowFunctionKey:
[self doAction:'>'];
break;
case '<':
case NSLeftArrowFunctionKey:
[self doAction:'<'];
break;
case '?':
case '/':
[self doAction:'/'];
break;
default:
[super keyDown:event];
break;
}
}
@end
unison-2.40.102/uimac/PreferencesController.m 0000644 0061316 0061316 00000006073 11361646373 021176 0 ustar bcpierce bcpierce #import "PreferencesController.h"
#define CAML_NAME_SPACE
#include
#include
extern value Callback3_checkexn(value,value,value,value);
@implementation PreferencesController
- (void)reset
{
[profileNameText setStringValue:@""];
[firstRootText setStringValue:@""];
[secondRootUser setStringValue:@""];
[secondRootHost setStringValue:@""];
[secondRootText setStringValue:@""];
[remoteButtonCell setState:NSOnState];
[localButtonCell setState:NSOffState];
[secondRootUser setSelectable:YES];
[secondRootUser setEditable:YES];
[secondRootHost setSelectable:YES];
[secondRootHost setEditable:YES];
}
- (BOOL)validatePrefs
{
NSString *profileName = [profileNameText stringValue];
if (profileName == nil | [profileName isEqualTo:@""]) {
// FIX: should check for already existing names too
NSRunAlertPanel(@"Error",@"You must enter a profile name",@"OK",nil,nil);
return NO;
}
NSString *firstRoot = [firstRootText stringValue];
if (firstRoot == nil | [firstRoot isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a first root",@"OK",nil,nil);
return NO;
}
NSString *secondRoot;
if ([remoteButtonCell state] == NSOnState) {
NSString *user = [secondRootUser stringValue];
if (user == nil | [user isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a user",@"OK",nil,nil);
return NO;
}
NSString *host = [secondRootHost stringValue];
if (host == nil | [host isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a host",@"OK",nil,nil);
return NO;
}
NSString *file = [secondRootText stringValue];
// OK for empty file, e.g., ssh://foo@bar/
secondRoot = [NSString stringWithFormat:@"ssh://%@@%@/%@",user,host,file];
}
else {
secondRoot = [secondRootText stringValue];
if (secondRoot == nil | [secondRoot isEqualTo:@""]) {
NSRunAlertPanel(@"Error",@"You must enter a second root file",@"OK",nil,nil);
return NO;
}
}
value *f = caml_named_value("unisonProfileInit");
Callback3_checkexn(*f, caml_copy_string([profileName cString]),
caml_copy_string([firstRoot cString]),
caml_copy_string([secondRoot cString]));
return YES;
}
/* The target when enter is pressed in any of the text fields */
// FIX: this is broken, it takes tab, mouse clicks, etc.
- (IBAction)anyEnter:(id)sender
{
NSLog(@"enter");
[self validatePrefs];
}
- (IBAction)localClick:(id)sender
{
NSLog(@"local");
[secondRootUser setStringValue:@""];
[secondRootHost setStringValue:@""];
[secondRootUser setSelectable:NO];
[secondRootUser setEditable:NO];
[secondRootHost setSelectable:NO];
[secondRootHost setEditable:NO];
}
- (IBAction)remoteClick:(id)sender
{
NSLog(@"remote");
[secondRootUser setSelectable:YES];
[secondRootUser setEditable:YES];
[secondRootHost setSelectable:YES];
[secondRootHost setEditable:YES];
}
@end
unison-2.40.102/uimac/Info.plist.template 0000644 0061316 0061316 00000002117 11361646373 020270 0 ustar bcpierce bcpierce
CFBundleName
Unison
CFBundleDevelopmentRegion
English
CFBundleExecutable
Unison
CFBundleIconFile
Unison.icns
CFBundleIdentifier
edu.upenn.cis.Unison
CFBundleInfoDictionaryVersion
6.0
CFBundlePackageType
APPL
CFBundleSignature
????
CFBundleVersion
@@VERSION@@
CFBundleShortVersionString
@@VERSION@@
CFBundleGetInfoString
@@VERSION@@. ©1999-2007, licensed under GNU GPL.
NSHumanReadableCopyright
©1999-2006, licensed under GNU GPL.
NSMainNibFile
MainMenu
NSPrincipalClass
NSApplication
unison-2.40.102/uimac/ProfileController.m 0000644 0061316 0061316 00000004376 11361646373 020341 0 ustar bcpierce bcpierce /* Copyright (c) 2003, see file COPYING for details. */
#import "ProfileController.h"
#define CAML_NAME_SPACE
#include
#include
extern value Callback_checkexn(value,value);
@implementation ProfileController
NSString *unisonDirectory()
{
static value *f = NULL;
if (f == NULL)
f = caml_named_value("unisonDirectory");
return [NSString stringWithCString:String_val(Callback_checkexn(*f, Val_unit))];
}
- (void)initProfiles
{
NSString *directory = unisonDirectory();
NSArray *files = [[NSFileManager defaultManager] directoryContentsAtPath:directory];
unsigned int count = [files count];
unsigned int i,j;
[profiles release];
profiles = [[NSMutableArray alloc] init];
defaultIndex = -1;
for (i = j = 0; i < count; i++) {
NSString *file = [files objectAtIndex:i];
if ([[file pathExtension] isEqualTo:@"prf"]) {
NSString *withoutExtension = [file stringByDeletingPathExtension];
[profiles insertObject:withoutExtension atIndex:j];
if ([@"default" isEqualTo:withoutExtension]) defaultIndex = j;
j++;
}
}
if (j > 0)
[tableView selectRow:0 byExtendingSelection:NO];
}
- (void)awakeFromNib
{
// start with the default profile selected
[self initProfiles];
if (defaultIndex >= 0)
[tableView selectRow:defaultIndex byExtendingSelection:NO];
// on awake the scroll bar is inactive, but after adding profiles we might need it;
// reloadData makes it happen. Q: is setNeedsDisplay more efficient?
[tableView reloadData];
}
- (int)numberOfRowsInTableView:(NSTableView *)aTableView
{
if (!profiles) return 0;
else return [profiles count];
}
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex
{
if (rowIndex >= 0 && rowIndex < [profiles count])
return [profiles objectAtIndex:rowIndex];
else return @"[internal error!]";
}
- (NSString *)selected
{
int rowIndex = [tableView selectedRow];
if (rowIndex >= 0 && rowIndex < [profiles count])
return [profiles objectAtIndex:rowIndex];
else return @"[internal error!]";
}
- (NSTableView *)tableView
{
return tableView;
}
@end
unison-2.40.102/uimac/ReconTableView.h 0000644 0061316 0061316 00000001460 11361646373 017530 0 ustar bcpierce bcpierce //
// ReconTableView.h
//
// NSTableView extended to handle additional keyboard events for the reconcile window.
// The keyDown: method is redefined.
//
// Created by Trevor Jim on Wed Aug 27 2003.
// Copyright (c) 2003, licensed under GNU GPL.
//
#import
@interface ReconTableView : NSTableView {
BOOL editable;
}
- (BOOL)editable;
- (void)setEditable:(BOOL)x;
- (IBAction)ignorePath:(id)sender;
- (IBAction)ignoreExt:(id)sender;
- (IBAction)ignoreName:(id)sender;
- (IBAction)copyLR:(id)sender;
- (IBAction)copyRL:(id)sender;
- (IBAction)leaveAlone:(id)sender;
- (IBAction)forceOlder:(id)sender;
- (IBAction)forceNewer:(id)sender;
- (IBAction)selectConflicts:(id)sender;
- (IBAction)revert:(id)sender;
- (IBAction)merge:(id)sender;
- (BOOL)validateMenuItem:(NSMenuItem *)item;
@end
unison-2.40.102/uimac/ProfileTableView.m 0000644 0061316 0061316 00000000474 11361646373 020073 0 ustar bcpierce bcpierce #import "ProfileTableView.h"
@implementation ProfileTableView
- (void)keyDown:(NSEvent *)event
{
unichar c = [[event characters] characterAtIndex:0];
switch (c) {
case '\r':
[myController openButton:self];
break;
default:
[super keyDown:event];
break;
}
}
@end
unison-2.40.102/uimac/PreferencesController.h 0000644 0061316 0061316 00000001154 11361646373 021164 0 ustar bcpierce bcpierce /* PreferencesController */
#import
@interface PreferencesController : NSObject
{
IBOutlet NSButton *cancelButton;
IBOutlet NSTextField *firstRootText;
IBOutlet NSButtonCell *localButtonCell;
IBOutlet NSTextField *profileNameText;
IBOutlet NSButtonCell *remoteButtonCell;
IBOutlet NSButton *saveButton;
IBOutlet NSTextField *secondRootHost;
IBOutlet NSTextField *secondRootText;
IBOutlet NSTextField *secondRootUser;
}
- (IBAction)anyEnter:(id)sender;
- (IBAction)localClick:(id)sender;
- (IBAction)remoteClick:(id)sender;
- (BOOL)validatePrefs;
- (void)reset;
@end
unison-2.40.102/uimac/TrevorsUnison.icns 0000644 0061316 0061316 00000057744 11361646373 020244 0 ustar bcpierce bcpierce icns _it32 !! !! ## ## !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# !##! !##! #11# #11# "##! !##! #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "##" "##" #11# #11# "#1Z ւZ1#" "#1ZZ1#" ## ## #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### #### ##J# #J## "#c# #c#" !##! !##! !### ##ד#! !#c#! !#c#! #V## ##V# #0c#! !#p0# "#ʔ0#! !#0#" !#0#! !#0ʕ#! #V0#! !#0V# ##0##! !##0ʖ## !#c#! !#c#! #Ic#cI# ##֖c=#=c֚## !#pp#! #### !#cc#! #### !#II#! "##" ##Ȼ## !#<<#! "#bb#" ##||## #### !####! !####! !##||##! !##bb##! ##<ȩ<## "####" !##<<##! "##VԟV##" !#bb#! !#II#! !"#VǏǕV#"! !#0VV0#! !"#"! !#! ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,ޙ, ,ޙ, +כ+ +כ+ +ҝ+ +ҝ+ }} }} +̟+ +̟+ *M M* *MՃM* ҆ ҇ } } { { y y w w t t r r p p n n l l j j g g e e c c a a _+ +_ M]2 2]M KZD DZK CXQ QX? ;W0 0W; ,TG GT, "R/ 2R" GPM" "MPG 9NE" "EN9 *L;" "@L* GJA" "AJG 8HE, ,EH8 &F<+ +
@interface ProfileController : NSObject
{
IBOutlet NSTableView *tableView;
NSMutableArray *profiles;
int defaultIndex; // -1 if no default, else the index in profiles of @"default"
}
- (void)initProfiles;
- (int)numberOfRowsInTableView:(NSTableView *)aTableView;
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex;
- (NSString *)selected;
- (NSTableView *)tableView; // allows MyController to set up firstResponder
@end
unison-2.40.102/uimac/uimac.pbproj/ 0000755 0061316 0061316 00000000000 12050210657 017062 5 ustar bcpierce bcpierce unison-2.40.102/uimac/uimac.pbproj/project.pbxproj 0000644 0061316 0061316 00000030604 11361646373 022155 0 ustar bcpierce bcpierce // !$*UTF8*$!
{
archiveVersion = 1;
classes = {
};
objectVersion = 39;
objects = {
080E96DDFE201D6D7F000001 = {
children = (
);
isa = PBXGroup;
name = Classes;
refType = 4;
sourceTree = "";
};
089C165CFE840E0CC02AAC07 = {
children = (
089C165DFE840E0CC02AAC07,
);
isa = PBXVariantGroup;
name = InfoPlist.strings;
refType = 4;
sourceTree = "";
};
089C165DFE840E0CC02AAC07 = {
fileEncoding = 10;
isa = PBXFileReference;
lastKnownFileType = text.plist.strings;
name = English;
path = English.lproj/InfoPlist.strings;
refType = 4;
sourceTree = "";
};
//080
//081
//082
//083
//084
//100
//101
//102
//103
//104
1058C7A0FEA54F0111CA2CBB = {
children = (
1058C7A1FEA54F0111CA2CBB,
);
isa = PBXGroup;
name = "Linked Frameworks";
refType = 4;
sourceTree = "";
};
1058C7A1FEA54F0111CA2CBB = {
isa = PBXFileReference;
lastKnownFileType = wrapper.framework;
name = Cocoa.framework;
path = /System/Library/Frameworks/Cocoa.framework;
refType = 0;
sourceTree = "";
};
1058C7A2FEA54F0111CA2CBB = {
children = (
29B97325FDCFA39411CA2CEA,
29B97324FDCFA39411CA2CEA,
);
isa = PBXGroup;
name = "Other Frameworks";
refType = 4;
sourceTree = "";
};
//100
//101
//102
//103
//104
//190
//191
//192
//193
//194
19C28FACFE9D520D11CA2CBB = {
children = (
69C625F50664EC3300B3C46A,
);
isa = PBXGroup;
name = Products;
refType = 4;
sourceTree = "";
};
//190
//191
//192
//193
//194
//290
//291
//292
//293
//294
29B97313FDCFA39411CA2CEA = {
buildSettings = {
};
buildStyles = (
4A9504CCFFE6A4B311CA0CBA,
4A9504CDFFE6A4B311CA0CBA,
);
hasScannedForEncodings = 1;
isa = PBXProject;
mainGroup = 29B97314FDCFA39411CA2CEA;
projectDirPath = "";
targets = (
69C625DD0664EC3300B3C46A,
);
};
29B97314FDCFA39411CA2CEA = {
children = (
69E407B907EB95AA00D37AA1,
080E96DDFE201D6D7F000001,
29B97315FDCFA39411CA2CEA,
29B97317FDCFA39411CA2CEA,
29B97323FDCFA39411CA2CEA,
19C28FACFE9D520D11CA2CBB,
69C625F40664EC3300B3C46A,
);
isa = PBXGroup;
name = uimac;
path = "";
refType = 4;
sourceTree = "";
};
29B97315FDCFA39411CA2CEA = {
children = (
29B97316FDCFA39411CA2CEA,
69660DC604F08CC100CF23A4,
69660DC704F08CC100CF23A4,
69BA7DA804FD695200CF23A4,
69BA7DA904FD695200CF23A4,
690F564404F11EC300CF23A4,
690F564504F11EC300CF23A4,
69D3C6FA04F1CC3700CF23A4,
69D3C6F904F1CC3700CF23A4,
697985CD050CFA2D00CF23A4,
697985CE050CFA2D00CF23A4,
691CE180051BB44A00CF23A4,
691CE181051BB44A00CF23A4,
);
isa = PBXGroup;
name = "Other Sources";
path = "";
refType = 4;
sourceTree = "";
};
29B97316FDCFA39411CA2CEA = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = main.m;
refType = 4;
sourceTree = "";
};
29B97317FDCFA39411CA2CEA = {
children = (
29B97318FDCFA39411CA2CEA,
089C165CFE840E0CC02AAC07,
69C625CA0664E94E00B3C46A,
);
isa = PBXGroup;
name = Resources;
path = "";
refType = 4;
sourceTree = "";
};
29B97318FDCFA39411CA2CEA = {
children = (
29B97319FDCFA39411CA2CEA,
);
isa = PBXVariantGroup;
name = MainMenu.nib;
path = "";
refType = 4;
sourceTree = "";
};
29B97319FDCFA39411CA2CEA = {
isa = PBXFileReference;
lastKnownFileType = wrapper.nib;
name = English;
path = English.lproj/MainMenu.nib;
refType = 4;
sourceTree = "";
};
29B97323FDCFA39411CA2CEA = {
children = (
1058C7A0FEA54F0111CA2CBB,
1058C7A2FEA54F0111CA2CBB,
);
isa = PBXGroup;
name = Frameworks;
path = "";
refType = 4;
sourceTree = "";
};
29B97324FDCFA39411CA2CEA = {
isa = PBXFileReference;
lastKnownFileType = wrapper.framework;
name = AppKit.framework;
path = /System/Library/Frameworks/AppKit.framework;
refType = 0;
sourceTree = "";
};
29B97325FDCFA39411CA2CEA = {
isa = PBXFileReference;
lastKnownFileType = wrapper.framework;
name = Foundation.framework;
path = /System/Library/Frameworks/Foundation.framework;
refType = 0;
sourceTree = "";
};
//290
//291
//292
//293
//294
//4A0
//4A1
//4A2
//4A3
//4A4
4A9504CCFFE6A4B311CA0CBA = {
buildSettings = {
COPY_PHASE_STRIP = NO;
GCC_DYNAMIC_NO_PIC = NO;
GCC_ENABLE_FIX_AND_CONTINUE = YES;
GCC_GENERATE_DEBUGGING_SYMBOLS = YES;
GCC_OPTIMIZATION_LEVEL = 0;
NSZombieEnabled = YES;
OPTIMIZATION_CFLAGS = "-O0";
ZERO_LINK = YES;
};
isa = PBXBuildStyle;
name = Development;
};
4A9504CDFFE6A4B311CA0CBA = {
buildSettings = {
COPY_PHASE_STRIP = YES;
GCC_ENABLE_FIX_AND_CONTINUE = NO;
GCC_WARN_FOUR_CHARACTER_CONSTANTS = YES;
ZERO_LINK = NO;
};
isa = PBXBuildStyle;
name = Deployment;
};
//4A0
//4A1
//4A2
//4A3
//4A4
//690
//691
//692
//693
//694
690F564404F11EC300CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.h;
path = ProfileController.h;
refType = 4;
sourceTree = "";
};
690F564504F11EC300CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = ProfileController.m;
refType = 4;
sourceTree = "";
};
691CE180051BB44A00CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.h;
path = ProfileTableView.h;
refType = 4;
sourceTree = "";
};
691CE181051BB44A00CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = ProfileTableView.m;
refType = 4;
sourceTree = "";
};
69660DC604F08CC100CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.h;
path = MyController.h;
refType = 4;
sourceTree = "";
};
69660DC704F08CC100CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = MyController.m;
refType = 4;
sourceTree = "";
};
697985CD050CFA2D00CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.h;
path = PreferencesController.h;
refType = 4;
sourceTree = "";
};
697985CE050CFA2D00CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = PreferencesController.m;
refType = 4;
sourceTree = "";
};
69BA7DA804FD695200CF23A4 = {
fileEncoding = 4;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.h;
path = ReconTableView.h;
refType = 4;
sourceTree = "";
};
69BA7DA904FD695200CF23A4 = {
fileEncoding = 4;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = ReconTableView.m;
refType = 4;
sourceTree = "";
};
69C625CA0664E94E00B3C46A = {
isa = PBXFileReference;
lastKnownFileType = image.icns;
path = Unison.icns;
refType = 4;
sourceTree = "";
};
69C625DD0664EC3300B3C46A = {
buildPhases = (
69C625DE0664EC3300B3C46A,
69C625E50664EC3300B3C46A,
69C625E90664EC3300B3C46A,
69C625F10664EC3300B3C46A,
);
buildRules = (
);
buildSettings = {
FRAMEWORK_SEARCH_PATHS = "";
GCC_PRECOMPILE_PREFIX_HEADER = YES;
HEADER_SEARCH_PATHS = "$(OCAMLLIBDIR)";
INFOPLIST_FILE = Info.plist;
INSTALL_PATH = "$(HOME)/Applications";
LIBRARY_SEARCH_PATHS = "";
OCAMLLIBDIR = /usr/local/lib/ocaml;
OTHER_CFLAGS = "";
OTHER_LDFLAGS = "$(SRCROOT)/../unison-blob.o -L$(OCAMLLIBDIR) -lunix -lstr -lasmrun";
PREBINDING = NO;
PRODUCT_NAME = Unison;
SECTORDER_FLAGS = "";
WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas";
WRAPPER_EXTENSION = app;
};
dependencies = (
);
isa = PBXNativeTarget;
name = uimac;
productInstallPath = "$(HOME)/Applications";
productName = uimac;
productReference = 69C625F50664EC3300B3C46A;
productType = "com.apple.product-type.application";
};
69C625DE0664EC3300B3C46A = {
buildActionMask = 2147483647;
files = (
69C625DF0664EC3300B3C46A,
69C625E00664EC3300B3C46A,
69C625E10664EC3300B3C46A,
69C625E20664EC3300B3C46A,
69C625E30664EC3300B3C46A,
69C625E40664EC3300B3C46A,
);
isa = PBXHeadersBuildPhase;
runOnlyForDeploymentPostprocessing = 0;
};
69C625DF0664EC3300B3C46A = {
fileRef = 69660DC604F08CC100CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625E00664EC3300B3C46A = {
fileRef = 690F564404F11EC300CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625E10664EC3300B3C46A = {
fileRef = 69D3C6FA04F1CC3700CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625E20664EC3300B3C46A = {
fileRef = 69BA7DA804FD695200CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625E30664EC3300B3C46A = {
fileRef = 697985CD050CFA2D00CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625E40664EC3300B3C46A = {
fileRef = 691CE180051BB44A00CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625E50664EC3300B3C46A = {
buildActionMask = 2147483647;
files = (
69C625E60664EC3300B3C46A,
69C625E70664EC3300B3C46A,
69C625E80664EC3300B3C46A,
);
isa = PBXResourcesBuildPhase;
runOnlyForDeploymentPostprocessing = 0;
};
69C625E60664EC3300B3C46A = {
fileRef = 29B97318FDCFA39411CA2CEA;
isa = PBXBuildFile;
settings = {
};
};
69C625E70664EC3300B3C46A = {
fileRef = 089C165CFE840E0CC02AAC07;
isa = PBXBuildFile;
settings = {
};
};
69C625E80664EC3300B3C46A = {
fileRef = 69C625CA0664E94E00B3C46A;
isa = PBXBuildFile;
settings = {
};
};
69C625E90664EC3300B3C46A = {
buildActionMask = 2147483647;
files = (
69C625EA0664EC3300B3C46A,
69C625EB0664EC3300B3C46A,
69C625EC0664EC3300B3C46A,
69C625ED0664EC3300B3C46A,
69C625EE0664EC3300B3C46A,
69C625EF0664EC3300B3C46A,
69C625F00664EC3300B3C46A,
);
isa = PBXSourcesBuildPhase;
runOnlyForDeploymentPostprocessing = 0;
};
69C625EA0664EC3300B3C46A = {
fileRef = 29B97316FDCFA39411CA2CEA;
isa = PBXBuildFile;
settings = {
ATTRIBUTES = (
);
};
};
69C625EB0664EC3300B3C46A = {
fileRef = 69660DC704F08CC100CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625EC0664EC3300B3C46A = {
fileRef = 690F564504F11EC300CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625ED0664EC3300B3C46A = {
fileRef = 69D3C6F904F1CC3700CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625EE0664EC3300B3C46A = {
fileRef = 69BA7DA904FD695200CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625EF0664EC3300B3C46A = {
fileRef = 697985CE050CFA2D00CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625F00664EC3300B3C46A = {
fileRef = 691CE181051BB44A00CF23A4;
isa = PBXBuildFile;
settings = {
};
};
69C625F10664EC3300B3C46A = {
buildActionMask = 2147483647;
files = (
69C625F20664EC3300B3C46A,
69E407BA07EB95AA00D37AA1,
);
isa = PBXFrameworksBuildPhase;
runOnlyForDeploymentPostprocessing = 0;
};
69C625F20664EC3300B3C46A = {
fileRef = 1058C7A1FEA54F0111CA2CBB;
isa = PBXBuildFile;
settings = {
};
};
69C625F40664EC3300B3C46A = {
isa = PBXFileReference;
lastKnownFileType = text.xml;
path = Info.plist;
refType = 4;
sourceTree = "";
};
69C625F50664EC3300B3C46A = {
explicitFileType = wrapper.application;
includeInIndex = 0;
isa = PBXFileReference;
path = Unison.app;
refType = 3;
sourceTree = BUILT_PRODUCTS_DIR;
};
69D3C6F904F1CC3700CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.objc;
path = ReconItem.m;
refType = 4;
sourceTree = "";
};
69D3C6FA04F1CC3700CF23A4 = {
fileEncoding = 30;
isa = PBXFileReference;
lastKnownFileType = sourcecode.c.h;
path = ReconItem.h;
refType = 4;
sourceTree = "";
};
69E407B907EB95AA00D37AA1 = {
isa = PBXFileReference;
lastKnownFileType = wrapper.framework;
name = Security.framework;
path = /System/Library/Frameworks/Security.framework;
refType = 0;
sourceTree = "";
};
69E407BA07EB95AA00D37AA1 = {
fileRef = 69E407B907EB95AA00D37AA1;
isa = PBXBuildFile;
settings = {
};
};
};
rootObject = 29B97313FDCFA39411CA2CEA;
}
unison-2.40.102/uimac/ProfileTableView.h 0000644 0061316 0061316 00000000246 11361646373 020063 0 ustar bcpierce bcpierce /* ProfileTableView */
#import
#import "MyController.h"
@interface ProfileTableView : NSTableView
{
IBOutlet MyController *myController;
}
@end
unison-2.40.102/uimac/Info.plist 0000644 0061316 0061316 00000000000 11361646373 016443 0 ustar bcpierce bcpierce unison-2.40.102/uimac/MyController.m 0000644 0061316 0061316 00000037506 11361646373 017327 0 ustar bcpierce bcpierce /* Copyright (c) 2003, see file COPYING for details. */
#import "MyController.h"
#import "ReconItem.h"
#include
#include
#include
#include
extern value Callback_checkexn(value,value);
extern value Callback2_checkexn(value,value,value);
@implementation MyController
static MyController *me; // needed by reloadTable and displayStatus, below
- (void)resizeWindowToSize:(NSSize)newSize
{
NSRect aFrame;
float newHeight = newSize.height;
float newWidth = newSize.width;
aFrame = [NSWindow contentRectForFrameRect:[mainWindow frame]
styleMask:[mainWindow styleMask]];
aFrame.origin.y += aFrame.size.height;
aFrame.origin.y -= newHeight;
aFrame.size.height = newHeight;
aFrame.size.width = newWidth;
aFrame = [NSWindow frameRectForContentRect:aFrame
styleMask:[mainWindow styleMask]];
[mainWindow setFrame:aFrame display:YES animate:YES];
}
- (void)chooseProfiles
{
[mainWindow setContentView:blankView];
[self resizeWindowToSize:chooseProfileSize];
[mainWindow setContentView:chooseProfileView];
[mainWindow makeFirstResponder:[profileController tableView]]; // profiles get keyboard input
}
- (IBAction)createButton:(id)sender
{
[preferencesController reset];
[mainWindow setContentView:blankView];
[self resizeWindowToSize:preferencesSize];
[mainWindow setContentView:preferencesView];
}
- (IBAction)saveProfileButton:(id)sender
{
if ([preferencesController validatePrefs]) {
[profileController initProfiles]; // so the list contains the new profile
[self chooseProfiles];
}
}
- (IBAction)cancelProfileButton:(id)sender
{
[self chooseProfiles];
}
- (void)updateReconItems
{
[reconItems release];
reconItems = [[NSMutableArray alloc] init];
int j = 0;
int n = Wosize_val(caml_reconItems);
for (; j= 0 && i < [reconItems count])
[detailsTextView setString:[[reconItems objectAtIndex:i] details]];
}
- (void)clearDetails
{
[detailsTextView setString:@""];
}
- (void)doUpdateThread:(id)whatever
{
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
preconn = Val_unit; // so old preconn can be garbage collected
value *f = caml_named_value("unisonInit2");
caml_reconItems = Callback_checkexn(*f, Val_unit);
[pool release];
}
- (void)afterUpdate:(NSNotification *)notification
{
[[NSNotificationCenter defaultCenter] removeObserver:self
name:NSThreadWillExitNotification
object:nil];
[self updateReconItems];
if ([reconItems count] > 0)
[tableView selectRow:0 byExtendingSelection:NO];
// label the left and right columns with the roots
NSTableHeaderCell *left = [[[tableView tableColumns] objectAtIndex:0] headerCell];
value *f = caml_named_value("unisonFirstRootString");
[left setObjectValue:[NSString stringWithCString:String_val(Callback_checkexn(*f, Val_unit))]];
NSTableHeaderCell *right = [[[tableView tableColumns] objectAtIndex:2] headerCell];
f = caml_named_value("unisonSecondRootString");
[right setObjectValue:[NSString stringWithCString:String_val(Callback_checkexn(*f, Val_unit))]];
// cause scrollbar to display if necessary
[tableView reloadData];
// activate menu items
[tableView setEditable:YES];
}
- (void)afterOpen
{
NSLog(@"Connected.");
// move to updates window after clearing it
[self clearDetails];
[reconItems release];
reconItems = nil;
[mainWindow setContentView:blankView];
[self resizeWindowToSize:updatesSize];
[mainWindow setContentView:updatesView];
// reconItems table gets keyboard input
[mainWindow makeFirstResponder:tableView];
[[NSNotificationCenter defaultCenter] addObserver:self
selector:@selector(afterUpdate:)
name:NSThreadWillExitNotification object:nil];
[NSThread detachNewThreadSelector:@selector(doUpdateThread:)
toTarget:self withObject:nil];
}
- (void)connect:(value)profileName
{
// contact server, propagate prefs
NSLog(@"Connecting...");
// Switch to ConnectingView
[mainWindow setContentView:blankView];
[self resizeWindowToSize:ConnectingSize];
[mainWindow setContentView:ConnectingView];
[ConnectingView setNeedsDisplay:YES]; // FIX: this doesn't seem to work fast enough
// possibly slow -- need another thread? Print "contacting server"
value *f = NULL;
f = caml_named_value("unisonInit1");
preconn = Callback_checkexn(*f, profileName);
if (preconn == Val_unit) {
[self afterOpen]; // no prompting required
return;
}
// prompting required
preconn = Field(preconn,0); // value of Some
f = caml_named_value("openConnectionPrompt");
value prompt = Callback_checkexn(*f, preconn);
if (prompt == Val_unit) {
// turns out, no prompt needed, but must finish opening connection
f = caml_named_value("openConnectionEnd");
Callback_checkexn(*f, preconn);
[self afterOpen];
return;
}
[self raisePasswordWindow:[NSString stringWithCString:String_val(Field(prompt,0))]];
}
- (IBAction)openButton:(id)sender
{
NSString *profile = [profileController selected];
[updatesText setStringValue:[NSString stringWithFormat:@"Synchronizing profile '%@'",
profile]];
const char *s = [profile cString];
value caml_s = caml_copy_string(s);
[self connect:caml_s];
return;
}
- (IBAction)restartButton:(id)sender
{
[tableView setEditable:NO];
[self chooseProfiles];
}
- (void)doSyncThread:(id)whatever
{
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
value *f = caml_named_value("unisonSynchronize");
Callback_checkexn(*f, Val_unit);
[pool release];
}
- (void)afterSync:(NSNotification *)notification
{
[[NSNotificationCenter defaultCenter] removeObserver:self
name:NSThreadWillExitNotification
object:nil];
int i;
for (i = 0; i < [reconItems count]; i++) {
[[reconItems objectAtIndex:i] resetProgress];
}
[tableView reloadData];
}
- (IBAction)syncButton:(id)sender
{
[tableView setEditable:NO];
[[NSNotificationCenter defaultCenter] addObserver:self
selector:@selector(afterSync:)
name:NSThreadWillExitNotification object:nil];
[NSThread detachNewThreadSelector:@selector(doSyncThread:)
toTarget:self withObject:nil];
}
- (void)updateTableView:(int)i
{
[[reconItems objectAtIndex:i] resetProgress];
[tableView reloadData]; // FIX: can we redisplay just row i?
}
// A function called from ocaml
CAMLprim value reloadTable(value row)
{
int i = Int_val(row);
[me updateTableView:i]; // we need 'me' to access its instance variables
return Val_unit;
}
- (int)numberOfRowsInTableView:(NSTableView *)aTableView
{
if (!reconItems) return 0;
else return [reconItems count];
}
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex
{
if (!reconItems) {
return @"[internal error]";
}
if (rowIndex >= 0 && rowIndex < [reconItems count]) {
NSString *identifier = [aTableColumn identifier];
ReconItem *ri = [reconItems objectAtIndex:rowIndex];
NSString *s = [ri valueForKey:identifier];
return s;
}
else return @"[internal error!]";
}
- (void)tableViewSelectionDidChange:(NSNotification *)note
{
int n = [tableView numberOfSelectedRows];
if (n == 1) [self displayDetails:[tableView selectedRow]];
else [self clearDetails];
}
- (void)raisePasswordWindow:(NSString *)prompt
{
// FIX: some prompts don't ask for password, need to look at it
NSLog(@"Got the prompt: '%@'",prompt);
value *f = caml_named_value("unisonPasswordMsg");
value v = Callback_checkexn(*f, caml_copy_string([prompt cString]));
if (v == Val_true) {
[NSApp beginSheet:passwordWindow
modalForWindow:mainWindow
modalDelegate:nil
didEndSelector:nil
contextInfo:nil];
return;
}
f = caml_named_value("unisonAuthenticityMsg");
v = Callback_checkexn(*f, caml_copy_string([prompt cString]));
if (v == Val_true) {
int i = NSRunAlertPanel(@"New host",prompt,@"Yes",@"No",nil);
if (i == NSAlertDefaultReturn) {
f = caml_named_value("openConnectionReply");
Callback2_checkexn(*f, preconn, caml_copy_string("yes"));
f = caml_named_value("openConnectionPrompt");
value prompt = Callback_checkexn(*f, preconn);
if (prompt == Val_unit) {
// all done with prompts, finish opening connection
f = caml_named_value("openConnectionEnd");
Callback_checkexn(*f, preconn);
[self afterOpen];
return;
}
else {
[self raisePasswordWindow:[NSString stringWithCString:String_val(Field(prompt,0))]];
return;
}
}
if (i == NSAlertAlternateReturn) {
f = caml_named_value("openConnectionCancel");
Callback_checkexn(*f, preconn);
return;
}
else {
NSLog(@"Unrecognized response '%d' from NSRunAlertPanel",i);
f = caml_named_value("openConnectionCancel");
Callback_checkexn(*f, preconn);
return;
}
}
NSLog(@"Unrecognized message from ssh: %@",prompt);
f = caml_named_value("openConnectionCancel");
Callback_checkexn(*f, preconn);
}
// The password window will invoke this when Enter occurs, b/c we
// are the delegate.
- (void)controlTextDidEndEditing:(NSNotification *)notification
{
NSNumber *reason = [[notification userInfo] objectForKey:@"NSTextMovement"];
int code = [reason intValue];
if (code == NSReturnTextMovement)
[self endPasswordWindow:self];
}
// Or, the Continue button will invoke this when clicked
- (IBAction)endPasswordWindow:(id)sender
{
[passwordWindow orderOut:self];
[NSApp endSheet:passwordWindow];
if ([sender isEqualTo:passwordCancelButton]) {
value *f = caml_named_value("openConnectionCancel");
Callback_checkexn(*f, preconn);
[self chooseProfiles];
return;
}
NSString *password = [passwordText stringValue];
value *f = NULL;
const char *s = [password cString];
value caml_s = caml_copy_string(s);
f = caml_named_value("openConnectionReply");
Callback2_checkexn(*f, preconn, caml_s);
f = caml_named_value("openConnectionPrompt");
value prompt = Callback_checkexn(*f, preconn);
if (prompt == Val_unit) {
// all done with prompts, finish opening connection
f = caml_named_value("openConnectionEnd");
Callback_checkexn(*f, preconn);
[self afterOpen];
}
else [self raisePasswordWindow:[NSString stringWithCString:String_val(Field(prompt,0))]];
}
- (IBAction)raiseAboutWindow:(id)sender
{
[aboutWindow makeKeyAndOrderFront:nil];
}
- (IBAction)onlineHelp:(id)sender
{
[[NSWorkspace sharedWorkspace]
openURL:[NSURL URLWithString:@"http://www.cis.upenn.edu/~bcpierce/unison/docs.html"]];
}
- (NSMutableArray *)reconItems // used in ReconTableView only
{
return reconItems;
}
- (int)updateForIgnore:(int)i
{
value *f = caml_named_value("unisonUpdateForIgnore");
int j = Int_val(Callback_checkexn(*f,Val_int(i)));
f = caml_named_value("unisonState");
caml_reconItems = Callback_checkexn(*f, Val_unit);
[self updateReconItems];
return j;
}
- (void)statusTextSet:(NSString *)s {
[statusText setStringValue:s];
}
// A function called from ocaml
CAMLprim value displayStatus(value s)
{
[me statusTextSet:[NSString stringWithCString:String_val(s)]];
// NSLog(@"dS: %s",String_val(s));
return Val_unit;
}
- (void)awakeFromNib
{
/**** Initialize locals ****/
me = self;
chooseProfileSize = [chooseProfileView frame].size;
updatesSize = [updatesView frame].size;
preferencesSize = [preferencesView frame].size;
ConnectingSize = [ConnectingView frame].size;
blankView = [[NSView alloc] init];
/* Double clicking in the profile list will open the profile */
[[profileController tableView] setTarget:self];
[[profileController tableView] setDoubleAction:@selector(openButton:)];
/* Set up the version string in the about box. We use a custom
about box just because PRCS doesn't seem capable of getting the
version into the InfoPlist.strings file; otherwise we'd use the
standard about box. */
value *f = NULL;
f = caml_named_value("unisonGetVersion");
[versionText setStringValue:
[NSString stringWithCString:
String_val(Callback_checkexn(*f, Val_unit))]];
/* Ocaml initialization */
// FIX: Does this occur before ProfileController awakeFromNib?
caml_reconItems = preconn = Val_int(0);
caml_register_global_root(&caml_reconItems);
caml_register_global_root(&preconn);
/* Command-line processing */
f = caml_named_value("unisonInit0");
value clprofile = Callback_checkexn(*f, Val_unit);
/* Set up the first window the user will see */
if (Is_block(clprofile)) {
/* A profile name was given on the command line */
value caml_profile = Field(clprofile,0);
NSString *profile = [NSString stringWithCString:String_val(caml_profile)];
[updatesText setStringValue:[NSString stringWithFormat:@"Synchronizing profile '%@'",
profile]];
/* If invoked from terminal we need to bring the app to the front */
[NSApp activateIgnoringOtherApps:YES];
/* Start the connection */
[self connect:caml_profile];
}
else {
/* If invoked from terminal we need to bring the app to the front */
[NSApp activateIgnoringOtherApps:YES];
/* Bring up the dialog to choose a profile */
[self chooseProfiles];
}
}
/* from http://developer.apple.com/documentation/Security/Conceptual/authorization_concepts/index.html */
#include
#include
- (IBAction)installCommandLineTool:(id)sender
{
/* Install the command-line tool in /usr/bin/unison.
Requires root privilege, so we ask for it and pass the task off to /bin/sh. */
OSStatus myStatus;
AuthorizationFlags myFlags = kAuthorizationFlagDefaults;
AuthorizationRef myAuthorizationRef;
myStatus = AuthorizationCreate(NULL, kAuthorizationEmptyEnvironment,
myFlags, &myAuthorizationRef);
if (myStatus != errAuthorizationSuccess) return;
{
AuthorizationItem myItems = {kAuthorizationRightExecute, 0,
NULL, 0};
AuthorizationRights myRights = {1, &myItems};
myFlags = kAuthorizationFlagDefaults |
kAuthorizationFlagInteractionAllowed |
kAuthorizationFlagPreAuthorize |
kAuthorizationFlagExtendRights;
myStatus =
AuthorizationCopyRights(myAuthorizationRef,&myRights,NULL,myFlags,NULL);
}
if (myStatus == errAuthorizationSuccess) {
NSBundle *bundle = [NSBundle mainBundle];
NSString *bundle_path = [bundle bundlePath];
NSString *exec_path =
[bundle_path stringByAppendingString:@"/Contents/MacOS/cltool"];
// Not sure why but this doesn't work:
// [bundle pathForResource:@"cltool" ofType:nil];
if (exec_path == nil) return;
char *args[] = { "-f", (char *)[exec_path cString], "/usr/bin/unison", NULL };
myFlags = kAuthorizationFlagDefaults;
myStatus = AuthorizationExecuteWithPrivileges
(myAuthorizationRef, "/bin/cp", myFlags, args,
NULL);
}
AuthorizationFree (myAuthorizationRef, kAuthorizationFlagDefaults);
/*
if (myStatus == errAuthorizationCanceled)
NSLog(@"The attempt was canceled\n");
else if (myStatus) NSLog(@"There was an authorization error: %ld\n", myStatus);
*/
}
@end
unison-2.40.102/uimac/ReconItem.m 0000644 0061316 0061316 00000007242 11361646373 016555 0 ustar bcpierce bcpierce #import "ReconItem.h"
#include
#include
extern value Callback_checkexn(value,value);
@implementation ReconItem
-(void)dealloc
{
ri = Val_unit;
caml_remove_global_root(&ri);
[super dealloc];
}
- (void)setRi:(value)v
{
caml_register_global_root(&ri); // needed in case of ocaml garbage collection
ri = v;
}
+ (id)initWithRi:(value)v
{
ReconItem *r = [[ReconItem alloc] init];
[r setRi:v];
return r;
}
- (NSString *)path
{
if (path) return path;
value *f = caml_named_value("unisonRiToPath");
[path release];
path = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))];
[path retain];
return path;
}
- (NSString *)left
{
if (left) return left;
value *f = caml_named_value("unisonRiToLeft");
[left release];
left = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))];
[left retain];
return left;
}
- (NSString *)right
{
if (right) return right;
value *f = caml_named_value("unisonRiToRight");
[right release];
right = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))];
[right retain];
return right;
}
- (NSString *)direction
{
if (direction) return direction;
value *f = caml_named_value("unisonRiToDirection");
value v = Callback_checkexn(*f, ri);
char *s = String_val(v);
[direction release];
direction = [NSString stringWithCString:s];
[direction retain];
return direction;
}
- (void)setDirection:(char *)d
{
[direction release];
direction = nil;
value *f = caml_named_value(d);
Callback_checkexn(*f, ri);
}
- (void)doAction:(unichar)action
{
switch (action) {
case '>':
[self setDirection:"unisonRiSetRight"];
break;
case '<':
[self setDirection:"unisonRiSetLeft"];
break;
case '/':
[self setDirection:"unisonRiSetConflict"];
break;
case '-':
[self setDirection:"unisonRiForceOlder"];
break;
case '+':
[self setDirection:"unisonRiForceNewer"];
break;
case 'm':
[self setDirection:"unisonRiSetMerge"];
break;
default:
NSLog(@"ReconItem.doAction : unknown action");
break;
}
}
- (void)doIgnore:(unichar)action
{
value *f;
switch (action) {
case 'I':
f = caml_named_value("unisonIgnorePath");
Callback_checkexn(*f, ri);
break;
case 'E':
f = caml_named_value("unisonIgnoreExt");
Callback_checkexn(*f, ri);
break;
case 'N':
f = caml_named_value("unisonIgnoreName");
Callback_checkexn(*f, ri);
break;
default:
NSLog(@"ReconItem.doIgnore : unknown ignore");
break;
}
}
- (NSString *)progress
{
if (progress) return progress;
value *f = caml_named_value("unisonRiToProgress");
progress = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))];
[progress retain];
return progress;
}
- (void)resetProgress
{
// Get rid of the memoized progress because we expect it to change
[progress release];
progress = nil;
}
- (NSString *)details
{
if (details) return details;
value *f = caml_named_value("unisonRiToDetails");
details = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))];
[details retain];
return details;
}
- (BOOL)isConflict
{
value *f = caml_named_value("unisonRiIsConflict");
if (Callback_checkexn(*f, ri) == Val_true) return YES;
else return NO;
}
- (void)revertDirection
{
value *f = caml_named_value("unisonRiRevert");
Callback_checkexn(*f, ri);
[direction release];
direction = nil;
}
@end
unison-2.40.102/uimac/main.m 0000644 0061316 0061316 00000005737 11361646373 015623 0 ustar bcpierce bcpierce //
// main.m
// uimac
//
// Created by Trevor Jim on Sun Aug 17 2003.
// Copyright (c) 2003, see file COPYING for details.
//
#import
#define CAML_NAME_SPACE
#include
void reportExn(value e) {
value *f = caml_named_value("unisonExnInfo");
char *m = String_val(caml_callback(*f,Extract_exception(e)));
NSString *s = [NSString stringWithFormat:@"Uncaught exception: %s", m];
NSLog(@"%@",s);
NSRunAlertPanel(@"Fatal error",s,@"Exit",nil,nil);
}
value Callback_checkexn(value c,value v) {
value e = caml_callback_exn(c,v);
if (!Is_exception_result(e)) return e;
reportExn(e);
exit(1);
}
value Callback2_checkexn(value c,value v1,value v2) {
value e = caml_callback2_exn(c,v1,v2);
if (!Is_exception_result(e)) return e;
reportExn(e);
exit(1);
}
value Callback3_checkexn(value c,value v1,value v2,value v3) {
value e = caml_callback3_exn(c,v1,v2,v3);
if (!Is_exception_result(e)) return e;
reportExn(e);
exit(1);
}
int main(int argc, const char *argv[])
{
int i;
/* When you click-start or use the open command, the program is invoked with
a command-line arg of the form -psn_XXXXXXXXX. The XXXXXXXX is a "process
serial number" and it seems to be important for Carbon programs. We need
to get rid of it if it's there so the ocaml code won't exit. Note, the
extra arg is not added if the binary is invoked directly from the command
line without using the open command. */
if (argc == 2 && strncmp(argv[1],"-psn_",5) == 0) {
argc--;
argv[1] = NULL;
}
/* Initialize ocaml gc, etc. */
caml_startup((char **)argv); // cast to avoid warning, caml_startup assumes non-const,
// NSApplicationMain assumes const
/* Check for invocations that don't start up the gui */
for (i=1; i
#define CAML_NAME_SPACE
#include
#import "ProfileController.h"
#import "PreferencesController.h"
#import "ReconTableView.h"
@interface MyController : NSObject
{
IBOutlet NSWindow *mainWindow;
IBOutlet ProfileController *profileController;
IBOutlet NSView *chooseProfileView;
NSSize chooseProfileSize;
IBOutlet PreferencesController *preferencesController;
IBOutlet NSView *preferencesView;
NSSize preferencesSize;
IBOutlet NSView *updatesView;
NSSize updatesSize;
IBOutlet NSView *ConnectingView;
NSSize ConnectingSize;
IBOutlet ReconTableView *tableView;
IBOutlet NSTextField *updatesText;
IBOutlet NSWindow *passwordWindow;
IBOutlet NSTextField *passwordText;
IBOutlet NSTextView *detailsTextView;
IBOutlet NSTextField *statusText;
IBOutlet NSButton *passwordCancelButton;
IBOutlet NSWindow *aboutWindow;
IBOutlet NSTextField *versionText;
NSView *blankView;
value caml_reconItems;
NSMutableArray *reconItems;
value preconn;
NSString *pName;
}
- (IBAction)createButton:(id)sender;
- (IBAction)saveProfileButton:(id)sender;
- (IBAction)cancelProfileButton:(id)sender;
- (IBAction)openButton:(id)sender;
- (IBAction)restartButton:(id)sender;
- (IBAction)syncButton:(id)sender;
- (IBAction)onlineHelp:(id)sender;
- (int)numberOfRowsInTableView:(NSTableView *)aTableView;
- (id)tableView:(NSTableView *)aTableView
objectValueForTableColumn:(NSTableColumn *)aTableColumn
row:(int)rowIndex;
- (void)raisePasswordWindow:(NSString *)prompt;
- (IBAction)raiseAboutWindow:(id)sender;
- (void)controlTextDidEndEditing:(NSNotification *)notification;
- (IBAction)endPasswordWindow:(id)sender;
- (NSMutableArray *)reconItems;
- (int)updateForIgnore:(int)i;
- (void)displayDetails:(int)i;
- (IBAction)installCommandLineTool:(id)sender;
@end
unison-2.40.102/fileutil.mli 0000644 0061316 0061316 00000000450 11361646373 015726 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/fileutil.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
(* Convert backslashes in a string to forward slashes. Useful in Windows. *)
val backslashes2forwardslashes : string -> string
val removeTrailingSlashes : string -> string
unison-2.40.102/uimacbridgenew.ml 0000644 0061316 0061316 00000063401 11361646373 016732 0 ustar bcpierce bcpierce (* ML side of a bridge to C for the Mac GUI *)
open Common;;
open Lwt;;
let debug = Trace.debug "startup"
let unisonNonGuiStartup() = begin
(* If there's no GUI, don't print progress in the GUI *)
Uutil.setProgressPrinter (fun _ _ _ -> ());
Main.nonGuiStartup() (* If this returns the GUI should be started *)
end;;
Callback.register "unisonNonGuiStartup" unisonNonGuiStartup;;
type stateItem = { mutable ri : reconItem;
mutable bytesTransferred : Uutil.Filesize.t;
mutable bytesToTransfer : Uutil.Filesize.t;
mutable whatHappened : Util.confirmation option;
mutable statusMessage : string option };;
let theState = ref [| |];;
let unisonDirectory() = System.fspathToString Os.unisonDir
;;
Callback.register "unisonDirectory" unisonDirectory;;
(* Global progress indicator, similar to uigtk2.m; *)
external displayGlobalProgress : float -> unit = "displayGlobalProgress";;
let totalBytesToTransfer = ref Uutil.Filesize.zero;;
let totalBytesTransferred = ref Uutil.Filesize.zero;;
let lastFrac = ref 0.;;
let showGlobalProgress b =
(* Concatenate the new message *)
totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b;
let v =
if !totalBytesToTransfer = Uutil.Filesize.dummy then 0.
else if !totalBytesToTransfer = Uutil.Filesize.zero then 100.
else (Uutil.Filesize.percentageOfTotalSize
!totalBytesTransferred !totalBytesToTransfer)
in
if v = 0. || abs_float (v -. !lastFrac) > 1. then begin
lastFrac := v;
displayGlobalProgress v
end;;
let initGlobalProgress b =
totalBytesToTransfer := b;
totalBytesTransferred := Uutil.Filesize.zero;
displayGlobalProgress 0.;;
(* Defined in Bridge.m, used to redisplay the table
when the status for a row changes *)
external bridgeThreadWait : int -> unit = "bridgeThreadWait";;
(* Defined in MyController.m, used to redisplay the table
when the status for a row changes *)
external displayStatus : string -> unit = "displayStatus";;
let displayStatus s = displayStatus (Unicode.protect s);;
(*
Called to create callback threads which wait on the C side for callbacks.
(We create three just for good measure...)
FIXME: the thread created by Thread.create doesn't run even if we yield --
we have to join. At that point we actually do get a different pthread, but
we've caused the calling thread to block (forever). As a result, this call
never returns.
*)
let callbackThreadCreate() =
let tCode () =
bridgeThreadWait 1;
in ignore (Thread.create tCode ()); ignore (Thread.create tCode ());
let tid = Thread.create tCode ()
in Thread.join tid;
;;
Callback.register "callbackThreadCreate" callbackThreadCreate;;
(* Defined in MyController.m; display the error message and exit *)
external displayFatalError : string -> unit = "fatalError";;
let fatalError message =
Trace.log (message ^ "\n");
displayFatalError message
let doInOtherThread f =
Thread.create
(fun () ->
try
f ()
with
Util.Transient s | Util.Fatal s -> fatalError s
| exn -> fatalError (Uicommon.exn2string exn))
()
(* Defined in MyController.m, used to redisplay the table
when the status for a row changes *)
external reloadTable : int -> unit = "reloadTable";;
(* from uigtk2 *)
let showProgress i bytes dbg =
(* Trace.status "showProgress"; *)
let i = Uutil.File.toLine i in
let item = !theState.(i) in
item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes;
let b = item.bytesTransferred in
let len = item.bytesToTransfer in
let newstatus =
if b = Uutil.Filesize.zero || len = Uutil.Filesize.zero then "start "
else if len = Uutil.Filesize.zero then
Printf.sprintf "%5s " (Uutil.Filesize.toString b)
else Util.percent2string (Uutil.Filesize.percentageOfTotalSize b len) in
let oldstatus = item.statusMessage in
item.statusMessage <- Some newstatus;
showGlobalProgress bytes;
(* FIX: No status window in Mac version, see GTK version for how to do it *)
if oldstatus <> Some newstatus then reloadTable i;;
let unisonGetVersion() = Uutil.myVersion
;;
Callback.register "unisonGetVersion" unisonGetVersion;;
(* snippets from Uicommon, duplicated for now *)
(* BCP: Duplicating this is a really bad idea!!! *)
(* First initialization sequence *)
(* Returns a string option: command line profile, if any *)
let unisonInit0() =
ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150});
(* Install an appropriate function for finding preference files. (We put
this in Util just because the Prefs module lives below the Os module in the
dependency hierarchy, so Prefs can't call Os directly.) *)
Util.supplyFileInUnisonDirFn
(fun n -> Os.fileInUnisonDir(n));
(* Display status in GUI instead of on stderr *)
let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in
Trace.messageDisplayer := displayStatus;
Trace.statusFormatter := formatStatus;
Trace.sendLogMsgsToStderr := false;
(* Display progress in GUI *)
Uutil.setProgressPrinter showProgress;
(* Initialise global progress so progress bar is not updated *)
initGlobalProgress Uutil.Filesize.dummy;
(* Make sure we have a directory for archives and profiles *)
Os.createUnisonDir();
(* Extract any command line profile or roots *)
let clprofile = ref None in
begin
try
let args = Prefs.scanCmdLine Uicommon.usageMsg in
match Util.StringMap.find "rest" args with
[] -> ()
| [profile] -> clprofile := Some profile
| [root2;root1] -> Globals.setRawRoots [root1;root2]
| [root2;root1;profile] ->
Globals.setRawRoots [root1;root2];
clprofile := Some profile
| _ ->
(Printf.eprintf
"%s was invoked incorrectly (too many roots)" Uutil.myName;
exit 1)
with Not_found -> ()
end;
(* Print header for debugging output *)
debug (fun() ->
Printf.eprintf "%s, version %s\n\n" Uutil.myName Uutil.myVersion);
debug (fun() -> Util.msg "initializing UI");
debug (fun () ->
(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
[] -> Util.msg "No roots given on command line"
| [root1;root2] ->
Printf.eprintf "Roots '%s' and '%s' given on command line"
root1 root2
| _ -> assert false));
begin match !clprofile with
None -> ()
| Some n ->
let f = Prefs.profilePathname n in
if not(System.file_exists f)
then (Printf.eprintf "Profile %s does not exist"
(System.fspathToPrintString f);
exit 1)
end;
!clprofile
;;
Callback.register "unisonInit0" unisonInit0;;
(* The first time we load preferences, we also read the command line
arguments; if we re-load prefs (because the user selected a new profile)
we ignore the command line *)
let firstTime = ref(true)
(* After figuring out the profile name *)
let do_unisonInit1 profileName =
(* Load the profile and command-line arguments *)
(* Restore prefs to their default values, if necessary *)
if not !firstTime then Prefs.resetToDefaults();
(* Tell the preferences module the name of the profile *)
Prefs.profileName := Some(profileName);
(* If the profile does not exist, create an empty one (this should only
happen if the profile is 'default', since otherwise we will already
have checked that the named one exists). *)
if not(System.file_exists (Prefs.profilePathname profileName)) then
Prefs.addComment "Unison preferences file";
(* Load the profile *)
(Trace.debug "" (fun() -> Util.msg "about to load prefs");
Prefs.loadTheFile());
(* Parse the command line. This will temporarily override
settings from the profile. *)
if !firstTime then begin
Trace.debug "" (fun() -> Util.msg "about to parse command line");
Prefs.parseCmdLine Uicommon.usageMsg;
end;
firstTime := false;
(* Print the preference settings *)
Trace.debug "" (fun() -> Prefs.dumpPrefsToStderr() );
(* FIX: if no roots, ask the user *)
Recon.checkThatPreferredRootIsValid();
let localRoots,remoteRoots =
Safelist.partition
(function Clroot.ConnectLocal _ -> true | _ -> false)
(Safelist.map Clroot.parseRoot (Globals.rawRoots())) in
match remoteRoots with
[r] ->
(* FIX: tell the user the next step (contacting server) might
take a while *)
Remote.openConnectionStart r
| _::_::_ ->
raise(Util.Fatal "cannot synchronize more than one remote root");
| _ -> None
;;
external unisonInit1Complete : Remote.preconnection option -> unit = "unisonInit1Complete";;
(* Do this in another thread and return immedidately to free up main thread in cocoa *)
let unisonInit1 profileName =
doInOtherThread
(fun () ->
let r = do_unisonInit1 profileName in
unisonInit1Complete r)
;;
Callback.register "unisonInit1" unisonInit1;;
Callback.register "openConnectionPrompt" Remote.openConnectionPrompt;;
Callback.register "openConnectionReply" Remote.openConnectionReply;;
Callback.register "openConnectionEnd" Remote.openConnectionEnd;;
Callback.register "openConnectionCancel" Remote.openConnectionCancel;;
let commitUpdates () =
Trace.status "Updating synchronizer state";
let t = Trace.startTimer "Updating synchronizer state" in
Update.commitUpdates();
Trace.showTimer t
let do_unisonInit2 () =
(* Canonize the names of the roots and install them in Globals. *)
Globals.installRoots2();
(* If both roots are local, disable the xferhint table to save time *)
begin match Globals.roots() with
((Local,_),(Local,_)) -> Prefs.set Xferhint.xferbycopying false
| _ -> ()
end;
(* If no paths were specified, then synchronize the whole replicas *)
if Prefs.read Globals.paths = [] then Prefs.set Globals.paths [Path.empty];
(* Expand any "wildcard" paths [with final component *] *)
Globals.expandWildcardPaths();
Update.storeRootsName ();
Trace.debug ""
(fun() ->
Printf.eprintf "Roots: \n";
Safelist.iter (fun clr -> Printf.eprintf " %s\n" clr)
(Globals.rawRoots ());
Printf.eprintf " i.e. \n";
Safelist.iter (fun clr -> Printf.eprintf " %s\n"
(Clroot.clroot2string (Clroot.parseRoot clr)))
(Globals.rawRoots ());
Printf.eprintf " i.e. (in canonical order)\n";
Safelist.iter (fun r ->
Printf.eprintf " %s\n" (root2string r))
(Globals.rootsInCanonicalOrder());
Printf.eprintf "\n"
);
Lwt_unix.run
(Uicommon.validateAndFixupPrefs () >>=
Globals.propagatePrefs);
(* Initializes some backups stuff according to the preferences just loaded from the profile.
Important to do it here, after prefs are propagated, because the function will also be
run on the server, if any. Also, this should be done each time a profile is reloaded
on this side, that's why it's here. *)
Stasher.initBackups ();
(* Turn on GC messages, if the '-debug gc' flag was provided *)
if Trace.enabled "gc" then Gc.set {(Gc.get ()) with Gc.verbose = 0x3F};
(* BCPFIX: Should/can this be done earlier?? *)
Files.processCommitLogs();
(* from Uigtk2 *)
(* detect updates and reconcile *)
let _ = Globals.roots () in
let t = Trace.startTimer "Checking for updates" in
let findUpdates () =
Trace.status "Looking for changes";
let updates = Update.findUpdates () in
Trace.showTimer t;
updates in
let reconcile updates = Recon.reconcileAll updates in
let (reconItemList, thereAreEqualUpdates, dangerousPaths) =
reconcile (findUpdates ()) in
if not !Update.foundArchives then commitUpdates ();
if reconItemList = [] then
if thereAreEqualUpdates then begin
if !Update.foundArchives then commitUpdates ();
Trace.status
"Replicas have been changed only in identical ways since last sync"
end else
Trace.status "Everything is up to date"
else
Trace.status "Check and/or adjust selected actions; then press Go";
Trace.status (Printf.sprintf "There are %d reconitems" (Safelist.length reconItemList));
let stateItemList =
Safelist.map
(fun ri -> { ri = ri;
bytesTransferred = Uutil.Filesize.zero;
bytesToTransfer = Uutil.Filesize.zero;
whatHappened = None; statusMessage = None })
reconItemList in
theState := Array.of_list stateItemList;
if dangerousPaths <> [] then begin
Prefs.set Globals.batch false;
Util.warn (Uicommon.dangerousPathMsg dangerousPaths)
end;
!theState
;;
external unisonInit2Complete : stateItem array -> unit = "unisonInit2Complete";;
(* Do this in another thread and return immedidately to free up main thread in cocoa *)
let unisonInit2 () =
doInOtherThread
(fun () ->
let r = do_unisonInit2 () in
unisonInit2Complete r)
;;
Callback.register "unisonInit2" unisonInit2;;
let unisonRiToDetails ri =
Unicode.protect
(match ri.whatHappened with
Some (Util.Failed s) ->
Path.toString ri.ri.path1 ^ "\n" ^ s
| _ ->
Path.toString ri.ri.path1 ^ "\n" ^
Uicommon.details2string ri.ri " ");;
Callback.register "unisonRiToDetails" unisonRiToDetails;;
let unisonRiToPath ri = Unicode.protect (Path.toString ri.ri.path1);;
Callback.register "unisonRiToPath" unisonRiToPath;;
let rcToString rc =
match rc.status with
`Deleted -> "Deleted"
| `Modified -> "Modified"
| `PropsChanged -> "PropsChanged"
| `Created -> "Created"
| `Unchanged -> "";;
let unisonRiToLeft ri =
match ri.ri.replicas with
Problem _ -> ""
| Different {rc1 = rc} -> rcToString rc;;
Callback.register "unisonRiToLeft" unisonRiToLeft;;
let unisonRiToRight ri =
match ri.ri.replicas with
Problem _ -> ""
| Different {rc2 = rc} -> rcToString rc;;
Callback.register "unisonRiToRight" unisonRiToRight;;
let unisonRiToFileSize ri =
Uutil.Filesize.toFloat (riLength ri.ri);;
Callback.register "unisonRiToFileSize" unisonRiToFileSize;;
let unisonRiToFileType ri =
riFileType ri.ri;;
Callback.register "unisonRiToFileType" unisonRiToFileType;;
let direction2niceString = function (* from Uicommon where it's not exported *)
Conflict -> "<-?->"
| Replica1ToReplica2 -> "---->"
| Replica2ToReplica1 -> "<----"
| Merge -> "<-M->"
let unisonRiToDirection ri =
match ri.ri.replicas with
Problem _ -> "XXXXX"
| Different diff -> direction2niceString diff.direction;;
Callback.register "unisonRiToDirection" unisonRiToDirection;;
let unisonRiSetLeft ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Replica2ToReplica1;;
Callback.register "unisonRiSetLeft" unisonRiSetLeft;;
let unisonRiSetRight ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Replica1ToReplica2;;
Callback.register "unisonRiSetRight" unisonRiSetRight;;
let unisonRiSetConflict ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Conflict;;
Callback.register "unisonRiSetConflict" unisonRiSetConflict;;
let unisonRiSetMerge ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Merge;;
Callback.register "unisonRiSetMerge" unisonRiSetMerge;;
let unisonRiForceOlder ri =
Recon.setDirection ri.ri `Older `Force;;
Callback.register "unisonRiForceOlder" unisonRiForceOlder;;
let unisonRiForceNewer ri =
Recon.setDirection ri.ri `Newer `Force;;
Callback.register "unisonRiForceNewer" unisonRiForceNewer;;
let unisonRiToProgress ri =
match (ri.statusMessage, ri.whatHappened,ri.ri.replicas) with
(None,None,_) -> ""
| (Some s,None,_) -> Unicode.protect s
| (_,_,Different {direction = Conflict}) -> ""
| (_,_,Problem _) -> ""
| (_,Some Util.Succeeded,_) -> "done"
| (_,Some (Util.Failed s),_) -> "FAILED";;
Callback.register "unisonRiToProgress" unisonRiToProgress;;
let unisonRiToBytesTransferred ri =
Uutil.Filesize.toFloat ri.bytesTransferred;;
Callback.register "unisonRiToBytesTransferred" unisonRiToBytesTransferred;;
(* --------------------------------------------------- *)
(* Defined in MyController.m, used to show diffs *)
external displayDiff : string -> string -> unit = "displayDiff";;
external displayDiffErr : string -> unit = "displayDiffErr";;
let displayDiff title text =
displayDiff (Unicode.protect title) (Unicode.protect text);;
let displayDiffErr err = displayDiffErr (Unicode.protect err)
(* If only properties have changed, we can't diff or merge.
'Can't diff' is produced (uicommon.ml) if diff is attemped
when either side has PropsChanged *)
let filesAreDifferent status1 status2 =
match status1, status2 with
`PropsChanged, `Unchanged -> false
| `Unchanged, `PropsChanged -> false
| `PropsChanged, `PropsChanged -> false
| _, _ -> true;;
(* check precondition for diff; used to disable diff button *)
let canDiff ri =
match ri.ri.replicas with
Problem _ -> false
| Different {rc1 = {typ = `FILE; status = status1};
rc2 = {typ = `FILE; status = status2}} ->
filesAreDifferent status1 status2
| Different _ -> false;;
Callback.register "canDiff" canDiff;;
(* from Uicommon *)
(* precondition: uc = File (Updates(_, ..) on both sides *)
let showDiffs ri printer errprinter id =
match ri.replicas with
Problem _ ->
errprinter
"Can't diff files: there was a problem during update detection"
| Different
{rc1 = {typ = `FILE; status = status1; ui = ui1};
rc2 = {typ = `FILE; status = status2; ui = ui2}} ->
if filesAreDifferent status1 status2 then
(let (root1,root2) = Globals.roots() in
begin
try Files.diff root1 ri.path1 ui1 root2 ri.path2 ui2 printer id
with Util.Transient e -> errprinter e
end)
| Different _ ->
errprinter "Can't diff: path doesn't refer to a file in both replicas"
let runShowDiffs ri i =
let file = Uutil.File.ofLine i in
showDiffs ri.ri displayDiff displayDiffErr file;;
Callback.register "runShowDiffs" runShowDiffs;;
(* --------------------------------------------------- *)
let do_unisonSynchronize () =
if Array.length !theState = 0 then
Trace.status "Nothing to synchronize"
else begin
Trace.status "Propagating changes";
Transport.logStart ();
let totalLength =
Array.fold_left
(fun l si ->
si.bytesTransferred <- Uutil.Filesize.zero;
let len =
if si.whatHappened = None then Common.riLength si.ri else
Uutil.Filesize.zero
in
si.bytesToTransfer <- len;
Uutil.Filesize.add l len)
Uutil.Filesize.zero !theState in
initGlobalProgress totalLength;
let t = Trace.startTimer "Propagating changes" in
let im = Array.length !theState in
let rec loop i actions pRiThisRound =
if i < im then begin
let theSI = !theState.(i) in
let action =
match theSI.whatHappened with
None ->
if not (pRiThisRound theSI.ri) then
return ()
else
catch (fun () ->
Transport.transportItem
theSI.ri (Uutil.File.ofLine i)
(fun title text ->
debug (fun () -> Util.msg "MERGE '%s': '%s'"
title text);
displayDiff title text; true)
>>= (fun () ->
return Util.Succeeded))
(fun e ->
match e with
Util.Transient s ->
return (Util.Failed s)
| _ ->
fail e)
>>= (fun res ->
let rem =
Uutil.Filesize.sub
theSI.bytesToTransfer theSI.bytesTransferred
in
if rem <> Uutil.Filesize.zero then
showProgress (Uutil.File.ofLine i) rem "done";
theSI.whatHappened <- Some res;
return ())
| Some _ ->
return () (* Already processed this one (e.g. merged it) *)
in
loop (i + 1) (action :: actions) pRiThisRound
end else
return actions
in
Lwt_unix.run
(loop 0 [] (fun ri -> not (Common.isDeletion ri)) >>= (fun actions ->
Lwt_util.join actions));
Lwt_unix.run
(loop 0 [] Common.isDeletion >>= (fun actions ->
Lwt_util.join actions));
Transport.logFinish ();
Trace.showTimer t;
commitUpdates ();
let failures =
let count =
Array.fold_left
(fun l si ->
l + (match si.whatHappened with Some(Util.Failed(_)) -> 1 | _ -> 0))
0 !theState in
if count = 0 then [] else
[Printf.sprintf "%d failure%s" count (if count=1 then "" else "s")] in
let partials =
let count =
Array.fold_left
(fun l si ->
l + match si.whatHappened with
Some Util.Succeeded
when partiallyProblematic si.ri &&
not (problematic si.ri) ->
1
| _ ->
0)
0 !theState in
if count = 0 then [] else
[Printf.sprintf "%d partially transferred" count] in
let skipped =
let count =
Array.fold_left
(fun l si ->
l + (if problematic si.ri then 1 else 0))
0 !theState in
if count = 0 then [] else
[Printf.sprintf "%d skipped" count] in
Trace.status
(Printf.sprintf "Synchronization complete %s"
(String.concat ", " (failures @ partials @ skipped)));
initGlobalProgress Uutil.Filesize.dummy;
end;;
external syncComplete : unit -> unit = "syncComplete";;
(* Do this in another thread and return immedidately to free up main thread in cocoa *)
let unisonSynchronize () =
doInOtherThread
(fun () ->
do_unisonSynchronize ();
syncComplete ())
;;
Callback.register "unisonSynchronize" unisonSynchronize;;
let unisonIgnorePath pathString =
Uicommon.addIgnorePattern (Uicommon.ignorePath (Path.fromString pathString));;
let unisonIgnoreExt pathString =
Uicommon.addIgnorePattern (Uicommon.ignoreExt (Path.fromString pathString));;
let unisonIgnoreName pathString =
Uicommon.addIgnorePattern (Uicommon.ignoreName (Path.fromString pathString));;
Callback.register "unisonIgnorePath" unisonIgnorePath;;
Callback.register "unisonIgnoreExt" unisonIgnoreExt;;
Callback.register "unisonIgnoreName" unisonIgnoreName;;
(* Update the state to take into account ignore patterns.
Return the new index of the first state item that is
not ignored starting at old index i.
*)
let unisonUpdateForIgnore i =
let l = ref [] in
let num = ref(-1) in
let newI = ref None in
(* FIX: we should actually test whether any prefix is now ignored *)
let keep s = not (Globals.shouldIgnore s.ri.path1) in
for j = 0 to (Array.length !theState - 1) do
let s = !theState.(j) in
if keep s then begin
l := s :: !l;
num := !num + 1;
if (j>=i && !newI=None) then newI := Some !num
end
done;
theState := Array.of_list (Safelist.rev !l);
match !newI with None -> (Array.length !theState - 1)
| Some i' -> i';;
Callback.register "unisonUpdateForIgnore" unisonUpdateForIgnore;;
let unisonState () = !theState;;
Callback.register "unisonState" unisonState;;
(* from Uicommon *)
let roots2niceStrings length = function
(Local,fspath1), (Local,fspath2) ->
let name1, name2 = Fspath.differentSuffix fspath1 fspath2 in
(Util.truncateString name1 length, Util.truncateString name2 length)
| (Local,fspath1), (Remote host, fspath2) ->
(Util.truncateString "local" length, Util.truncateString host length)
| (Remote host, fspath1), (Local,fspath2) ->
(Util.truncateString host length, Util.truncateString "local" length)
| _ -> assert false (* BOGUS? *);;
let unisonFirstRootString() =
let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in
Unicode.protect replica1;;
let unisonSecondRootString() =
let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in
Unicode.protect replica2;;
Callback.register "unisonFirstRootString" unisonFirstRootString;;
Callback.register "unisonSecondRootString" unisonSecondRootString;;
(* Note, this returns whether the files conflict, NOT whether
the current setting is Conflict *)
let unisonRiIsConflict ri =
match ri.ri.replicas with
| Different {default_direction = Conflict} -> true
| _ -> false;;
Callback.register "unisonRiIsConflict" unisonRiIsConflict;;
(* Test whether reconItem's current state is different from
Unison's recommendation. Used to colour arrows in
the reconItems table *)
let changedFromDefault ri =
match ri.ri.replicas with
Different diff -> diff.direction <> diff.default_direction
| _ -> false;;
Callback.register "changedFromDefault" changedFromDefault;;
let unisonRiRevert ri =
match ri.ri.replicas with
| Different diff -> diff.direction <- diff.default_direction
| _ -> ();;
Callback.register "unisonRiRevert" unisonRiRevert;;
let unisonProfileInit (profileName:string) (r1:string) (r2:string) =
Prefs.resetToDefaults();
Prefs.profileName := Some(profileName);
Prefs.addComment "Unison preferences file"; (* Creates the file, assumes it doesn't exist *)
ignore (Prefs.add "root" r1);
ignore (Prefs.add "root" r2);;
Callback.register "unisonProfileInit" unisonProfileInit;;
Callback.register "unisonPasswordMsg" Terminal.password;;
Callback.register "unisonPassphraseMsg" Terminal.passphrase;;
Callback.register "unisonAuthenticityMsg" Terminal.authenticity;;
let unisonExnInfo e =
match e with
Util.Fatal s -> Printf.sprintf "Fatal error: %s" s
| Invalid_argument s -> Printf.sprintf "Invalid argument: %s" s
| Unix.Unix_error(ue,s1,s2) ->
Printf.sprintf "Unix error(%s,%s,%s)" (Unix.error_message ue) s1 s2
| _ -> Printexc.to_string e;;
Callback.register "unisonExnInfo"
(fun e -> Unicode.protect (unisonExnInfo e));;
unison-2.40.102/transfer.ml 0000644 0061316 0061316 00000067026 11361646373 015600 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/transfer.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* rsync compression algorithm
To compress, we use a compression buffer with a size a lot
greater than the size of a block, typically half a megabyte. This
buffer is loaded with the file contents. Its valid part is
represented by its limit 'length'.
We scan the file contents by sliding a window with the size of a
block over the compression buffer. This window is represented by
its 'offset' and its size 'blockSize'.
We transmit STRING tokens, containing the differences between the
files, and BLOCK tokens, containing the number of a block from the
old file found in the new one. The data not transmitted yet are
pointed by 'toBeSent'.
For each position of the window, we compute the checksum of the
block it contains and try to find a matching entry in the hashed
block information data. If there is a match, we compute the
fingerprint of our block to match it with the candidates'
fingerprints :
- if there is a match, we've just hit, we can transmit the data not
sent yet as a STRING token and emit a BLOCK token representing our
match, then we slide the window one block ahead and try again;
- in any other case, we've missed, we just slide the window one
character ahead and try again.
If the file size is greater than the compression buffer size,
then we have to update the compression buffer when the window
reaches its limit. We do so by sending any data not sent yet, then
copying the end of the buffer at its beginning and filling it up
with the file contents coming next. We now place our window at the
beginning of the buffer and we continue the process.
The compression is over when we reach the end of the file. We
just have to send the data not sent yet together with the last
characters that could not fill a block. *)
let debug = Trace.debug "transfer"
let debugV = Trace.debug "transfer+"
let debugToken = Trace.debug "rsynctoken"
let debugLog = Trace.debug "rsynclog"
open Lwt
type transfer_instruction = Bytearray.t * int * int
type transmitter = transfer_instruction -> unit Lwt.t
(*************************************************************************)
(* BUFFERED DISK I/O *)
(*************************************************************************)
let reallyRead infd buffer pos length =
let rec read pos length =
let n = input infd buffer pos length in
if n = length || n = 0 then pos + n else
read (pos + n) (length - n)
in
read pos length - pos
let rec reallyWrite outfd buffer pos length =
output outfd buffer pos length
(*************************************************************************)
(* TOKEN QUEUE *)
(*************************************************************************)
(* There are two goals:
1) to merge consecutive compatible tokens (catenating STRING tokens
and combining BLOCK tokens when the referenced blocks are
consecutive)
2) to delay the transmission of the tokens across the network until
their total size is greater than a limit, not to make a costly
RPC for each token (therefore, the rsync module uses memory up to
(2 * comprBufSize + tokenQueueLimit) bytes at a time) *)
type token =
| STRING of string * int * int
| BLOCK of int
| EOF
(* Size of a block *)
let minBlockSize = 700
(* This should at most 65535+3 bytes, as we are using this size to
ensure that string token lengths will fit in 2 bytes. *)
let queueSize = 65500
let queueSizeFS = Uutil.Filesize.ofInt queueSize
type tokenQueue =
{ mutable data : Bytearray.t; (* the queued tokens *)
mutable previous : [`Str of int | `Block of int | `None];
(* some informations about the
previous token *)
mutable pos : int; (* head of the queue *)
mutable prog : int; (* the size of the data they represent *)
mutable bSize : int } (* block size *)
let encodeInt3 s pos i =
assert (i >= 0 && i < 256 * 256 * 256);
s.{pos + 0} <- Char.chr ((i lsr 0) land 0xff);
s.{pos + 1} <- Char.chr ((i lsr 8) land 0xff);
s.{pos + 2} <- Char.chr ((i lsr 16) land 0xff)
let decodeInt3 s pos =
(Char.code s.{pos + 0} lsl 0) lor
(Char.code s.{pos + 1} lsl 8) lor
(Char.code s.{pos + 2} lsl 16)
let encodeInt2 s pos i =
assert (i >= 0 && i < 65536);
s.{pos + 0} <- Char.chr ((i lsr 0) land 0xff);
s.{pos + 1} <- Char.chr ((i lsr 8) land 0xff)
let decodeInt2 s pos =
(Char.code s.{pos + 0} lsl 0) lor (Char.code s.{pos + 1} lsl 8)
let encodeInt1 s pos i =
assert (i >= 0 && i < 256);
s.{pos + 0} <- Char.chr i
let decodeInt1 s pos =
Char.code s.{pos + 0}
(* Transmit the contents of the tokenQueue *)
let flushQueue q showProgress transmit cond =
if cond && q.pos > 0 then begin
debugToken (fun() -> Util.msg "flushing the token queue\n");
transmit (q.data, 0, q.pos) >>= (fun () ->
showProgress q.prog;
q.pos <- 0; q.prog <- 0; q.previous <- `None;
return ())
end else
return ()
let pushEOF q showProgress transmit =
flushQueue q showProgress transmit
(q.pos + 1 > queueSize) >>= (fun () ->
q.data.{q.pos} <- 'E';
q.pos <- q.pos + 1;
q.previous <- `None;
return ())
let rec pushString q id transmit s pos len =
flushQueue q id transmit (q.pos + len + 3 > queueSize) >>= fun () ->
let l = min len (queueSize - q.pos - 3) in
q.data.{q.pos} <- 'S';
encodeInt2 q.data (q.pos + 1) l;
Bytearray.blit_from_string s pos q.data (q.pos + 3) l;
q.pos <- q.pos + l + 3;
q.prog <- q.prog + l;
q.previous <- `Str l;
if l < len then
pushString q id transmit s (pos + l) (len - l)
else
return ()
let growString q id transmit len' s pos len =
let l = min (queueSize - q.pos) len in
Bytearray.blit_from_string s pos q.data q.pos l;
assert (q.data.{q.pos - len' - 3} = 'S');
assert (decodeInt2 q.data (q.pos - len' - 2) = len');
let len'' = len' + l in
encodeInt2 q.data (q.pos - len' - 2) len'';
q.pos <- q.pos + l;
q.prog <- q.prog + l;
q.previous <- `Str len'';
if l < len then
pushString q id transmit s (pos + l) (len - l)
else
return ()
let pushBlock q id transmit pos =
flushQueue q id transmit (q.pos + 5 > queueSize) >>= (fun () ->
q.data.{q.pos} <- 'B';
encodeInt3 q.data (q.pos + 1) pos;
encodeInt1 q.data (q.pos + 4) 1;
q.pos <- q.pos + 5;
q.prog <- q.prog + q.bSize;
q.previous <- `Block (pos + 1);
return ())
let growBlock q id transmit pos =
let count = decodeInt1 q.data (q.pos - 1) in
assert (q.data.{q.pos - 5} = 'B');
assert (decodeInt3 q.data (q.pos - 4) + count = pos);
assert (count < 255);
encodeInt1 q.data (q.pos - 1) (count + 1);
q.prog <- q.prog + q.bSize;
q.previous <- if count = 254 then `None else `Block (pos + 1);
return ()
(* Queue a new token, possibly merging it with a previous compatible
token and flushing the queue if its size becomes greater than the
limit *)
let queueToken q id transmit token =
match token, q.previous with
EOF, _ ->
pushEOF q id transmit
| STRING (s, pos, len), `Str len' ->
growString q id transmit len' s pos len
| STRING (s, pos, len), _ ->
pushString q id transmit s pos len
| BLOCK pos, `Block pos' when pos = pos' ->
growBlock q id transmit pos
| BLOCK pos, _ ->
pushBlock q id transmit pos
let makeQueue blockSize =
{ data =
(* We need to make sure here that the size of the queue is not
larger than 65538
(1 byte: header, 2 bytes: string size, 65535 bytes: string) *)
Bytearray.create queueSize;
pos = 0; previous = `None; prog = 0;
bSize = blockSize }
(*************************************************************************)
(* GENERIC TRANSMISSION *)
(*************************************************************************)
let debug = Trace.debug "generic"
(* Slice the file into STRING tokens that are transmitted incrementally *)
let send infd length showProgress transmit =
debug (fun() -> Util.msg "sending file\n");
let timer = Trace.startTimer "Sending file using generic transmission" in
let bufSz = 8192 in
let bufSzFS = Uutil.Filesize.ofInt 8192 in
let buf = String.create bufSz in
let q = makeQueue 0 in
let rec sendSlice length =
let count =
reallyRead infd buf 0
(if length > bufSzFS then bufSz else Uutil.Filesize.toInt length) in
queueToken q showProgress transmit (STRING (buf, 0, count)) >>= (fun () ->
let length = Uutil.Filesize.sub length (Uutil.Filesize.ofInt count) in
if count = bufSz && length > Uutil.Filesize.zero then
sendSlice length
else
return ())
in
sendSlice length >>= (fun () ->
queueToken q showProgress transmit EOF >>= (fun () ->
flushQueue q showProgress transmit true >>= (fun () ->
Trace.showTimer timer;
return ())))
let rec receiveRec outfd showProgress data pos maxPos =
if pos = maxPos then false else
match data.{pos} with
'S' ->
let length = decodeInt2 data (pos + 1) in
if Trace.enabled "generic" then debug (fun() -> Util.msg
"receiving %d bytes\n" length);
reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length;
showProgress length;
receiveRec outfd showProgress data (pos + length + 3) maxPos
| 'E' ->
true
| _ ->
assert false
let receive outfd showProgress (data, pos, len) =
receiveRec outfd showProgress data pos (pos + len)
(*************************************************************************)
(* RSYNC TRANSMISSION *)
(*************************************************************************)
module Rsync =
struct
(* Debug messages *)
let debug = Trace.debug "rsync"
(**************************** DESTINATION HOST ***************************)
(* It is impossible to use rsync when the file size is smaller than
the size of a block *)
let minBlockSizeFs = Uutil.Filesize.ofInt minBlockSize
let aboveRsyncThreshold sz = sz > minBlockSizeFs
(* The type of the info that will be sent to the source host *)
type rsync_block_info =
{ blockSize : int;
blockCount : int;
checksumSize : int;
weakChecksum :
(int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t;
strongChecksum : Bytearray.t }
(*** PREPROCESS ***)
(* Worst case probability of a failure *)
let logProba = -27. (* One time in 100 millions *)
(* Strength of the weak checksum
(how many bit of the weak checksum we can rely on) *)
let weakLen = 27.
(* This is what rsync uses:
let logProba = -10.
let weakLen = 31.
This would save almost 3 bytes per block, but one need to be able
to recover from an rsync error.
(We would have to take into account that our weak checksum is
only 31 bits.)
*)
(* Block size *)
let computeBlockSize l = truncate (max 700. (min (sqrt l) 131072.))
(* Size of each strong checksum *)
let checksumSize bs sl dl =
let bits =
-. logProba -. weakLen +. log (sl *. dl /. float bs) /. log 2. in
max 2 (min 16 (truncate ((bits +. 7.99) /. 8.)))
let sizes srcLength dstLength =
let blockSize = computeBlockSize (Uutil.Filesize.toFloat dstLength) in
let blockCount =
let count =
Int64.div (Uutil.Filesize.toInt64 dstLength) (Int64.of_int blockSize)
in
Int64.to_int (min 16777216L count)
in
let csSize =
checksumSize blockSize
(Uutil.Filesize.toFloat srcLength)(Uutil.Filesize.toFloat dstLength)
in
(blockSize, blockCount, csSize)
(* Incrementally build arg by executing f on successive blocks (of size
'blockSize') of the input stream (pointed by 'infd').
The procedure uses a buffer of size 'bufferSize' to load the input,
and eventually handles the buffer update. *)
let blockIter infd f blockSize maxCount =
let bufferSize = 8192 + blockSize in
let buffer = String.create bufferSize in
let rec iter count offset length =
if count = maxCount then
count
else begin
let newOffset = offset + blockSize in
if newOffset <= length then begin
f count buffer offset;
iter (count + 1) newOffset length
end else if offset > 0 then begin
let chunkSize = length - offset in
String.blit buffer offset buffer 0 chunkSize;
iter count 0 chunkSize
end else begin
let l = input infd buffer length (bufferSize - length) in
if l = 0 then
count
else
iter count 0 (length + l)
end
end
in
iter 0 0 0
(* Given a block size, get blocks from the old file and compute a
checksum and a fingerprint for each one. *)
let rsyncPreprocess infd srcLength dstLength =
debug (fun() -> Util.msg "preprocessing\n");
let (blockSize, blockCount, csSize) = sizes srcLength dstLength in
debugLog (fun() ->
Util.msg "block size = %d bytes; block count = %d; \
strong checksum size = %d\n" blockSize blockCount csSize);
let timer = Trace.startTimer "Preprocessing old file" in
let weakCs =
Bigarray.Array1.create Bigarray.int32 Bigarray.c_layout blockCount in
let strongCs = Bytearray.create (blockCount * csSize) in
let addBlock i buf offset =
weakCs.{i} <- Int32.of_int (Checksum.substring buf offset blockSize);
Bytearray.blit_from_string
(Digest.substring buf offset blockSize) 0 strongCs (i * csSize) csSize
in
(* Make sure we are at the beginning of the file
(important for AppleDouble files *)
LargeFile.seek_in infd 0L;
let count =
(* Limit the number of blocks so that there is no overflow in
encodeInt3 *)
blockIter infd addBlock blockSize (min blockCount (256*256*256)) in
debugLog (fun() -> Util.msg "%d blocks\n" count);
Trace.showTimer timer;
({ blockSize = blockSize; blockCount = count; checksumSize = csSize;
weakChecksum = weakCs; strongChecksum = strongCs },
blockSize)
(* Expected size of the [rsync_block_info] datastructure (in KiB). *)
let memoryFootprint srcLength dstLength =
let (blockSize, blockCount, csSize) = sizes srcLength dstLength in
blockCount * (csSize + 4)
(*** DECOMPRESSION ***)
(* Decompression buffer size *)
let decomprBufSize = 8192
(* For each transfer instruction, either output a string or copy one or
several blocks from the old file. *)
let rsyncDecompress blockSize infd outfd showProgress (data, pos, len) =
let decomprBuf = String.create decomprBufSize in
let progress = ref 0 in
let rec copy length =
if length > decomprBufSize then begin
let _ = reallyRead infd decomprBuf 0 decomprBufSize in
reallyWrite outfd decomprBuf 0 decomprBufSize;
copy (length - decomprBufSize)
end else
let _ = reallyRead infd decomprBuf 0 length in
reallyWrite outfd decomprBuf 0 length
in
let copyBlocks n k =
LargeFile.seek_in infd (Int64.mul n (Int64.of_int blockSize));
let length = k * blockSize in
copy length;
progress := !progress + length
in
let maxPos = pos + len in
let rec decode pos =
if pos = maxPos then false else
match data.{pos} with
'S' ->
let length = decodeInt2 data (pos + 1) in
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "decompressing string (%d bytes)\n" length);
reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length;
progress := !progress + length;
decode (pos + length + 3)
| 'B' ->
let n = decodeInt3 data (pos + 1) in
let k = decodeInt1 data (pos + 4) in
if Trace.enabled "rsynctoken" then
debugToken (fun() -> Util.msg
"decompressing %d block(s) (sequence %d->%d)\n"
k n (n + k - 1));
copyBlocks (Int64.of_int n) k;
decode (pos + 5)
| 'E' ->
true
| _ ->
assert false
in
let finished = decode pos in
showProgress !progress;
finished
(***************************** SOURCE HOST *******************************)
(*** CUSTOM HASH TABLE ***)
(* Half the maximum number of entries in the hash table.
MUST be a power of 2 !
Typical values are around an average 2 * fileSize / blockSize. *)
let hashTableMaxLength = 1024 * 1024
let rec upperPowerOfTwo n n2 =
if (n2 >= n) || (n2 = hashTableMaxLength) then
n2
else
upperPowerOfTwo n (2 * n2)
let hash checksum = checksum
(* Compute the hash table length as a function of the number of blocks *)
let computeHashTableLength signatures =
2 * (upperPowerOfTwo signatures.blockCount 32)
(* Hash the block signatures into the hash table *)
let hashSig hashTableLength signatures =
let hashTable = Array.make hashTableLength [] in
for k = 0 to signatures.blockCount - 1 do
let cs = Int32.to_int signatures.weakChecksum.{k} land 0x7fffffff in
let h = (hash cs) land (hashTableLength - 1) in
hashTable.(h) <- (k, cs) :: hashTable.(h)
done;
hashTable
(* Given a key, retrieve the corresponding entry in the table *)
let findEntry hashTable hashTableLength checksum :
(int * Checksum.t) list =
Array.unsafe_get hashTable ((hash checksum) land (hashTableLength - 1))
let sigFilter hashTableLength signatures =
let len = hashTableLength lsl 2 in
let filter = String.make len '\000' in
for k = 0 to signatures.blockCount - 1 do
let cs = Int32.to_int signatures.weakChecksum.{k} land 0x7fffffff in
let h1 = cs lsr 28 in
assert (h1 >= 0 && h1 < 8);
let h2 = (cs lsr 5) land (len - 1) in
let mask = 1 lsl h1 in
filter.[h2] <- Char.chr (Char.code filter.[h2] lor mask)
done;
filter
let filterMem filter hashTableLength checksum =
let len = hashTableLength lsl 2 in
let h2 = (checksum lsr 5) land (len - 1) in
let h1 = checksum lsr 28 in
let mask = 1 lsl h1 in
Char.code (String.unsafe_get filter h2) land mask <> 0
(* Log the values of the parameters associated with the hash table *)
let logHash hashTable hashTableLength =
let rec probe empty collision i =
if i = hashTableLength then (empty, collision)
else begin
let length = Safelist.length hashTable.(i) in
let next =
if length = 0 then probe (empty + 1) collision
else if length > 1 then probe empty (collision + 1)
else probe empty collision
in
next (i + 1)
end
in
let (empty, collision) = probe 0 0 0 in
debugLog (fun() -> Util.msg "%d hash table entries\n" hashTableLength);
debugLog (fun() -> Util.msg
"%d empty, %d used, %d collided\n"
empty (hashTableLength - empty) collision)
(*** MEASURES ***)
type probes = {
mutable hitHit : int;
mutable hitMiss : int;
mutable missMiss : int;
mutable nbBlock : int;
mutable nbString : int;
mutable stringSize : int
}
let logMeasures pb =
debugLog (fun() -> Util.msg
"hit-hit = %d, hit-miss = %d, miss-miss = %d, hit rate = %d%%\n"
pb.hitHit pb.hitMiss pb.missMiss
(if pb.hitHit <> 0 then
pb.hitHit * 100 / (pb.hitHit + pb.hitMiss)
else 0))
(*
debugLog (fun() -> Util.msg
"%d strings (%d bytes), %d blocks\n"
pb.nbString pb.stringSize pb.nbBlock);
let generic = pb.stringSize + pb.nbBlock * blockSize in
debugLog (fun() -> Util.msg
"file size = %d bytes\n"
generic);
debug (fun() -> Util.msg
"compression rate = %d%%\n" ((pb.stringSize * 100) / generic))
*)
(*** COMPRESSION ***)
(* Compression buffer size *)
(* MUST be >= 2 * blockSize *)
let minComprBufSize = 8192
type compressorState =
{ (* Rolling checksum data *)
mutable checksum : int;
mutable cksumOutgoing : char;
(* Buffering *)
mutable offset : int;
mutable toBeSent : int;
mutable length : int;
(* Position in file *)
mutable absolutePos : Uutil.Filesize.t }
(* Compress the file using the algorithm described in the header *)
let rsyncCompress sigs infd srcLength showProgress transmit =
debug (fun() -> Util.msg "compressing\n");
let blockSize = sigs.blockSize in
let comprBufSize = (2 * blockSize + 8191) land (-8192) in
let comprBufSizeFS = Uutil.Filesize.ofInt comprBufSize in
debugLog (fun() -> Util.msg
"compression buffer size = %d bytes\n" comprBufSize);
debugLog (fun() -> Util.msg "block size = %d bytes\n" blockSize);
assert (comprBufSize >= 2 * blockSize);
let timer = Trace.startTimer "Compressing the new file" in
(* Measures *)
let pb =
{ hitHit = 0; hitMiss = 0; missMiss = 0;
nbBlock = 0; nbString = 0; stringSize = 0 } in
(*
let transmit tokenList =
Safelist.iter
(fun token ->
match token with
| STRING s ->
let length = String.length s in
if Trace.enabled "rsynctoken" then debugToken (fun() ->
Util.msg "transmitting string (%d bytes)\n" length);
pb.nbString <- pb.nbString + 1;
pb.stringSize <- pb.stringSize + length
| BLOCK n ->
if Trace.enabled "rsynctoken" then debugToken (fun() -> Util.msg
"transmitting %d block(s) (sequence %d->%d)\n"
1 n (n));
pb.nbBlock <- pb.nbBlock + k)
tokenList;
transmit tokenList
in
*)
(* Enable token buffering *)
let tokenQueue = makeQueue blockSize in
let flushTokenQueue () =
flushQueue tokenQueue showProgress transmit true in
let transmit token = queueToken tokenQueue showProgress transmit token in
(* Set up the hash table for fast checksum look-up *)
let hashTableLength = computeHashTableLength sigs in
let blockTable = hashSig hashTableLength sigs in
logHash blockTable hashTableLength;
let filter = sigFilter hashTableLength sigs in
let rec fingerprintMatchRec checksums pos fp i =
let i = i - 1 in
i < 0 ||
(String.unsafe_get fp i = checksums.{pos + i} &&
fingerprintMatchRec checksums pos fp i)
in
let fingerprintMatch k fp =
fingerprintMatchRec sigs.strongChecksum (k * sigs.checksumSize)
fp sigs.checksumSize
in
(* Create the compression buffer *)
let comprBuf = String.create comprBufSize in
(* If there is data waiting to be sent, transmit it as a STRING token *)
let transmitString toBeSent offset =
if offset > toBeSent then
transmit (STRING (comprBuf, toBeSent, offset - toBeSent))
else
return ()
in
(* Set up the rolling checksum data *)
let cksumTable = Checksum.init blockSize in
let initialState =
{ checksum = 0; cksumOutgoing = ' ';
offset = comprBufSize; toBeSent = comprBufSize; length = comprBufSize;
absolutePos = Uutil.Filesize.zero }
in
(* Check the new window position and update the compression buffer
if its end has been reached *)
let rec slideWindow st miss : unit Lwt.t =
if st.offset + blockSize <= st.length then
computeChecksum st miss
else if st.length = comprBufSize then begin
transmitString st.toBeSent st.offset >>= (fun () ->
let chunkSize = st.length - st.offset in
if chunkSize > 0 then begin
assert(comprBufSize >= blockSize);
String.blit comprBuf st.offset comprBuf 0 chunkSize
end;
let rem = Uutil.Filesize.sub srcLength st.absolutePos in
let avail = comprBufSize - chunkSize in
let l =
reallyRead infd comprBuf chunkSize
(if rem > comprBufSizeFS then avail else
min (Uutil.Filesize.toInt rem) avail)
in
st.absolutePos <-
Uutil.Filesize.add st.absolutePos (Uutil.Filesize.ofInt l);
st.offset <- 0;
st.toBeSent <- 0;
st.length <- chunkSize + l;
debugToken (fun() -> Util.msg "updating the compression buffer\n");
debugToken (fun() -> Util.msg "new length = %d bytes\n" st.length);
slideWindow st miss)
end else
transmitString st.toBeSent st.length >>= (fun () ->
transmit EOF)
(* Compute the window contents checksum, in a rolling fashion if there
was a miss *)
and computeChecksum st miss =
if miss then
rollChecksum st
else begin
let cksum = Checksum.substring comprBuf st.offset blockSize in
st.checksum <- cksum;
st.cksumOutgoing <- String.unsafe_get comprBuf st.offset;
processBlock st
end
and rollChecksum st =
let ingoingChar =
String.unsafe_get comprBuf (st.offset + blockSize - 1) in
let cksum =
Checksum.roll cksumTable st.checksum st.cksumOutgoing ingoingChar in
st.checksum <- cksum;
st.cksumOutgoing <- String.unsafe_get comprBuf st.offset;
if filterMem filter hashTableLength cksum then
processBlock st
else
miss st
(* Try to match the current block with one existing in the old file *)
and processBlock st =
let checksum = st.checksum in
match findEntry blockTable hashTableLength checksum with
| [] ->
pb.missMiss <- pb.missMiss + 1;
miss st
| entry ->
let blockNum = findBlock st checksum entry None in
if blockNum = -1 then begin
pb.hitMiss <- pb.hitMiss + 1;
miss st
end else begin
pb.hitHit <- pb.hitHit + 1;
hit st blockNum
end
(* In the hash table entry, find nodes with the right checksum and
match fingerprints *)
and findBlock st checksum entry fingerprint =
match entry, fingerprint with
| [], _ ->
-1
| (k, cs) :: tl, None
when cs = checksum ->
let fingerprint = Digest.substring comprBuf st.offset blockSize in
findBlock st checksum entry (Some fingerprint)
| (k, cs) :: tl, Some fingerprint
when cs = checksum && fingerprintMatch k fingerprint ->
k
| _ :: tl, _ ->
findBlock st checksum tl fingerprint
(* Miss : slide the window one character ahead *)
and miss st =
st.offset <- st.offset + 1;
if st.offset + blockSize <= st.length then
rollChecksum st
else
slideWindow st true
(* Hit : send the data waiting and a BLOCK token, then slide the window
one block ahead *)
and hit st blockNum =
transmitString st.toBeSent st.offset >>= (fun () ->
let sent = st.offset in
st.toBeSent <- sent + blockSize;
transmit (BLOCK blockNum) >>= (fun () ->
st.offset <- st.offset + blockSize;
slideWindow st false))
in
(* Initialization and termination *)
slideWindow initialState false >>= (fun () ->
flushTokenQueue () >>= (fun () ->
logMeasures pb;
Trace.showTimer timer;
return ()))
end
unison-2.40.102/terminal.mli 0000644 0061316 0061316 00000001471 11361646373 015730 0 ustar bcpierce bcpierce (* Like Unix.create_process except that we also try to set up a
controlling terminal for the new process. If successful, a file
descriptor for the master end of the controlling terminal is
returned. *)
val create_session :
string -> string array ->
Unix.file_descr -> Unix.file_descr -> Unix.file_descr ->
Lwt_unix.file_descr option * int
(* termInput fdTerm fdInput
Wait until there is input on at least one file descriptor.
If there is terminal input s, return Some s.
Otherwise, return None. *)
val termInput :
Lwt_unix.file_descr -> Lwt_unix.file_descr -> string option
val handlePasswordRequests :
Lwt_unix.file_descr -> (string -> string) -> unit
(* For recognizing messages from OpenSSH *)
val password : string -> bool
val passphrase : string -> bool
val authenticity : string -> bool
unison-2.40.102/case.mli 0000644 0061316 0061316 00000002732 11361646373 015031 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/case.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
val caseInsensitiveMode : [`True|`False|`Default] Prefs.t
val unicodeEncoding : bool Prefs.t
val useUnicodeAPI : unit -> bool
type mode = Sensitive | Insensitive | UnicodeSensitive | UnicodeInsensitive
val ops : unit ->
< mode : mode; modeDesc : string; (* Current mode *)
compare : string -> string -> int; (* Comparison function *)
hash : string -> int; (* Hash function compatible with
the comparison function *)
normalizePattern : string -> string; (* Normalize a pattern *)
caseInsensitiveMatch : bool; (* Whether pattern matching
should be done in a case
insensitive way *)
normalizeMatchedString : string -> string;
(* Put the string in some form
suitable for pattern matching *)
normalizeFilename : string -> string; (* Convert a filename into
its preferred form
(NFC for Unicode). *)
badEncoding : string -> bool > (* Test whether the string uses
the correct encoding *)
val init : bool -> bool -> unit
val caseSensitiveModeDesc : string
unison-2.40.102/system.ml 0000644 0061316 0061316 00000001406 11361646373 015266 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/system.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
include System_impl.System
unison-2.40.102/unison.hgr 0000644 0061316 0061316 00000000577 11361646373 015435 0 ustar bcpierce bcpierce # Hungarian convention for the unison project
# The convention applies to a bunch of types in the module Common
ui.* : Common.updateItem
ui.* : updateItem
uc.* : Common.updateContent
uc.* : updateContent
rc.* : Common.replicaContent
rc.* : replicaContent
rplc.* : Common.replicas
rplc.* : replicas
ri.* : Common.reconItem
ri.* : reconItem
<> : Prop.t
# The end
unison-2.40.102/globals.ml 0000644 0061316 0061316 00000027551 11361646373 015376 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/globals.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Common
let debug = Trace.debug "globals"
(*****************************************************************************)
(* ROOTS and PATHS *)
(*****************************************************************************)
let rawroots =
Prefs.createStringList "root"
"root of a replica (should be used exactly twice)"
("Each use of this preference names the root of one of the replicas "
^ "for Unison to synchronize. Exactly two roots are needed, so normal "
^ "modes of usage are either to give two values for \\verb|root| in the "
^ "profile, or to give no values in the profile and provide two "
^ "on the command line. "
^ "Details of the syntax of roots can be found in "
^ "\\sectionref{roots}{Roots}.\n\n"
^ "The two roots can be given in either order; Unison will sort them "
^ "into a canonical order before doing anything else. It also tries to "
^ "`canonize' the machine names and paths that appear in the roots, so "
^ "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 (Safelist.rev l)
let rawRoots () = Safelist.rev (Prefs.read rawroots)
let rawRootPair () =
match rawRoots () with
[r1; r2] -> (r1, r2)
| _ -> assert false
let theroots = ref []
open Lwt
let installRoots termInteract =
let roots = rawRoots () in
if Safelist.length roots <> 2 then
raise (Util.Fatal (Printf.sprintf
"Wrong number of roots: 2 expected, but %d provided (%s)\n(Maybe you specified roots both on the command line and in the profile?)"
(Safelist.length roots)
(String.concat ", " roots) ));
Safelist.fold_right
(fun r cont ->
Remote.canonizeRoot r (Clroot.parseRoot r) termInteract
>>= (fun r' ->
cont >>= (fun l ->
return (r' :: l))))
roots (return []) >>= (fun roots' ->
theroots := roots';
return ())
(* Alternate interface, should replace old interface eventually *)
let installRoots2 () =
debug (fun () -> Util.msg "Installing roots...");
let roots = rawRoots () in
theroots :=
Safelist.map Remote.canonize ((Safelist.map Clroot.parseRoot) roots);
theroots := !theroots
let roots () =
match !theroots with
[root1;root2] -> (root1,root2)
| _ -> assert false
let rootsList() = !theroots
let rootsInCanonicalOrder() = Common.sortRoots (!theroots)
let localRoot () = List.hd (rootsInCanonicalOrder ())
let reorderCanonicalListToUsersOrder l =
if rootsList() = rootsInCanonicalOrder() then l
else Safelist.rev l
let rec nice_rec i
: unit Lwt.t =
if i <= 0 then
Lwt.return ()
else
Lwt_unix.yield() >>= (fun () -> nice_rec (i - 1))
(* [nice r] yields 5 times on local roots [r] to give processes
corresponding to remote roots a chance to run *)
let nice r =
if List.exists (fun r -> fst r <> Local) (rootsList ()) && fst r = Local then
nice_rec 5
else
Lwt.return ()
let allRootsIter f =
Lwt_util.iter
(fun r -> nice r >>= (fun () -> f r)) (rootsInCanonicalOrder ())
let allRootsIter2 f l =
let l = Safelist.combine (rootsList ()) l in
Lwt_util.iter (fun (r, v) -> nice r >>= (fun () -> f r v))
(Safelist.sort (fun (r, _) (r', _) -> Common.compareRoots r r') l)
let allRootsMap f =
Lwt_util.map
(fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v))))
(rootsInCanonicalOrder ()) >>= (fun l ->
return (Safelist.map snd (reorderCanonicalListToUsersOrder l)))
let allRootsMapWithWaitingAction f wa =
Lwt_util.map_with_waiting_action
(fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v))))
(fun r -> wa r)
(rootsInCanonicalOrder ()) >>= (fun l ->
return (Safelist.map snd (reorderCanonicalListToUsersOrder l)))
let replicaHostnames () =
Safelist.map
(function (Local, _) -> ""
| (Remote h,_) -> h)
(rootsList())
let allHostsIter f =
let rec iter l =
match l with
[] ->
return ()
| root :: rem ->
f root >>= (fun () ->
iter rem)
in
iter (replicaHostnames ())
let allHostsMap f = Safelist.map f (replicaHostnames())
let paths =
Prefs.create "path" []
"path to synchronize"
("When no \\verb|path| preference is given, Unison will simply synchronize "
^ "the two entire replicas, beginning from the given pair of roots. "
^ "If one or more \\verb|path| preferences are given, then Unison will "
^ "synchronize only these paths and their children. (This is useful "
^ "for doing a fast sync of just one directory, for example.) "
^ "Note that {\\tt path} preferences are intepreted literally---they "
^ "are not regular expressions.")
(fun oldpaths string -> Safelist.append oldpaths [Path.fromString string])
(fun l -> Safelist.map Path.toString l)
(* FIX: this does weird things in case-insensitive mode... *)
let globPath lr p =
let p = Path.forceLocal p in
debug (fun() ->
Util.msg "Checking path '%s' for expansions\n"
(Path.toDebugString p) );
match Path.deconstructRev p with
Some(n,parent) when (Name.toString n = "*") -> begin
debug (fun() -> Util.msg "Expanding path %s\n" (Path.toString p));
match lr with
None -> raise (Util.Fatal (Printf.sprintf
"Path %s ends with *, %s"
(Path.toString p)
"but first root (after canonizing) is non-local"))
| Some lrfspath ->
Safelist.map (fun c -> Path.makeGlobal (Path.child parent c))
(Os.childrenOf lrfspath parent)
end
| _ -> [Path.makeGlobal p]
let expandWildcardPaths() =
let lr =
match rootsInCanonicalOrder() with
[(Local, fspath); _] -> Some fspath
| _ -> None in
Prefs.set paths
(Safelist.flatten_map (globPath lr) (Prefs.read paths))
(*****************************************************************************)
(* PROPAGATION OF PREFERENCES *)
(*****************************************************************************)
let propagatePrefsTo =
Remote.registerHostCmd
"installPrefs"
(fun prefs -> return (Prefs.load prefs))
let propagatePrefs () =
let prefs = Prefs.dump() in
let toHost root =
match root with
(Local, _) -> return ()
| (Remote host,_) ->
propagatePrefsTo host prefs
in
allRootsIter toHost
(*****************************************************************************)
(* PREFERENCES AND PREDICATES *)
(*****************************************************************************)
let batch =
Prefs.createBool "batch" false "batch mode: ask no questions at all"
("When this is set to {\\tt true}, the user "
^ "interface will ask no questions at all. Non-conflicting changes "
^ "will be propagated; conflicts will be skipped.")
let confirmBigDeletes =
Prefs.createBool "confirmbigdel" true
"!ask about whole-replica (or path) deletes"
("When this is set to {\\tt true}, Unison will request an extra confirmation if it appears "
^ "that the entire replica has been deleted, before propagating the change. If the {\\tt batch} "
^ "flag is also set, synchronization will be aborted. When the {\\tt path} preference is used, "
^ "the same confirmation will be requested for top-level paths. (At the moment, this flag only "
^ "affects the text user interface.) See also the {\\tt mountpoint} preference.")
let () = Prefs.alias confirmBigDeletes "confirmbigdeletes"
let ignorePred =
Pred.create "ignore"
("Including the preference \\texttt{-ignore \\ARG{pathspec}} causes Unison to "
^ "completely ignore paths that match \\ARG{pathspec} (as well as their "
^ "children). This is useful for avoiding synchronizing temporary "
^ "files, object files, etc. The syntax of \\ARG{pathspec} is "
^ "described in \\sectionref{pathspec}{Path Specification}, and further "
^ "details on ignoring paths is found in"
^ " \\sectionref{ignore}{Ignoring Paths}.")
let ignorenotPred =
Pred.create "ignorenot"
("This preference overrides the preference \\texttt{ignore}.
It gives a list of patterns
(in the same format as
\\verb|ignore|) for paths that should definitely {\\em not} be ignored,
whether or not they happen to match one of the \\verb|ignore| patterns.
\\par Note that the semantics of {\\tt ignore} and {\\tt ignorenot} is a
little counter-intuitive. When detecting updates, Unison examines
paths in depth-first order, starting from the roots of the replicas
and working downwards. Before examining each path, it checks whether
it matches {\\tt ignore} and does not match {\\tt ignorenot}; in this case
it skips this path {\\em and all its descendants}. This means that,
if some parent of a given path matches an {\\tt ignore} pattern, then
it will be skipped even if the path itself matches an {\\tt ignorenot}
pattern. In particular, putting {\\tt ignore = Path *} in your profile
and then using {\\tt ignorenot} to select particular paths to be
synchronized will not work. Instead, you should use the {\\tt path}
preference to choose particular paths to synchronize.")
let shouldIgnore p =
let p = Path.toString p in
(Pred.test ignorePred p) && not (Pred.test ignorenotPred p)
let addRegexpToIgnore re =
let oldRE = Pred.extern ignorePred in
let newRE = re::oldRE in
Pred.intern ignorePred newRE
let merge =
Pred.create "merge" ~advanced:true
("This preference can be used to run a merge program which will create "
^ "a new version for each of the files and the backup, "
^ "with the last backup and the both replicas. Setting the {\\tt merge} "
^ "preference for a path will also cause this path to be backed up, "
^ "just like {\tt backup}. "
^ "The syntax of \\ARG{pathspec>cmd} is "
^ "described in \\sectionref{pathspec}{Path Specification}, and further "
^ "details on Merging functions are present in "
^ "\\sectionref{merge}{Merging files}.")
let shouldMerge p = Pred.test merge (Path.toString p)
let mergeCmdForPath p = Pred.assoc merge (Path.toString p)
let someHostIsRunningWindows =
Prefs.createBool "someHostIsRunningWindows" false "*" ""
let allHostsAreRunningWindows =
Prefs.createBool "allHostsAreRunningWindows" false "*" ""
let fatFilesystem =
Prefs.createBool "fat" ~local:true false
"use appropriate options for FAT filesystems"
("When this is set to {\\tt true}, Unison will use appropriate options \
to synchronize efficiently and without error a replica located on a \
FAT filesystem on a non-Windows machine: \
do not synchronize permissions ({\\tt perms = 0}); \
never use chmod ({\tt dontchmod = true}); \
treat filenames as case insensitive ({\\tt ignorecase = true}); \
do not attempt to synchronize symbolic links ({\\tt links = false}); \
ignore inode number changes when detecting updates \
({\\tt ignoreinodenumbers = true}). \
Any of these change can be overridden by explicitely setting \
the corresponding preference in the profile.")
unison-2.40.102/sortri.ml 0000644 0061316 0061316 00000011633 11361646373 015267 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/sortri.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Common
let dbgsort = Util.debug "sort"
(* Preferences *)
let bysize =
Prefs.createBool "sortbysize" false
"!list changed files by size, not name"
("When this flag is set, the user interface will list changed files "
^ "by size (smallest first) rather than by name. This is useful, for "
^ "example, for synchronizing over slow links, since it puts very "
^ "large files at the end of the list where they will not prevent "
^ "smaller files from being transferred quickly.\n\n"
^ "This preference (as well as the other sorting flags, but not the "
^ "sorting preferences that require patterns as arguments) can be "
^ "set interactively and temporarily using the 'Sort' menu in the "
^ "graphical user interface.")
let newfirst =
Prefs.createBool "sortnewfirst" false
"!list new before changed files"
("When this flag is set, the user interface will list newly created "
^ "files before all others. This is useful, for example, for checking "
^ "that newly created files are not `junk', i.e., ones that should be "
^ "ignored or deleted rather than synchronized.")
let sortfirst = Pred.create "sortfirst" ~advanced:true
("Each argument to \\texttt{sortfirst} is a pattern \\ARG{pathspec}, "
^ "which describes a set of paths. "
^ "Files matching any of these patterns will be listed first in the "
^ "user interface. "
^ "The syntax of \\ARG{pathspec} is "
^ "described in \\sectionref{pathspec}{Path Specification}.")
let sortlast = Pred.create "sortlast" ~advanced:true
("Similar to \\verb|sortfirst|, except that files matching one of these "
^ "patterns will be listed at the very end.")
type savedPrefs = {nf:bool; bs:bool; sf:string list; sl:string list}
let savedPrefs = ref(None)
let saveSortingPrefs () =
if !savedPrefs = None then
savedPrefs := Some {
sf = Pred.extern sortfirst;
sl = Pred.extern sortlast;
bs = Prefs.read bysize;
nf = Prefs.read newfirst }
let restoreDefaultSettings () =
match !savedPrefs with
None -> ()
| Some {nf=nf; bs=bs; sf=sf; sl=sl} ->
Prefs.set newfirst nf;
Prefs.set bysize bs;
Pred.intern sortfirst sf;
Pred.intern sortlast sl
let zeroSortingPrefs () =
Prefs.set newfirst false;
Prefs.set bysize false;
Pred.intern sortfirst [];
Pred.intern sortlast []
(* ------------------- *)
let sortByName () =
saveSortingPrefs();
zeroSortingPrefs()
let sortBySize () =
saveSortingPrefs();
zeroSortingPrefs();
Prefs.set bysize true
let sortNewFirst () =
saveSortingPrefs();
Prefs.set newfirst (not (Prefs.read newfirst))
(* ---------------------------------------------------------------------- *)
(* Main sorting functions *)
let shouldSortFirst ri =
Pred.test sortfirst (Path.toString ri.path1)
let shouldSortLast ri =
Pred.test sortlast (Path.toString ri.path1)
let newItem ri =
let newItem1 ri =
match ri.replicas with
Different diff -> diff.rc1.status = `Created
| _ -> false in
let newItem2 ri =
match ri.replicas with
Different diff -> diff.rc2.status = `Created
| _ -> false
in newItem1 ri || newItem2 ri
(* Should these go somewhere else? *)
let rec combineCmp = function
[] -> 0
| c::cs -> if c<>0 then c else combineCmp cs
let invertCmp c = c * -1
let compareReconItems () =
let newfirst = Prefs.read newfirst in
fun ri1 ri2 ->
let pred p =
let b1 = p ri1 in let b2 = p ri2 in
if b1 && b2 then 0 else if b1 then -1 else if b2 then 1 else 0 in
let cmp =
combineCmp [
pred problematic;
pred partiallyProblematic;
pred shouldSortFirst;
invertCmp (pred shouldSortLast);
if newfirst then pred newItem else 0;
(if Prefs.read bysize then
let l1 = Common.riLength ri1 in
let l2 = Common.riLength ri2 in
if l1 Util.msg "%s <= %s --> %d\n"
(Path.toString ri1.path1) (Path.toString ri2.path1) cmp);
cmp
let sortReconItems items = Safelist.stable_sort (compareReconItems()) items
unison-2.40.102/uitext.ml 0000644 0061316 0061316 00000074200 11361646373 015266 0 ustar bcpierce bcpierce (* Unison file synchronizer: src/uitext.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Common
open Lwt
module Body : Uicommon.UI = struct
let debug = Trace.debug "ui"
let dumbtty =
Prefs.createBool "dumbtty"
(try System.getenv "EMACS" <> "" with Not_found -> false)
"!do not change terminal settings in text UI"
("When set to \\verb|true|, this flag makes the text mode user "
^ "interface avoid trying to change any of the terminal settings. "
^ "(Normally, Unison puts the terminal in `raw mode', so that it can "
^ "do things like overwriting the current line.) This is useful, for "
^ "example, when Unison runs in a shell inside of Emacs. "
^ "\n\n"
^ "When \\verb|dumbtty| is set, commands to the user interface need to "
^ "be followed by a carriage return before Unison will execute them. "
^ "(When it is off, Unison "
^ "recognizes keystrokes as soon as they are typed.)\n\n"
^ "This preference has no effect on the graphical user "
^ "interface.")
let silent =
Prefs.createBool "silent" false "print nothing except error messages"
("When this preference is set to {\\tt true}, the textual user "
^ "interface will print nothing at all, except in the case of errors. "
^ "Setting \\texttt{silent} to true automatically sets the "
^ "\\texttt{batch} preference to {\\tt true}.")
let cbreakMode = ref None
(* FIX: this may also work with Cygwin, but someone needs to try it... *)
let supportSignals = Util.osType = `Unix (*|| Util.isCygwin*)
let rawTerminal () =
match !cbreakMode with
None -> ()
| Some funs -> funs.System.rawTerminal ()
let defaultTerminal () =
match !cbreakMode with
None -> ()
| Some funs -> funs.System.defaultTerminal ()
let restoreTerminal() =
if supportSignals && not (Prefs.read dumbtty) then
Sys.set_signal Sys.sigcont Sys.Signal_default;
defaultTerminal ();
cbreakMode := None
let setupTerminal() =
if not (Prefs.read dumbtty) then
try
cbreakMode := Some (System.terminalStateFunctions ());
let suspend _ =
defaultTerminal ();
Sys.set_signal Sys.sigtstp Sys.Signal_default;
Unix.kill (Unix.getpid ()) Sys.sigtstp
in
let resume _ =
if supportSignals then
Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend);
rawTerminal ()
in
if supportSignals then
Sys.set_signal Sys.sigcont (Sys.Signal_handle resume);
resume ()
with Unix.Unix_error _ ->
restoreTerminal ()
let alwaysDisplay message =
print_string message;
flush stdout
let alwaysDisplayAndLog message =
(* alwaysDisplay message;*)
Trace.log (message ^ "\n")
let display message =
if not (Prefs.read silent) then alwaysDisplay message
let displayWhenInteractive message =
if not (Prefs.read Globals.batch) then alwaysDisplay message
let getInput () =
match !cbreakMode with
None ->
let l = input_line stdin in
if l="" then "" else String.sub l 0 1
| Some funs ->
let input_char () =
(* We cannot used buffered I/Os under Windows, as character
'\r' is not passed through (probably due to the code that
turns \r\n into \n) *)
let s = String.create 1 in
let n = Unix.read Unix.stdin s 0 1 in
if n = 0 then raise End_of_file;
if s.[0] = '\003' then raise Sys.Break;
s.[0]
in
funs.System.startReading ();
let c = input_char () in
funs.System.stopReading ();
let c = if c='\n' || c = '\r' then "" else String.make 1 c in
display c;
c
let newLine () =
if !cbreakMode <> None then display "\n"
let overwrite () =
if !cbreakMode <> None then display "\r"
let rec selectAction batch actions tryagain =
let formatname = function
"" -> ""
| " " -> ""
| n -> n in
let summarizeChoices() =
display "[";
Safelist.iter
(fun (names,doc,action) ->
if (Safelist.nth names 0) = "" then
display (formatname (Safelist.nth names 1)))
actions;
display "] " in
let tryagainOrLoop() =
tryagain ();
selectAction batch actions tryagain in
let rec find n = function
[] -> raise Not_found
| (names,doc,action)::rest ->
if Safelist.mem n names then action else find n rest
in
let doAction a =
if a="?" then
(newLine ();
display "Commands:\n";
Safelist.iter (fun (names,doc,action) ->
let n = Util.concatmap " or " formatname names in
let space = String.make (max 2 (22 - String.length n)) ' ' in
display (" " ^ n ^ space ^ doc ^ "\n"))
actions;
tryagainOrLoop())
else
let action = try Some (find a actions) with Not_found -> None in
match action with
Some action ->
action ()
| None ->
newLine ();
if a="" then
display ("No default command [type '?' for help]\n")
else
display ("Unrecognized command '" ^ String.escaped a
^ "': try again [type '?' for help]\n");
tryagainOrLoop()
in
doAction (match batch with
None ->
summarizeChoices();
getInput ()
| Some i -> i)
let alwaysDisplayErrors prefix l =
List.iter
(fun err -> alwaysDisplay (Format.sprintf "%s%s\n" prefix err)) l
let alwaysDisplayDetails ri =
alwaysDisplay ((Uicommon.details2string ri " ") ^ "\n");
match ri.replicas with
Problem _ ->
()
| Different diff ->
alwaysDisplayErrors "[root 1]: " diff.errors1;
alwaysDisplayErrors "[root 2]: " diff.errors2
let displayDetails ri =
if not (Prefs.read silent) then alwaysDisplayDetails ri
let displayri ri =
let (r1, action, r2, path) = Uicommon.reconItem2stringList Path.empty ri in
let forced =
match ri.replicas with
Different diff -> diff.direction <> diff.default_direction
| Problem _ -> false
in
let (defaultAction, forcedAction) =
match action with
Uicommon.AError -> ("error", "error")
| Uicommon.ASkip _ -> ("<-?->", "<=?=>")
| Uicommon.ALtoR false -> ("---->", "====>")
| Uicommon.ALtoR true -> ("--?->", "==?=>")
| Uicommon.ARtoL false -> ("<----", "<====")
| Uicommon.ARtoL true -> ("<-?--", "<=?==")
| Uicommon.AMerge -> ("<-M->", "<=M=>")
in
let action = if forced then forcedAction else defaultAction in
let s = Format.sprintf "%s %s %s %s " r1 action r2 path in
match ri.replicas with
Problem _ ->
alwaysDisplay s
| Different {direction = d} when d=Conflict ->
alwaysDisplay s
| _ ->
display s
type proceed = ConfirmBeforeProceeding | ProceedImmediately
let interact rilist =
let (r1,r2) = Globals.roots() in
let (host1, host2) = root2hostname r1, root2hostname r2 in
if not (Prefs.read Globals.batch) then display ("\n" ^ Uicommon.roots2string() ^ "\n");
let rec loop prev =
function
[] -> (ConfirmBeforeProceeding, Safelist.rev prev)
| ri::rest as ril ->
let next() = loop (ri::prev) rest in
let repeat() = loop prev ril in
let ignore pat rest what =
if !cbreakMode <> None then display "\n";
display " ";
Uicommon.addIgnorePattern pat;
display (" Permanently ignoring " ^ what ^ "\n");
begin match !Prefs.profileName with None -> assert false |
Some(n) ->
display (" To un-ignore, edit "
^ System.fspathToPrintString (Prefs.profilePathname n)
^ " and restart " ^ Uutil.myName ^ "\n") end;
let nukeIgnoredRis =
Safelist.filter (fun ri -> not (Globals.shouldIgnore ri.path1)) in
loop (nukeIgnoredRis (ri::prev)) (nukeIgnoredRis ril) in
(* This should work on most terminals: *)
let redisplayri() = overwrite (); displayri ri; display "\n" in
displayri ri;
match ri.replicas with
Problem s -> display "\n"; display s; display "\n"; next()
| Different ({rc1 = rc1; rc2 = rc2; direction = dir} as diff) ->
if Prefs.read Uicommon.auto && dir<>Conflict then begin
display "\n"; next()
end else
let (descr, descl) =
if host1 = host2 then
"left to right", "right to left"
else
"from "^host1^" to "^host2,
"from "^host2^" to "^host1
in
if Prefs.read Globals.batch then begin
display "\n";
if not (Prefs.read Trace.terse) then
displayDetails ri
end;
selectAction
(if Prefs.read Globals.batch then Some " " else None)
[((if dir=Conflict && not (Prefs.read Globals.batch)
then ["f"] (* Offer no default behavior if we've got
a conflict and we're in interactive mode *)
else ["";"f";" "]),
("follow " ^ Uutil.myName ^ "'s recommendation (if any)"),
fun ()->
newLine ();
if dir = Conflict && not (Prefs.read Globals.batch)
then begin
display "No default action [type '?' for help]\n";
repeat()
end else
next());
(["I"],
("ignore this path permanently"),
(fun () ->
ignore (Uicommon.ignorePath ri.path1) rest
"this path"));
(["E"],
("permanently ignore files with this extension"),
(fun () ->
ignore (Uicommon.ignoreExt ri.path1) rest
"files with this extension"));
(["N"],
("permanently ignore paths ending with this name"),
(fun () ->
ignore (Uicommon.ignoreName ri.path1) rest
"files with this name"));
(["m"],
("merge the versions"),
(fun () ->
diff.direction <- Merge;
redisplayri();
next()));
(["d"],
("show differences"),
(fun () ->
newLine ();
Uicommon.showDiffs ri
(fun title text ->
try
let pager = System.getenv "PAGER" in
restoreTerminal ();
let out = System.open_process_out pager in
Printf.fprintf out "\n%s\n\n%s\n\n" title text;
let _ = System.close_process_out out in
setupTerminal ()
with Not_found ->
Printf.printf "\n%s\n\n%s\n\n" title text)
(fun s -> Printf.printf "%s\n" s)
Uutil.File.dummy;
repeat()));
(["x"],
("show details"),
(fun () -> display "\n"; displayDetails ri; repeat()));
(["L"],
("list all suggested changes tersely"),
(fun () -> display "\n";
Safelist.iter
(fun ri -> displayri ri; display "\n ")
ril;
display "\n";
repeat()));
(["l"],
("list all suggested changes with details"),
(fun () -> display "\n";
Safelist.iter
(fun ri -> displayri ri; display "\n ";
alwaysDisplayDetails ri)
ril;
display "\n";
repeat()));
(["p";"b"],
("go back to previous item"),
(fun () ->
newLine();
match prev with
[] -> repeat()
| prevri::prevprev -> loop prevprev (prevri :: ril)));
(["g"],
("proceed immediately to propagating changes"),
(fun() ->
(ProceedImmediately, Safelist.rev_append prev ril)));
(["q"],
("exit " ^ Uutil.myName ^ " without propagating any changes"),
fun () -> raise Sys.Break);
(["/"],
("skip"),
(fun () ->
diff.direction <- Conflict;
redisplayri();
next()));
([">";"."],
("propagate from " ^ descr),
(fun () ->
diff.direction <- Replica1ToReplica2;
redisplayri();
next()));
(["<";","],
("propagate from " ^ descl),
(fun () ->
diff.direction <- Replica2ToReplica1;
redisplayri();
next()))
]
(fun () -> displayri ri)
in
loop [] rilist
let verifyMerge title text =
Printf.printf "%s\n" text;
if Prefs.read Globals.batch then
true
else begin
if Prefs.read Uicommon.confirmmerge then begin
display "Commit results of merge? ";
selectAction
None (* Maybe better: (Some "n") *)
[(["y";"g"],
"Yes: commit",
(fun() -> true));
(["n"],
"No: leave this file unchanged",
(fun () -> false));
]
(fun () -> display "Commit results of merge? ")
end else
true
end
type stateItem =
{ mutable ri : reconItem;
mutable bytesTransferred : Uutil.Filesize.t;
mutable bytesToTransfer : Uutil.Filesize.t }
let doTransport reconItemList =
let items =
Array.map
(fun ri ->
{ri = ri;
bytesTransferred = Uutil.Filesize.zero;
bytesToTransfer = Common.riLength ri})
(Array.of_list reconItemList)
in
let totalBytesTransferred = ref Uutil.Filesize.zero in
let totalBytesToTransfer =
ref
(Array.fold_left
(fun s item -> Uutil.Filesize.add item.bytesToTransfer s)
Uutil.Filesize.zero items)
in
let t0 = Unix.gettimeofday () in
let showProgress i bytes dbg =
let i = Uutil.File.toLine i in
let item = items.(i) in
item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes;
totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred bytes;
let v =
(Uutil.Filesize.percentageOfTotalSize
!totalBytesTransferred !totalBytesToTransfer)
in
let t1 = Unix.gettimeofday () in
let remTime =
if v <= 0. then "--:--"
else if v >= 100. then "00:00"
else
let t = truncate ((t1 -. t0) *. (100. -. v) /. v +. 0.5) in
Format.sprintf "%02d:%02d" (t / 60) (t mod 60)
in
Util.set_infos
(Format.sprintf "%s %s ETA" (Util.percent2string v) remTime)
in
if not (Prefs.read Trace.terse) && (Prefs.read Trace.debugmods = []) then
Uutil.setProgressPrinter showProgress;
Transport.logStart ();
let fFailedPaths = ref [] in
let fPartialPaths = ref [] in
let uiWrapper i item f =
Lwt.try_bind f
(fun () ->
if partiallyProblematic item.ri && not (problematic item.ri) then
fPartialPaths := item.ri.path1 :: !fPartialPaths;
Lwt.return ())
(fun e ->
match e with
Util.Transient s ->
let rem =
Uutil.Filesize.sub
item.bytesToTransfer item.bytesTransferred
in
if rem <> Uutil.Filesize.zero then
showProgress (Uutil.File.ofLine i) rem "done";
let m = "[" ^ (Path.toString item.ri.path1) ^ "]: " ^ s in
alwaysDisplay ("Failed " ^ m ^ "\n");
fFailedPaths := item.ri.path1 :: !fFailedPaths;
return ()
| _ ->
fail e) in
let im = Array.length items in
let rec loop i actions pRiThisRound =
if i < im then begin
let item = items.(i) in
let actions =
if pRiThisRound item.ri then
uiWrapper i item
(fun () -> Transport.transportItem item.ri
(Uutil.File.ofLine i) verifyMerge)
:: actions
else
actions
in
loop (i + 1) actions pRiThisRound
end else
actions
in
Lwt_unix.run
(let actions = loop 0 [] (fun ri -> not (Common.isDeletion ri)) in
Lwt_util.join actions);
Lwt_unix.run
(let actions = loop 0 [] Common.isDeletion in
Lwt_util.join actions);
Transport.logFinish ();
Uutil.setProgressPrinter (fun _ _ _ -> ());
Util.set_infos "";
(Safelist.rev !fFailedPaths, Safelist.rev !fPartialPaths)
let setWarnPrinterForInitialization()=
Util.warnPrinter :=
Some(fun s ->
alwaysDisplay "Error: ";
alwaysDisplay s;
alwaysDisplay "\n";
exit Uicommon.fatalExit)
let setWarnPrinter() =
Util.warnPrinter :=
Some(fun s ->
alwaysDisplay "Warning: ";
alwaysDisplay s;
if not (Prefs.read Globals.batch) then begin
display "Press return to continue.";
selectAction None
[(["";" ";"y"],
("Continue"),
fun()->());
(["n";"q";"x"],
("Exit"),
fun()->
alwaysDisplay "\n";
restoreTerminal ();
Lwt_unix.run (Update.unlockArchives ());
exit Uicommon.fatalExit)]
(fun()-> display "Press return to continue.")
end)
let lastMajor = ref ""
let formatStatus major minor =
let s =
if major = !lastMajor then " " ^ minor
else major ^ (if minor="" then "" else "\n " ^ minor)
in
lastMajor := major;
s
let rec interactAndPropagateChanges reconItemList
: bool * bool * bool * (Path.t list)
(* anySkipped?, anyPartial?, anyFailures?, failingPaths *) =
let (proceed,newReconItemList) = interact reconItemList in
let (updatesToDo, skipped) =
Safelist.fold_left
(fun (howmany, skipped) ri ->
if problematic ri then (howmany, skipped + 1)
else (howmany + 1, skipped))
(0, 0) newReconItemList in
let doit() =
if not (Prefs.read Globals.batch || Prefs.read Trace.terse) then newLine();
if not (Prefs.read Trace.terse) then Trace.status "Propagating updates";
let timer = Trace.startTimer "Transmitting all files" in
let (failedPaths, partialPaths) = doTransport newReconItemList in
let failures = Safelist.length failedPaths in
let partials = Safelist.length partialPaths in
Trace.showTimer timer;
if not (Prefs.read Trace.terse) then Trace.status "Saving synchronizer state";
Update.commitUpdates ();
let trans = updatesToDo - failures in
let summary =
Printf.sprintf
"Synchronization %s at %s (%d item%s transferred, %s%d skipped, %d failed)"
(if failures=0 then "complete" else "incomplete")
(let tm = Util.localtime (Util.time()) in
Printf.sprintf "%02d:%02d:%02d"
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec)
trans (if trans=1 then "" else "s")
(if partials <> 0 then
Format.sprintf "%d partially transferred, " partials
else
"")
skipped
failures in
Trace.log (summary ^ "\n");
if skipped>0 then
Safelist.iter
(fun ri ->
if problematic ri then
alwaysDisplayAndLog
(" skipped: " ^ (Path.toString ri.path1)))
newReconItemList;
if partials>0 then
Safelist.iter
(fun p ->
alwaysDisplayAndLog (" partially transferred: " ^ Path.toString p))
partialPaths;
if failures>0 then
Safelist.iter
(fun p -> alwaysDisplayAndLog (" failed: " ^ (Path.toString p)))
failedPaths;
(skipped > 0, partials > 0, failures > 0, failedPaths) in
if not !Update.foundArchives then Update.commitUpdates ();
if updatesToDo = 0 then begin
(* BCP (3/09): We need to commit the archives even if there are
no updates to propagate because some files (in fact, if we've
just switched to DST on windows, a LOT of files) might have new
modtimes in the archive. *)
(* JV (5/09): Don't save the archive in repeat mode as it has some
costs and its unlikely there is much change to the archives in
this mode. *)
if !Update.foundArchives && Prefs.read Uicommon.repeat = "" then
Update.commitUpdates ();
display "No updates to propagate\n";
(skipped > 0, false, false, [])
end else if proceed=ProceedImmediately then begin
doit()
end else begin
displayWhenInteractive "\nProceed with propagating updates? ";
selectAction
(* BCP: I find it counterintuitive that every other prompt except this one
would expect