From a8042a318861ecd4d3046db8fd4cfb28b4aa1bb8 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Mon, 5 Feb 2018 20:49:16 +0100 Subject: [PATCH 01/24] Pred.compile_pattern: factorize with new subfunction checkpath --- src/pred.ml | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index 9f2d00e24..db775a004 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -70,23 +70,20 @@ let compile_pattern clause = ^ "Only one instance of " ^ mapSeparator ^ " allowed.")) in let compiled = begin try + let checkpath prefix str = + let msg = + "Malformed pattern: \"" ^ p ^ "\"\n" + ^ "'" ^ prefix ^ "' patterns may not begin with a slash; " + ^ "only relative paths are allowed." in + if str<>"" && str.[0] = '/' then + raise (Prefs.IllegalValue msg) in select p [("Name ", fun str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); ("Path ", fun str -> - if str<>"" && str.[0] = '/' then - raise (Prefs.IllegalValue - ("Malformed pattern: " - ^ "\"" ^ p ^ "\"\n" - ^ "'Path' patterns may not begin with a slash; " - ^ "only relative paths are allowed.")); + checkpath "Path" str; Rx.globx str); ("BelowPath ", fun str -> - if str<>"" && str.[0] = '/' then - raise (Prefs.IllegalValue - ("Malformed pattern: " - ^ "\"" ^ p ^ "\"\n" - ^ "'BelowPath' patterns may not begin with a slash; " - ^ "only relative paths are allowed.")); + checkpath "BelowPath" str; Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]); ("Regex ", Rx.rx)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) From 3dc0634ebb8c88f04d5c77acbd3656a6b65bbf5d Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Mon, 5 Feb 2018 20:11:16 +0100 Subject: [PATCH 02/24] Pred.compile_pattern: return a variant regex This will be used to mark regexps as negative or positive. --- src/pred.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index db775a004..d2a08e990 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -78,14 +78,14 @@ let compile_pattern clause = if str<>"" && str.[0] = '/' then raise (Prefs.IllegalValue msg) in select p - [("Name ", fun str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); + [("Name ", fun str -> `Alt (Rx.seq [Rx.rx "(.*/)?"; Rx.globx str])); ("Path ", fun str -> checkpath "Path" str; - Rx.globx str); + `Alt (Rx.globx str)); ("BelowPath ", fun str -> checkpath "BelowPath" str; - Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]); - ("Regex ", Rx.rx)] + `Alt (Rx.seq [Rx.globx str; Rx.rx "(/.*)?"])); + ("Regex ", fun str -> `Alt (Rx.rx str))] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with Rx.Parse_error | Rx.Not_supported -> @@ -115,13 +115,13 @@ let alias p n = Prefs.alias p.pref n let recompile mode p = let pref = Prefs.read p.pref in let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in - let compiled = Rx.alt (Safelist.map fst compiledList) in + let compiled = Rx.alt (Safelist.map (fun (`Alt rx, _) -> rx) compiledList) in let handleCase rx = if (Case.ops())#caseInsensitiveMatch then Rx.case_insensitive rx else rx in let strings = Safelist.filterMap - (fun (rx,vo) -> + (fun (`Alt rx, vo) -> match vo with None -> None | Some v -> Some (handleCase rx,v)) From 1a3a820dd9dba8b003a8f123802e99a65bf5a759 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Mon, 19 Feb 2018 08:31:49 +0100 Subject: [PATCH 03/24] pred.mli: document the BelowPath pattern prefix --- src/pred.mli | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/pred.mli b/src/pred.mli index 487aac4d5..fb8c1e909 100644 --- a/src/pred.mli +++ b/src/pred.mli @@ -19,9 +19,10 @@ [ -> ] The associated string is ignored by [test] but can be looked up by [assoc]. - Three forms of / are recognized: + Four forms of / are recognized: "Name ": ..../ (using globx) "Path ": , not starting with "/" (using globx) + "BelowPath ": , not starting with "/" (using globx) "Regex ": (using rx) *) From 65976a41a0f5a1c7a48e3201211b78422408f950 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Sun, 25 Feb 2018 08:59:21 +0100 Subject: [PATCH 04/24] Pred.recompile: new subfunction rev_acc_alt_or_dif to group consecutive of same sign --- src/pred.ml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/pred.ml b/src/pred.ml index d2a08e990..c04787f2f 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -113,6 +113,14 @@ let addDefaultPatterns p pats = let alias p n = Prefs.alias p.pref n let recompile mode p = + (* Accumulate consecutive pathspec regexps with the same sign *) + let rev_acc_alt_or_dif acc r = + match acc, r with + (`Alt rl :: t), `Alt rx -> `Alt (rx::rl) :: t + | (`Dif rl :: t), `Dif rx -> `Dif (rx::rl) :: t + | _ , `Alt rx -> `Alt [rx] :: acc + | _ , `Dif rx -> `Dif [rx] :: acc + in let pref = Prefs.read p.pref in let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in let compiled = Rx.alt (Safelist.map (fun (`Alt rx, _) -> rx) compiledList) in From 2468d7d9c8883babfa2a1ce9e99a9c1844bcde06 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Sun, 25 Feb 2018 09:04:41 +0100 Subject: [PATCH 05/24] Pred.recompile: new subfunction combine_alt_or_dif to combine newer regexps --- src/pred.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/pred.ml b/src/pred.ml index c04787f2f..678a554f2 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -120,6 +120,11 @@ let recompile mode p = | (`Dif rl :: t), `Dif rx -> `Dif (rx::rl) :: t | _ , `Alt rx -> `Alt [rx] :: acc | _ , `Dif rx -> `Dif [rx] :: acc + (* Combine newer positive or negative pathspec regexps with the older ones *) + and combine_alt_or_dif rx = function + `Alt rl -> Rx.alt [Rx.alt rl; rx] + | `Dif rl -> Rx.diff rx (Rx.alt rl) + (* A negative pattern is diff'ed from the former ones only *) in let pref = Prefs.read p.pref in let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in From 025f20e31fcad1e5045b1aa7b94b8bfd8874a94c Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Sun, 25 Feb 2018 09:08:35 +0100 Subject: [PATCH 06/24] Pred: parse new negative pathspec of the form 'del ' Note that a string associated with a pathspec is not overriden nor deleted by a negative pathspec; a string given with a negative pathspec is completely ignored. At present this behaviour is fine as when a pathspec preference is overriden by another (negative) preference (ending in "not") the associated string is not used. If this changes the functions assoc and assoc_all may have to be adapted. pred.mli: mention negative pathspec patterns. --- src/pred.ml | 31 +++++++++++++++++++++---------- src/pred.mli | 3 +++ 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index 678a554f2..8d2070b87 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -36,7 +36,7 @@ type t = let error_msg s = Printf.sprintf "bad pattern: %s\n\ A pattern must be introduced by one of the following keywords:\n\ - \032 Name, Path, BelowPath or Regex." s + \032 Name, Path, BelowPath or Regex (or del )." s (* [select str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) (* match str with *) @@ -79,13 +79,21 @@ let compile_pattern clause = raise (Prefs.IllegalValue msg) in select p [("Name ", fun str -> `Alt (Rx.seq [Rx.rx "(.*/)?"; Rx.globx str])); + ("del Name ", fun str -> `Dif (Rx.seq [Rx.rx "(.*/)?"; Rx.globx str])); ("Path ", fun str -> checkpath "Path" str; `Alt (Rx.globx str)); + ("del Path ", fun str -> + checkpath "Path" str; + `Dif (Rx.globx str)); ("BelowPath ", fun str -> checkpath "BelowPath" str; `Alt (Rx.seq [Rx.globx str; Rx.rx "(/.*)?"])); - ("Regex ", fun str -> `Alt (Rx.rx str))] + ("del BelowPath ", fun str -> + checkpath "BelowPath" str; + `Dif (Rx.seq [Rx.globx str; Rx.rx "(/.*)?"])); + ("Regex ", fun str -> `Alt (Rx.rx str)); + ("del Regex ", fun str -> `Dif (Rx.rx str))] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with Rx.Parse_error | Rx.Not_supported -> @@ -127,18 +135,21 @@ let recompile mode p = (* A negative pattern is diff'ed from the former ones only *) in let pref = Prefs.read p.pref in - let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in - let compiled = Rx.alt (Safelist.map (fun (`Alt rx, _) -> rx) compiledList) in + let compiledList = Safelist.append p.default pref + |> Safelist.map compile_pattern in + let compiled = compiledList + |> Safelist.fold_left (fun a (r, _) -> rev_acc_alt_or_dif a r) [] + |> Safelist.fold_left combine_alt_or_dif Rx.empty in + (* The patterns are processed in order of appearance so that later + preferences override the previous ones. *) let handleCase rx = if (Case.ops())#caseInsensitiveMatch then Rx.case_insensitive rx else rx in - let strings = Safelist.filterMap - (fun (`Alt rx, vo) -> - match vo with - None -> None - | Some v -> Some (handleCase rx,v)) - compiledList in + let altonly_string = function + `Alt rx, Some v -> Some (handleCase rx, v) + | _ -> None in + let strings = Safelist.filterMap altonly_string compiledList in p.compiled <- handleCase compiled; p.associated_strings <- strings; p.last_pref <- pref; diff --git a/src/pred.mli b/src/pred.mli index fb8c1e909..d14397e56 100644 --- a/src/pred.mli +++ b/src/pred.mli @@ -24,6 +24,9 @@ "Path ": , not starting with "/" (using globx) "BelowPath ": , not starting with "/" (using globx) "Regex ": (using rx) + + Four negative patterns "del " are also recognized that prevent a + matching string from matching a former pattern. *) From 0b8f78d9ba9fb554051be70db868cf820197d939 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Tue, 6 Feb 2018 07:46:01 +0100 Subject: [PATCH 07/24] unison-manual.tex: fix the number of pathspec types --- doc/unison-manual.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 8a818f6d1..9a3d98d76 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1833,7 +1833,7 @@ \end{alltt} adds \ARG{pattern} to the list of patterns to be ignored. -\item Each \ARG{pattern} can have one of three forms. The most +\item Each \ARG{pattern} can have one of four forms. The most general form is a Posix extended regular expression introduced by the keyword \verb|Regex|. (The collating sequences and character classes of full Posix regexps are not currently supported). From f058571a03e99f559e990b01a9b5594d41671dab Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Tue, 6 Feb 2018 08:03:36 +0100 Subject: [PATCH 08/24] unison-manual.tex: document negative pathspec patterns --- doc/unison-manual.tex | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 9a3d98d76..00ca0feea 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1876,6 +1876,16 @@ running under Windows, where the normal separator character is a backslash. This makes it possible to use the same set of path patterns for both Unix and Windows file systems. +\item +The matching of a path by preceding patterns can be removed by a negative +pattern, that is any pattern prefixed by \texttt{del} separated exactly by one +space. Any subsequent (positive) pattern can select the path again. A +negative pattern is similar to a positive pattern in the corresponding +negative preference (one whose name ends with \texttt{not}), except that the +matched paths can be selected again by following (positive) patterns. However +a negative pattern in a negative preference can only make a path selected by a +positive preference if the path has also been explicitely selected with the +positive preference. \end{itemize} Some examples of path patterns appear in \sectionref{ignore}{Ignoring Paths}. From 77cbd0754b35017b448af0fe1b9c9b7896c0c2b3 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Fri, 9 Feb 2018 11:32:44 +0100 Subject: [PATCH 09/24] unison-manual.tex: document that negative patterns keep associated strings --- doc/unison-manual.tex | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 00ca0feea..20a8ed87d 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1886,6 +1886,14 @@ a negative pattern in a negative preference can only make a path selected by a positive preference if the path has also been explicitely selected with the positive preference. + +A negative pattern does not remove the string associated with a path, so that +this string need not be given again when reenabling a path. For example: +\begin{verbatim} + preferpartial = Name *.txt -> /local/path + preferpartial = del Path prefix*.txt + preferpartial = Path prefix.txt +\end{verbatim} \end{itemize} Some examples of path patterns appear in \sectionref{ignore}{Ignoring Paths}. From bcc401242d73d5b8fc2471ddd9b799a3e8cbe92c Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Wed, 21 Feb 2018 11:13:44 +0100 Subject: [PATCH 10/24] Update.findUpdates: append a warning about server failures due to discrepancies --- src/update.ml | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/update.ml b/src/update.ml index d2e96b1d3..d2f8d9a67 100644 --- a/src/update.ml +++ b/src/update.ml @@ -2100,9 +2100,19 @@ let findUpdatesOnPaths ?wantWatcher pathList subpaths = Lwt.return result)))) let findUpdates ?wantWatcher subpaths = - (* TODO: We should filter the paths to remove duplicates (including prefixes) - and ignored paths *) - findUpdatesOnPaths ?wantWatcher (Prefs.read Globals.paths) subpaths + try + (* TODO: We should filter the paths to remove duplicates (including + prefixes) and ignored paths *) + findUpdatesOnPaths ?wantWatcher (Prefs.read Globals.paths) subpaths + (* Append a message (so that it can be seen in the graphical UI) to point out + that a server failure can be caused by a discrepancy in features' support + between a client and a server having compatible version numbers. *) + with Util.Fatal ("Lost connection with the server" as msg) -> + if Uutil.myMajorVersion = "2.51" + then raise (Util.Fatal (msg^"\nMaybe the server does not support " + ^"negative pathspec patterns" + ^"\n(see the standard error of the server)")) + else raise (Util.Fatal msg) (*****************************************************************************) From a9771f6e27681cb0d7f99be684345e7e2a57fbd4 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Wed, 21 Feb 2018 11:31:45 +0100 Subject: [PATCH 11/24] unison-manual.tex: warn that unsetting merge may not necessarily imply skipping --- doc/unison-manual.tex | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 20a8ed87d..811ecdd04 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1709,6 +1709,11 @@ \begin{verbatim} unison profile -merge 'Name *.txt -> echo SKIP' \end{verbatim} +Note that unsetting the merge preference by \verb|-merge 'del Name *.txt'| is +not exactly the same: in the case where the preference \verb|prefer| or +\verb|preferpartial| for the path is set, this extra setting does not make the +path be skipped but let it be updated without merging; the preference +\verb|preferpartial| can be unset at the same time to avoid that. If the \verb|confirmmerge| preference is set and Unison is not run in batch mode, then Unison will always ask for confirmation before From 48329a90b0d165fbeac70dc33f458c722a7d77ab Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Sun, 25 Feb 2018 09:21:58 +0100 Subject: [PATCH 12/24] Safelist: new functions rev_filterMap and rev_filterMap2 --- src/ubase/safelist.ml | 12 ++++++++---- src/ubase/safelist.mli | 2 ++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/ubase/safelist.ml b/src/ubase/safelist.ml index 678a8b551..adf532a6b 100644 --- a/src/ubase/safelist.ml +++ b/src/ubase/safelist.ml @@ -24,19 +24,21 @@ let filterBoth f l = else loop r1 (hd::r2) tl in loop [] [] l -let filterMap f l = +let rev_filterMap f l = let rec loop r = function - [] -> List.rev r + [] -> r | hd::tl -> begin match f hd with None -> loop r tl | Some x -> loop (x::r) tl end in loop [] l +let filterMap f l = + List.rev (rev_filterMap f l) -let filterMap2 f l = +let rev_filterMap2 f l = let rec loop r s = function - [] -> List.rev r, List.rev s + [] -> r, s | hd::tl -> begin let (a, b) = f hd in let r' = match a with None -> r | Some x -> x::r in @@ -44,6 +46,8 @@ let filterMap2 f l = loop r' s' tl end in loop [] [] l +let filterMap2 f l = + match rev_filterMap2 f l with r, s -> List.rev r, List.rev s (* These are tail-recursive versions of the standard ones from the List module *) diff --git a/src/ubase/safelist.mli b/src/ubase/safelist.mli index 21aa94ac1..b3466e1b6 100644 --- a/src/ubase/safelist.mli +++ b/src/ubase/safelist.mli @@ -38,7 +38,9 @@ val sort : ('a -> 'a -> int) -> 'a list -> 'a list (* Other useful list-processing functions *) val filterMap : ('a -> 'b option) -> 'a list -> 'b list +val rev_filterMap : ('a -> 'b option) -> 'a list -> 'b list val filterMap2 : ('a -> 'b option * 'c option) -> 'a list -> 'b list * 'c list +val rev_filterMap2 : ('a -> 'b option * 'c option) -> 'a list -> 'b list * 'c list val transpose : 'a list list -> 'a list list val filterBoth : ('a -> bool) -> 'a list -> ('a list * 'a list) val allElementsEqual : 'a list -> bool From f2a4c3a0157f62162342ca568bca9f6a8d561484 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Sun, 25 Feb 2018 09:27:31 +0100 Subject: [PATCH 13/24] Pred.recompile: minimize list reversing Avoid 2 list reversing and add 1 new. --- src/pred.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index 8d2070b87..a8ed3bca5 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -136,8 +136,8 @@ let recompile mode p = in let pref = Prefs.read p.pref in let compiledList = Safelist.append p.default pref - |> Safelist.map compile_pattern in - let compiled = compiledList + |> Safelist.rev_map compile_pattern in + let compiled = Safelist.rev compiledList |> Safelist.fold_left (fun a (r, _) -> rev_acc_alt_or_dif a r) [] |> Safelist.fold_left combine_alt_or_dif Rx.empty in (* The patterns are processed in order of appearance so that later @@ -149,7 +149,7 @@ let recompile mode p = let altonly_string = function `Alt rx, Some v -> Some (handleCase rx, v) | _ -> None in - let strings = Safelist.filterMap altonly_string compiledList in + let strings = Safelist.rev_filterMap altonly_string compiledList in p.compiled <- handleCase compiled; p.associated_strings <- strings; p.last_pref <- pref; From da425c9b8f89260aef686e09c66458d30ef6b384 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 11:53:43 +0100 Subject: [PATCH 14/24] Pred: factorize negative pattern processing --- src/pred.ml | 57 +++++++++++++++++++++++------------------------------ 1 file changed, 25 insertions(+), 32 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index a8ed3bca5..d2b0dd84c 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -38,23 +38,24 @@ let error_msg s = A pattern must be introduced by one of the following keywords:\n\ \032 Name, Path, BelowPath or Regex (or del )." s -(* [select str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) -(* match str with *) -(* p1 p' -> f1 p' *) -(* ... *) -(* pN p' -> fN p' *) -(* otherwise -> fO str *) -let rec select str l f = +(* [select_pattern str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) +(* match str with *) +(* p1 p' -> f1 p' *) +(* ... *) +(* pN p' -> fN p' *) +(* otherwise -> fO str *) +let rec select_pattern str l err = + let rest realpref g = + let l = String.length realpref in + let s = + Util.trimWhitespace (String.sub str l (String.length str - l)) in + g (Util.trimWhitespace realpref) ((Case.ops())#normalizePattern s) in match l with - [] -> f str + [] -> err str | (pref, g)::r -> - if Util.startswith str pref then - let l = String.length pref in - let s = - Util.trimWhitespace (String.sub str l (String.length str - l)) in - g ((Case.ops())#normalizePattern s) - else - select str r f + if Util.startswith str pref then `Alt (rest pref g) + else if Util.startswith str ("del "^pref) then `Dif (rest ("del "^pref) g) + else select_pattern str r err let mapSeparator = "->" @@ -77,23 +78,15 @@ let compile_pattern clause = ^ "only relative paths are allowed." in if str<>"" && str.[0] = '/' then raise (Prefs.IllegalValue msg) in - select p - [("Name ", fun str -> `Alt (Rx.seq [Rx.rx "(.*/)?"; Rx.globx str])); - ("del Name ", fun str -> `Dif (Rx.seq [Rx.rx "(.*/)?"; Rx.globx str])); - ("Path ", fun str -> - checkpath "Path" str; - `Alt (Rx.globx str)); - ("del Path ", fun str -> - checkpath "Path" str; - `Dif (Rx.globx str)); - ("BelowPath ", fun str -> - checkpath "BelowPath" str; - `Alt (Rx.seq [Rx.globx str; Rx.rx "(/.*)?"])); - ("del BelowPath ", fun str -> - checkpath "BelowPath" str; - `Dif (Rx.seq [Rx.globx str; Rx.rx "(/.*)?"])); - ("Regex ", fun str -> `Alt (Rx.rx str)); - ("del Regex ", fun str -> `Dif (Rx.rx str))] + select_pattern p + [("Name ", fun realpref str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); + ("Path ", fun realpref str -> + checkpath realpref str; + Rx.globx str); + ("BelowPath ", fun realpref str -> + checkpath realpref str; + Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]); + ("Regex ", fun realpref str -> Rx.rx str)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with Rx.Parse_error | Rx.Not_supported -> From ee736416d5c19f4a1d0456cc7c7cde4474ca8e4b Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 11:51:35 +0100 Subject: [PATCH 15/24] unison-manual.tex: better document the pathspecs' globbing patterns ubase/rx.mli: document the glob patterns. --- doc/unison-manual.tex | 4 +++- src/ubase/rx.ml | 6 ++++-- src/ubase/rx.mli | 2 ++ 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 811ecdd04..1a89d7537 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1870,10 +1870,12 @@ \item a \verb|?| matches any single character except \verb|/| (and leading \verb|.|) \item \verb|[xyz]| matches any character from the set $\{{\tt x}, - {\tt y}, {\tt z} \}$ + {\tt y}, {\tt z} \}$ (you can negate the set by the forms \verb|[!xyz]| or + \verb|[^xyz]| and you can give ranges of the form \verb|[x-z]|) \item \verb|{a,bb,ccc}| matches any one of \verb|a|, \verb|bb|, or \verb|ccc|. (Be careful not to put extra spaces after the commas: these will be interpreted literally as part of the strings to be matched!) +\item a \verb|\| escapes the following character \end{itemize} \item The path separator in path patterns is always the diff --git a/src/ubase/rx.ml b/src/ubase/rx.ml index 0003e43fc..bd7dea477 100644 --- a/src/ubase/rx.ml +++ b/src/ubase/rx.ml @@ -784,10 +784,12 @@ let glob_parse init s = Sequence [beg_start; Set (csingle c)]), if c = '/' then init else Mid) and bracket s = - if s <> [] && accept ']' then s else begin + if s <> [] && accept ']' then s + else begin let c = char () in if accept '-' then begin - if accept ']' then (cadd c (cadd '-' s)) else begin + if accept ']' then (cadd c (cadd '-' s)) + else begin let c' = char () in bracket (cunion (cseq c c') s) end diff --git a/src/ubase/rx.mli b/src/ubase/rx.mli index 7018fd2c8..84385e444 100644 --- a/src/ubase/rx.mli +++ b/src/ubase/rx.mli @@ -8,6 +8,8 @@ val rx : string -> t (* File globbing *) val glob : string -> t + (* Recognize ?, * and [] (which supports ranges - and negations ! and ^) + with the escape \ *) val glob' : bool -> string -> t (* Same, but allows to choose whether dots at the beginning of a file name need to be explicitly matched (true) or not (false) *) From ae4b121be54c201f90894ea0708f81bc7f0f2380 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 12:24:52 +0100 Subject: [PATCH 16/24] Pred.compile_pattern: define subfunctions to change Name and BelowPath to Path --- src/pred.ml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index d2b0dd84c..983c37530 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -78,15 +78,18 @@ let compile_pattern clause = ^ "only relative paths are allowed." in if str<>"" && str.[0] = '/' then raise (Prefs.IllegalValue msg) in + let name rx = Rx.seq [Rx.rx "(.*/)?"; rx] + and below rx = Rx.seq [rx; Rx.rx "(/.*)?"] + in select_pattern p - [("Name ", fun realpref str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); - ("Path ", fun realpref str -> - checkpath realpref str; + [("Name ", fun realpref str -> + name (Rx.globx str)); + ("Path ", fun realpref str -> checkpath realpref str; Rx.globx str); - ("BelowPath ", fun realpref str -> - checkpath realpref str; - Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]); - ("Regex ", fun realpref str -> Rx.rx str)] + ("BelowPath ", fun realpref str -> checkpath realpref str; + below (Rx.globx str)); + ("Regex ", fun realpref str -> + Rx.rx str)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with Rx.Parse_error | Rx.Not_supported -> From 6540d7dedfaee46d9d4a303d4381ef86f1f062ba Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 12:28:56 +0100 Subject: [PATCH 17/24] Pred: parse fixed string patterns NameString, String and BelowString pred.mli: update the documentation. --- src/pred.ml | 8 +++++++- src/pred.mli | 7 ++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index 983c37530..22e3d9e83 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -36,7 +36,7 @@ type t = let error_msg s = Printf.sprintf "bad pattern: %s\n\ A pattern must be introduced by one of the following keywords:\n\ - \032 Name, Path, BelowPath or Regex (or del )." s + \032 Regex, Name, Path, BelowPath, NameString, String, BelowString (or del )." s (* [select_pattern str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) (* match str with *) @@ -88,6 +88,12 @@ let compile_pattern clause = Rx.globx str); ("BelowPath ", fun realpref str -> checkpath realpref str; below (Rx.globx str)); + ("NameString ", fun realpref str -> + name (Rx.str str)); + ("String ", fun realpref str -> checkpath realpref str; + Rx.str str); + ("BelowString ", fun realpref str -> checkpath realpref str; + below (Rx.str str)); ("Regex ", fun realpref str -> Rx.rx str)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) diff --git a/src/pred.mli b/src/pred.mli index d14397e56..a4b410d98 100644 --- a/src/pred.mli +++ b/src/pred.mli @@ -25,7 +25,12 @@ "BelowPath ": , not starting with "/" (using globx) "Regex ": (using rx) - Four negative patterns "del " are also recognized that prevent a + Three additional forms of / are recognized: + "NameString ": ..../ (using fixed string) + "String ": , not starting with "/" (using fixed string) + "BelowString ": , not starting with "/" (using fixed string) + + Seven negative patterns "del " are also recognized that prevent a matching string from matching a former pattern. *) From 315c0ab3f340169a0b690f422eb8c166fb9d9075 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 12:35:49 +0100 Subject: [PATCH 18/24] Pred: remove single quotes surrounding String patterns' values --- src/pred.ml | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index 22e3d9e83..b028af57c 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -80,6 +80,11 @@ let compile_pattern clause = raise (Prefs.IllegalValue msg) in let name rx = Rx.seq [Rx.rx "(.*/)?"; rx] and below rx = Rx.seq [rx; Rx.rx "(/.*)?"] + and del_quotes c str = + let l = String.length str in + if l >= 2 && str.[0] = c && str.[l-1] = c + then String.sub str 1 (l-2) + else str in select_pattern p [("Name ", fun realpref str -> @@ -89,11 +94,11 @@ let compile_pattern clause = ("BelowPath ", fun realpref str -> checkpath realpref str; below (Rx.globx str)); ("NameString ", fun realpref str -> - name (Rx.str str)); - ("String ", fun realpref str -> checkpath realpref str; - Rx.str str); - ("BelowString ", fun realpref str -> checkpath realpref str; - below (Rx.str str)); + name (Rx.str (del_quotes '\'' str))); + ("String ", fun realpref str -> checkpath realpref (del_quotes '\'' str); + Rx.str (del_quotes '\'' str)); + ("BelowString ", fun realpref str -> checkpath realpref (del_quotes '\'' str); + below (Rx.str (del_quotes '\'' str))); ("Regex ", fun realpref str -> Rx.rx str)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) From 8a3c3318e2dfe976aedd7b3b7627701f92b1567d Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 13:16:14 +0100 Subject: [PATCH 19/24] Uicommon: document why String pathspec patterns are not generated --- src/uicommon.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/uicommon.ml b/src/uicommon.ml index 9fa94cf54..b9a30182f 100644 --- a/src/uicommon.ml +++ b/src/uicommon.ml @@ -356,7 +356,10 @@ let dangerousPathMsg dangerousPaths = Useful patterns for ignoring paths **********************************************************************) -let quote s = +(* Generate a glob pattern (string) that matches only the input fixed string *) +(* Note: The newer String pathspec patterns are deliberately not generated + below to keep compatibility with unison <= 2.51. *) +let globx_quote s = let len = String.length s in let buf = Bytes.create (2 * len) in let pos = ref 0 in @@ -369,11 +372,11 @@ let quote s = done; "{" ^ String.sub buf 0 !pos ^ "}" -let ignorePath path = "Path " ^ quote (Path.toString path) +let ignorePath path = "Path " ^ globx_quote (Path.toString path) let ignoreName path = match Path.finalName path with - Some name -> "Name " ^ quote (Name.toString name) + Some name -> "Name " ^ globx_quote (Name.toString name) | None -> assert false let ignoreExt path = @@ -383,9 +386,9 @@ let ignoreExt path = begin try let pos = String.rindex str '.' in let ext = String.sub str pos (String.length str - pos) in - "Name {,.}*" ^ quote ext + "Name {,.}*" ^ globx_quote ext with Not_found -> (* str does not contain '.' *) - "Name " ^ quote str + "Name " ^ globx_quote str end | None -> assert false From 9fc005be15d39e4ff998385c7d9a20887fd5f3cb Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 13:23:56 +0100 Subject: [PATCH 20/24] unison-manual.tex: document the String pathspec patterns --- doc/unison-manual.tex | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 1a89d7537..1538103eb 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1838,14 +1838,14 @@ \end{alltt} adds \ARG{pattern} to the list of patterns to be ignored. -\item Each \ARG{pattern} can have one of four forms. The most +\item Each \ARG{pattern} can have one of seven forms. The most general form is a Posix extended regular expression introduced by the keyword \verb|Regex|. (The collating sequences and character classes of full Posix regexps are not currently supported). \begin{alltt} Regex \ARG{regexp} \end{alltt} -For convenience, three other styles of pattern are also recognized: +For convenience, three other styles of globbing patterns are also recognized: \begin{alltt} Name \ARG{name} \end{alltt} @@ -1877,6 +1877,17 @@ these will be interpreted literally as part of the strings to be matched!) \item a \verb|\| escapes the following character \end{itemize} +To match fixed string names three other styles of string patterns are +recognized, maching a fixed string against the same path components as the +corresponding globbing pattern: +\begin{alltt} + NameString \ARG{string} + String \ARG{string} + BelowString \ARG{string} + String '\ARG{string}' +\end{alltt} +If the given string is surrounded by single quotes, they are removed and not +matched against; they can protect leading and trailing whitespace. \item The path separator in path patterns is always the forward-slash character ``/'' --- even when the client or server is From da4693374f31465ef782226a63b94b63c1023d5b Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Thu, 1 Mar 2018 13:29:31 +0100 Subject: [PATCH 21/24] Pred: [fix] check that paths do not start by '/' for all patterns This check is as valid for "name" patterns or Regex as for the others. It is imperfect for glob patterns or regexes though (as was already the case): a pattern always matching a leading slash may not begin by a slash. --- src/pred.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index b028af57c..63ef9c793 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -87,19 +87,19 @@ let compile_pattern clause = else str in select_pattern p - [("Name ", fun realpref str -> + [("Name ", fun realpref str -> checkpath realpref str; name (Rx.globx str)); ("Path ", fun realpref str -> checkpath realpref str; Rx.globx str); ("BelowPath ", fun realpref str -> checkpath realpref str; below (Rx.globx str)); - ("NameString ", fun realpref str -> + ("NameString ", fun realpref str -> checkpath realpref (del_quotes '\'' str); name (Rx.str (del_quotes '\'' str))); ("String ", fun realpref str -> checkpath realpref (del_quotes '\'' str); Rx.str (del_quotes '\'' str)); ("BelowString ", fun realpref str -> checkpath realpref (del_quotes '\'' str); below (Rx.str (del_quotes '\'' str))); - ("Regex ", fun realpref str -> + ("Regex ", fun realpref str -> checkpath realpref str; Rx.rx str)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with From 9b7d42a16afd046503809c45a310651cd635851c Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Wed, 14 Mar 2018 08:00:01 +0100 Subject: [PATCH 22/24] Pred: parse new assoc pathspec of the form 'assoc ' The assoc patterns can record an associated string without having to set the preference for the matching paths. So a preference that requires an associated string can be enabled independently someplace else. The associated string is recorded but the pattern is completely ignored for the compiled regex used to match a path in Pred.test. pred.mli: update the documentation. --- src/pred.ml | 19 +++++++++++++------ src/pred.mli | 4 ++++ 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/pred.ml b/src/pred.ml index 63ef9c793..798db114f 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -36,7 +36,11 @@ type t = let error_msg s = Printf.sprintf "bad pattern: %s\n\ A pattern must be introduced by one of the following keywords:\n\ - \032 Regex, Name, Path, BelowPath, NameString, String, BelowString (or del )." s + \032 Regex, Name, Path, BelowPath, NameString, String, BelowString\n\ + \032 (or del or assoc )." s + +let delPref = "del " +let assocPref = "assoc " (* [select_pattern str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) (* match str with *) @@ -54,7 +58,8 @@ let rec select_pattern str l err = [] -> err str | (pref, g)::r -> if Util.startswith str pref then `Alt (rest pref g) - else if Util.startswith str ("del "^pref) then `Dif (rest ("del "^pref) g) + else if Util.startswith str (delPref^pref) then `Dif (rest (delPref^pref) g) + else if Util.startswith str (assocPref^pref) then `Nul (rest (assocPref^pref) g) else select_pattern str r err let mapSeparator = "->" @@ -128,13 +133,15 @@ let addDefaultPatterns p pats = let alias p n = Prefs.alias p.pref n let recompile mode p = - (* Accumulate consecutive pathspec regexps with the same sign *) + (* Accumulate consecutive pathspec regexps with the same sign and discard + null patterns *) let rev_acc_alt_or_dif acc r = match acc, r with (`Alt rl :: t), `Alt rx -> `Alt (rx::rl) :: t | (`Dif rl :: t), `Dif rx -> `Dif (rx::rl) :: t | _ , `Alt rx -> `Alt [rx] :: acc | _ , `Dif rx -> `Dif [rx] :: acc + | _ , `Nul rx -> acc (* Combine newer positive or negative pathspec regexps with the older ones *) and combine_alt_or_dif rx = function `Alt rl -> Rx.alt [Rx.alt rl; rx] @@ -153,10 +160,10 @@ let recompile mode p = if (Case.ops())#caseInsensitiveMatch then Rx.case_insensitive rx else rx in - let altonly_string = function - `Alt rx, Some v -> Some (handleCase rx, v) + let nodif_string = function + `Alt rx, Some v | `Nul rx, Some v -> Some (handleCase rx, v) | _ -> None in - let strings = Safelist.rev_filterMap altonly_string compiledList in + let strings = Safelist.rev_filterMap nodif_string compiledList in p.compiled <- handleCase compiled; p.associated_strings <- strings; p.last_pref <- pref; diff --git a/src/pred.mli b/src/pred.mli index a4b410d98..94401867d 100644 --- a/src/pred.mli +++ b/src/pred.mli @@ -32,6 +32,10 @@ Seven negative patterns "del " are also recognized that prevent a matching string from matching a former pattern. + + Seven assoc only patterns "assoc " are also recognized that record the + associated string but do not set the preference for the paths matching the + given pattern. *) From 0539943b93c2942621a0b43b3cafefd73d422d82 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Wed, 14 Mar 2018 08:19:11 +0100 Subject: [PATCH 23/24] unison-manual.tex: document the assoc pathspec pattern --- doc/unison-manual.tex | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 1538103eb..3c30c510d 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1912,6 +1912,20 @@ preferpartial = del Path prefix*.txt preferpartial = Path prefix.txt \end{verbatim} +\item +An associated string can also be defined and recorded without setting the +corresponding preference by an assoc pattern, that is any pattern prefixed by +\texttt{assoc} separated exactly by one space. Any (preceding or following) +(positive) pattern can set the preference independently without having to +specify an associated string. + +For example one can define a generic merge command without enbaling the +\verb|merge| preference, then select some paths to merge without having to give +the merge command again and again: +\begin{verbatim} + merge = assoc Name *.txt -> mergecmd CURRENT1 CURRENT2 + merge = Path prefix*.txt +\end{verbatim} \end{itemize} Some examples of path patterns appear in \sectionref{ignore}{Ignoring Paths}. From 6adc57e84222b4b03a3df70ec00b56f3405bd878 Mon Sep 17 00:00:00 2001 From: "G.raud" Date: Wed, 14 Mar 2018 08:23:09 +0100 Subject: [PATCH 24/24] Pred: parse add pathspec patterns of the form 'add ' These are equivalent to the non prefixed patterns and are added only for completeness. --- src/pred.ml | 4 +++- src/pred.mli | 3 +++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/pred.ml b/src/pred.ml index 798db114f..26bab1809 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -37,8 +37,9 @@ let error_msg s = Printf.sprintf "bad pattern: %s\n\ A pattern must be introduced by one of the following keywords:\n\ \032 Regex, Name, Path, BelowPath, NameString, String, BelowString\n\ - \032 (or del or assoc )." s + \032 (or add or del or assoc )." s +let addPref = "add " let delPref = "del " let assocPref = "assoc " @@ -58,6 +59,7 @@ let rec select_pattern str l err = [] -> err str | (pref, g)::r -> if Util.startswith str pref then `Alt (rest pref g) + else if Util.startswith str (addPref^pref) then `Alt (rest (addPref^pref) g) else if Util.startswith str (delPref^pref) then `Dif (rest (delPref^pref) g) else if Util.startswith str (assocPref^pref) then `Nul (rest (assocPref^pref) g) else select_pattern str r err diff --git a/src/pred.mli b/src/pred.mli index 94401867d..415c40e2d 100644 --- a/src/pred.mli +++ b/src/pred.mli @@ -36,6 +36,9 @@ Seven assoc only patterns "assoc " are also recognized that record the associated string but do not set the preference for the paths matching the given pattern. + + Seven patterns "add " are also recognized that are equivalent to the + non prefixed patterns. *)