From c1def76024adb3f6eb55ab476f53fa2f68281d9b Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 15 Feb 2024 01:30:04 +0100 Subject: Pattern compiler: Compile to regexps and a predicate function Compiling to predicate functions makes it possible to implement a wide range of additional matching styles. Two of them are implemented here: - orderless-annotation: Match on candidate annotations with a regexp. - orderless-without-regexp: Exclude candidates matching a regexp (Fix #88). One could imagine creating additional matchers. Many completion category specific ideas had been mentioned in #30. A regexp could match against the content of a buffer or the buffer major mode. Such a matcher would only apply to the buffer completon category. --- orderless.el | 109 ++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 81 insertions(+), 28 deletions(-) diff --git a/orderless.el b/orderless.el index 0ff178d..e2d64c8 100644 --- a/orderless.el +++ b/orderless.el @@ -129,7 +129,8 @@ customizing this variable to see a list of them." (defcustom orderless-affix-dispatch-alist `((?% . ,#'char-fold-to-regexp) - (?! . ,#'orderless-without-literal) + (?! . ,#'orderless-without-regexp) + (?@ . ,#'orderless-annotation) (?, . ,#'orderless-initialism) (?= . ,#'orderless-literal) (?~ . ,#'orderless-flex)) @@ -142,9 +143,11 @@ matched according the style associated to it." :type `(alist :key-type character :value-type (choice + (const :tag "Annotation" ,#'orderless-annotation) (const :tag "Literal" ,#'orderless-literal) (const :tag "Regexp" ,#'orderless-regexp) - (const :tag "Without" ,#'orderless-without-literal) + (const :tag "Without literal" ,#'orderless-without-literal) + (const :tag "Without regexp" ,#'orderless-without-regexp) (const :tag "Flex" ,#'orderless-flex) (const :tag "Initialism" ,#'orderless-initialism) (const :tag "Prefixes" ,#'orderless-prefixes) @@ -268,6 +271,27 @@ at a word boundary in the candidate. This is similar to the string-end))))) string-end)) +(defun orderless-without-regexp (component) + "Match strings that do *not* contain COMPONENT as a regexp match." + (unless (equal component "") + (lambda (str) + (not (string-match-p component str))))) + +(defun orderless-annotation (component) + "Match candidates where the annotation matches COMPONENT as a regexp." + (when-let (((not (equal component ""))) + ((minibufferp)) + (table minibuffer-completion-table) + (metadata (completion-metadata + (buffer-substring-no-properties (minibuffer-prompt-end) (point)) + table minibuffer-completion-predicate)) + (fun (or (completion-metadata-get metadata 'annotation-function) + (when-let ((aff (completion-metadata-get metadata 'affixation-function))) + (lambda (cand) (caddr (funcall aff (list cand)))))))) + (lambda (str) + (when-let ((ann (funcall fun str))) + (string-match-p component ann))))) + ;;; Highlighting matches (defun orderless--highlight (regexps ignore-case string) @@ -353,7 +377,7 @@ DEFAULT as the list of styles." when result return (cons result string) finally (return (cons default string)))) -(defun orderless-pattern-compiler (pattern &optional styles dispatchers) +(defun orderless-pattern-compiler (pattern &optional styles dispatchers predicate) "Build regexps to match the components of PATTERN. Split PATTERN on `orderless-component-separator' and compute matching styles for each component. For each component the style @@ -365,12 +389,14 @@ matching STYLES is used. See `orderless-dispatch' for details on dispatchers. The STYLES default to `orderless-matching-styles', and the -DISPATCHERS default to `orderless-dipatchers'. Since nil gets you -the default, if you want no dispatchers to be run, use \\='(ignore) -as the value of DISPATCHERS." +DISPATCHERS default to `orderless-dipatchers'. Since nil gets +you the default, if you want no dispatchers to be run, use +\\='(ignore) as the value of DISPATCHERS. If PREDICATE is +non-nil return a pair of a predicate function and the regexps." (unless styles (setq styles orderless-matching-styles)) (unless dispatchers (setq dispatchers orderless-style-dispatchers)) (cl-loop + with predicate-res = nil with components = (if (functionp orderless-component-separator) (funcall orderless-component-separator pattern) (split-string pattern orderless-component-separator t)) @@ -379,22 +405,51 @@ as the value of DISPATCHERS." for (newstyles . newcomp) = (orderless-dispatch dispatchers styles component index total) when (functionp newstyles) do (setq newstyles (list newstyles)) + for pred = nil for regexps = (cl-loop for style in newstyles - for result = (funcall style newcomp) - when result collect - (if (stringp result) `(regexp ,result) result)) - when regexps collect (rx-to-string `(or ,@(delete-dups regexps))))) + for res = (funcall style newcomp) + if (functionp res) do (cl-callf orderless--predicate-or pred res) + else if res collect (if (stringp res) `(regexp ,res) res)) + when regexps collect (rx-to-string `(or ,@(delete-dups regexps))) into regexps-res + when pred do (cl-callf orderless--predicate-and predicate-res pred) + finally return (if predicate (cons predicate-res regexps-res) regexps-res))) ;;; Completion style implementation +(defun orderless--predicate-normalized-and (p q) + "Combine two predicate functions P and Q with `and'. +The first function P is a completion predicate which can receive +up to two arguments. The second function Q always receives a +normalized string as argument." + (cond + ((and p q) + (lambda (k &rest v) ;; v for hash table + (when (if v (funcall p k (car v)) (funcall p k)) + (setq k (if (consp k) (car k) k)) ;; alist + (funcall q (if (symbolp k) (symbol-name k) k))))) + (q + (lambda (k &optional _) ;; _ for hash table + (setq k (if (consp k) (car k) k)) ;; alist + (funcall q (if (symbolp k) (symbol-name k) k)))) + (p))) + +(defun orderless--predicate-and (p q) + "Combine two predicate functions P and Q with `and'." + (or (and p q (lambda (x) (and (funcall p x) (funcall q x)))) p q)) + +(defun orderless--predicate-or (p q) + "Combine two predicate functions P and Q with `or'." + (or (and p q (lambda (x) (or (funcall p x) (funcall q x)))) p q)) + (defun orderless--compile (string table pred) "Compile STRING to a prefix and a list of regular expressions. The predicate PRED is used to constrain the entries in TABLE." - (let* ((limit (car (completion-boundaries string table pred ""))) - (prefix (substring string 0 limit)) - (pattern (substring string limit)) - (regexps (orderless-pattern-compiler pattern))) - (list prefix regexps (orderless--ignore-case-p regexps)))) + (pcase-let* ((limit (car (completion-boundaries string table pred ""))) + (prefix (substring string 0 limit)) + (pattern (substring string limit)) + (`(,fun . ,regexps) (orderless-pattern-compiler pattern nil nil t))) + (list prefix regexps (orderless--ignore-case-p regexps) + (orderless--predicate-normalized-and pred fun)))) ;; Thanks to @jakanakaevangeli for writing a version of this function: ;; https://github.com/oantolin/orderless/issues/79#issuecomment-916073526 @@ -436,7 +491,7 @@ The matching should be case-insensitive if IGNORE-CASE is non-nil." (defun orderless-filter (string table &optional pred) "Split STRING into components and find entries TABLE matching all. The predicate PRED is used to constrain the entries in TABLE." - (pcase-let ((`(,prefix ,regexps ,ignore-case) + (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) (orderless--compile string table pred))) (orderless--filter prefix regexps ignore-case table pred))) @@ -447,7 +502,7 @@ The predicate PRED is used to constrain the entries in TABLE. The matching portions of each candidate are highlighted. This function is part of the `orderless' completion style." (defvar completion-lazy-hilit-fn) - (pcase-let ((`(,prefix ,regexps ,ignore-case) + (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) (orderless--compile string table pred))) (when-let ((completions (orderless--filter prefix regexps ignore-case table pred))) (if (bound-and-true-p completion-lazy-hilit) @@ -467,7 +522,7 @@ returns nil. In any other case it \"completes\" STRING to itself, without moving POINT. This function is part of the `orderless' completion style." (catch 'orderless--many - (pcase-let ((`(,prefix ,regexps ,ignore-case) + (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) (orderless--compile string table pred)) (one nil)) ;; Abuse all-completions/orderless--filter as a fast search loop. @@ -475,16 +530,14 @@ This function is part of the `orderless' completion style." ;; called more than two times. (orderless--filter prefix regexps ignore-case table - (lambda (arg &rest val) ;; val for hash table - (when (or (not pred) (if val (funcall pred arg (car val)) (funcall pred arg))) - ;; Normalize predicate argument - (setq arg (if (consp arg) (car arg) arg) ;; alist - arg (if (symbolp arg) (symbol-name arg) arg)) ;; symbols - ;; Check if there is more than a single match (= many). - (when (and one (not (equal one arg))) - (throw 'orderless--many (cons string point))) - (setq one arg) - t))) + (orderless--predicate-normalized-and + pred + (lambda (arg) + ;; Check if there is more than a single match (= many). + (when (and one (not (equal one arg))) + (throw 'orderless--many (cons string point))) + (setq one arg) + t))) (when one ;; Prepend prefix if the candidate does not already have the same ;; prefix. This workaround is needed since the predicate may either -- cgit v1.0 From 10bce1bcde5dc7cd3796bb9202dd0eae72e1a088 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 15 Feb 2024 16:52:12 +0100 Subject: orderless-annotation, orderless-without-regexp: Check validity --- orderless.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/orderless.el b/orderless.el index e2d64c8..93a1fd8 100644 --- a/orderless.el +++ b/orderless.el @@ -273,13 +273,14 @@ at a word boundary in the candidate. This is similar to the (defun orderless-without-regexp (component) "Match strings that do *not* contain COMPONENT as a regexp match." - (unless (equal component "") + (when (and (not (equal component "")) (orderless-regexp component)) (lambda (str) (not (string-match-p component str))))) (defun orderless-annotation (component) "Match candidates where the annotation matches COMPONENT as a regexp." (when-let (((not (equal component ""))) + ((orderless-regexp component)) ;; valid regexp ((minibufferp)) (table minibuffer-completion-table) (metadata (completion-metadata -- cgit v1.0 From 0e9fe2e90231cd1bc8895ff99bbff6b7a97db60f Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 15 Feb 2024 18:47:43 +0100 Subject: orderless-annotation: Also check completion-extra-properties --- orderless.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/orderless.el b/orderless.el index 93a1fd8..2e5831f 100644 --- a/orderless.el +++ b/orderless.el @@ -287,7 +287,9 @@ at a word boundary in the candidate. This is similar to the (buffer-substring-no-properties (minibuffer-prompt-end) (point)) table minibuffer-completion-predicate)) (fun (or (completion-metadata-get metadata 'annotation-function) - (when-let ((aff (completion-metadata-get metadata 'affixation-function))) + (plist-get completion-extra-properties :annotation-function) + (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) + (plist-get completion-extra-properties :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand)))))))) (lambda (str) (when-let ((ann (funcall fun str))) -- cgit v1.0 From f172c801361b17e3538bac2eb17645cd24330590 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 15 Feb 2024 23:22:37 +0100 Subject: Extend orderless-without-literal comment --- orderless.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/orderless.el b/orderless.el index 2e5831f..eb645d0 100644 --- a/orderless.el +++ b/orderless.el @@ -261,7 +261,10 @@ at a word boundary in the candidate. This is similar to the collect `(seq word-boundary ,prefix)))) (defun orderless-without-literal (component) - "Match strings that do *not* contain COMPONENT as a literal match." + "Match strings that do *not* contain COMPONENT as a literal match. +You may prefer to use the more general `orderless-without' +instead which compiles the input to a predicate instead of a +regexp." `(seq (group string-start) ; highlight nothing! (zero-or-more -- cgit v1.0 From b770a4de47dd81e6ca7e83026dd91a679f7bf6d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Omar=20Antol=C3=ADn=20Camarena?= Date: Thu, 15 Feb 2024 12:37:16 -0600 Subject: Remove orderless--predicate-or This simplifies the semantics: all predicates are and-ed together. --- orderless.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/orderless.el b/orderless.el index eb645d0..706af69 100644 --- a/orderless.el +++ b/orderless.el @@ -414,7 +414,7 @@ non-nil return a pair of a predicate function and the regexps." for pred = nil for regexps = (cl-loop for style in newstyles for res = (funcall style newcomp) - if (functionp res) do (cl-callf orderless--predicate-or pred res) + if (functionp res) do (cl-callf orderless--predicate-and pred res) else if res collect (if (stringp res) `(regexp ,res) res)) when regexps collect (rx-to-string `(or ,@(delete-dups regexps))) into regexps-res when pred do (cl-callf orderless--predicate-and predicate-res pred) @@ -443,10 +443,6 @@ normalized string as argument." "Combine two predicate functions P and Q with `and'." (or (and p q (lambda (x) (and (funcall p x) (funcall q x)))) p q)) -(defun orderless--predicate-or (p q) - "Combine two predicate functions P and Q with `or'." - (or (and p q (lambda (x) (or (funcall p x) (funcall q x)))) p q)) - (defun orderless--compile (string table pred) "Compile STRING to a prefix and a list of regular expressions. The predicate PRED is used to constrain the entries in TABLE." -- cgit v1.0 From 41a9d218e6dcf44ed2814a416930d9d4b66bf86b Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 15 Feb 2024 23:03:34 +0100 Subject: orderless-pattern-compiler: Simplify slightly, remove variable pred --- orderless.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/orderless.el b/orderless.el index 706af69..793498c 100644 --- a/orderless.el +++ b/orderless.el @@ -411,13 +411,11 @@ non-nil return a pair of a predicate function and the regexps." for (newstyles . newcomp) = (orderless-dispatch dispatchers styles component index total) when (functionp newstyles) do (setq newstyles (list newstyles)) - for pred = nil for regexps = (cl-loop for style in newstyles for res = (funcall style newcomp) - if (functionp res) do (cl-callf orderless--predicate-and pred res) + if (functionp res) do (cl-callf orderless--predicate-and predicate-res res) else if res collect (if (stringp res) `(regexp ,res) res)) when regexps collect (rx-to-string `(or ,@(delete-dups regexps))) into regexps-res - when pred do (cl-callf orderless--predicate-and predicate-res pred) finally return (if predicate (cons predicate-res regexps-res) regexps-res))) ;;; Completion style implementation -- cgit v1.0 From 3e8f2c6616f9eb91eeb1d77a3653965dd2127c92 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Thu, 15 Feb 2024 23:16:34 +0100 Subject: Add orderless--component-compiler and use it in orderless-without/annotation --- orderless.el | 47 ++++++++++++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/orderless.el b/orderless.el index 793498c..fdeb38c 100644 --- a/orderless.el +++ b/orderless.el @@ -129,7 +129,7 @@ customizing this variable to see a list of them." (defcustom orderless-affix-dispatch-alist `((?% . ,#'char-fold-to-regexp) - (?! . ,#'orderless-without-regexp) + (?! . ,#'orderless-without) (?@ . ,#'orderless-annotation) (?, . ,#'orderless-initialism) (?= . ,#'orderless-literal) @@ -147,7 +147,7 @@ matched according the style associated to it." (const :tag "Literal" ,#'orderless-literal) (const :tag "Regexp" ,#'orderless-regexp) (const :tag "Without literal" ,#'orderless-without-literal) - (const :tag "Without regexp" ,#'orderless-without-regexp) + (const :tag "Without regexp" ,#'orderless-without) (const :tag "Flex" ,#'orderless-flex) (const :tag "Initialism" ,#'orderless-initialism) (const :tag "Prefixes" ,#'orderless-prefixes) @@ -274,16 +274,16 @@ regexp." string-end))))) string-end)) -(defun orderless-without-regexp (component) - "Match strings that do *not* contain COMPONENT as a regexp match." - (when (and (not (equal component "")) (orderless-regexp component)) - (lambda (str) - (not (string-match-p component str))))) +(defun orderless-without (component) + "Match strings that do *not* match COMPONENT." + (unless (equal component "") + (let ((regexp (cdr (orderless--component-compiler component)))) + (lambda (str) + (not (string-match-p regexp str)))))) (defun orderless-annotation (component) - "Match candidates where the annotation matches COMPONENT as a regexp." + "Match candidates where the annotation matches COMPONENT." (when-let (((not (equal component ""))) - ((orderless-regexp component)) ;; valid regexp ((minibufferp)) (table minibuffer-completion-table) (metadata (completion-metadata @@ -293,10 +293,11 @@ regexp." (plist-get completion-extra-properties :annotation-function) (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) - (lambda (cand) (caddr (funcall aff (list cand)))))))) + (lambda (cand) (caddr (funcall aff (list cand))))))) + (regexp (cdr (orderless--component-compiler component)))) (lambda (str) (when-let ((ann (funcall fun str))) - (string-match-p component ann))))) + (string-match-p regexp ann))))) ;;; Highlighting matches @@ -383,6 +384,17 @@ DEFAULT as the list of styles." when result return (cons result string) finally (return (cons default string)))) +(defun orderless--component-compiler (component &optional styles) + "Compile COMPONENT with matching STYLES." + (unless styles (setq styles orderless-matching-styles)) + (cl-loop + with pred = nil + for style in styles + for res = (funcall style component) + if (functionp res) do (cl-callf orderless--predicate-and pred res) + else if res collect (if (stringp res) `(regexp ,res) res) into regexps + finally return (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps))))))) + (defun orderless-pattern-compiler (pattern &optional styles dispatchers predicate) "Build regexps to match the components of PATTERN. Split PATTERN on `orderless-component-separator' and compute @@ -407,15 +419,12 @@ non-nil return a pair of a predicate function and the regexps." (funcall orderless-component-separator pattern) (split-string pattern orderless-component-separator t)) with total = (length components) - for component in components and index from 0 - for (newstyles . newcomp) = (orderless-dispatch - dispatchers styles component index total) + for comp in components and idx from 0 + for (newstyles . newcomp) = (orderless-dispatch dispatchers styles comp idx total) when (functionp newstyles) do (setq newstyles (list newstyles)) - for regexps = (cl-loop for style in newstyles - for res = (funcall style newcomp) - if (functionp res) do (cl-callf orderless--predicate-and predicate-res res) - else if res collect (if (stringp res) `(regexp ,res) res)) - when regexps collect (rx-to-string `(or ,@(delete-dups regexps))) into regexps-res + for (pred . regexps) = (orderless--component-compiler newcomp newstyles) + when regexps collect regexps into regexps-res + when pred do (cl-callf orderless--predicate-and predicate-res pred) finally return (if predicate (cons predicate-res regexps-res) regexps-res))) ;;; Completion style implementation -- cgit v1.0 From dc89fdfa01b32fac3ac014fc2833cb32d2a6c60c Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 06:36:34 +0100 Subject: Rename orderless-dispatch to orderless--dispatch The function is internal. --- README.org | 2 +- orderless.el | 7 ++++--- orderless.texi | 2 +- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/README.org b/README.org index 661b2d2..6c6a21d 100644 --- a/README.org +++ b/README.org @@ -197,7 +197,7 @@ regexp styles. A style dispatcher can either decline to handle the input string or component, or it can return which matching styles to use. It can also, if desired, additionally return a new string to use in place of - the given one. Consult the documentation of =orderless-dispatch= for + the given one. Consult the documentation of =orderless--dispatch= for full details. As an example of writing your own dispatchers, say you wanted the diff --git a/orderless.el b/orderless.el index fdeb38c..7280e43 100644 --- a/orderless.el +++ b/orderless.el @@ -186,7 +186,7 @@ the 0-based index of the component and the total number of components. It can decide what matching styles to use for the component and optionally replace the component with a different string, or it can decline to handle the component leaving it for -future dispatchers. For details see `orderless-dispatch'. +future dispatchers. For details see `orderless--dispatch'. For example, a style dispatcher could arrange for the first component to match as an initialism and subsequent components to @@ -341,7 +341,8 @@ converted to a list of regexps according to the value of string 'fixedcase 'literal) " +" t))) -(defun orderless-dispatch (dispatchers default string &rest args) +(define-obsolete-function-alias 'orderless-dispatch 'orderless--dispatch "1.0") +(defun orderless--dispatch (dispatchers default string &rest args) "Run DISPATCHERS to compute matching styles for STRING. A style dispatcher is a function that takes a string and possibly @@ -420,7 +421,7 @@ non-nil return a pair of a predicate function and the regexps." (split-string pattern orderless-component-separator t)) with total = (length components) for comp in components and idx from 0 - for (newstyles . newcomp) = (orderless-dispatch dispatchers styles comp idx total) + for (newstyles . newcomp) = (orderless--dispatch dispatchers styles comp idx total) when (functionp newstyles) do (setq newstyles (list newstyles)) for (pred . regexps) = (orderless--component-compiler newcomp newstyles) when regexps collect regexps into regexps-res diff --git a/orderless.texi b/orderless.texi index 8afe2e9..487fc0a 100644 --- a/orderless.texi +++ b/orderless.texi @@ -249,7 +249,7 @@ that specific component, overriding the default matching styles. A style dispatcher can either decline to handle the input string or component, or it can return which matching styles to use. It can also, if desired, additionally return a new string to use in place of -the given one. Consult the documentation of @samp{orderless-dispatch} for +the given one. Consult the documentation of @samp{orderless--dispatch} for full details. As an example of writing your own dispatchers, say you wanted the -- cgit v1.0 From 604c05f436e159a771fa8fb58bae6dab91be7aa5 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 06:44:53 +0100 Subject: Rename orderless-pattern-compiler to orderless-compile orderless-compile returns a predicate and a list of regexps. Keep orderless-pattern-compiler as obsolete function. --- README.org | 9 ++++----- orderless.el | 36 +++++++++++++++++++++--------------- orderless.texi | 9 ++++----- 3 files changed, 29 insertions(+), 25 deletions(-) diff --git a/README.org b/README.org index 6c6a21d..1ad12ad 100644 --- a/README.org +++ b/README.org @@ -308,11 +308,10 @@ completion is the one that ends up being used, of course. ** Pattern compiler The default mechanism for turning an input string into a list of regexps to -match against, configured using =orderless-matching-styles=, is probably -flexible enough for the vast majority of users. The patterns are compiled by the -=orderless-pattern-compiler=. Under special circumstances it may be useful to -implement a custom pattern compiler by advising the -=orderless-pattern-compiler=. +match against, configured using =orderless-matching-styles=, is probably flexible +enough for the vast majority of users. The patterns are compiled by the +=orderless-compile=. Under special circumstances it may be useful to implement a +custom pattern compiler by advising the =orderless-compile=. ** Interactively changing the configuration diff --git a/orderless.el b/orderless.el index 7280e43..e2ad552 100644 --- a/orderless.el +++ b/orderless.el @@ -194,7 +194,7 @@ match as literals. As another example, a style dispatcher could arrange for a component starting with `?' to match the rest of the component in the `orderless-flex' style. For more information on how this variable is used, see -`orderless-pattern-compiler'." +`orderless-compile'." :type 'hook) (defcustom orderless-smart-case t @@ -294,7 +294,7 @@ regexp." (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand))))))) - (regexp (cdr (orderless--component-compiler component)))) + (regexp (cdr (orderless--compile-component component)))) (lambda (str) (when-let ((ann (funcall fun str))) (string-match-p regexp ann))))) @@ -324,7 +324,7 @@ For the user's convenience, if REGEXPS is a string, it is converted to a list of regexps according to the value of `orderless-matching-styles'." (when (stringp regexps) - (setq regexps (orderless-pattern-compiler regexps))) + (setq regexps (cdr (orderless-compile regexps)))) (cl-loop with ignore-case = (orderless--ignore-case-p regexps) for str in strings collect (orderless--highlight regexps ignore-case (substring str)))) @@ -385,7 +385,7 @@ DEFAULT as the list of styles." when result return (cons result string) finally (return (cons default string)))) -(defun orderless--component-compiler (component &optional styles) +(defun orderless--compile-component (component &optional styles) "Compile COMPONENT with matching STYLES." (unless styles (setq styles orderless-matching-styles)) (cl-loop @@ -396,7 +396,7 @@ DEFAULT as the list of styles." else if res collect (if (stringp res) `(regexp ,res) res) into regexps finally return (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps))))))) -(defun orderless-pattern-compiler (pattern &optional styles dispatchers predicate) +(defun orderless-compile (pattern &optional styles dispatchers) "Build regexps to match the components of PATTERN. Split PATTERN on `orderless-component-separator' and compute matching styles for each component. For each component the style @@ -404,14 +404,16 @@ DISPATCHERS are run to determine the matching styles to be used; they are called with arguments the component, the 0-based index of the component and the total number of components. If the DISPATCHERS decline to handle the component, then the list of -matching STYLES is used. See `orderless-dispatch' for details on -dispatchers. +matching STYLES is used. See `orderless--dispatch' for details +on dispatchers. The STYLES default to `orderless-matching-styles', and the DISPATCHERS default to `orderless-dipatchers'. Since nil gets you the default, if you want no dispatchers to be run, use -\\='(ignore) as the value of DISPATCHERS. If PREDICATE is -non-nil return a pair of a predicate function and the regexps." +\\='(ignore) as the value of DISPATCHERS. + +The return value is a pair of a predicate function and a list of +regexps." (unless styles (setq styles orderless-matching-styles)) (unless dispatchers (setq dispatchers orderless-style-dispatchers)) (cl-loop @@ -423,10 +425,16 @@ non-nil return a pair of a predicate function and the regexps." for comp in components and idx from 0 for (newstyles . newcomp) = (orderless--dispatch dispatchers styles comp idx total) when (functionp newstyles) do (setq newstyles (list newstyles)) - for (pred . regexps) = (orderless--component-compiler newcomp newstyles) + for (pred . regexps) = (orderless--compile-component newcomp newstyles) when regexps collect regexps into regexps-res when pred do (cl-callf orderless--predicate-and predicate-res pred) - finally return (if predicate (cons predicate-res regexps-res) regexps-res))) + finally return (cons predicate-res regexps-res))) + +(defun orderless-pattern-compiler (pattern &optional styles dispatchers) + "Obsolete function, use `orderless-compile' instead. +See `orderless-compile' for the arguments PATTERN, STYLES and DISPATCHERS." + (cdr (orderless-compile pattern styles dispatchers))) +(make-obsolete 'orderless-pattern-compiler 'orderless-compile "1.0") ;;; Completion style implementation @@ -457,7 +465,7 @@ The predicate PRED is used to constrain the entries in TABLE." (pcase-let* ((limit (car (completion-boundaries string table pred ""))) (prefix (substring string 0 limit)) (pattern (substring string limit)) - (`(,fun . ,regexps) (orderless-pattern-compiler pattern nil nil t))) + (`(,fun . ,regexps) (orderless-compile pattern))) (list prefix regexps (orderless--ignore-case-p regexps) (orderless--predicate-normalized-and pred fun)))) @@ -616,9 +624,7 @@ specifically for the %s style.") "Convert STR into regexps for use with ivy. This function is for integration of orderless with ivy, use it as a value in `ivy-re-builders-alist'." - (or (mapcar (lambda (x) (cons x t)) - (orderless-pattern-compiler str)) - "")) + (or (mapcar (lambda (x) (cons x t)) (cdr (orderless-compile str))) "")) (defvar ivy-regex) (defun orderless-ivy-highlight (str) diff --git a/orderless.texi b/orderless.texi index 487fc0a..d8d2a78 100644 --- a/orderless.texi +++ b/orderless.texi @@ -370,11 +370,10 @@ completion is the one that ends up being used, of course. @section Pattern compiler The default mechanism for turning an input string into a list of regexps to -match against, configured using @samp{orderless-matching-styles}, is probably -flexible enough for the vast majority of users. The patterns are compiled by the -@samp{orderless-pattern-compiler}. Under special circumstances it may be useful to -implement a custom pattern compiler by advising the -@samp{orderless-pattern-compiler}. +match against, configured using @samp{orderless-matching-styles}, is probably flexible +enough for the vast majority of users. The patterns are compiled by the +@samp{orderless-compile}. Under special circumstances it may be useful to implement a +custom pattern compiler by advising the @samp{orderless-compile}. @node Interactively changing the configuration @section Interactively changing the configuration -- cgit v1.0 From a89ac17b41f993d90cf341ec350efca403e752f2 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 06:48:27 +0100 Subject: orderless-affix-dispatch: Ignore single dispatcher character --- orderless.el | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/orderless.el b/orderless.el index e2ad552..056dd3a 100644 --- a/orderless.el +++ b/orderless.el @@ -161,12 +161,10 @@ as a key in `orderless-affix-dispatch-alist', then that character is removed and the remainder of the COMPONENT is matched in the style associated to the character." (cond - ;; Ignore single without-literal dispatcher - ((and (= (length component) 1) - (equal (aref component 0) - (car (rassq #'orderless-without-literal - orderless-affix-dispatch-alist)))) - '(orderless-literal . "")) + ;; Ignore single dispatcher character + ((and (= (length component) 1) (alist-get (aref component 0) + orderless-affix-dispatch-alist)) + #'ignore) ;; Prefix ((when-let ((style (alist-get (aref component 0) orderless-affix-dispatch-alist))) @@ -276,15 +274,13 @@ regexp." (defun orderless-without (component) "Match strings that do *not* match COMPONENT." - (unless (equal component "") - (let ((regexp (cdr (orderless--component-compiler component)))) - (lambda (str) - (not (string-match-p regexp str)))))) + (let ((regexp (cdr (orderless--compile-component component)))) + (lambda (str) + (not (string-match-p regexp str))))) (defun orderless-annotation (component) "Match candidates where the annotation matches COMPONENT." - (when-let (((not (equal component ""))) - ((minibufferp)) + (when-let (((minibufferp)) (table minibuffer-completion-table) (metadata (completion-metadata (buffer-substring-no-properties (minibuffer-prompt-end) (point)) -- cgit v1.0 From c4845948759b91295134e7c2edf6de247c879ab7 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 07:14:21 +0100 Subject: Update documentation of orderless-style-dispatchers --- orderless.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/orderless.el b/orderless.el index 056dd3a..b7deb76 100644 --- a/orderless.el +++ b/orderless.el @@ -189,10 +189,11 @@ future dispatchers. For details see `orderless--dispatch'. For example, a style dispatcher could arrange for the first component to match as an initialism and subsequent components to match as literals. As another example, a style dispatcher could -arrange for a component starting with `?' to match the rest of -the component in the `orderless-flex' style. For more -information on how this variable is used, see -`orderless-compile'." +arrange for a component starting with `~' to match the rest of +the component in the `orderless-flex' style. See +`orderless-affix-dispatch' and `orderless-affix-dispatch-alist' +for such a configuration. For more information on how this +variable is used, see `orderless-compile'." :type 'hook) (defcustom orderless-smart-case t -- cgit v1.0 From 87640f70617860ad331ee7f1113bdd955f4080d3 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 08:08:14 +0100 Subject: orderless-without: orderless--compile-component can return nil --- orderless.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/orderless.el b/orderless.el index b7deb76..01d434d 100644 --- a/orderless.el +++ b/orderless.el @@ -275,7 +275,7 @@ regexp." (defun orderless-without (component) "Match strings that do *not* match COMPONENT." - (let ((regexp (cdr (orderless--compile-component component)))) + (when-let ((regexp (cdr (orderless--compile-component component)))) (lambda (str) (not (string-match-p regexp str))))) -- cgit v1.0 From 766a194b90b7535e082aa7d84da13bb7ff1b16fd Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 08:31:41 +0100 Subject: Use orderless--dispatch in orderless--compile-component --- orderless.el | 46 +++++++++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 19 deletions(-) diff --git a/orderless.el b/orderless.el index 01d434d..a28f4b1 100644 --- a/orderless.el +++ b/orderless.el @@ -275,9 +275,11 @@ regexp." (defun orderless-without (component) "Match strings that do *not* match COMPONENT." - (when-let ((regexp (cdr (orderless--compile-component component)))) - (lambda (str) - (not (string-match-p regexp str))))) + (pcase-let ((`(,pred . ,regexp) (orderless--compile-component component))) + (when (or pred regexp) + (lambda (str) + (not (or (and pred (funcall pred str)) + (and regexp (string-match-p regexp str)))))))) (defun orderless-annotation (component) "Match candidates where the annotation matches COMPONENT." @@ -290,11 +292,13 @@ regexp." (plist-get completion-extra-properties :annotation-function) (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) - (lambda (cand) (caddr (funcall aff (list cand))))))) - (regexp (cdr (orderless--compile-component component)))) - (lambda (str) - (when-let ((ann (funcall fun str))) - (string-match-p regexp ann))))) + (lambda (cand) (caddr (funcall aff (list cand)))))))) + (pcase-let ((`(,pred . ,regexp) (orderless--compile-component component))) + (when (or pred regexp) + (lambda (str) + (when-let ((ann (funcall fun str))) + (and (or (not pred) (funcall pred ann)) + (or (not regexp) (string-match-p regexp ann))))))))) ;;; Highlighting matches @@ -382,9 +386,17 @@ DEFAULT as the list of styles." when result return (cons result string) finally (return (cons default string)))) -(defun orderless--compile-component (component &optional styles) - "Compile COMPONENT with matching STYLES." +(defun orderless--compile-component (component &optional idx total styles dispatchers) + "Compile COMPONENT at IDX of TOTAL components with STYLES and DISPATCHERS." (unless styles (setq styles orderless-matching-styles)) + (unless dispatchers (setq dispatchers orderless-style-dispatchers)) + (unless idx (setq idx 0)) + (unless total (setq total 1)) + (let ((dispatched (orderless--dispatch dispatchers styles component idx total))) + (setq styles (car dispatched) + component (cdr dispatched)) + (when (functionp styles) + (setq styles (list styles)))) (cl-loop with pred = nil for style in styles @@ -411,21 +423,17 @@ you the default, if you want no dispatchers to be run, use The return value is a pair of a predicate function and a list of regexps." - (unless styles (setq styles orderless-matching-styles)) - (unless dispatchers (setq dispatchers orderless-style-dispatchers)) (cl-loop - with predicate-res = nil + with predicate = nil with components = (if (functionp orderless-component-separator) (funcall orderless-component-separator pattern) (split-string pattern orderless-component-separator t)) with total = (length components) for comp in components and idx from 0 - for (newstyles . newcomp) = (orderless--dispatch dispatchers styles comp idx total) - when (functionp newstyles) do (setq newstyles (list newstyles)) - for (pred . regexps) = (orderless--compile-component newcomp newstyles) - when regexps collect regexps into regexps-res - when pred do (cl-callf orderless--predicate-and predicate-res pred) - finally return (cons predicate-res regexps-res))) + for (pred . regexp) = (orderless--compile-component comp idx total styles dispatchers) + when regexp collect regexp into regexps + when pred do (cl-callf orderless--predicate-and predicate pred) + finally return (cons predicate regexps))) (defun orderless-pattern-compiler (pattern &optional styles dispatchers) "Obsolete function, use `orderless-compile' instead. -- cgit v1.0 From 37c00837369e3938e1ec71259298d18622355c7e Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 17:04:29 +0100 Subject: orderless--dispatch: Explicitly specify the arguments - The dispatchers have a fixed calling convention. - Explicitly specifying the arguments is both safer and more efficient. --- orderless.el | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/orderless.el b/orderless.el index a28f4b1..534ae34 100644 --- a/orderless.el +++ b/orderless.el @@ -343,17 +343,18 @@ converted to a list of regexps according to the value of " +" t))) (define-obsolete-function-alias 'orderless-dispatch 'orderless--dispatch "1.0") -(defun orderless--dispatch (dispatchers default string &rest args) +(defun orderless--dispatch (dispatchers default string index total) "Run DISPATCHERS to compute matching styles for STRING. -A style dispatcher is a function that takes a string and possibly -some extra arguments. It should either return (a) nil to -indicate the dispatcher will not handle the string, (b) a new -string to replace the current string and continue dispatch, -or (c) the matching styles to use and, if needed, a new string to -use in place of the current one (for example, a dispatcher can -decide which style to use based on a suffix of the string and -then it must also return the component stripped of the suffix). +A style dispatcher is a function that takes a STRING, component +INDEX and the TOTAL number of components. It should either +return (a) nil to indicate the dispatcher will not handle the +string, (b) a new string to replace the current string and +continue dispatch, or (c) the matching styles to use and, if +needed, a new string to use in place of the current one (for +example, a dispatcher can decide which style to use based on a +suffix of the string and then it must also return the component +stripped of the suffix). More precisely, the return value of a style dispatcher can be of one of the following forms: @@ -370,13 +371,12 @@ one of the following forms: whose `cdr' is a string (to replace the current one). This function tries all DISPATCHERS in sequence until one returns -a list of styles (passing any extra ARGS to every style -dispatcher). When that happens it returns a `cons' of the list -of styles and the possibly updated STRING. If none of the +a list of styles. When that happens it returns a `cons' of the +list of styles and the possibly updated STRING. If none of the DISPATCHERS returns a list of styles, the return value will use DEFAULT as the list of styles." (cl-loop for dispatcher in dispatchers - for result = (apply dispatcher string args) + for result = (funcall dispatcher string index total) if (stringp result) do (setq string result result nil) else if (and (consp result) (null (car result))) -- cgit v1.0 From fe5b6672b409edd89dc4ddfb3a122b6e472725b5 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 11:08:59 +0100 Subject: Add comment regarding the orderless--component-compiler calls --- orderless.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/orderless.el b/orderless.el index 534ae34..fbdefe3 100644 --- a/orderless.el +++ b/orderless.el @@ -275,6 +275,9 @@ regexp." (defun orderless-without (component) "Match strings that do *not* match COMPONENT." + ;; TODO I am not happy that we call the internal orderless--compile-component + ;; function here. Somehow we have not yet reached sufficient elegance here in + ;; this patch. :( (pcase-let ((`(,pred . ,regexp) (orderless--compile-component component))) (when (or pred regexp) (lambda (str) @@ -293,6 +296,9 @@ regexp." (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand)))))))) + ;; TODO I am not happy that we call the internal orderless--compile-component + ;; function here. Somehow we have not yet reached sufficient elegance here in + ;; this patch. :( (pcase-let ((`(,pred . ,regexp) (orderless--compile-component component))) (when (or pred regexp) (lambda (str) -- cgit v1.0 From 61815c7ed91b8fe411bbf35453ce0533604119e2 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Fri, 16 Feb 2024 11:31:44 +0100 Subject: Alternative approach: Add COMPILE arg to orderless-annotation/without This way the index and total are preserved even for the recursive matchers. --- orderless.el | 47 ++++++++++++++++++++--------------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/orderless.el b/orderless.el index fbdefe3..e4a4d30 100644 --- a/orderless.el +++ b/orderless.el @@ -273,18 +273,15 @@ regexp." string-end))))) string-end)) -(defun orderless-without (component) +(defun orderless-without (component compile) "Match strings that do *not* match COMPONENT." - ;; TODO I am not happy that we call the internal orderless--compile-component - ;; function here. Somehow we have not yet reached sufficient elegance here in - ;; this patch. :( - (pcase-let ((`(,pred . ,regexp) (orderless--compile-component component))) + (pcase-let ((`(,pred . ,regexp) (funcall compile component))) (when (or pred regexp) (lambda (str) (not (or (and pred (funcall pred str)) (and regexp (string-match-p regexp str)))))))) -(defun orderless-annotation (component) +(defun orderless-annotation (component compile) "Match candidates where the annotation matches COMPONENT." (when-let (((minibufferp)) (table minibuffer-completion-table) @@ -296,10 +293,7 @@ regexp." (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand)))))))) - ;; TODO I am not happy that we call the internal orderless--compile-component - ;; function here. Somehow we have not yet reached sufficient elegance here in - ;; this patch. :( - (pcase-let ((`(,pred . ,regexp) (orderless--compile-component component))) + (pcase-let ((`(,pred . ,regexp) (funcall compile component))) (when (or pred regexp) (lambda (str) (when-let ((ann (funcall fun str))) @@ -392,24 +386,21 @@ DEFAULT as the list of styles." when result return (cons result string) finally (return (cons default string)))) -(defun orderless--compile-component (component &optional idx total styles dispatchers) +(defun orderless--compile-component (component idx total styles dispatchers) "Compile COMPONENT at IDX of TOTAL components with STYLES and DISPATCHERS." - (unless styles (setq styles orderless-matching-styles)) - (unless dispatchers (setq dispatchers orderless-style-dispatchers)) - (unless idx (setq idx 0)) - (unless total (setq total 1)) - (let ((dispatched (orderless--dispatch dispatchers styles component idx total))) - (setq styles (car dispatched) - component (cdr dispatched)) - (when (functionp styles) - (setq styles (list styles)))) - (cl-loop - with pred = nil - for style in styles - for res = (funcall style component) - if (functionp res) do (cl-callf orderless--predicate-and pred res) - else if res collect (if (stringp res) `(regexp ,res) res) into regexps - finally return (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps))))))) + (pcase-let ((compile (lambda (c) (orderless--compile-component c idx total styles dispatchers))) + (`(,newsty . ,newcomp) (orderless--dispatch dispatchers styles component idx total))) + (when (functionp newsty) + (setq newsty (list newsty))) + (cl-loop + with pred = nil + for style in newsty + for res = (condition-case nil + (funcall style newcomp) + (wrong-number-of-arguments (funcall style newcomp compile))) + if (functionp res) do (cl-callf orderless--predicate-and pred res) + else if res collect (if (stringp res) `(regexp ,res) res) into regexps + finally return (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)))))))) (defun orderless-compile (pattern &optional styles dispatchers) "Build regexps to match the components of PATTERN. @@ -429,6 +420,8 @@ you the default, if you want no dispatchers to be run, use The return value is a pair of a predicate function and a list of regexps." + (unless styles (setq styles orderless-matching-styles)) + (unless dispatchers (setq dispatchers orderless-style-dispatchers)) (cl-loop with predicate = nil with components = (if (functionp orderless-component-separator) -- cgit v1.0 From 7c99212dd3297281a1c430f13d32c807d7ad5503 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 08:12:01 +0100 Subject: Alternative 2: Compile component before passing it to orderless-annotation --- orderless.el | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/orderless.el b/orderless.el index e4a4d30..3ca7628 100644 --- a/orderless.el +++ b/orderless.el @@ -273,15 +273,14 @@ regexp." string-end))))) string-end)) -(defun orderless-without (component compile) +(defun orderless-without (component) "Match strings that do *not* match COMPONENT." - (pcase-let ((`(,pred . ,regexp) (funcall compile component))) - (when (or pred regexp) - (lambda (str) - (not (or (and pred (funcall pred str)) - (and regexp (string-match-p regexp str)))))))) + (pcase-let ((`(,pred . ,regexp) component)) + (lambda (str) + (not (or (and pred (funcall pred str)) + (and regexp (string-match-p regexp str))))))) -(defun orderless-annotation (component compile) +(defun orderless-annotation (component) "Match candidates where the annotation matches COMPONENT." (when-let (((minibufferp)) (table minibuffer-completion-table) @@ -293,12 +292,11 @@ regexp." (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand)))))))) - (pcase-let ((`(,pred . ,regexp) (funcall compile component))) - (when (or pred regexp) - (lambda (str) - (when-let ((ann (funcall fun str))) - (and (or (not pred) (funcall pred ann)) - (or (not regexp) (string-match-p regexp ann))))))))) + (pcase-let ((`(,pred . ,regexp) component)) + (lambda (str) + (when-let ((ann (funcall fun str))) + (and (or (not pred) (funcall pred ann)) + (or (not regexp) (string-match-p regexp ann)))))))) ;;; Highlighting matches @@ -388,19 +386,24 @@ DEFAULT as the list of styles." (defun orderless--compile-component (component idx total styles dispatchers) "Compile COMPONENT at IDX of TOTAL components with STYLES and DISPATCHERS." - (pcase-let ((compile (lambda (c) (orderless--compile-component c idx total styles dispatchers))) - (`(,newsty . ,newcomp) (orderless--dispatch dispatchers styles component idx total))) + (pcase-let ((`(,newsty . ,newcomp) (orderless--dispatch dispatchers styles component idx total))) (when (functionp newsty) (setq newsty (list newsty))) (cl-loop with pred = nil for style in newsty - for res = (condition-case nil - (funcall style newcomp) - (wrong-number-of-arguments (funcall style newcomp compile))) + ;; TODO orderless-without and orderless-annotation are hardcoded here. + ;; Changed this such that orderless-affix-dispatch-alist contains a flag or + ;; introduce a new configuration variable. + for newcomp2 = (if (memq style '(orderless-without orderless-annotation)) + (orderless--compile-component newcomp idx total styles dispatchers) + newcomp) + when newcomp2 + for res = (funcall style newcomp2) if (functionp res) do (cl-callf orderless--predicate-and pred res) else if res collect (if (stringp res) `(regexp ,res) res) into regexps - finally return (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)))))))) + finally return + (and (or pred regexps) (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps))))))))) (defun orderless-compile (pattern &optional styles dispatchers) "Build regexps to match the components of PATTERN. -- cgit v1.0 From b56db3eea43ba67f319defca1ed65666b7f68bd5 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 08:41:39 +0100 Subject: Turn orderless-annotation/without into a "pattern transformer" orderless-annotation and orderless-without take a PRED and a REGEXP argument and turn it into a new predicate. This looks like a good solution. The complexity is pushed to orderless--compile-component and orderless-without is as simple as possible. --- orderless.el | 39 +++++++++++++++++---------------------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/orderless.el b/orderless.el index 3ca7628..ea36428 100644 --- a/orderless.el +++ b/orderless.el @@ -273,15 +273,14 @@ regexp." string-end))))) string-end)) -(defun orderless-without (component) - "Match strings that do *not* match COMPONENT." - (pcase-let ((`(,pred . ,regexp) component)) - (lambda (str) - (not (or (and pred (funcall pred str)) - (and regexp (string-match-p regexp str))))))) - -(defun orderless-annotation (component) - "Match candidates where the annotation matches COMPONENT." +(defun orderless-without (pred regexp) + "Match strings that do *not* match PRED or REGEXP." + (lambda (str) + (not (or (and pred (funcall pred str)) + (and regexp (string-match-p regexp str)))))) + +(defun orderless-annotation (pred regexp) + "Match candidates where the annotation matches PRED and REGEXP." (when-let (((minibufferp)) (table minibuffer-completion-table) (metadata (completion-metadata @@ -292,11 +291,10 @@ regexp." (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) (plist-get completion-extra-properties :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand)))))))) - (pcase-let ((`(,pred . ,regexp) component)) - (lambda (str) - (when-let ((ann (funcall fun str))) - (and (or (not pred) (funcall pred ann)) - (or (not regexp) (string-match-p regexp ann)))))))) + (lambda (str) + (when-let ((ann (funcall fun str))) + (and (or (not pred) (funcall pred ann)) + (or (not regexp) (string-match-p regexp ann))))))) ;;; Highlighting matches @@ -392,14 +390,11 @@ DEFAULT as the list of styles." (cl-loop with pred = nil for style in newsty - ;; TODO orderless-without and orderless-annotation are hardcoded here. - ;; Changed this such that orderless-affix-dispatch-alist contains a flag or - ;; introduce a new configuration variable. - for newcomp2 = (if (memq style '(orderless-without orderless-annotation)) - (orderless--compile-component newcomp idx total styles dispatchers) - newcomp) - when newcomp2 - for res = (funcall style newcomp2) + for res = (condition-case nil + (funcall style newcomp) + (wrong-number-of-arguments + (when-let ((res (orderless--compile-component newcomp idx total styles dispatchers))) + (funcall style (car res) (cdr res))))) if (functionp res) do (cl-callf orderless--predicate-and pred res) else if res collect (if (stringp res) `(regexp ,res) res) into regexps finally return -- cgit v1.0 From 71a4557269f509243f7d33e78324c7cdb9461d10 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 08:45:45 +0100 Subject: Rename orderless-without to orderless-not --- orderless.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/orderless.el b/orderless.el index ea36428..dd95b14 100644 --- a/orderless.el +++ b/orderless.el @@ -129,7 +129,7 @@ customizing this variable to see a list of them." (defcustom orderless-affix-dispatch-alist `((?% . ,#'char-fold-to-regexp) - (?! . ,#'orderless-without) + (?! . ,#'orderless-not) (?@ . ,#'orderless-annotation) (?, . ,#'orderless-initialism) (?= . ,#'orderless-literal) @@ -147,7 +147,7 @@ matched according the style associated to it." (const :tag "Literal" ,#'orderless-literal) (const :tag "Regexp" ,#'orderless-regexp) (const :tag "Without literal" ,#'orderless-without-literal) - (const :tag "Without regexp" ,#'orderless-without) + (const :tag "Not" ,#'orderless-not) (const :tag "Flex" ,#'orderless-flex) (const :tag "Initialism" ,#'orderless-initialism) (const :tag "Prefixes" ,#'orderless-prefixes) @@ -261,9 +261,8 @@ at a word boundary in the candidate. This is similar to the (defun orderless-without-literal (component) "Match strings that do *not* contain COMPONENT as a literal match. -You may prefer to use the more general `orderless-without' -instead which compiles the input to a predicate instead of a -regexp." +You may prefer to use the more general `orderless-not' instead +which can invert any predicate or regexp." `(seq (group string-start) ; highlight nothing! (zero-or-more @@ -273,7 +272,7 @@ regexp." string-end))))) string-end)) -(defun orderless-without (pred regexp) +(defun orderless-not (pred regexp) "Match strings that do *not* match PRED or REGEXP." (lambda (str) (not (or (and pred (funcall pred str)) -- cgit v1.0 From 45d5d457b215aeacdb3471f527947d37b20e1c02 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 10:00:48 +0100 Subject: Update commentary, recommend (setq completion-styles '(orderless basic)) --- orderless.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/orderless.el b/orderless.el index dd95b14..98e4080 100644 --- a/orderless.el +++ b/orderless.el @@ -37,7 +37,7 @@ ;; To use this completion style you can use the following minimal ;; configuration: -;; (setq completion-styles '(orderless)) +;; (setq completion-styles '(orderless basic)) ;; You can customize the `orderless-component-separator' to decide how ;; the input pattern is split into component regexps. The default -- cgit v1.0 From 9e810f43f0152148f34ab5c84ab311da6bfc8762 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 13:47:08 +0100 Subject: Simplify orderless--compile-component --- orderless.el | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/orderless.el b/orderless.el index 98e4080..395f1f2 100644 --- a/orderless.el +++ b/orderless.el @@ -383,21 +383,19 @@ DEFAULT as the list of styles." (defun orderless--compile-component (component idx total styles dispatchers) "Compile COMPONENT at IDX of TOTAL components with STYLES and DISPATCHERS." - (pcase-let ((`(,newsty . ,newcomp) (orderless--dispatch dispatchers styles component idx total))) - (when (functionp newsty) - (setq newsty (list newsty))) - (cl-loop - with pred = nil - for style in newsty - for res = (condition-case nil - (funcall style newcomp) - (wrong-number-of-arguments - (when-let ((res (orderless--compile-component newcomp idx total styles dispatchers))) - (funcall style (car res) (cdr res))))) - if (functionp res) do (cl-callf orderless--predicate-and pred res) - else if res collect (if (stringp res) `(regexp ,res) res) into regexps - finally return - (and (or pred regexps) (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps))))))))) + (cl-loop + with pred = nil + with (newsty . newcomp) = (orderless--dispatch dispatchers styles component idx total) + for style in (if (functionp newsty) (list newsty) newsty) + for res = (condition-case nil + (funcall style newcomp) + (wrong-number-of-arguments + (when-let ((res (orderless--compile-component newcomp idx total styles dispatchers))) + (funcall style (car res) (cdr res))))) + if (functionp res) do (cl-callf orderless--predicate-and pred res) + else if res collect (if (stringp res) `(regexp ,res) res) into regexps + finally return + (and (or pred regexps) (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)))))))) (defun orderless-compile (pattern &optional styles dispatchers) "Build regexps to match the components of PATTERN. -- cgit v1.0 From 7af2ee23d8c837a2021b71bc14377b719815cb7c Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 13:47:22 +0100 Subject: orderless-compile: Expand docstring --- orderless.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/orderless.el b/orderless.el index 395f1f2..f1d7868 100644 --- a/orderless.el +++ b/orderless.el @@ -414,7 +414,8 @@ you the default, if you want no dispatchers to be run, use \\='(ignore) as the value of DISPATCHERS. The return value is a pair of a predicate function and a list of -regexps." +regexps. The predicate function can also be nil. It takes a +string as argument." (unless styles (setq styles orderless-matching-styles)) (unless dispatchers (setq dispatchers orderless-style-dispatchers)) (cl-loop -- cgit v1.0 From 258b9f54e193ffb58942e7ff193ca8d0f16ecd35 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 13:59:45 +0100 Subject: README: Fix language after renaming of orderless-pattern-compiler --- README.org | 10 +++++----- orderless.texi | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/README.org b/README.org index 1ad12ad..e4f02f7 100644 --- a/README.org +++ b/README.org @@ -307,11 +307,11 @@ completion is the one that ends up being used, of course. ** Pattern compiler -The default mechanism for turning an input string into a list of regexps to -match against, configured using =orderless-matching-styles=, is probably flexible -enough for the vast majority of users. The patterns are compiled by the -=orderless-compile=. Under special circumstances it may be useful to implement a -custom pattern compiler by advising the =orderless-compile=. +The default mechanism for turning an input string into a predicate and a list of +regexps to match against, configured using =orderless-matching-styles=, is +probably flexible enough for the vast majority of users. The patterns are +compiled by =orderless-compile=. Under special circumstances it may be useful to +implement a custom pattern compiler by advising =orderless-compile=. ** Interactively changing the configuration diff --git a/orderless.texi b/orderless.texi index d8d2a78..6586e05 100644 --- a/orderless.texi +++ b/orderless.texi @@ -369,11 +369,11 @@ completion is the one that ends up being used, of course. @node Pattern compiler @section Pattern compiler -The default mechanism for turning an input string into a list of regexps to -match against, configured using @samp{orderless-matching-styles}, is probably flexible -enough for the vast majority of users. The patterns are compiled by the -@samp{orderless-compile}. Under special circumstances it may be useful to implement a -custom pattern compiler by advising the @samp{orderless-compile}. +The default mechanism for turning an input string into a predicate and a list of +regexps to match against, configured using @samp{orderless-matching-styles}, is +probably flexible enough for the vast majority of users. The patterns are +compiled by @samp{orderless-compile}. Under special circumstances it may be useful to +implement a custom pattern compiler by advising @samp{orderless-compile}. @node Interactively changing the configuration @section Interactively changing the configuration -- cgit v1.0 From add8d5af3af8cadbba60e68c1b3c78cf9b8b3475 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sat, 17 Feb 2024 17:34:28 +0100 Subject: Break long lines --- orderless.el | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/orderless.el b/orderless.el index f1d7868..26c4783 100644 --- a/orderless.el +++ b/orderless.el @@ -283,12 +283,17 @@ which can invert any predicate or regexp." (when-let (((minibufferp)) (table minibuffer-completion-table) (metadata (completion-metadata - (buffer-substring-no-properties (minibuffer-prompt-end) (point)) + (buffer-substring-no-properties + (minibuffer-prompt-end) (point)) table minibuffer-completion-predicate)) - (fun (or (completion-metadata-get metadata 'annotation-function) - (plist-get completion-extra-properties :annotation-function) - (when-let ((aff (or (completion-metadata-get metadata 'affixation-function) - (plist-get completion-extra-properties :affixation-function)))) + (fun (or (completion-metadata-get + metadata 'annotation-function) + (plist-get completion-extra-properties + :annotation-function) + (when-let ((aff (or (completion-metadata-get + metadata 'affixation-function) + (plist-get completion-extra-properties + :affixation-function)))) (lambda (cand) (caddr (funcall aff (list cand)))))))) (lambda (str) (when-let ((ann (funcall fun str))) @@ -381,21 +386,24 @@ DEFAULT as the list of styles." when result return (cons result string) finally (return (cons default string)))) -(defun orderless--compile-component (component idx total styles dispatchers) - "Compile COMPONENT at IDX of TOTAL components with STYLES and DISPATCHERS." +(defun orderless--compile-component (component index total styles dispatchers) + "Compile COMPONENT at INDEX of TOTAL components with STYLES and DISPATCHERS." (cl-loop with pred = nil - with (newsty . newcomp) = (orderless--dispatch dispatchers styles component idx total) + with (newsty . newcomp) = (orderless--dispatch dispatchers styles + component index total) for style in (if (functionp newsty) (list newsty) newsty) for res = (condition-case nil (funcall style newcomp) (wrong-number-of-arguments - (when-let ((res (orderless--compile-component newcomp idx total styles dispatchers))) + (when-let ((res (orderless--compile-component + newcomp index total styles dispatchers))) (funcall style (car res) (cdr res))))) if (functionp res) do (cl-callf orderless--predicate-and pred res) else if res collect (if (stringp res) `(regexp ,res) res) into regexps finally return - (and (or pred regexps) (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)))))))) + (when (or pred regexps) + (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)))))))) (defun orderless-compile (pattern &optional styles dispatchers) "Build regexps to match the components of PATTERN. @@ -424,8 +432,9 @@ string as argument." (funcall orderless-component-separator pattern) (split-string pattern orderless-component-separator t)) with total = (length components) - for comp in components and idx from 0 - for (pred . regexp) = (orderless--compile-component comp idx total styles dispatchers) + for comp in components and index from 0 + for (pred . regexp) = (orderless--compile-component + comp index total styles dispatchers) when regexp collect regexp into regexps when pred do (cl-callf orderless--predicate-and predicate pred) finally return (cons predicate regexps))) -- cgit v1.0