diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/globals.ml | 13 | ||||
| -rw-r--r-- | src/recon.ml | 3 | ||||
| -rw-r--r-- | src/stasher.ml | 11 | ||||
| -rw-r--r-- | src/ubase/prefs.ml | 19 | ||||
| -rw-r--r-- | src/ubase/trace.ml | 5 | ||||
| -rw-r--r-- | src/ubase/uarg.ml | 13 | ||||
| -rw-r--r-- | src/ubase/util.ml | 13 | ||||
| -rw-r--r-- | src/ubase/util.mli | 2 | ||||
| -rw-r--r-- | src/uitext.ml | 440 |
9 files changed, 372 insertions, 147 deletions
diff --git a/src/globals.ml b/src/globals.ml index d96fb63..009339a 100644 --- a/src/globals.ml +++ b/src/globals.ml @@ -260,8 +260,11 @@ let ignorenotPred = preference to choose particular paths to synchronize.") let atomic = Pred.create "atomic" ~advanced:true - ("This preference specifies paths for directories whose \ - contents will be considered as a group rather than individually.") + ("This preference specifies paths for directories whose " + ^ "contents will be considered as a group rather than individually when " + ^ "they are both modified. " + ^ "The backups are also made atomically in this case. The option " + ^ "\\texttt{backupcurr} however has no effect on atomic directories.") let shouldIgnore p = let p = Path.toString p in @@ -276,10 +279,8 @@ let merge = Pred.create "merge" ~advanced:true ("This preference can be used to run a merge program which will create " ^ "a new version for each of the files and the backup, " - ^ "with the last backup and the both replicas. Setting the {\\tt merge} " - ^ "preference for a path will also cause this path to be backed up, " - ^ "just like {\tt backup}. " - ^ "The syntax of \\ARG{pathspec>cmd} is " + ^ "with the last backup and both replicas. " + ^ "The syntax of \\ARG{pathspec -> cmd} is " ^ "described in \\sectionref{pathspec}{Path Specification}, and further " ^ "details on Merging functions are present in " ^ "\\sectionref{merge}{Merging Conflicting Versions}.") diff --git a/src/recon.ml b/src/recon.ml index 2c619bb..490baf1 100644 --- a/src/recon.ml +++ b/src/recon.ml @@ -116,7 +116,8 @@ let preferRoot: string Prefs.t = "!choose this replica's version for conflicting changes" ("Including the preference \\texttt{-prefer \\ARG{root}} causes Unison always to " ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " - ^ "guidance from the user. (The syntax of \\ARG{root} is the same as " + ^ "guidance from the user, except for paths marked by the preference " + ^ "\\texttt{merge}. (The syntax of \\ARG{root} is the same as " ^ "for the \\verb|root| preference, plus the special values " ^ "\\verb|newer| and \\verb|older|.) \n\n" ^ "This preference is overridden by the \\verb|preferpartial| preference.\n\n" diff --git a/src/stasher.ml b/src/stasher.ml index f306f89..201c9b2 100644 --- a/src/stasher.ml +++ b/src/stasher.ml @@ -39,7 +39,8 @@ let backup = Pred.create "backup" ~advanced:true ("Including the preference \\texttt{-backup \\ARG{pathspec}} " ^ "causes Unison to keep backup files for each path that matches " - ^ "\\ARG{pathspec}. These backup files are kept in the " + ^ "\\ARG{pathspec}; directories (nor their permissions or any other " + ^ " metadata) are not backed up. These backup files are kept in the " ^ "directory specified by the \\verb|backuplocation| preference. The backups are named " ^ "according to the \\verb|backupprefix| and \\verb|backupsuffix| preferences." ^ " The number of versions that are kept is determined by the " @@ -54,9 +55,7 @@ let backupnot = ("The values of this preference specify paths or individual files or" ^ " regular expressions that should {\\em not} " ^ "be backed up, even if the {\\tt backup} preference selects " - ^ "them---i.e., " - ^ "it selectively overrides {\\tt backup}. The same caveats apply here " - ^ "as with {\\tt ignore} and {\\tt ignorenot}.") + ^ "them---i.e., it selectively overrides {\\tt backup}.") let _ = Pred.alias backupnot "mirrornot" @@ -159,10 +158,6 @@ let backupcurrentnot = "Exceptions to \\verb|backupcurr|, like the \\verb|ignorenot| preference." let shouldBackupCurrent p = - (* BCP: removed next line [Apr 2007]: causes ALL mergeable files to be backed - up, which is probably not what users want -- the backupcurrent - switch should be used instead. - Globals.shouldMerge p || *) (let s = Path.toString p in Pred.test backupcurrent s && not (Pred.test backupcurrentnot s)) diff --git a/src/ubase/prefs.ml b/src/ubase/prefs.ml index 44df052..7049719 100644 --- a/src/ubase/prefs.ml +++ b/src/ubase/prefs.ml @@ -392,16 +392,15 @@ and parseLines filename lines = | _ -> raise (Util.Fatal(Printf.sprintf "File \"%s\", line %d:\nGarbled 'include' directive: %s" filename lineNum theLine)) - else try - let pos = String.index theLine '=' in - let varName = Util.trimWhitespace (String.sub theLine 0 pos) in - let theResult = - Util.trimWhitespace (String.sub theLine (pos+1) - (String.length theLine - pos - 1)) in - loop rest (lineNum+1) ((filename, lineNum, varName, theResult)::res) - with Not_found -> (* theLine does not contain '=' *) - raise(Util.Fatal(Printf.sprintf - "File \"%s\", line %d:\nGarbled line (no '='):\n%s" filename lineNum theLine)) in + else + let l = Util.splitAtFirstChar theLine '=' in + match Safelist.map Util.trimWhitespace l with + [varName;theResult] -> + loop rest (lineNum+1) ((filename, lineNum, varName, theResult)::res) + | _ -> (* theLine does not contain '=' *) + raise (Util.Fatal(Printf.sprintf + "File \"%s\", line %d:\nGarbled line (no '='):\n%s" + filename lineNum theLine)) in loop lines 1 [] let processLines lines = diff --git a/src/ubase/trace.ml b/src/ubase/trace.ml index 08caddf..d47054a 100644 --- a/src/ubase/trace.ml +++ b/src/ubase/trace.ml @@ -117,7 +117,7 @@ let logfile = "!logfile name" "By default, logging messages will be appended to the file \\verb|unison.log| in your HOME directory. Set this preference if - you prefer another file." + you prefer another file. It can be a path relative to your HOME directory." let logch = ref None @@ -125,7 +125,8 @@ let rec getLogch() = Util.convertUnixErrorsToFatal "getLogch" (fun() -> match !logch with None -> - let file = Prefs.read logfile in + let prefstr = System.fspathToString (Prefs.read logfile) in + let file = Util.fileMaybeRelToHomeDir prefstr in let ch = System.open_out_gen [Open_wronly; Open_creat; Open_append] 0o600 file in logch := Some (ch, file); diff --git a/src/ubase/uarg.ml b/src/ubase/uarg.ml index 5ffd924..2d9e55e 100644 --- a/src/ubase/uarg.ml +++ b/src/ubase/uarg.ml @@ -69,7 +69,7 @@ let parse speclist anonfun errmsg = while !current < l do let ss = argv.(!current) in if String.length ss >= 1 & String.get ss 0 = '-' then begin - let args = Util.splitIntoWords ss '=' in + let args = Util.splitAtFirstChar ss '=' in let s = Safelist.nth args 0 in let arg conv mesg = match args with @@ -79,10 +79,13 @@ let parse speclist anonfun errmsg = incr current; (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) | [_;a] -> (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) - | _ -> stop (Message (sprintf "Garbled argument %s" s)) in + | _ -> assert false in let action = try assoc3 s speclist with Not_found -> stop (Unknown s) + and catch f a = + try f a + with Invalid_argument s -> raise (Failure s) in begin try match action with @@ -92,11 +95,11 @@ let parse speclist anonfun errmsg = | Bool f -> begin match args with [_] -> f true - | _ -> f (arg bool_of_string "a boolean") + | _ -> f (arg (catch bool_of_string) "a boolean") end | String f -> f (arg (fun s-> s) "") - | Int f -> f (arg int_of_string "an integer") - | Float f -> f (arg float_of_string "a float") + | Int f -> f (arg (catch int_of_string) "an integer") + | Float f -> f (arg (catch float_of_string) "a float") | Rest f -> while !current < l-1 do f argv.(!current+1); diff --git a/src/ubase/util.ml b/src/ubase/util.ml index 8af4714..9634a85 100644 --- a/src/ubase/util.ml +++ b/src/ubase/util.ml @@ -401,6 +401,14 @@ let trimWhitespace s = in loop 0 (l-1) +let splitAtFirstChar (s:string) (c:char) = + try + let i = String.index s c + and l= String.length s in + (* rest is possibly the empty string *) + [String.sub s 0 i; String.sub s (i+1) (l-i-1)] + with Not_found -> [s] + let splitIntoWords ?esc:(e='\\') (s:string) (c:char) = let rec inword acc eacc start pos = if pos >= String.length s || s.[pos] = c then @@ -460,6 +468,11 @@ let homeDir () = let fileInHomeDir n = System.fspathConcat (homeDir ()) n +let fileMaybeRelToHomeDir n = + if Filename.is_relative n + then fileInHomeDir n + else System.fspathFromString n + (*****************************************************************************) (* "Upcall" for building pathnames in the .unison dir *) (*****************************************************************************) diff --git a/src/ubase/util.mli b/src/ubase/util.mli index b213560..24bdb9d 100644 --- a/src/ubase/util.mli +++ b/src/ubase/util.mli @@ -55,6 +55,7 @@ val replacesubstrings : string -> (string * string) list -> string val concatmap : string -> ('a -> string) -> 'a list -> string val removeTrailingCR : string -> string val trimWhitespace : string -> string +val splitAtFirstChar : string -> char -> string list val splitIntoWords : ?esc:char -> string -> char -> string list val splitIntoWordsByString : string -> string -> string list val padto : int -> string -> string @@ -79,6 +80,7 @@ val percentageOfTotal : val monthname : int -> string val percent2string : float -> string val fileInHomeDir : string -> System.fspath +val fileMaybeRelToHomeDir : string -> System.fspath val homeDirStr : string (* Just like the versions in the Unix module, but raising Transient diff --git a/src/uitext.ml b/src/uitext.ml index 0b50628..fc5e8eb 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -135,6 +135,8 @@ let rec selectAction batch actions tryagain = let formatname = function "" -> "<ret>" | " " -> "<spc>" + | "\x7f" -> "<del>" + | "\b" -> "<bsp>" | n -> n in let summarizeChoices() = display "["; @@ -247,6 +249,61 @@ let interact prilist rilist = if not (Prefs.read Globals.batch) then display ("\n" ^ Uicommon.roots2string() ^ "\n"); let (r1,r2) = Globals.roots() in let (host1, host2) = root2hostname r1, root2hostname r2 in + let showdiffs ri = + Uicommon.showDiffs ri + (fun title text -> + try + let pager = System.getenv "PAGER" in + restoreTerminal (); + let out = System.open_process_out pager in + Printf.fprintf out "\n%s\n\n%s\n\n" title text; + let _ = System.close_process_out out in + setupTerminal () + with Not_found -> + Printf.printf "\n%s\n\n%s\n\n" title text) + (fun s -> Printf.printf "%s\n" s) + Uutil.File.dummy; + true + and ispropschanged = function + {replicas = Different {rc1 = rc1; rc2 = rc2}} + when rc1.status = `PropsChanged && + (rc2.status = `PropsChanged || rc2.status = `Unchanged) -> true + | {replicas = Different {rc1 = rc1; rc2 = rc2}} + when rc1.status = `Unchanged && rc2.status = `PropsChanged -> true + | _ -> false + and setdirchanged = function + {replicas = Different ({rc1 = rc1; rc2 = rc2} as diff)} + when rc1.status = `Modified && rc2.status = `PropsChanged -> + diff.direction <- Replica1ToReplica2; true + | {replicas = Different ({rc1 = rc1; rc2 = rc2} as diff)} + when rc1.status = `PropsChanged && rc2.status = `Modified -> + diff.direction <- Replica2ToReplica1; true + | {replicas = Different _} -> false + | _ -> true + and setskip = function + {replicas = Different ({direction = Conflict _})} -> true + | {replicas = Different diff} -> + begin diff.direction <- Conflict "skip requested"; true end + | _ -> true + and setdir dir = function + {replicas = Different diff} -> begin diff.direction <- dir; true end + | _ -> true + and invertdir = function + {replicas = Different ({direction = Replica1ToReplica2} as diff)} + -> diff.direction <- Replica2ToReplica1; true + | {replicas = Different ({direction = Replica2ToReplica1} as diff)} + -> diff.direction <- Replica1ToReplica2; true + | {replicas = Different _} -> false + | _ -> true + and setDirectionIfConflict dir = function + {replicas = Different ({direction = Conflict _})} as ri -> + begin Recon.setDirection ri dir `Force; true end + | ri -> begin Recon.setDirection ri dir `Prefer; true end + in + let ripred = ref [] in + let ritest ri = match !ripred with + [] -> true + | test::_ -> test ri in let rec loop prev = let rec previous prev ril = match prev with @@ -255,13 +312,21 @@ let interact prilist rilist = previous pril (pri::ril) | pri::pril -> loop pril (pri::ril) | [] -> display ("\n" ^ Uicommon.roots2string() ^ "\n"); loop prev ril in + let rec forward n prev ril = + match n, prev, ril with + 0, prev, ril -> loop prev ril + | n, [], ril when n < 0 -> loop [] ril + | n, pri::pril, ril when n < 0 -> forward (n+1) pril (pri::ril) + | _, [], [] -> loop [] [] + | n, pri::pril, [] when n > 0 -> loop pril [pri] + | n, prev, ri::rest when n > 0 -> forward (n-1) (ri::prev) rest + | _ -> assert false (* to silence the compiler *) in function [] -> (ConfirmBeforeProceeding, Safelist.rev prev) | ri::rest as ril -> let next() = loop (ri::prev) rest in let repeat() = loop prev ril in let ignore pat rest what = - if !cbreakMode <> None then display "\n"; display " "; Uicommon.addIgnorePattern pat; display (" Permanently ignoring " ^ what ^ "\n"); @@ -275,6 +340,43 @@ let interact prilist rilist = loop (nukeIgnoredRis (ri::prev)) (nukeIgnoredRis ril) in (* This should work on most terminals: *) let redisplayri() = overwrite (); displayri ri; display "\n" in + let setripred cmd = + ripred := match cmd, !ripred with + `Unset, [] -> display "Matching condition already disabled\n"; [] + | `Unset, _ | `Pop, [_] -> display " Disabling matching condition\n"; [] + | `Pop, p::pp::t -> pp::t + | `Push rp, [] -> display " Enabling matching condition\n"; [rp] + | `Push rp, p -> rp::p + | _, [] -> display "Matching condition not enabled\n"; [] + | `Op1 op, p::t -> (fun ri -> op (p ri))::t + | `Op2 op, [p] -> display "Missing previous matching condition\n"; [p] + | `Op2 op, p::pp::t -> (fun ri -> op (p ri) (pp ri))::t + | _ -> assert false in + let actOnMatching ?(change=true) ?(fail=Some(fun()->())) f = + (* [f] can have effects on the ri and return false to discard it *) + (* Disabling [change] avoids to redisplay the item, allows [f] to + print a message (info or error) on a separate line and repeats + instead of going to the next item *) + (* When [fail] is [None] if [f] returns false then instead of + executing [fail] and repeating we discard the item and go to the next *) + let discard, err = + match fail with Some e -> false, e | None -> true, fun()->() in + match !ripred with + | [] -> if not change then newLine(); + let t = f ri in + if t || not discard + then begin + if change then redisplayri(); + if not t then err(); + if t && change then next() else repeat() + end else begin + if change then newLine(); + loop prev rest + end + | test::_ -> newLine(); + let filt = fun ri -> if test ri then f ri || not discard else true in + loop prev (ri::Safelist.filter filt rest) + in displayri ri; match ri.replicas with Problem s -> display "\n"; display s; display "\n"; next() @@ -297,112 +399,220 @@ let interact prilist rilist = selectAction (if Prefs.read Globals.batch then Some " " else None) [((if (isConflict dir) && not (Prefs.read Globals.batch) - then ["f"] (* Offer no default behavior if we've got - a conflict and we're in interactive mode *) - else ["";"f";" "]), + then ["f"] (* Offer no default behavior if we've got a + conflict and we're in interactive mode *) + else ["";"f";" "]), ("follow " ^ Uutil.myName ^ "'s recommendation (if any)"), - fun ()-> - newLine (); - if (isConflict dir) && not (Prefs.read Globals.batch) - then begin - display "No default action [type '?' for help]\n"; - repeat() - end else - next()); - (["I"], - ("ignore this path permanently"), - (fun () -> - ignore (Uicommon.ignorePath ri.path1) rest - "this path")); - (["E"], - ("permanently ignore files with this extension"), - (fun () -> - ignore (Uicommon.ignoreExt ri.path1) rest - "files with this extension")); - (["N"], - ("permanently ignore paths ending with this name"), - (fun () -> - ignore (Uicommon.ignoreName ri.path1) rest - "files with this name")); - (["m"], - ("merge the versions"), + (fun () -> newLine(); + if (isConflict dir) && not (Prefs.read Globals.batch) + then begin + display "No default action [type '?' for help]\n"; + repeat() + end else + next())); + (["n";"j"], + ("go to the next item"), + (fun () -> newLine(); + next())); + (["p";"b";"k"], + ("go back to previous item"), + (fun () -> newLine(); + previous prev ril)); + (["\x7f";"\b"], + ("revert then go back to previous item"), (fun () -> - diff.direction <- Merge; - redisplayri(); - next())); + Recon.revertToDefaultDirection ri; redisplayri(); + previous prev ril)); + (["0"], + ("go to the start of the list"), + (fun () -> newLine(); + loop [] (Safelist.rev_append prev ril))); + (["9"], + ("go to the end of the list"), + (fun () -> newLine(); + match Safelist.rev_append ril prev with + [] -> loop [] [] + | lri::prev -> loop prev [lri])); + (["5"], + ("go forward to the middle of the following items"), + (fun () -> newLine(); + forward ((Safelist.length ril)/2) prev ril)); + (["6"], + ("go backward to the middle of the preceding items"), + (fun () -> newLine(); + forward (-((Safelist.length prev)+1)/2) prev ril)); + (["R"], + ("reverse the list"), + (fun () -> newLine(); + loop rest (ri::prev))); (["d"], - ("show differences"), + ("show differences (curr or match)"), (fun () -> - newLine (); - Uicommon.showDiffs ri - (fun title text -> - try - let pager = System.getenv "PAGER" in - restoreTerminal (); - let out = System.open_process_out pager in - Printf.fprintf out "\n%s\n\n%s\n\n" title text; - let _ = System.close_process_out out in - setupTerminal () - with Not_found -> - Printf.printf "\n%s\n\n%s\n\n" title text) - (fun s -> Printf.printf "%s\n" s) - Uutil.File.dummy; - repeat())); + actOnMatching ~change:false showdiffs)); (["x"], - ("show details"), - (fun () -> newLine(); displayDetails ri; repeat())); + ("show details (curr or match)"), + (fun () -> + actOnMatching ~change:false + (fun ri -> displayDetails ri; true))); (["L"], - ("list all suggested changes tersely"), + ("list all (or matching) following changes tersely"), (fun () -> newLine(); Safelist.iter - (fun ri -> displayri ri; display "\n ") - ril; - display "\n"; + (fun ri -> display " "; displayri ri; display "\n") + (Safelist.filter ritest ril); repeat())); (["l"], - ("list all suggested changes with details"), + ("list all (or matching) following changes with details"), (fun () -> newLine(); Safelist.iter - (fun ri -> displayri ri; display "\n "; + (fun ri -> display " "; displayri ri; display "\n"; alwaysDisplayDetails ri) - ril; - display "\n"; + (Safelist.filter ritest ril); repeat())); - (["p";"b"], - ("go back to previous item"), + (["A";"*"], + ("match all the following"), + (fun () -> newLine(); + setripred (`Push (fun _ -> true)); + repeat())); + (["1"], + ("match all the following that propagate " ^ descr), + (fun () -> newLine(); + setripred (`Push (function + {replicas = Different ({direction = Replica1ToReplica2})} -> true + | _ -> false)); + repeat())); + (["2"], + ("match all the following that propagate " ^ descl), + (fun () -> newLine(); + setripred (`Push (function + {replicas = Different ({direction = Replica2ToReplica1})} -> true + | _ -> false)); + repeat())); + (["C"], + ("match all the following conflicts"), + (fun () -> newLine(); + setripred (`Push (function + {replicas = Different ({direction = Conflict _})} -> true + | _ -> false)); + repeat())); + (["P";"="], + ("match all the following with only props changes"), + (fun () -> newLine(); + setripred (`Push ispropschanged); + repeat())); + (["M"], + ("match all the following merges"), + (fun () -> newLine(); + setripred (`Push (function + {replicas = Different ({direction = Merge})} -> true + | _ -> false)); + repeat())); + (["X";"!"], + ("invert the matching condition"), + (fun () -> newLine(); + setripred (`Op1 not); + repeat())); + (["&"], + ("and the last two matching conditions"), + (fun () -> newLine(); + setripred (`Op2 (&&)); + repeat())); + (["|"], + ("or the last two matching conditions"), + (fun () -> newLine(); + setripred (`Op2 (||)); + repeat())); + (["D";"_"], + ("delete/pop the active matching condition"), + (fun () -> newLine(); + setripred `Pop; + repeat())); + (["U";"$"], + ("unmatch (select current)"), + (fun () -> newLine(); + setripred `Unset; + repeat())); + (["r";"u"], + ("revert to " ^ Uutil.myName ^ "'s default recommendation (curr or match)"), (fun () -> - newLine(); - previous prev ril)); - (["s";"n"], - ("stop the selection"), - (fun() -> - newLine(); + actOnMatching + (fun ri->Recon.revertToDefaultDirection ri; true))); + (["m"], + ("merge the versions (curr or match)"), + (fun () -> + actOnMatching (setdir Merge))); + ([">";"."], + ("propagate from " ^ descr ^ " (curr or match)"), + (fun () -> + actOnMatching (setdir Replica1ToReplica2))); + (["<";","], + ("propagate from " ^ descl ^ " (curr or match)"), + (fun () -> + actOnMatching (setdir Replica2ToReplica1))); + (["]";"\""], + ("resolve conflicts in favor of the newer (curr or match)"), + (fun () -> + actOnMatching (setDirectionIfConflict `Newer))); + (["[";"'"], + ("resolve conflicts in favor of the older (curr or match)"), + (fun () -> + actOnMatching (setDirectionIfConflict `Older))); + (["c"], + ("resolve conflicts in favor of changed (curr or match)"), + (fun () -> + actOnMatching + ~fail:(Some (fun()->display "Cannot set direction\n")) + setdirchanged)); + (["i"], + ("invert direction of propagation and go to next item"), + (fun () -> + actOnMatching + ~fail:(Some (fun()->display "Cannot invert direction\n")) + invertdir)); + (["/";":"], + ("skip"), + (fun () -> + actOnMatching setskip)); + (["%"], + ("skip all the following"), + (fun () -> newLine(); + Safelist.iter (fun ri -> setskip ri; ()) rest; + repeat())); + (["-"], + ("skip and discard for this session (curr or match)"), + (fun () -> + actOnMatching ~fail:None (fun _->false))); + (["+"], + ("skip and discard all the following"), + (fun () -> newLine(); + loop prev [ri])); + (["I"], + ("ignore this path permanently"), + (fun () -> newLine(); + ignore (Uicommon.ignorePath ri.path1) rest + "this path")); + (["E"], + ("permanently ignore files with this extension"), + (fun () -> newLine(); + ignore (Uicommon.ignoreExt ri.path1) rest + "files with this extension")); + (["N"], + ("permanently ignore paths ending with this name"), + (fun () -> newLine(); + ignore (Uicommon.ignoreName ri.path1) rest + "files with this name")); + (["s"], + ("stop reconciling and go to the proceed menu"), + (fun () -> newLine(); (ConfirmBeforeProceeding, Safelist.rev_append prev ril))); (["g"], ("proceed immediately to propagating changes"), - (fun() -> + (fun () -> newLine(); (ProceedImmediately, Safelist.rev_append prev ril))); (["q"], ("exit " ^ Uutil.myName ^ " without propagating any changes"), - fun () -> raise Sys.Break); - (["/"], - ("skip"), - (fun () -> - if not (isConflict dir) then diff.direction <- Conflict "skip requested"; - redisplayri(); - next())); - ([">";"."], - ("propagate from " ^ descr), - (fun () -> - diff.direction <- Replica1ToReplica2; - redisplayri(); - next())); - (["<";","], - ("propagate from " ^ descl), - (fun () -> - diff.direction <- Replica2ToReplica1; - redisplayri(); - next())) + (fun () -> newLine(); + raise Sys.Break)) ] (fun () -> displayri ri) in loop prilist rilist @@ -537,24 +747,24 @@ let setWarnPrinterForInitialization()= let setWarnPrinter() = Util.warnPrinter := - Some(fun s -> - alwaysDisplay "Warning: "; - alwaysDisplay s; - if not (Prefs.read Globals.batch) then begin - display "Press return to continue."; - selectAction None - [(["";" ";"y"], - ("Continue"), - fun()->()); - (["n";"q";"x"], - ("Exit"), - fun()-> - alwaysDisplay "\n"; - restoreTerminal (); - Lwt_unix.run (Update.unlockArchives ()); - exit Uicommon.fatalExit)] - (fun()-> display "Press return to continue.") - end) + Some(fun s -> + alwaysDisplay "Warning: "; + alwaysDisplay s; + if not (Prefs.read Globals.batch) then begin + display "Press return to continue."; + selectAction None + [(["";" ";"y"], + ("Continue"), + (fun () -> ())); + (["n";"q";"x"], + ("Exit"), + (fun () -> + alwaysDisplay "\n"; + restoreTerminal (); + Lwt_unix.run (Update.unlockArchives ()); + exit Uicommon.fatalExit))] + (fun () -> display "Press return to continue.") + end) let lastMajor = ref "" @@ -669,16 +879,14 @@ let rec interactAndPropagateChanges prevItemList reconItemList "Yes: proceed with updates as selected above", doit); (["n"], - "No: go through selections again", - (fun () -> + "No: go through reconciliation process again", + (fun () -> newLine(); Prefs.set Uicommon.auto false; - newLine(); interactAndPropagateChanges [] newReconItemList)); (["p";"b"], - "go back to the last item of the selection", - (fun () -> + "go back to the last item of the reconciliation", + (fun () -> newLine(); Prefs.set Uicommon.auto false; - newLine(); match Safelist.rev newReconItemList with [] -> interactAndPropagateChanges [] [] | lastri::prev -> interactAndPropagateChanges prev [lastri])); @@ -707,7 +915,8 @@ let rec interactAndPropagateChanges prevItemList reconItemList (fun () -> askagain (Safelist.rev newReconItemList))); (["q"], ("exit " ^ Uutil.myName ^ " without propagating any changes"), - fun () -> raise Sys.Break) + (fun () -> newLine(); + raise Sys.Break)) ] (fun () -> display "Proceed with propagating updates? ") in askagain newReconItemList @@ -725,11 +934,12 @@ let checkForDangerousPath dangerousPaths = None [(["y"], "Continue", - (fun() -> ())); - (["n"; "q"; "x"; ""], + (fun () -> ())); + (["n";"q";"x";""], "Exit", - (fun () -> alwaysDisplay "\n"; restoreTerminal (); - exit Uicommon.fatalExit))] + (fun () -> alwaysDisplay "\n"; + restoreTerminal (); + exit Uicommon.fatalExit))] (fun () -> display "Do you really want to proceed? ") end end |