From 862eed345c0f521a0b009180dd1ddf0e51b72790 Mon Sep 17 00:00:00 2001
From: Fox Kiester <noct@posteo.net>
Date: Fri, 24 Apr 2020 20:47:35 -0400
Subject: Add more orderless initialism styles

The orderless-strict-initialism style does not allow unmatched words to be in
between initials. The orderless-strict-leading-initialism style additionally
requires that the first initial match the candidate's beginning. The
orderless-strict-full-initialiasm style additionally requires the last initial
be at the last word.
---
 README.org   | 16 ++++++++++++++++
 orderless.el | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 67 insertions(+), 4 deletions(-)

diff --git a/README.org b/README.org
index 5f67c59..67f5257 100644
--- a/README.org
+++ b/README.org
@@ -101,6 +101,22 @@ define new matching styles. The predefined ones are:
 
   This maps =abc= to =\<a.*\<b.*\c=.
 
+- orderless-strict-initialism :: like initialism but only allow
+  non-letters in between the matched words.
+
+	For example =fb= would match =foo-bar= but not =foo-qux-bar=.
+
+- orderless-strict-leading-initialism :: like strict-initialism but
+  require the first initial to match the candidate's first word.
+
+	For example =bb= would match =bar-baz= but not =foo-bar-baz=.
+
+- orderless-strict-full-initialism :: like strict-initialism but
+  require the first initial to match the candidate's first word and the
+  last initial to be at the final word.
+
+	For example =fbb= would match =foo-bar-baz= but not =foo-bar-baz-qux=.
+
 - orderless-flex :: the characters of the component should appear in
   that order in the candidate, but not necessarily consecutively.
 
diff --git a/orderless.el b/orderless.el
index 06780f4..ce90427 100644
--- a/orderless.el
+++ b/orderless.el
@@ -121,6 +121,11 @@ highlighted, otherwise just the captured groups are."
           (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"))
@@ -134,12 +139,21 @@ This is simply the identity function.")
   "Match a component as a literal string.
 This is simply `regexp-quote'.")
 
+(cl-defun orderless--separated-by (sep rxs &optional (before "") (after ""))
+  "Return a regexp to match the rx-regexps RXS with SEP in between.
+If BEFORE is specified, add it to the beginning of the rx sequence. If AFTER is
+specified, add it to the end of the rx sequence."
+  (rx-to-string
+   `(seq
+     ,before
+     ,@(cl-loop for (sexp . more) on rxs
+                collect `(group ,sexp)
+                when more collect `,sep)
+     ,after)))
+
 (defun orderless--anything-between (rxs)
   "Return a regexp to match the rx-regexps RXS with .* in between."
-  (rx-to-string
-   `(seq ,@(cl-loop for (sexp . more) on rxs
-                    collect `(group ,sexp)
-                    when more collect `(zero-or-more nonl)))))
+  (orderless--separated-by '(zero-or-more nonl) rxs))
 
 (defun orderless-flex (component)
   "Match a component in flex style.
@@ -155,6 +169,39 @@ candidate, in that order, at the beginning of words."
   (orderless--anything-between
    (cl-loop for char across component collect `(seq word-start ,char))))
 
+(defun orderless-strict-initialism (component)
+  "Match a COMPONENT as a strict initialism.
+This means the characters in COMPONENT must occur in the candidate in that order
+at the beginning of subsequent words comprised of letters. Only non-letters can
+be in between the words that start with the initials."
+  (orderless--separated-by '(seq (zero-or-more word)
+                                 word-end
+                                 (zero-or-more (not alpha)))
+   (cl-loop for char across component collect `(seq word-start ,char))))
+
+(defun orderless-strict-leading-initialism (component)
+  "Match a COMPONENT as a strict initialism (see `orderless-strict-initialism').
+Additionally require that the first initial appear at the first word of the
+candidate."
+  (orderless--separated-by
+   '(seq (zero-or-more word)
+         word-end
+         (zero-or-more (not alpha)))
+   (cl-loop for char across component collect `(seq word-start ,char))
+   '(seq buffer-start (zero-or-more (not alpha)))))
+
+(defun orderless-strict-full-initialism (component)
+  "Match a COMPONENT as a strict initialism (see `orderless-strict-initialism').
+Additionally require that the first initial appear at the first word of the
+candidate and the last initial appear the the last word in the candidate."
+  (orderless--separated-by
+   '(seq (zero-or-more word)
+         word-end
+         (zero-or-more (not alpha)))
+   (cl-loop for char across component collect `(seq word-start ,char))
+   '(seq buffer-start (zero-or-more (not alpha)))
+   '(seq (zero-or-more word) word-end (zero-or-more (not alpha)) eol)))
+
 (defun orderless-prefixes (component)
   "Match a component as multiple word prefixes.
 The COMPONENT is split at word endings, and each piece must match
-- 
cgit v1.0