diff --git a/src/files.ml b/src/files.ml index 5ff188106..798a437eb 100644 --- a/src/files.ml +++ b/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 diff --git a/src/globals.ml b/src/globals.ml index 009339a4a..ee4a9e9be 100644 --- a/src/globals.ml +++ b/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 "*" "" diff --git a/src/globals.mli b/src/globals.mli index db8bc250d..d4e20e577 100644 --- a/src/globals.mli +++ b/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 diff --git a/src/uicommon.ml b/src/uicommon.ml index 9fa94cf54..961fab880 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' command not provided for this path" + | Some p -> "'merge' command not provided 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 04c4da4a0..731ed1095 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.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 diff --git a/src/uimacbridge.ml b/src/uimacbridge.ml index b679752a8..3d20d4987 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.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;; diff --git a/src/uimacbridgenew.ml b/src/uimacbridgenew.ml index e83061cf1..cf1f68866 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.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;; diff --git a/src/uitext.ml b/src/uitext.ml index 72b22e31f..ed1421c5e 100644 --- a/src/uitext.ml +++ b/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 () ->