* Removed -mergebatch preference. (I never found it very useful, and

  its semantics were confusing.)

  Bumped minor version number.

* Refined debugging code so that the verbosity of individual modules
  can be controlled separately.  Instead of just putting '-debug
  verbose' on the command line, you can put '-debug update+', which
  causes all the extra messages in the Update module, but not other
  modules, to be printed.  Putting '-debug verbose' causes all modules
  to print with maximum verbosity.

19 files changed, 62 insertions, 54 deletions

diff --git a/src/RECENTNEWS b/src/RECENTNEWS
index e50720e..17b8fd5 100644
--- a/src/RECENTNEWS
+++ b/src/RECENTNEWS
@@ -1,3 +1,18 @@
+CHANGES FROM VERSION 2.21.-1
+
+* Removed -mergebatch preference.  (I never found it very useful, and
+  its semantics were confusing.)
+
+  Bumped minor version number.
+
+* Refined debugging code so that the verbosity of individual modules
+  can be controlled separately.  Instead of just putting '-debug
+  verbose' on the command line, you can put '-debug update+', which
+  causes all the extra messages in the Update module, but not other
+  modules, to be printed.  Putting '-debug verbose' causes all modules
+  to print with maximum verbosity.
+
+-------------------------------
 CHANGES FROM VERSION 2.20.2
 
 * Fixed a bug in merging code where Unison could sometimes deadlock
diff --git a/src/clroot.ml b/src/clroot.ml
index a7434ca..7fee2d8 100644
--- a/src/clroot.ml
+++ b/src/clroot.ml
@@ -197,7 +197,6 @@ let sshversion = Prefs.createString "sshversion" ""
 
 (* Main external function *)
 let parseRoot string =
-  let illegal s = raise(Prefs.IllegalValue s) in
   let illegal2 s = raise(Prefs.IllegalValue
                            (Printf.sprintf
                               "%s: %s" string s)) in
diff --git a/src/files.ml b/src/files.ml
index c0ddbf2..6d9d03a 100644
--- a/src/files.ml
+++ b/src/files.ml
@@ -7,7 +7,7 @@ open Lwt
 open Fileinfo
   
 let debug = Trace.debug "files"
-let debugverbose = Trace.debug "verbose"
+let debugverbose = Trace.debug "files+"
     
 (* ------------------------------------------------------------ *)
     
@@ -758,12 +758,7 @@ let keeptempfilesaftermerge =
     "keeptempfilesaftermerge" false "*" ""
 
 let makeSureMergeTempfilesAreIgnored () =
-  let oldRE = Pred.extern Globals.ignore in
-  if List.mem "Name .unisonmerge*" oldRE then
-    ()
-  else
-    let newRE = "Name .unisonmerge*"::oldRE in
-    Pred.intern Globals.ignore newRE
+  Globals.addRegexpToIgnore "Name .unisonmerge*"
 
 let merge root1 root2 path id ui1 ui2 showMergeFn =
   debug (fun () -> Util.msg "merge path %s between roots %s and %s\n"
@@ -886,7 +881,7 @@ let merge root1 root2 path id ui1 ui2 showMergeFn =
           Lwt_unix.open_process_full cmd (Unix.environment ()) 
           >>= (fun (out, ipt, err) ->
           readChannelsTillEof [out;err]
-          >>= (fun [mergeLogOut;mergeLogErr] ->
+          >>= (function [mergeLogOut;mergeLogErr] ->
           Lwt_unix.close_process_full (out, ipt, err)
           >>= (fun returnValue ->
           return (returnValue, (
@@ -898,7 +893,9 @@ let merge root1 root2 path id ui1 ui2 showMergeFn =
             ^"\n\n" 
             ^ (if returnValue = Unix.WEXITED 0
                then ""
-               else Util.process_status_to_string returnValue))))))) in
+               else Util.process_status_to_string returnValue))))
+            (* Stop typechechecker from complaining about non-exhaustive pattern above *)
+            | _ -> assert false))) in
       
       if not
           (showMergeFn
diff --git a/src/fspath.ml b/src/fspath.ml
index cb383e1..3a2bc97 100644
--- a/src/fspath.ml
+++ b/src/fspath.ml
@@ -15,7 +15,7 @@
 (*                                                                         - *)
 
 let debug = Util.debug "fspath"
-let debugverbose = Util.debug "verbose"
+let debugverbose = Util.debug "fspath+"
 
 type t = Fspath of string
 
diff --git a/src/globals.ml b/src/globals.ml
index e70f9c7..6cd26cd 100644
--- a/src/globals.ml
+++ b/src/globals.ml
@@ -245,6 +245,11 @@ let shouldIgnore p =
   let p = Path.toString p in
   (Pred.test ignore p) && not (Pred.test ignorenot p) 
 
+let addRegexpToIgnore re =
+  let oldRE = Pred.extern ignore in
+  let newRE = re::oldRE in
+  Pred.intern ignore newRE
+
 let merge = 
   Pred.create "merge"
     ("This preference can be used to run a merge program which will create "
@@ -257,21 +262,6 @@ let merge =
      ^ "details on Merging functions are present in "
      ^ "\\sectionref{merge}{Merging files}.")
         
-let mergebatch = 
-  Pred.create "mergebatch"
-    ("Normally, when Unison is run with the {\\tt batch} flag set to true, it does not "
-     ^ "invoke any external merge programs.  To tell it that a given file can be merged "
-     ^ "even when in batch mode, use the {\\tt mergebatch} preference instead of "
-     ^ "{\\tt merge}.  When running in non-batch mode, the {\\tt merge} preference is used "
-     ^ "instead of {\\tt mergebatch} if both are specified for a given path.")
-        
-let shouldMerge p =
-     Pred.test mergebatch (Path.toString p)
-  || (not (Prefs.read batch) && Pred.test merge (Path.toString p))
+let shouldMerge p = Pred.test merge (Path.toString p)
 
-let mergeCmdForPath p =
-  if Prefs.read batch then
-    Pred.assoc mergebatch (Path.toString p)
-  else
-    try Pred.assoc merge (Path.toString p)
-    with Not_found -> Pred.assoc mergebatch (Path.toString p)
+let mergeCmdForPath p = Pred.assoc merge (Path.toString p)
diff --git a/src/globals.mli b/src/globals.mli
index ce67fbf..21c41ed 100644
--- a/src/globals.mli
+++ b/src/globals.mli
@@ -71,8 +71,8 @@ val batch : bool Prefs.t
 val confirmBigDeletes : bool Prefs.t
 
 (* Predicates on paths *)
-val ignore : Pred.t
 val shouldIgnore : 'a Path.path -> bool
+val addRegexpToIgnore : string -> unit
 val shouldMerge : 'a Path.path -> bool
 
 (* Merging commands *)  
diff --git a/src/mkProjectInfo.ml b/src/mkProjectInfo.ml
index 07a3ec9..9fadebe 100644
--- a/src/mkProjectInfo.ml
+++ b/src/mkProjectInfo.ml
@@ -2,8 +2,8 @@
 
 let projectName = "unison"
 let majorVersion = 2
-let minorVersion = 20
-let pointVersionOrigin = 156 (* Revision that corresponds to point version 0 *)
+let minorVersion = 21
+let pointVersionOrigin = 160 (* Revision that corresponds to point version 0 *)
 
 (* You shouldn't need to edit below. *)
 
@@ -124,3 +124,4 @@ Printf.printf "NAME=%s\n" projectName;;
 
 
 
+
diff --git a/src/props.ml b/src/props.ml
index c0075cc..d0050de 100644
--- a/src/props.ml
+++ b/src/props.ml
@@ -280,7 +280,7 @@ let extern id =
         if id = 0 then
           raise (Util.Transient
                    (Printf.sprintf "Trying to map the non-root %s %s to %s 0"
-                      M.kind nm M.kind))
+                      M.kind nm M.kind));
         Hashtbl.add tbl nm id;
         id
 
diff --git a/src/remote.ml b/src/remote.ml
index a34ec90..03637af 100644
--- a/src/remote.ml
+++ b/src/remote.ml
@@ -12,9 +12,9 @@ XXX
 let (>>=) = Lwt.bind
 
 let debug = Trace.debug "remote"
-let debugV = Trace.debug "verbose"
-let debugE = Trace.debug "verbose"
-let debugT = Trace.debug "verbose"
+let debugV = Trace.debug "remote+"
+let debugE = Trace.debug "remote+"
+let debugT = Trace.debug "remote+"
 
 (* BCP: The previous definitions of the last two were like this:
      let debugE = Trace.debug "remote_emit"
diff --git a/src/stasher.ml b/src/stasher.ml
index 0020911..25df027 100644
--- a/src/stasher.ml
+++ b/src/stasher.ml
@@ -208,9 +208,8 @@ let addBackupFilesToIgnorePref () =
     | Some _ -> "Regex " ^ dir in
   debug (fun () -> 
      Util.msg "New pattern being added to ignore preferences: %s\n" theRegExp);
-  let oldRE = Pred.extern Globals.ignore in
-  let newRE = theRegExp::oldBackupPrefPathspec::oldRE in
-  Pred.intern Globals.ignore newRE
+  Globals.addRegexpToIgnore oldBackupPrefPathspec;
+  Globals.addRegexpToIgnore theRegExp
 
 (*------------------------------------------------------------------------------------*)
 
@@ -404,7 +403,7 @@ let stashPath st fspath path =
 	  Os.delete tempfspath tempPath 
 	else begin 
         (* we still a keep a second backup just in case something go bad *)
-	  Trace.debug "verbose" 
+	  Trace.debug "stasher+" 
 	    (fun () -> Util.msg "Creating a safety backup for (%s, %s)\n" 
 		(Fspath.toString tempfspath) (Path.toString path));
 	  let olBackup = findStash path 1 in
diff --git a/src/transfer.ml b/src/transfer.ml
index 9a8ed40..bb8f399 100644
--- a/src/transfer.ml
+++ b/src/transfer.ml
@@ -36,7 +36,7 @@
    characters that could not fill a block.  *)
 
 let debug  = Trace.debug "transfer"
-let debugV = Trace.debug "verbose"
+let debugV = Trace.debug "transfer+"
 let debugToken = Trace.debug "rsynctoken"
 let debugLog =   Trace.debug "rsynclog"
 
@@ -590,7 +590,6 @@ struct
         computeChecksum newOffset toBeSent length miss
       else if length = comprBufSize then begin
         transmitString toBeSent newOffset >>= (fun () ->
-        let toBeSent = newOffset in
         let chunkSize = length - newOffset in
         if chunkSize > 0 then begin
           assert(comprBufSize >= blockSize);
@@ -629,7 +628,7 @@ struct
 
     (* Try to match the current block with one existing in the old file *)
     and processBlock offset toBeSent length checksum =
-      if Trace.enabled "verbose" then
+      if Trace.enabled "transfer+" then
         debugV (fun() -> Util.msg
             "processBlock offset=%d toBeSent=%d length=%d blockSize = %d\n"
             offset toBeSent length blockSize);
diff --git a/src/transport.ml b/src/transport.ml
index 77bab68..436d292 100644
--- a/src/transport.ml
+++ b/src/transport.ml
@@ -55,7 +55,7 @@ let logLwt (msgBegin: string)
 let rLogCounter = ref 0
 let logLwtNumbered (lwtDescription: string) (lwtShortDescription: string)
     (t: unit -> 'a Lwt.t): 'a Lwt.t =
-  let lwt_id = (rLogCounter := (!rLogCounter) + 1; !rLogCounter) in
+  let _ = (rLogCounter := (!rLogCounter) + 1; !rLogCounter) in
   logLwt (Printf.sprintf "[BGN] %s\n" lwtDescription) t
     (fun _ ->
       Printf.sprintf "[END] %s\n" lwtShortDescription)
diff --git a/src/ubase/Makefile b/src/ubase/Makefile
index b1fdb0d..c37a5ef 100644
--- a/src/ubase/Makefile
+++ b/src/ubase/Makefile
@@ -52,3 +52,6 @@ uninstall:
 clean::
 	rm -f *.cmi *.cmo *.cmx *.cma *.cmxa *.a *.o *~ *.bak
 
+# Used by BCP to update Harmony's copy of these files from Unison's
+update:
+	cp $(HOME)/current/unison/trunk/src/ubase/{*.ml,*.mli,Makefile} .
\ No newline at end of file
diff --git a/src/ubase/myMap.ml b/src/ubase/myMap.ml
index bb80ca8..4016419 100644
--- a/src/ubase/myMap.ml
+++ b/src/ubase/myMap.ml
@@ -97,7 +97,7 @@ module Make(Ord: OrderedType) = struct
     let rec add x data = function
         Empty ->
           Node(Empty, x, data, Empty, 1)
-      | Node(l, v, d, r, h) as t ->
+      | Node(l, v, d, r, h) ->
           let c = Ord.compare x v in
           if c = 0 then
             Node(l, x, data, r, h)
@@ -150,7 +150,7 @@ module Make(Ord: OrderedType) = struct
     let rec remove x = function
         Empty ->
           Empty
-      | Node(l, v, d, r, h) as t ->
+      | Node(l, v, d, r, h) ->
           let c = Ord.compare x v in
           if c = 0 then
             merge l r
diff --git a/src/ubase/prefs.ml b/src/ubase/prefs.ml
index 193c81a..7bcdd71 100644
--- a/src/ubase/prefs.ml
+++ b/src/ubase/prefs.ml
@@ -304,7 +304,7 @@ let listVisiblePrefs () =
          if String.length fulldoc > 0 then begin
            (name, pspec, fulldoc) :: l
          end else l) !prefs [] in
-  Safelist.stable_sort (fun (name1,_,_) (name2,_,_) -> compare name1 name2) l
+  Safelist.stable_sort (fun (name1,_,_) (name2,_,_) -> compare name2 name1) l
 
 let printFullDocs () =
   Printf.eprintf "\\begin{description}\n";
diff --git a/src/ubase/rx.ml b/src/ubase/rx.ml
index c24e190..0e13ec5 100644
--- a/src/ubase/rx.ml
+++ b/src/ubase/rx.ml
@@ -722,7 +722,7 @@ let glob_parse init s =
   let test c = not (eos ()) && s.[!i] = c in
   let accept c = let r = test c in if r then incr i; r in
   let get () = let r = s.[!i] in incr i; r in
-  let unget () = decr i in
+  (* let unget () = decr i in *)
 
   let rec expr () = expr' init (Sequence [])
   and expr' beg left =
@@ -746,7 +746,7 @@ let glob_parse init s =
        end,
        Mid)
     else if accept '[' then begin
-      let mask = if beg <> Mid then notdot else gany in
+      (* let mask = if beg <> Mid then notdot else gany in *)
       let set =
         if accept '^' || accept '!' then
           cnegate 0 255 (bracket [])
diff --git a/src/ubase/trace.ml b/src/ubase/trace.ml
index adf2854..251c481 100644
--- a/src/ubase/trace.ml
+++ b/src/ubase/trace.ml
@@ -31,12 +31,18 @@ let runningasserver = ref false
 let debugging() = (Prefs.read debugmods) <> []
 
 let enabled modname =
+  let modnamebase,plus =
+    if Util.endswith modname "+" then (Util.replacesubstring modname "+" "", true)
+    else (modname, false) in
   let m = Prefs.read debugmods in
   m <> [] && (   (modname = "")
               || (Safelist.mem "verbose" m)
-              || ((Safelist.mem "all" m || Safelist.mem "-all" m)
-                    && modname <> "verbose")
-              || (Safelist.mem modname m))
+              || (Safelist.mem "all+" m)
+              || (Safelist.mem "all+" m)
+              || (Safelist.mem "all" m && not plus)
+              || (Safelist.mem modname m)
+              || (Safelist.mem modnamebase m && not plus)
+             )
 
 let enable modname onoff =
   let m = Prefs.read debugmods in
diff --git a/src/uicommon.ml b/src/uicommon.ml
index 2bafa5a..fc9d9ef 100644
--- a/src/uicommon.ml
+++ b/src/uicommon.ml
@@ -352,8 +352,7 @@ let ignoreExt path =
 let addIgnorePattern theRegExp =
   if theRegExp = "Path " then
     raise (Util.Transient "Can't ignore the root path!");
-  let theRegExps = theRegExp::(Pred.extern Globals.ignore) in
-  Pred.intern Globals.ignore theRegExps;
+  Globals.addRegexpToIgnore theRegExp;
   let r = Prefs.add "ignore" theRegExp in
   Trace.status r;
   (* Make sure the server has the same ignored paths (in case, for
diff --git a/src/update.ml b/src/update.ml
index 2944f57..7d75ff5 100644
--- a/src/update.ml
+++ b/src/update.ml
@@ -6,7 +6,7 @@ open Common
 let (>>=)  = Lwt.(>>=)
 
 let debug = Trace.debug "update"
-let debugverbose = Trace.debug "verbose"
+let debugverbose = Trace.debug "update+"
 let debugalias = Trace.debug "rootalias"
 let debugignore = Trace.debug "ignore"