diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 894689b89..5401c3e18 100755 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1721,6 +1721,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 @@ -1845,14 +1850,14 @@ \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 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,17 +1882,62 @@ \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} +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 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. + +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} +\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}. diff --git a/src/pred.ml b/src/pred.ml index 9f2d00e24..26bab1809 100644 --- a/src/pred.ml +++ b/src/pred.ml @@ -36,25 +36,33 @@ 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 - -(* [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 = + \032 Regex, Name, Path, BelowPath, NameString, String, BelowString\n\ + \032 (or add or del or assoc )." s + +let addPref = "add " +let delPref = "del " +let assocPref = "assoc " + +(* [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 (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 let mapSeparator = "->" @@ -70,25 +78,36 @@ let compile_pattern clause = ^ "Only one instance of " ^ mapSeparator ^ " allowed.")) in let compiled = begin try - 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.")); + 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 + 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 -> checkpath realpref str; + name (Rx.globx str)); + ("Path ", fun realpref str -> checkpath realpref 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.")); - Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]); - ("Regex ", Rx.rx)] + ("BelowPath ", fun realpref str -> checkpath realpref str; + below (Rx.globx 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 -> checkpath realpref str; + Rx.rx str)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with Rx.Parse_error | Rx.Not_supported -> @@ -116,19 +135,37 @@ 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 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] + | `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 - let compiled = Rx.alt (Safelist.map fst compiledList) in + let compiledList = Safelist.append p.default pref + |> 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 + 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 (rx,vo) -> - match vo with - None -> None - | Some v -> Some (handleCase rx,v)) - compiledList in + let nodif_string = function + `Alt rx, Some v | `Nul rx, Some v -> Some (handleCase rx, v) + | _ -> None 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 487aac4d5..415c40e2d 100644 --- a/src/pred.mli +++ b/src/pred.mli @@ -19,10 +19,26 @@ [ -> ] 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) + + 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. + + 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. *) 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) *) 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 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 diff --git a/src/update.ml b/src/update.ml index c7df6d373..52813e7fd 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) (*****************************************************************************)