Ui fix: refuse to choose merge when preference not set

src/files.ml

@@ -756,9 +756,8 @@ let ls dir pattern =
                   CALL OUT TO EXTERNAL MERGE PROGRAM
 ************************************************************************)
 
-let formatMergeCmd p f1 f2 backup out1 out2 outarch batchmode =
-  if not (Globals.shouldMerge p) then
-    raise (Util.Transient ("'merge' preference not set for "^(Path.toString p)));
+let formatMergeCmd p f1 f2 backup out1 out2 outarch =
+  assert (Globals.shouldMerge p); (* the UI should guarantee that *)
   let raw =
     try Globals.mergeCmdForPath p
     with Not_found ->

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' preference not set for this path"
+    | Some p -> "'merge' preference not set 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.shouldMerge 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.shouldMerge 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.shouldMerge 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

@@ -546,7 +546,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.shouldMerge ri.path1
+                                  then setdir Merge ri else false)));
                  ([">";"."],
                   ("propagate from " ^ descr ^ " (curr or match)"),
                   (fun () ->