UI: merge selection requires merge command instead of preference

src/files.ml

@@ -757,13 +757,10 @@ let ls dir pattern =
 ************************************************************************)
 
 let formatMergeCmd p f1 f2 backup out1 out2 outarch =
-  if not (Globals.shouldMerge p) then
-    raise (Util.Transient ("'merge' preference not set for "^(Path.toString p)));
+  assert (Globals.mayMerge p); (* the UI should guarantee that *)
   let raw =
     try Globals.mergeCmdForPath p
-    with Not_found ->
-      raise (Util.Transient ("'merge' preference does not provide a command "
-                             ^ "template for " ^ (Path.toString p)))
+    with Not_found -> assert false (* mayMerge guarantees that *)
   in
   let cooked = raw in
   let cooked = Util.replacesubstring cooked "CURRENT1" f1 in

src/globals.ml

@@ -285,10 +285,12 @@ let merge =
      ^ "details on Merging functions are present in "
      ^ "\\sectionref{merge}{Merging Conflicting Versions}.")
 
-let shouldMerge p = Pred.test merge (Path.toString p)
-
 let mergeCmdForPath p = Pred.assoc merge (Path.toString p)
 
+let mayMerge p = try let _ = mergeCmdForPath p in true with Not_found -> false
+
+let shouldMerge p = Pred.test merge (Path.toString p) && mayMerge p
+
 let someHostIsRunningWindows =
   Prefs.createBool "someHostIsRunningWindows" false "*" ""
 

src/globals.mli

@@ -77,7 +77,8 @@ val confirmBigDeletes : bool Prefs.t
 
 (* Predicates on paths *)
 val shouldIgnore : 'a Path.path -> bool
-val shouldMerge : 'a Path.path -> bool
+val shouldMerge : 'a Path.path -> bool (* merge conflicts by default *)
+val mayMerge : 'a Path.path -> bool (* can UI choose to merge *)
 val ignorePred : Pred.t
 val ignorenotPred : Pred.t
 val atomic : Pred.t

src/uicommon.ml

@@ -352,6 +352,10 @@ let dangerousPathMsg dangerousPaths =
          (Safelist.map (fun p -> "'" ^ (Path.toString p) ^ "'")
             dangerousPaths))
 
+let cannotMergeMsg ~path = match path with
+      None -> "'merge' command not provided for this path"
+    | Some p -> "'merge' command not provided for "^(Path.toString p)
+
 (**********************************************************************
                   Useful patterns for ignoring paths
  **********************************************************************)

src/uicommon.mli

@@ -74,6 +74,7 @@ val showDiffs :
   -> unit
 
 val dangerousPathMsg : Path.t list -> string
+val cannotMergeMsg : path:(Path.t option) -> string
 
 (* Utilities for adding ignore patterns *)
 val ignorePath : Path.t -> string

src/uigtk2.ml

@@ -3752,15 +3752,15 @@ lst_store#set ~row ~column:c_path path;
       done
     end
   in
-  let doAction f =
+  let doAction ?(next=fun _->true) f =
     (* FIX: when the window does not have the focus, we are not notified
        immediately from changes to the list of selected items.  So, we
        update our view of the current selection here. *)
     updateCurrent ();
     match currentRow () with
       Some i ->
         doActionOnRow f i;
-        nextInteresting ()
+        if next !theState.(i) then nextInteresting ()
     | None ->
         (* FIX: this is quadratic when all items are selected.
            We could trigger a redisplay instead, but it may be tricky
@@ -3779,7 +3779,12 @@ lst_store#set ~row ~column:c_path path;
   let rightAction _ =
     doAction (fun _ diff -> diff.direction <- Replica1ToReplica2) in
   let questionAction _ = doAction (fun _ diff -> diff.direction <- Conflict "") in
-  let mergeAction    _ = doAction (fun _ diff -> diff.direction <- Merge) in
+  let mergeAction    _ =
+    let checkAndMerge ri diff = if Globals.mayMerge ri.path1
+      then diff.direction <- Merge
+      else okBox ~parent:toplevelWindow ~title:"Cannot merge" ~typ:`ERROR
+          ~message:(Uicommon.cannotMergeMsg ~path:(Some ri.path1)) in
+    doAction ~next:(fun i->Globals.shouldMerge i.ri.path1) checkAndMerge in
 
 (*  actionBar#insert_space ();*)
   grAdd grAction

src/uimacbridge.ml

@@ -320,7 +320,9 @@ Callback.register "unisonRiSetConflict" unisonRiSetConflict;;
 let unisonRiSetMerge ri =
   match ri.ri.replicas with
     Problem _ -> ()
-  | Different diff -> diff.direction <- Merge;;
+  | Different diff -> if Globals.mayMerge ri.path1
+      then diff.direction <- Merge
+      else Util.warn (Uicommon.cannotMergeMsg ~path:(Some ri.path1));;
 Callback.register "unisonRiSetMerge" unisonRiSetMerge;;
 let unisonRiForceOlder ri =
   Recon.setDirection ri.ri `Older `Force;;

src/uimacbridgenew.ml

@@ -471,7 +471,9 @@ Callback.register "unisonRiSetConflict" unisonRiSetConflict;;
 let unisonRiSetMerge ri =
   match ri.ri.replicas with
     Problem _ -> ()
-  | Different diff -> diff.direction <- Merge;;
+  | Different diff -> if Globals.mayMerge ri.path1
+      then diff.direction <- Merge
+      else Util.warn (Uicommon.cannotMergeMsg ~path:(Some ri.path1));;
 Callback.register "unisonRiSetMerge" unisonRiSetMerge;;
 let unisonRiForceOlder ri =
   Recon.setDirection ri.ri `Older `Force;;

src/uitext.ml

@@ -544,7 +544,11 @@ let interact prilist rilist =
                  (["m"],
                   ("merge the versions (curr or match)"),
                   (fun () ->
-                     actOnMatching (setdir Merge)));
+                     actOnMatching
+                       ~fail:(Some (fun() ->
+                           display ((Uicommon.cannotMergeMsg ~path:None)^"\n")))
+                       (fun ri -> if Globals.mayMerge ri.path1
+                                  then setdir Merge ri else false)));
                  ([">";"."],
                   ("propagate from " ^ descr ^ " (curr or match)"),
                   (fun () ->