[Unison-hackers] [unison-svn] r536 - in trunk: doc src src/lwt src/system src/ubase src/uimac14
bcpierce at seas.upenn.edu
bcpierce at seas.upenn.edu
Mon Dec 29 13:34:47 EST 2014
Author: bcpierce
Date: 2014-12-29 13:34:45 -0500 (Mon, 29 Dec 2014)
New Revision: 536
Removed:
trunk/src/uigtk.ml
trunk/src/uigtk.mli
Modified:
trunk/doc/local.tex
trunk/doc/unison-manual.tex
trunk/src/RECENTNEWS
trunk/src/abort.ml
trunk/src/bytearray.ml
trunk/src/bytearray.mli
trunk/src/bytearray_stubs.c
trunk/src/case.ml
trunk/src/case.mli
trunk/src/checksum.ml
trunk/src/checksum.mli
trunk/src/clroot.ml
trunk/src/clroot.mli
trunk/src/common.ml
trunk/src/common.mli
trunk/src/copy.ml
trunk/src/external.ml
trunk/src/external.mli
trunk/src/fileinfo.ml
trunk/src/fileinfo.mli
trunk/src/files.ml
trunk/src/files.mli
trunk/src/fileutil.ml
trunk/src/fileutil.mli
trunk/src/fingerprint.ml
trunk/src/fingerprint.mli
trunk/src/fpcache.ml
trunk/src/fpcache.mli
trunk/src/fs.ml
trunk/src/fs.mli
trunk/src/fspath.ml
trunk/src/fspath.mli
trunk/src/fswatch.ml
trunk/src/fswatch.mli
trunk/src/fswatchold.ml
trunk/src/globals.ml
trunk/src/globals.mli
trunk/src/linkgtk.ml
trunk/src/linkgtk2.ml
trunk/src/linktext.ml
trunk/src/lock.ml
trunk/src/lock.mli
trunk/src/lwt/pqueue.ml
trunk/src/lwt/pqueue.mli
trunk/src/main.ml
trunk/src/mkProjectInfo.ml
trunk/src/name.ml
trunk/src/name.mli
trunk/src/os.ml
trunk/src/os.mli
trunk/src/osx.ml
trunk/src/osx.mli
trunk/src/path.ml
trunk/src/path.mli
trunk/src/pixmaps.ml
trunk/src/pred.ml
trunk/src/pred.mli
trunk/src/props.ml
trunk/src/props.mli
trunk/src/recon.ml
trunk/src/recon.mli
trunk/src/remote.ml
trunk/src/remote.mli
trunk/src/sortri.ml
trunk/src/sortri.mli
trunk/src/stasher.ml
trunk/src/strings.mli
trunk/src/system.ml
trunk/src/system.mli
trunk/src/system/system_generic.ml
trunk/src/system/system_intf.ml
trunk/src/system/system_win.ml
trunk/src/terminal.ml
trunk/src/test.ml
trunk/src/test.mli
trunk/src/transfer.ml
trunk/src/transfer.mli
trunk/src/transport.ml
trunk/src/transport.mli
trunk/src/tree.ml
trunk/src/tree.mli
trunk/src/ubase/proplist.ml
trunk/src/ubase/proplist.mli
trunk/src/ubase/rx.ml
trunk/src/ubase/rx.mli
trunk/src/ubase/safelist.ml
trunk/src/ubase/safelist.mli
trunk/src/ubase/trace.ml
trunk/src/ubase/trace.mli
trunk/src/ubase/uarg.ml
trunk/src/ubase/util.ml
trunk/src/ubase/util.mli
trunk/src/ui.mli
trunk/src/uicommon.ml
trunk/src/uicommon.mli
trunk/src/uigtk2.ml
trunk/src/uigtk2.mli
trunk/src/uimac14/MyController.m
trunk/src/uimac14/ProgressCell.m
trunk/src/uimac14/ReconTableView.m
trunk/src/uitext.ml
trunk/src/uitext.mli
trunk/src/unicode.ml
trunk/src/unicode.mli
trunk/src/update.ml
trunk/src/update.mli
trunk/src/uutil.ml
trunk/src/uutil.mli
trunk/src/xferhint.ml
trunk/src/xferhint.mli
Log:
* Remove uigtk.ml (superceded a long time ago by uigtk2)
* Update copyright dates for 2015
Modified: trunk/doc/local.tex
===================================================================
--- trunk/doc/local.tex 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/doc/local.tex 2014-12-29 18:34:45 UTC (rev 536)
@@ -2,6 +2,9 @@
\newif\iffull \fullfalse
\newif\ifdraft \drafttrue
+\IfFileExists{texdirectives.tex}
+ {\input{texdirectives}}
+ {\typeout{== ERROR == The dynamically generated file `texdirectives.tex' couldn't be found. You should use `make` to build the manual for Unison (`unison-manual.pdf'). Don't call latex directly.}\stop}
\input{texdirectives}
\input{unisonversion}
Modified: trunk/doc/unison-manual.tex
===================================================================
--- trunk/doc/unison-manual.tex 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/doc/unison-manual.tex 2014-12-29 18:34:45 UTC (rev 536)
@@ -51,7 +51,7 @@
\LARGE%
Version \unisonversion \\[4ex] %
% \today %
- \large Copyright 1998-2012, Benjamin C. Pierce
+ \large Copyright 1998-2014, Benjamin C. Pierce
\end{center}%
\fi%
%
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/RECENTNEWS 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,3 +1,11 @@
+CHANGES FROM VERSION 2.48.0
+
+* Remove uigtk.ml (superceded a long time ago by uigtk2)
+
+* Update copyright dates for 2015
+
+
+-------------------------------
CHANGES FROM VERSION 2.48.-1
* Preparing for new beta release
Modified: trunk/src/abort.ml
===================================================================
--- trunk/src/abort.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/abort.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/abort.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/bytearray.ml
===================================================================
--- trunk/src/bytearray.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/bytearray.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/bytearray.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/bytearray.mli
===================================================================
--- trunk/src/bytearray.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/bytearray.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/bytearray.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type t =
(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
Modified: trunk/src/bytearray_stubs.c
===================================================================
--- trunk/src/bytearray_stubs.c 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/bytearray_stubs.c 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
/* Unison file synchronizer: src/bytearray_stubs.c */
-/* Copyright 1999-2014 (see COPYING for details) */
+/* Copyright 1999-2015 (see COPYING for details) */
#include <string.h>
Modified: trunk/src/case.ml
===================================================================
--- trunk/src/case.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/case.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/case.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/case.mli
===================================================================
--- trunk/src/case.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/case.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/case.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val caseInsensitiveMode : [`True|`False|`Default] Prefs.t
val unicodeEncoding : bool Prefs.t
Modified: trunk/src/checksum.ml
===================================================================
--- trunk/src/checksum.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/checksum.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/checksum.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/checksum.mli
===================================================================
--- trunk/src/checksum.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/checksum.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/checksum.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type t = int
type u = int array
Modified: trunk/src/clroot.ml
===================================================================
--- trunk/src/clroot.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/clroot.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/clroot.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/clroot.mli
===================================================================
--- trunk/src/clroot.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/clroot.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/clroot.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Command-line roots *)
type clroot =
Modified: trunk/src/common.ml
===================================================================
--- trunk/src/common.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/common.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/common.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/common.mli
===================================================================
--- trunk/src/common.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/common.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/common.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(***************************************************************************)
(* COMMON TYPES USED BY ALL MODULES *)
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/copy.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/copy.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/external.ml
===================================================================
--- trunk/src/external.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/external.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/external.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/external.mli
===================================================================
--- trunk/src/external.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/external.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/external.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val runExternalProgram : string -> (Unix.process_status * string) Lwt.t
val readChannelTillEof : in_channel -> string
Modified: trunk/src/fileinfo.ml
===================================================================
--- trunk/src/fileinfo.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fileinfo.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fileinfo.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fileinfo.mli
===================================================================
--- trunk/src/fileinfo.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fileinfo.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fileinfo.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK]
val type2string : typ -> string
Modified: trunk/src/files.ml
===================================================================
--- trunk/src/files.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/files.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/files.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/files.mli
===================================================================
--- trunk/src/files.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/files.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/files.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* As usual, these functions should only be called by the client (i.e., in *)
(* the same address space as the user interface). *)
Modified: trunk/src/fileutil.ml
===================================================================
--- trunk/src/fileutil.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fileutil.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fileutil.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fileutil.mli
===================================================================
--- trunk/src/fileutil.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fileutil.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fileutil.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Convert backslashes in a string to forward slashes. Useful in Windows. *)
val backslashes2forwardslashes : string -> string
Modified: trunk/src/fingerprint.ml
===================================================================
--- trunk/src/fingerprint.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fingerprint.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fingerprint.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fingerprint.mli
===================================================================
--- trunk/src/fingerprint.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fingerprint.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fingerprint.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type t
Modified: trunk/src/fpcache.ml
===================================================================
--- trunk/src/fpcache.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fpcache.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fpcache.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fpcache.mli
===================================================================
--- trunk/src/fpcache.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fpcache.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fpcache.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Initialize the cache *)
val init : bool -> bool -> System.fspath -> unit
Modified: trunk/src/fs.ml
===================================================================
--- trunk/src/fs.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fs.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fs.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fs.mli
===================================================================
--- trunk/src/fs.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fs.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fs.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Operations on fspaths *)
Modified: trunk/src/fspath.ml
===================================================================
--- trunk/src/fspath.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fspath.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fspath.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fspath.mli
===================================================================
--- trunk/src/fspath.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fspath.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fspath.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Defines an abstract type of absolute filenames (fspaths) *)
Modified: trunk/src/fswatch.ml
===================================================================
--- trunk/src/fswatch.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fswatch.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fswatch.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/fswatch.mli
===================================================================
--- trunk/src/fswatch.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fswatch.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fswatch.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type archiveHash = string
Modified: trunk/src/fswatchold.ml
===================================================================
--- trunk/src/fswatchold.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/fswatchold.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/fswatcherold.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/globals.ml
===================================================================
--- trunk/src/globals.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/globals.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/globals.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/globals.mli
===================================================================
--- trunk/src/globals.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/globals.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/globals.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Global variables and functions needed by top-level modules and user *)
(* interfaces *)
Modified: trunk/src/linkgtk.ml
===================================================================
--- trunk/src/linkgtk.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/linkgtk.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/linkgtk.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/linkgtk2.ml
===================================================================
--- trunk/src/linkgtk2.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/linkgtk2.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/linkgtk2.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/linktext.ml
===================================================================
--- trunk/src/linktext.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/linktext.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/linktext.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/lock.ml
===================================================================
--- trunk/src/lock.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/lock.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/lock.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/lock.mli
===================================================================
--- trunk/src/lock.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/lock.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/lock.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* A simple utility module for setting and releasing inter-process locks
using entries in the filesystem. *)
Modified: trunk/src/lwt/pqueue.ml
===================================================================
--- trunk/src/lwt/pqueue.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/lwt/pqueue.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/lwt/pqueue.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/lwt/pqueue.mli
===================================================================
--- trunk/src/lwt/pqueue.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/lwt/pqueue.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/lwt/pqueue.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module type OrderedType =
sig
Modified: trunk/src/main.ml
===================================================================
--- trunk/src/main.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/main.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/main.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/mkProjectInfo.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -98,3 +98,4 @@
+
Modified: trunk/src/name.ml
===================================================================
--- trunk/src/name.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/name.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/name.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/name.mli
===================================================================
--- trunk/src/name.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/name.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/name.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type t
Modified: trunk/src/os.ml
===================================================================
--- trunk/src/os.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/os.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/os.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/os.mli
===================================================================
--- trunk/src/os.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/os.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/os.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val myCanonicalHostName : unit -> string
Modified: trunk/src/osx.ml
===================================================================
--- trunk/src/osx.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/osx.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/osx.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/osx.mli
===================================================================
--- trunk/src/osx.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/osx.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/osx.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val init : bool -> unit
val isMacOSX : bool
Modified: trunk/src/path.ml
===================================================================
--- trunk/src/path.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/path.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/path.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/path.mli
===================================================================
--- trunk/src/path.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/path.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/path.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Abstract type of relative pathnames *)
type 'a path
Modified: trunk/src/pixmaps.ml
===================================================================
--- trunk/src/pixmaps.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/pixmaps.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/pixmaps.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/pred.ml
===================================================================
--- trunk/src/pred.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/pred.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/pred.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/pred.mli
===================================================================
--- trunk/src/pred.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/pred.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/pred.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Predicates over paths.
Modified: trunk/src/props.ml
===================================================================
--- trunk/src/props.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/props.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/props.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/props.mli
===================================================================
--- trunk/src/props.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/props.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/props.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* File properties: time, permission, length, etc. *)
Modified: trunk/src/recon.ml
===================================================================
--- trunk/src/recon.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/recon.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/recon.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/recon.mli
===================================================================
--- trunk/src/recon.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/recon.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/recon.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val reconcileAll :
?allowPartial:bool (* whether we allow partial synchronization
Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/remote.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/remote.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/remote.mli
===================================================================
--- trunk/src/remote.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/remote.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/remote.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module Thread : sig
val unwindProtect : (unit -> 'a Lwt.t) -> (exn -> unit Lwt.t) -> 'a Lwt.t
Modified: trunk/src/sortri.ml
===================================================================
--- trunk/src/sortri.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/sortri.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/sortri.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/sortri.mli
===================================================================
--- trunk/src/sortri.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/sortri.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/sortri.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, 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
Modified: trunk/src/stasher.ml
===================================================================
--- trunk/src/stasher.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/stasher.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,6 +1,6 @@
(* Unison file synchronizer: src/stasher.ml *)
(* $I2: Last modified by lescuyer *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/strings.mli
===================================================================
--- trunk/src/strings.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/strings.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,4 +1,4 @@
(* Unison file synchronizer: src/strings.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val docs : (string * (string * string)) list
Modified: trunk/src/system/system_generic.ml
===================================================================
--- trunk/src/system/system_generic.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/system/system_generic.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/system/system_generic.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/system/system_intf.ml
===================================================================
--- trunk/src/system/system_intf.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/system/system_intf.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/system/system_intf.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/system/system_win.ml
===================================================================
--- trunk/src/system/system_win.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/system/system_win.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/system/system_win.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/system.ml
===================================================================
--- trunk/src/system.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/system.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/system.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/system.mli
===================================================================
--- trunk/src/system.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/system.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/system.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Operations on filesystem path *)
Modified: trunk/src/terminal.ml
===================================================================
--- trunk/src/terminal.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/terminal.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/terminal.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/test.ml
===================================================================
--- trunk/src/test.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/test.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/test.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/test.mli
===================================================================
--- trunk/src/test.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/test.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/test.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Internal self-tests *)
Modified: trunk/src/transfer.ml
===================================================================
--- trunk/src/transfer.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/transfer.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/transfer.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/transfer.mli
===================================================================
--- trunk/src/transfer.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/transfer.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/transfer.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(*
Rsync : general algorithm description
Modified: trunk/src/transport.ml
===================================================================
--- trunk/src/transport.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/transport.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/transport.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/transport.mli
===================================================================
--- trunk/src/transport.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/transport.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/transport.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Executes the actions implied by the reconItem list. *)
val transportItem :
Modified: trunk/src/tree.ml
===================================================================
--- trunk/src/tree.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/tree.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/tree.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/tree.mli
===================================================================
--- trunk/src/tree.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/tree.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/tree.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* An ('a, 'b) t is a tree with 'a-labeled arcs and 'b-labeled nodes. *)
(* Labeling for the internal nodes is optional *)
Modified: trunk/src/ubase/proplist.ml
===================================================================
--- trunk/src/ubase/proplist.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/proplist.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/proplist.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/ubase/proplist.mli
===================================================================
--- trunk/src/ubase/proplist.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/proplist.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/proplist.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type 'a key
type t
Modified: trunk/src/ubase/rx.ml
===================================================================
--- trunk/src/ubase/rx.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/rx.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/rx.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/ubase/rx.mli
===================================================================
--- trunk/src/ubase/rx.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/rx.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/rx.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type t
Modified: trunk/src/ubase/safelist.ml
===================================================================
--- trunk/src/ubase/safelist.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/safelist.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/safelist.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/ubase/safelist.mli
===================================================================
--- trunk/src/ubase/safelist.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/safelist.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/safelist.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, 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
Modified: trunk/src/ubase/trace.ml
===================================================================
--- trunk/src/ubase/trace.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/trace.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/trace.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/ubase/trace.mli
===================================================================
--- trunk/src/ubase/trace.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/trace.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/trace.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* ---------------------------------------------------------------------- *)
(* Debugging support *)
Modified: trunk/src/ubase/uarg.ml
===================================================================
--- trunk/src/ubase/uarg.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/uarg.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/uarg.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* by Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* Slightly modified by BCP, July 1999 *)
Modified: trunk/src/ubase/util.ml
===================================================================
--- trunk/src/ubase/util.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/util.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/util.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/ubase/util.mli
===================================================================
--- trunk/src/ubase/util.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ubase/util.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ubase/util.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Miscellaneous utility functions and datatypes *)
Modified: trunk/src/ui.mli
===================================================================
--- trunk/src/ui.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/ui.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/ui.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* The module Ui provides only the user interface signature.
Implementations are provided by Uitext and Uitk. *)
Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uicommon.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/uicommon.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/uicommon.mli
===================================================================
--- trunk/src/uicommon.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uicommon.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/uicommon.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Kinds of UI *)
type interface =
Deleted: trunk/src/uigtk.ml
===================================================================
--- trunk/src/uigtk.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uigtk.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,2155 +0,0 @@
-(* $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 *)
Deleted: trunk/src/uigtk.mli
===================================================================
--- trunk/src/uigtk.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uigtk.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +0,0 @@
-(* $I1: Unison file synchronizer: src/uigtk.mli $ *)
-(* $I2: Last modified by vouillon on Tue, 30 May 2000 18:27:30 -0400 $ *)
-(* $I3: Copyright 1999-2004 (see COPYING for details) $ *)
-
-module Body : Uicommon.UI
Modified: trunk/src/uigtk2.ml
===================================================================
--- trunk/src/uigtk2.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uigtk2.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/uigtk2.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
@@ -209,7 +209,7 @@
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;
+ 0x1234; 0x2018; 0x2019; 0x201C; 0x201D; 0x2022; 0x2013; 0x2015;
0x02DC; 0x2122; 0x0161; 0x203A; 0x0153; 0x1234; 0x017E; 0x0178;
0x00A0; 0x00A1; 0x00A2; 0x00A3; 0x00A4; 0x00A5; 0x00A6; 0x00A7;
0x00A8; 0x00A9; 0x00AA; 0x00AB; 0x00AC; 0x00AD; 0x00AE; 0x00AF;
Modified: trunk/src/uigtk2.mli
===================================================================
--- trunk/src/uigtk2.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uigtk2.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,4 +1,4 @@
(* Unison file synchronizer: src/uigtk2.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module Body : Uicommon.UI
Modified: trunk/src/uimac14/MyController.m
===================================================================
--- trunk/src/uimac14/MyController.m 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uimac14/MyController.m 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,4 +1,4 @@
-/* Copyright (c) 2003, 2014, see file COPYING for details. */
+/* Copyright (c) 2003, 2015, see file COPYING for details. */
#import "MyController.h"
Modified: trunk/src/uimac14/ProgressCell.m
===================================================================
--- trunk/src/uimac14/ProgressCell.m 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uimac14/ProgressCell.m 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
/******************************************************************************
- * Copyright 2008, 2014 (see file COPYING for more information)
+ * Copyright 2008, 2015 (see file COPYING for more information)
*
* Loosely based on TorrentCell from Transmission (.png files are from
* the original).
Modified: trunk/src/uimac14/ReconTableView.m
===================================================================
--- trunk/src/uimac14/ReconTableView.m 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uimac14/ReconTableView.m 2014-12-29 18:34:45 UTC (rev 536)
@@ -3,7 +3,7 @@
// Unison
//
// Created by Trevor Jim on Wed Aug 27 2003.
-// Copyright (c) 2003, 2014. See file COPYING for details.
+// Copyright (c) 2003, 2015. See file COPYING for details.
//
#import "ReconTableView.h"
Modified: trunk/src/uitext.ml
===================================================================
--- trunk/src/uitext.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uitext.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/uitext.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/uitext.mli
===================================================================
--- trunk/src/uitext.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uitext.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,4 +1,4 @@
(* Unison file synchronizer: src/uitext.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module Body : Uicommon.UI
Modified: trunk/src/unicode.ml
===================================================================
--- trunk/src/unicode.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/unicode.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/unicode.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/unicode.mli
===================================================================
--- trunk/src/unicode.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/unicode.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/unicode.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
exception Invalid
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/update.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/update.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/update.mli
===================================================================
--- trunk/src/update.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/update.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/update.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module NameMap : MyMap.S with type key = Name.t
Modified: trunk/src/uutil.ml
===================================================================
--- trunk/src/uutil.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uutil.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/uutil.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/uutil.mli
===================================================================
--- trunk/src/uutil.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/uutil.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/uutil.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* This module collects a number of low-level, Unison-specific utility
functions. It is kept separate from the Util module so that that module
Modified: trunk/src/xferhint.ml
===================================================================
--- trunk/src/xferhint.ml 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/xferhint.ml 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/xferhint.ml *)
-(* Copyright 1999-2014, Benjamin C. Pierce
+(* Copyright 1999-2015, 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
Modified: trunk/src/xferhint.mli
===================================================================
--- trunk/src/xferhint.mli 2014-10-23 06:49:38 UTC (rev 535)
+++ trunk/src/xferhint.mli 2014-12-29 18:34:45 UTC (rev 536)
@@ -1,5 +1,5 @@
(* Unison file synchronizer: src/xferhint.mli *)
-(* Copyright 1999-2014, Benjamin C. Pierce (see COPYING for details) *)
+(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* This module maintains a cache that can be used to map
an Os.fullfingerprint to a (Fspath.t * Path.t) naming a file that *may*
More information about the Unison-hackers
mailing list