Merge branch 'dispatcher'

1 files changed, 209 insertions, 36 deletions

diff --git a/orderless.el b/orderless.el
index 0684a0f..84923e4 100644
--- a/orderless.el
+++ b/orderless.el
@@ -4,7 +4,7 @@
 
 ;; Author: Omar Antolín Camarena <omar@matem.unam.mx>
 ;; Keywords: extensions
-;; Version: 0.3
+;; Version: 0.4
 ;; Homepage: https://github.com/oantolin/orderless
 ;; Package-Requires: ((emacs "24.4"))
 
@@ -46,8 +46,8 @@
 ;; literally, as a regexp, as an initialism, in the flex style, or as
 ;; word prefixes.  It is easy to add new styles: they are functions
 ;; from strings to strings that map a component to a regexp to match
-;; against.  The variable `orderless-component-matching-styles' lists
-;; the matching styles to be used for components, by default it allows
+;; against.  The variable `orderless-matching-styles' lists the
+;; matching styles to be used for components, by default it allows
 ;; regexp and initialism matching.
 
 ;;; Code:
@@ -99,6 +99,19 @@ component regexps."
                  (regexp :tag "Custom regexp"))
   :group 'orderless)
 
+(defcustom orderless-transient-component-separator nil
+  "Component separator regexp override.
+This variabel, if non-nil, overrides `orderless-component-separator'.
+It is meant to be set by commands that interactively change the
+separator.  No such commands are provided with this package, but
+this variable is meant to make writing them simple.  If you do
+use this variable you are likely to want to reset it to nil after
+every completion session, which can be achieved by adding the
+function `orderless-remove-transient-configuration' to the
+`minibuffer-exit-hook'."
+  :type '(choice string nil)
+  :group 'orderless)
+
 (defcustom orderless-match-faces
   [orderless-match-face-0
    orderless-match-face-1
@@ -108,29 +121,100 @@ component regexps."
   :type '(vector 'face)
   :group 'orderless)
 
-(defcustom orderless-component-matching-styles
+(define-obsolete-variable-alias
+  'orderless-component-matching-styles 'orderless-matching-styles
+  "20200502")
+
+(defcustom orderless-matching-styles
   '(orderless-regexp orderless-initialism)
-  "List of allowed component matching styles.
+  "List of component matching styles.
 If this variable is nil, regexp matching is assumed.
 
 A matching style is simply a function from strings to strings
 that takes a component to a regexp to match against.  If the
 resulting regexp has no capturing groups, the entire match is
-highlighted, otherwise just the captured groups are."
-  :type '(set
-          (const :tag "Regexp" orderless-regexp)
-          (const :tag "Literal" orderless-literal)
-          (const :tag "Initialism" orderless-initialism)
-          (const :tag "Strict initialism" orderless-strict-initialism)
-          (const :tag "Strict leading initialism"
-            orderless-strict-leading-initialism)
-          (const :tag "Strict full initialism"
-            orderless-strict-full-initialism)
-          (const :tag "Flex" orderless-flex)
-          (const :tag "Prefixes" orderless-prefixes)
-          (function :tag "Custom matching style"))
+highlighted, otherwise just the captured groups are.  Several are
+provided with this package: try customizing this variable to see
+a list of them."
+  :type 'hook
+  :options '(orderless-regexp
+             orderless-literal
+             orderless-initialism
+             orderless-strict-initialism
+             orderless-strict-leading-initialism
+             orderless-strict-full-initialism
+             orderless-prefixes
+             orderless-flex)
+  :group 'orderless)
+
+(defcustom orderless-style-dispatchers nil
+  "List of style dispatchers.
+Style dispatchers are used to override to the matching styles
+based on the actual component and its place in the list of
+components.  A style dispatcher is a function that takes a string
+and two integers as arguments, it gets called with a component,
+the 0-based index of the component and the total number of
+components.  It can decides what matching styles to use for the
+component and otionally 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'.
+
+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-default-pattern-compiler'."
+  :type 'hook
+  :group 'orderless)
+
+(defcustom orderless-transient-matching-styles nil
+  "Component matching styles override.
+This variable, if non-nil, overrides `orderless-matching-styles'.
+It is meant to be set by commands that interactively change the
+matching style configuration.  No such commands are provided with
+this package, but this variable is meant to make writing them
+simple.  If you do use this variable you are likely to want to
+reset it to nil after every completion session, which can be
+achieved by adding the function
+`orderless-remove-transient-configuration' to the
+`minibuffer-exit-hook'."
+  :type 'hook
+  :group 'orderless)
+
+(defcustom orderless-transient-style-dispatchers nil
+  "Component style dispatchers override.
+This variable, if non-nil, overrides `orderless-style-dispatchers'.
+It is meant to be set by commands that interactively change the
+matching style configuration.  No such commands are provided with
+this package, but this variable is meant to make writing them
+simple.  If you do use this variable you are likely to want to
+reset it to nil after every completion session, which can be
+achieved by adding the function
+`orderless-remove-transient-configuration' to the
+`minibuffer-exit-hook'."
+  :type 'hook
+  :group 'orderless)
+
+(defcustom orderless-pattern-compiler #'orderless-default-pattern-compiler
+  "The `orderless' pattern compiler.
+This should be a function that takes an input pattern and returns
+a list of regexps that must all match a candidate in order for
+the candidate to be considered a completion of the pattern.
+
+The default pattern compiler is probably flexible enough for most
+users.  See `orderless-default-pattern-compiler' for details.
+
+The documentation for `orderless-matching-styles' is written
+assuming the default pattern compiler is used, if you change the
+pattern compiler it can, of course, do anything and need not
+consult this variable at all."
+  :type 'function
   :group 'orderless)
 
+;;; Matching styles
+
 (defalias 'orderless-regexp #'identity
   "Match a component as a regexp.
 This is simply the identity function.")
@@ -214,6 +298,8 @@ at a word boundary in the candidate.  This is similar to the
    (cl-loop for prefix in (split-string component "\\>" t)
             collect `(seq word-boundary ,prefix))))
 
+;;; Highlighting matches
+
 (defun orderless--highlight (regexps string)
   "Propertize STRING to highlight a match of each of the REGEXPS.
 Warning: only use this if you know all REGEXPs match!"
@@ -234,26 +320,109 @@ Warning: only use this if you know all REGEXPs match!"
 Warning: only use this if you know all REGEXPs match all STRINGS!
 For the user's convenience, if REGEXPS is a string, it is
 converted to a list of regexps according to the value of
-`orderless-component-matching-styles'."
+`orderless-matching-styles'."
     (when (stringp regexps)
-      (setq regexps (orderless--component-regexps regexps)))
+      (setq regexps (funcall orderless-pattern-compiler regexps)))
     (cl-loop for original in strings
              for string = (copy-sequence original)
              collect (orderless--highlight regexps string)))
 
-(defun orderless--component-regexps (pattern)
-  "Build regexps to match PATTERN.
-Consults `orderless-component-matching-styles' to decide what to
-match."
-  (let ((components (split-string pattern orderless-component-separator t)))
-    (if orderless-component-matching-styles
-        (cl-loop for component in components
-                 collect
-                 (rx-to-string
-                  `(or
-                    ,@(cl-loop for style in orderless-component-matching-styles
-                               collect `(regexp ,(funcall style component))))))
-      components)))
+;;; Compiling patterns to lists of regexps
+
+(defun orderless-remove-transient-configuration ()
+  "Remove all transient orderless configuration.
+Meant to be added to `exit-minibuffer-hook'."
+  (setq orderless-transient-matching-styles nil
+        orderless-transient-component-separator nil))
+
+(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
+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).
+
+More precisely, the return value of a style dispatcher can be of
+one of the following forms:
+
+- nil (to continue dispatching)
+
+- a string (to replace the component and continue dispatching),
+
+- a matching style or non-empty list of matching styles to
+  return,
+
+- a `cons' whose `car' is either as in the previous case or
+  nil (to request returning the DEFAULT matching styles), and
+  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
+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)
+           if (stringp result)
+           do (setq string result result nil)
+           else if (and (consp result) (null (car result)))
+           do (setf (car result) default)
+           else if (and (consp result) (stringp (cdr result)))
+           do (setq string (cdr result) result (car result))
+           when result return (cons result string)
+           finally (return (cons default string))))
+
+(defun orderless-default-pattern-compiler (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
+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.
+
+The STYLES default to `orderless-matching-styles', and the
+DISPATCHERS default to `orderless-dipatchers'.  Since nil gets you
+the default, if want to no dispatchers to be run, use '(ignore)
+as the value of DISPATCHERS.
+
+The `orderless-transient-*' variables, when non-nil, override the
+corresponding value among `orderless-component-separator', STYLES
+and DISPATCHERS.
+
+This function is the default for `orderless-pattern-compiler' and
+might come in handy as a subroutine to implement other pattern
+compilers."
+  (unless styles (setq styles orderless-matching-styles))
+  (setq styles (or orderless-transient-matching-styles styles))
+  (unless dispatchers (setq dispatchers orderless-style-dispatchers))
+  (setq dispatchers (or orderless-transient-style-dispatchers dispatchers))
+  (cl-loop
+   with components = (split-string
+                      pattern
+                      (or orderless-transient-component-separator
+                          orderless-component-separator))
+   with total = (length components)
+   for component in components and index from 0
+   for (newstyles . newcomp) = (orderless-dispatch
+                                dispatchers styles component index total)
+   collect
+   (if (functionp newstyles)
+       (funcall newstyles newcomp)
+     (rx-to-string
+      `(or
+        ,@(cl-loop for style in newstyles
+                   collect `(regexp ,(funcall style newcomp))))))))
+
+;;; Completion style implementation
 
 (defun orderless--prefix+pattern (string table pred)
   "Split STRING into prefix and pattern according to TABLE.
@@ -270,7 +439,7 @@ The predicate PRED is used to constrain the entries in TABLE."
         (pcase-let* ((`(,prefix . ,pattern)
                       (orderless--prefix+pattern string table pred))
                      (completion-regexp-list
-                      (orderless--component-regexps pattern)))
+                      (funcall orderless-pattern-compiler pattern)))
           (all-completions prefix table pred)))
     (invalid-regexp nil)))
 
@@ -313,6 +482,8 @@ This function is part of the `orderless' completion style."
                orderless-try-completion orderless-all-completions
                "Completion of multiple components, in any order."))
 
+;;; Temporary separator change (does anyone use this?)
+
 (defvar orderless-old-component-separator nil
   "Stores the old value of `orderless-component-separator'.")
 (make-obsolete-variable 'orderless-old-component-separator
@@ -340,7 +511,7 @@ This function is part of the `orderless' completion style."
   (setq orderless-component-separator separator)
   (add-to-list 'minibuffer-exit-hook #'orderless--restore-component-separator))
 
-;;; ivy integration
+;;; Ivy integration
 
 (defvar ivy-regex)
 (defvar ivy-highlight-functions-alist)
@@ -350,7 +521,9 @@ This function is part of the `orderless' completion 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--component-regexps str)) ""))
+  (or (mapcar (lambda (x) (cons x t))
+              (funcall orderless-pattern-compiler str))
+      ""))
 
 (defun orderless-ivy-highlight (str)
   "Highlight a match in STR of each regexp in `ivy-regex'.