diff --git a/src/files.ml b/src/files.ml index 72cd33875..4d8ed37c9 100644 --- a/src/files.ml +++ b/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 -> diff --git a/src/uicommon.ml b/src/uicommon.ml index f5d82bf50..df606c554 100644 --- a/src/uicommon.ml +++ b/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 **********************************************************************) diff --git a/src/uicommon.mli b/src/uicommon.mli index ad3771b30..651f63574 100644 --- a/src/uicommon.mli +++ b/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 diff --git a/src/uigtk2.ml b/src/uigtk2.ml index 6806ec310..759402d00 100644 --- a/src/uigtk2.ml +++ b/src/uigtk2.ml @@ -3752,7 +3752,7 @@ 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. *) @@ -3760,7 +3760,7 @@ lst_store#set ~row ~column:c_path path; 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 diff --git a/src/uimacbridge.ml b/src/uimacbridge.ml index b679752a8..8ed05a7e9 100644 --- a/src/uimacbridge.ml +++ b/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;; diff --git a/src/uimacbridgenew.ml b/src/uimacbridgenew.ml index e83061cf1..3eb254f34 100644 --- a/src/uimacbridgenew.ml +++ b/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;; diff --git a/src/uitext.ml b/src/uitext.ml index 72ef5ddeb..6c1b45a60 100644 --- a/src/uitext.ml +++ b/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 () ->