diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/RECENTNEWS | 17 | ||||
| -rw-r--r-- | src/globals.ml | 13 | ||||
| -rw-r--r-- | src/main.ml | 10 | ||||
| -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 | 83 |
11 files changed, 119 insertions, 70 deletions
diff --git a/src/RECENTNEWS b/src/RECENTNEWS index e69de29..a4b5a53 100644 --- a/src/RECENTNEWS +++ b/src/RECENTNEWS @@ -0,0 +1,17 @@ +* Some nontrivial changes to profile parsing (G.raud Meyer) + - '=' has been considered whitespace until now: several following + chars are considered as only one; trailing chars are discarded; + any non emty sequence of char is splitting. This is non standard + and leads to confusion, for example -ignore== 'Name .*=*' is + valid when -ignore='Name .*=*' is not, and worse -ignore='Name + *=' is the same as -ignore='Name *'. The parser now takes just + a single '=' as delimiter after the option name. Other = + characters are considered as part of the value being assigned to + the option. + +* Numerous improvements to the text user-interface (G.raud Meyer) + - New key-commands that restrict the display to a set of + "matching" items: ones that are offering to propagate changes in + a particular direction, conflicts, files to be merged, etc., + plus several more useful key-commands. Type "?" to Unison to + see all available commands. 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/main.ml b/src/main.ml index 08a3d22..5fc8a9a 100644 --- a/src/main.ml +++ b/src/main.ml @@ -127,11 +127,13 @@ let interface = let catch_all f = try - (* Util.msg "Starting catch_all...\n"; *) - f (); - (* Util.msg "Done catch_all...\n"; *) + try + (* Util.msg "Starting catch_all...\n"; *) + f (); + (* Util.msg "Done catch_all...\n"; *) + with Prefs.IllegalValue str -> raise (Util.Fatal str) with e -> - Util.msg "Unison failed: %s\n" (Uicommon.exn2string e); exit 1;; + Util.msg "Unison server failed: %s\n" (Uicommon.exn2string e); exit 1;; let init () = begin ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); 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 30f0e89..72b22e3 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -300,10 +300,10 @@ let interact prilist rilist = begin Recon.setDirection ri dir `Force; true end | ri -> begin Recon.setDirection ri dir `Prefer; true end in - let ripred = ref None in + let ripred = ref [] in let ritest ri = match !ripred with - None -> true - | Some test -> test ri in + [] -> true + | test::_ -> test ri in let rec loop prev = let rec previous prev ril = match prev with @@ -340,10 +340,18 @@ 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 p = - begin match !ripred with - None -> display " Enabling matching condition\n" | _ -> () end; - ripred := Some p 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 @@ -354,7 +362,7 @@ let interact prilist rilist = let discard, err = match fail with Some e -> false, e | None -> true, fun()->() in match !ripred with - | None -> if not change then newLine(); + | [] -> if not change then newLine(); let t = f ri in if t || not discard then begin @@ -365,7 +373,7 @@ let interact prilist rilist = if change then newLine(); loop prev rest end - | Some test -> newLine(); + | 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 @@ -468,58 +476,65 @@ let interact prilist rilist = (["A";"*"], ("match all the following"), (fun () -> newLine(); - setripred (fun _ -> true); + setripred (`Push (fun _ -> true)); repeat())); (["1"], ("match all the following that propagate " ^ descr), (fun () -> newLine(); - setripred - (function - {replicas = Different ({direction = Replica1ToReplica2})} -> true - | _ -> false); + setripred (`Push (function + {replicas = Different ({direction = Replica1ToReplica2})} -> true + | _ -> false)); repeat())); (["2"], ("match all the following that propagate " ^ descl), (fun () -> newLine(); - setripred - (function - {replicas = Different ({direction = Replica2ToReplica1})} -> true - | _ -> false); + setripred (`Push (function + {replicas = Different ({direction = Replica2ToReplica1})} -> true + | _ -> false)); repeat())); (["C"], ("match all the following conflicts"), (fun () -> newLine(); - setripred - (function - {replicas = Different ({direction = Conflict _})} -> true - | _ -> false); + setripred (`Push (function + {replicas = Different ({direction = Conflict _})} -> true + | _ -> false)); repeat())); (["P";"="], ("match all the following with only props changes"), (fun () -> newLine(); - setripred ispropschanged; + setripred (`Push ispropschanged); repeat())); (["M"], ("match all the following merges"), (fun () -> newLine(); - setripred - (function - {replicas = Different ({direction = Merge})} -> true - | _ -> false); + setripred (`Push (function + {replicas = Different ({direction = Merge})} -> true + | _ -> false)); repeat())); (["X";"!"], ("invert the matching condition"), (fun () -> newLine(); - ripred := begin match !ripred with - None -> display "Matching condition not enabled\n"; None - | Some p -> Some (fun i -> not (p i)) end; + 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 all (select current)"), + ("unmatch (select current)"), (fun () -> newLine(); - begin match !ripred with - None -> display "Matching condition already disabled\n" - | Some _ -> display " Disabling matching condition\n"; ripred := None end; + setripred `Unset; repeat())); (["r";"u"], ("revert to " ^ Uutil.myName ^ "'s default recommendation (curr or match)"), |