orderless.el (29703B)
1 ;;; orderless.el --- Completion style for matching regexps in any order -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; Author: Omar Antolín Camarena <omar@matem.unam.mx> 6 ;; Maintainer: Omar Antolín Camarena <omar@matem.unam.mx>, Daniel Mendler <mail@daniel-mendler.de> 7 ;; Keywords: extensions 8 ;; Version: 1.2 9 ;; Homepage: https://github.com/oantolin/orderless 10 ;; Package-Requires: ((emacs "27.1") (compat "30")) 11 12 ;; This file is part of GNU Emacs. 13 14 ;; This program is free software; you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation, either version 3 of the License, or 17 ;; (at your option) any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 29 ;; This package provides an `orderless' completion style that divides 30 ;; the pattern into components (space-separated by default), and 31 ;; matches candidates that match all of the components in any order. 32 33 ;; Completion styles are used as entries in the variables 34 ;; `completion-styles' and `completion-category-overrides', see their 35 ;; documentation. 36 37 ;; To use this completion style you can use the following minimal 38 ;; configuration: 39 40 ;; (setq completion-styles '(orderless basic)) 41 42 ;; You can customize the `orderless-component-separator' to decide how 43 ;; the input pattern is split into component regexps. The default 44 ;; splits on spaces. You might want to add hyphens and slashes, for 45 ;; example, to ease completion of symbols and file paths, 46 ;; respectively. 47 48 ;; Each component can match in any one of several matching styles: 49 ;; literally, as a regexp, as an initialism, in the flex style, or as 50 ;; word prefixes. It is easy to add new styles: they are functions 51 ;; from strings to strings that map a component to a regexp to match 52 ;; against. The variable `orderless-matching-styles' lists the 53 ;; matching styles to be used for components, by default it allows 54 ;; literal and regexp matching. 55 56 ;;; Code: 57 58 (require 'compat) 59 (eval-when-compile (require 'cl-lib)) 60 61 (defgroup orderless nil 62 "Completion method that matches space-separated regexps in any order." 63 :group 'minibuffer) 64 65 (defface orderless-match-face-0 66 '((default :weight bold) 67 (((class color) (min-colors 88) (background dark)) :foreground "#72a4ff") 68 (((class color) (min-colors 88) (background light)) :foreground "#223fbf") 69 (t :foreground "blue")) 70 "Face for matches of components numbered 0 mod 4.") 71 72 (defface orderless-match-face-1 73 '((default :weight bold) 74 (((class color) (min-colors 88) (background dark)) :foreground "#ed92f8") 75 (((class color) (min-colors 88) (background light)) :foreground "#8f0075") 76 (t :foreground "magenta")) 77 "Face for matches of components numbered 1 mod 4.") 78 79 (defface orderless-match-face-2 80 '((default :weight bold) 81 (((class color) (min-colors 88) (background dark)) :foreground "#90d800") 82 (((class color) (min-colors 88) (background light)) :foreground "#145a00") 83 (t :foreground "green")) 84 "Face for matches of components numbered 2 mod 4.") 85 86 (defface orderless-match-face-3 87 '((default :weight bold) 88 (((class color) (min-colors 88) (background dark)) :foreground "#f0ce43") 89 (((class color) (min-colors 88) (background light)) :foreground "#804000") 90 (t :foreground "yellow")) 91 "Face for matches of components numbered 3 mod 4.") 92 93 (defcustom orderless-component-separator #'orderless-escapable-split-on-space 94 "Component separators for orderless completion. 95 This can either be a string, which is passed to `split-string', 96 or a function of a single string argument." 97 :type `(choice (const :tag "Spaces" " +") 98 (const :tag "Spaces, hyphen or slash" " +\\|[-/]") 99 (const :tag "Escapable space" 100 ,#'orderless-escapable-split-on-space) 101 (const :tag "Quotable spaces" ,#'split-string-and-unquote) 102 (regexp :tag "Custom regexp") 103 (function :tag "Custom function"))) 104 105 (defcustom orderless-match-faces 106 [orderless-match-face-0 107 orderless-match-face-1 108 orderless-match-face-2 109 orderless-match-face-3] 110 "Vector of faces used (cyclically) for component matches." 111 :type '(vector face)) 112 113 (defcustom orderless-matching-styles 114 (list #'orderless-literal #'orderless-regexp) 115 "List of component matching styles. 116 If this variable is nil, regexp matching is assumed. 117 118 A matching style is simply a function from strings to regexps. 119 The returned regexps can be either strings or s-expressions in 120 `rx' syntax. If the resulting regexp has no capturing groups, 121 the entire match is highlighted, otherwise just the captured 122 groups are. Several are provided with this package: try 123 customizing this variable to see a list of them." 124 :type 'hook 125 :options (list #'orderless-regexp 126 #'orderless-literal 127 #'orderless-initialism 128 #'orderless-prefixes 129 #'orderless-flex)) 130 131 (defcustom orderless-affix-dispatch-alist 132 `((?% . ,#'char-fold-to-regexp) 133 (?! . ,#'orderless-not) 134 (?& . ,#'orderless-annotation) 135 (?, . ,#'orderless-initialism) 136 (?= . ,#'orderless-literal) 137 (?^ . ,#'orderless-literal-prefix) 138 (?~ . ,#'orderless-flex)) 139 "Alist associating characters to matching styles. 140 The function `orderless-affix-dispatch' uses this list to 141 determine how to match a pattern component: if the component 142 either starts or ends with a character used as a key in this 143 alist, the character is removed from the component and the rest is 144 matched according the style associated to it." 145 :type `(alist 146 :key-type character 147 :value-type (choice 148 (const :tag "Annotation" ,#'orderless-annotation) 149 (const :tag "Literal" ,#'orderless-literal) 150 (const :tag "Without literal" ,#'orderless-without-literal) 151 (const :tag "Literal prefix" ,#'orderless-literal-prefix) 152 (const :tag "Regexp" ,#'orderless-regexp) 153 (const :tag "Not" ,#'orderless-not) 154 (const :tag "Flex" ,#'orderless-flex) 155 (const :tag "Initialism" ,#'orderless-initialism) 156 (const :tag "Prefixes" ,#'orderless-prefixes) 157 (const :tag "Ignore diacritics" ,#'char-fold-to-regexp) 158 (function :tag "Custom matching style")))) 159 160 (defun orderless-affix-dispatch (component _index _total) 161 "Match COMPONENT according to the styles in `orderless-affix-dispatch-alist'. 162 If the COMPONENT starts or ends with one of the characters used 163 as a key in `orderless-affix-dispatch-alist', then that character 164 is removed and the remainder of the COMPONENT is matched in the 165 style associated to the character." 166 (let ((len (length component)) 167 (alist orderless-affix-dispatch-alist)) 168 (when (> len 0) 169 (cond 170 ;; Ignore single dispatcher character 171 ((and (= len 1) (alist-get (aref component 0) alist)) #'ignore) 172 ;; Prefix 173 ((when-let ((style (alist-get (aref component 0) alist))) 174 (cons style (substring component 1)))) 175 ;; Suffix 176 ((when-let ((style (alist-get (aref component (1- len)) alist))) 177 (cons style (substring component 0 -1)))))))) 178 179 (defcustom orderless-style-dispatchers (list #'orderless-affix-dispatch) 180 "List of style dispatchers. 181 Style dispatchers are used to override the matching styles 182 based on the actual component and its place in the list of 183 components. A style dispatcher is a function that takes a string 184 and two integers as arguments, it gets called with a component, 185 the 0-based index of the component and the total number of 186 components. It can decide what matching styles to use for the 187 component and optionally replace the component with a different 188 string, or it can decline to handle the component leaving it for 189 future dispatchers. For details see `orderless--dispatch'. 190 191 For example, a style dispatcher could arrange for the first 192 component to match as an initialism and subsequent components to 193 match as literals. As another example, a style dispatcher could 194 arrange for a component starting with `~' to match the rest of 195 the component in the `orderless-flex' style. See 196 `orderless-affix-dispatch' and `orderless-affix-dispatch-alist' 197 for such a configuration. For more information on how this 198 variable is used, see `orderless-compile'." 199 :type 'hook) 200 201 (defcustom orderless-smart-case t 202 "Whether to use smart case. 203 If this variable is t, then case-sensitivity is decided as 204 follows: if any component contains upper case letters, the 205 matches are case sensitive; otherwise case-insensitive. This 206 is like the behavior of `isearch' when `search-upper-case' is 207 non-nil. 208 209 On the other hand, if this variable is nil, then case-sensitivity 210 is determined by the values of `completion-ignore-case', 211 `read-file-name-completion-ignore-case' and 212 `read-buffer-completion-ignore-case', as usual for completion." 213 :type 'boolean) 214 215 (defcustom orderless-expand-substring 'prefix 216 "Whether to perform literal substring expansion. 217 This configuration option affects the behavior of some completion 218 interfaces when pressing TAB. If enabled `orderless-try-completion' 219 will first attempt literal substring expansion. If disabled, 220 expansion is only performed for single unique matches. For 221 performance reasons only `prefix' expansion is enabled by default. 222 Set the variable to `substring' for full substring expansion." 223 :type '(choice (const :tag "No expansion" nil) 224 (const :tag "Substring" substring) 225 (const :tag "Prefix (efficient)" prefix))) 226 227 ;;; Matching styles 228 229 (defun orderless-regexp (component) 230 "Match COMPONENT as a regexp." 231 (condition-case nil 232 (progn (string-match-p component "") component) 233 (invalid-regexp nil))) 234 235 (defun orderless-literal (component) 236 "Match COMPONENT as a literal string." 237 ;; Do not use (literal component) here, such that `delete-dups' in 238 ;; `orderless--compile-component' has a chance to delete duplicates for 239 ;; literal input. The default configuration of `orderless-matching-styles' 240 ;; with `orderless-regexp' and `orderless-literal' leads to duplicates. 241 (regexp-quote component)) 242 243 (defun orderless-literal-prefix (component) 244 "Match COMPONENT as a literal prefix string." 245 `(seq bos (literal ,component))) 246 247 (defun orderless--separated-by (sep rxs &optional before after) 248 "Return a regexp to match the rx-regexps RXS with SEP in between. 249 If BEFORE is specified, add it to the beginning of the rx 250 sequence. If AFTER is specified, add it to the end of the rx 251 sequence." 252 (declare (indent 1)) 253 `(seq 254 ,(or before "") 255 ,@(cl-loop for (sexp . more) on rxs 256 collect `(group ,sexp) 257 when more collect sep) 258 ,(or after ""))) 259 260 (defun orderless-flex (component) 261 "Match a component in flex style. 262 This means the characters in COMPONENT must occur in the 263 candidate in that order, but not necessarily consecutively." 264 `(seq 265 ,@(cdr (cl-loop for char across component 266 append `((zero-or-more (not ,char)) (group ,char)))))) 267 268 (defun orderless-initialism (component) 269 "Match a component as an initialism. 270 This means the characters in COMPONENT must occur in the 271 candidate, in that order, at the beginning of words." 272 (orderless--separated-by '(zero-or-more nonl) 273 (cl-loop for char across component collect `(seq word-start ,char)))) 274 275 (defun orderless-prefixes (component) 276 "Match a component as multiple word prefixes. 277 The COMPONENT is split at word endings, and each piece must match 278 at a word boundary in the candidate. This is similar to the 279 `partial-completion' completion style." 280 (orderless--separated-by '(zero-or-more nonl) 281 (cl-loop for prefix in (split-string component "\\>") 282 collect `(seq word-boundary ,prefix)))) 283 284 (defun orderless-without-literal (component) 285 "Match strings that do *not* contain COMPONENT as a literal match. 286 You may prefer to use the more general `orderless-not' instead 287 which can invert any predicate or regexp." 288 `(seq 289 (group string-start) ; highlight nothing! 290 (zero-or-more 291 (or ,@(cl-loop for i below (length component) 292 collect `(seq ,(substring component 0 i) 293 (or (not (any ,(aref component i))) 294 string-end))))) 295 string-end)) 296 297 (defsubst orderless--match-p (pred regexp str) 298 "Return t if STR matches PRED and REGEXP." 299 (and str 300 (or (not pred) (funcall pred str)) 301 (or (not regexp) 302 (let ((case-fold-search completion-ignore-case)) 303 (string-match-p regexp str))))) 304 305 (defun orderless-not (pred regexp) 306 "Match strings that do *not* match PRED and REGEXP." 307 (lambda (str) 308 (not (orderless--match-p pred regexp str)))) 309 310 (defun orderless--metadata () 311 "Return completion metadata iff inside minibuffer." 312 (when-let (((minibufferp)) 313 (table minibuffer-completion-table)) 314 ;; Return non-nil metadata iff inside minibuffer 315 (or (completion-metadata (buffer-substring-no-properties 316 (minibuffer-prompt-end) (point)) 317 table minibuffer-completion-predicate) 318 '((nil . nil))))) 319 320 (defun orderless-annotation (pred regexp) 321 "Match candidates where the annotation matches PRED and REGEXP." 322 (let ((md (orderless--metadata))) 323 (if-let ((fun (compat-call completion-metadata-get md 'affixation-function))) 324 (lambda (str) 325 (cl-loop for s in (cdar (funcall fun (list str))) 326 thereis (orderless--match-p pred regexp s))) 327 (when-let ((fun (compat-call completion-metadata-get md 'annotation-function))) 328 (lambda (str) (orderless--match-p pred regexp (funcall fun str))))))) 329 330 ;;; Highlighting matches 331 332 (defun orderless--highlight (regexps ignore-case string) 333 "Destructively propertize STRING to highlight a match of each of the REGEXPS. 334 The search is case insensitive if IGNORE-CASE is non-nil." 335 (cl-loop with case-fold-search = ignore-case 336 with n = (length orderless-match-faces) 337 for regexp in regexps and i from 0 338 when (string-match regexp string) do 339 (cl-loop 340 for (x y) on (let ((m (match-data))) (or (cddr m) m)) by #'cddr 341 when x do 342 (add-face-text-property 343 x y 344 (aref orderless-match-faces (mod i n)) 345 nil string))) 346 string) 347 348 (defun orderless-highlight-matches (regexps strings) 349 "Highlight a match of each of the REGEXPS in each of the STRINGS. 350 Warning: only use this if you know all REGEXPs match all STRINGS! 351 For the user's convenience, if REGEXPS is a string, it is 352 converted to a list of regexps according to the value of 353 `orderless-matching-styles'." 354 (when (stringp regexps) 355 (setq regexps (cdr (orderless-compile regexps)))) 356 (cl-loop with ignore-case = (orderless--ignore-case-p regexps) 357 for str in strings 358 collect (orderless--highlight regexps ignore-case (substring str)))) 359 360 ;;; Compiling patterns to lists of regexps 361 362 (defun orderless-escapable-split-on-space (string) 363 "Split STRING on spaces, which can be escaped with backslash." 364 (mapcar 365 (lambda (piece) (replace-regexp-in-string (string 0) " " piece)) 366 (split-string (replace-regexp-in-string 367 "\\\\\\\\\\|\\\\ " 368 (lambda (x) (if (equal x "\\ ") (string 0) x)) 369 string 'fixedcase 'literal) 370 " +" t))) 371 372 (defun orderless--dispatch (dispatchers default string index total) 373 "Run DISPATCHERS to compute matching styles for STRING. 374 375 A style dispatcher is a function that takes a STRING, component 376 INDEX and the TOTAL number of components. It should either 377 return (a) nil to indicate the dispatcher will not handle the 378 string, (b) a new string to replace the current string and 379 continue dispatch, or (c) the matching styles to use and, if 380 needed, a new string to use in place of the current one (for 381 example, a dispatcher can decide which style to use based on a 382 suffix of the string and then it must also return the component 383 stripped of the suffix). 384 385 More precisely, the return value of a style dispatcher can be of 386 one of the following forms: 387 388 - nil (to continue dispatching) 389 390 - a string (to replace the component and continue dispatching), 391 392 - a matching style or non-empty list of matching styles to 393 return, 394 395 - a `cons' whose `car' is either as in the previous case or 396 nil (to request returning the DEFAULT matching styles), and 397 whose `cdr' is a string (to replace the current one). 398 399 This function tries all DISPATCHERS in sequence until one returns 400 a list of styles. When that happens it returns a `cons' of the 401 list of styles and the possibly updated STRING. If none of the 402 DISPATCHERS returns a list of styles, the return value will use 403 DEFAULT as the list of styles." 404 (cl-loop for dispatcher in dispatchers 405 for result = (funcall dispatcher string index total) 406 if (stringp result) 407 do (setq string result result nil) 408 else if (and (consp result) (null (car result))) 409 do (setf (car result) default) 410 else if (and (consp result) (stringp (cdr result))) 411 do (setq string (cdr result) result (car result)) 412 when result return (cons result string) 413 finally (return (cons default string)))) 414 415 (defun orderless--compile-component (component index total styles dispatchers) 416 "Compile COMPONENT at INDEX of TOTAL components with STYLES and DISPATCHERS." 417 (cl-loop 418 with pred = nil 419 with (newsty . newcomp) = (orderless--dispatch dispatchers styles 420 component index total) 421 for style in (if (functionp newsty) (list newsty) newsty) 422 for res = (condition-case nil 423 (funcall style newcomp) 424 (wrong-number-of-arguments 425 (when-let ((res (orderless--compile-component 426 newcomp index total styles dispatchers))) 427 (funcall style (car res) (cdr res))))) 428 if (functionp res) do (cl-callf orderless--predicate-and pred res) 429 else if res collect (if (stringp res) `(regexp ,res) res) into regexps 430 finally return 431 (when (or pred regexps) 432 (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)) t)))))) 433 434 (defun orderless-compile (pattern &optional styles dispatchers) 435 "Build regexps to match the components of PATTERN. 436 Split PATTERN on `orderless-component-separator' and compute 437 matching styles for each component. For each component the style 438 DISPATCHERS are run to determine the matching styles to be used; 439 they are called with arguments the component, the 0-based index 440 of the component and the total number of components. If the 441 DISPATCHERS decline to handle the component, then the list of 442 matching STYLES is used. See `orderless--dispatch' for details 443 on dispatchers. 444 445 The STYLES default to `orderless-matching-styles', and the 446 DISPATCHERS default to `orderless-dipatchers'. Since nil gets 447 you the default, if you want no dispatchers to be run, use 448 \\='(ignore) as the value of DISPATCHERS. 449 450 The return value is a pair of a predicate function and a list of 451 regexps. The predicate function can also be nil. It takes a 452 string as argument." 453 (unless styles (setq styles orderless-matching-styles)) 454 (unless dispatchers (setq dispatchers orderless-style-dispatchers)) 455 (cl-loop 456 with predicate = nil 457 with components = (if (functionp orderless-component-separator) 458 (funcall orderless-component-separator pattern) 459 (split-string pattern orderless-component-separator t)) 460 with total = (length components) 461 for comp in components and index from 0 462 for (pred . regexp) = (orderless--compile-component 463 comp index total styles dispatchers) 464 when regexp collect regexp into regexps 465 when pred do (cl-callf orderless--predicate-and predicate pred) 466 finally return (cons predicate regexps))) 467 468 ;;; Completion style implementation 469 470 (defun orderless--predicate-normalized-and (p q) 471 "Combine two predicate functions P and Q with `and'. 472 The first function P is a completion predicate which can receive 473 up to two arguments. The second function Q always receives a 474 normalized string as argument." 475 (cond 476 ((and p q) 477 (lambda (k &rest v) ;; v for hash table 478 (when (if v (funcall p k (car v)) (funcall p k)) 479 (setq k (if (consp k) (car k) k)) ;; alist 480 (funcall q (if (symbolp k) (symbol-name k) k))))) 481 (q 482 (lambda (k &optional _) ;; _ for hash table 483 (setq k (if (consp k) (car k) k)) ;; alist 484 (funcall q (if (symbolp k) (symbol-name k) k)))) 485 (p))) 486 487 (defun orderless--predicate-and (p q) 488 "Combine two predicate functions P and Q with `and'." 489 (or (and p q (lambda (x) (and (funcall p x) (funcall q x)))) p q)) 490 491 (defun orderless--compile (string table pred) 492 "Compile STRING to a prefix and a list of regular expressions. 493 The predicate PRED is used to constrain the entries in TABLE." 494 (pcase-let* ((limit (car (completion-boundaries string table pred ""))) 495 (prefix (substring string 0 limit)) 496 (pattern (substring string limit)) 497 (`(,fun . ,regexps) (orderless-compile pattern))) 498 (list prefix regexps (orderless--ignore-case-p regexps) 499 (orderless--predicate-normalized-and pred fun)))) 500 501 ;; Thanks to @jakanakaevangeli for writing a version of this function: 502 ;; https://github.com/oantolin/orderless/issues/79#issuecomment-916073526 503 (defun orderless--literal-prefix-p (regexp) 504 "Determine if REGEXP is a quoted regexp anchored at the beginning. 505 If REGEXP is of the form \"\\`q\" for q = (regexp-quote u), 506 then return (cons REGEXP u); else return nil." 507 (when (and (string-prefix-p "\\`" regexp) 508 (not (string-match-p "[$*+.?[\\^]" 509 (replace-regexp-in-string 510 "\\\\[$*+.?[\\^]" "" regexp 511 'fixedcase 'literal nil 2)))) 512 (cons regexp 513 (replace-regexp-in-string "\\\\\\([$*+.?[\\^]\\)" "\\1" 514 regexp 'fixedcase nil nil 2)))) 515 516 (defun orderless--ignore-case-p (regexps) 517 "Return non-nil if case should be ignored for REGEXPS." 518 (if orderless-smart-case 519 (cl-loop for regexp in regexps 520 always (isearch-no-upper-case-p regexp t)) 521 completion-ignore-case)) 522 523 (defun orderless--filter (prefix regexps ignore-case table pred) 524 "Filter TABLE by PREFIX, REGEXPS and PRED. 525 The matching should be case-insensitive if IGNORE-CASE is non-nil." 526 ;; If there is a regexp of the form \`quoted-regexp then 527 ;; remove the first such and add the unquoted form to the prefix. 528 (pcase (cl-loop for r in regexps 529 thereis (orderless--literal-prefix-p r)) 530 (`(,regexp . ,literal) 531 (setq prefix (concat prefix literal) 532 regexps (remove regexp regexps)))) 533 (let ((completion-regexp-list regexps) 534 (completion-ignore-case ignore-case)) 535 (all-completions prefix table pred))) 536 537 (defun orderless-filter (string table &optional pred) 538 "Split STRING into components and find entries TABLE matching all. 539 The predicate PRED is used to constrain the entries in TABLE." 540 (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) 541 (orderless--compile string table pred))) 542 (orderless--filter prefix regexps ignore-case table pred))) 543 544 ;;;###autoload 545 (defun orderless-all-completions (string table pred _point) 546 "Split STRING into components and find entries TABLE matching all. 547 The predicate PRED is used to constrain the entries in TABLE. The 548 matching portions of each candidate are highlighted. 549 This function is part of the `orderless' completion style." 550 (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) 551 (orderless--compile string table pred))) 552 (when-let ((completions (orderless--filter prefix regexps ignore-case table pred))) 553 (if completion-lazy-hilit 554 (setq completion-lazy-hilit-fn 555 (apply-partially #'orderless--highlight regexps ignore-case)) 556 (cl-loop for str in-ref completions do 557 (setf str (orderless--highlight regexps ignore-case (substring str))))) 558 (nconc completions (length prefix))))) 559 560 ;;;###autoload 561 (defun orderless-try-completion (string table pred point) 562 "Complete STRING to unique matching entry in TABLE. 563 This uses `orderless-all-completions' to find matches for STRING 564 in TABLE among entries satisfying PRED. If there is only one 565 match, it completes to that match. If there are no matches, it 566 returns nil. In any other case it \"completes\" STRING to 567 itself, without moving POINT. 568 This function is part of the `orderless' completion style." 569 (or 570 (pcase orderless-expand-substring 571 ('nil nil) 572 ('prefix (completion-emacs21-try-completion string table pred point)) 573 (_ (completion-substring-try-completion string table pred point))) 574 (catch 'orderless--many 575 (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) 576 (orderless--compile string table pred)) 577 (one nil)) 578 ;; Abuse all-completions/orderless--filter as a fast search loop. 579 ;; Should be almost allocation-free since our "predicate" is not 580 ;; called more than two times. 581 (orderless--filter 582 prefix regexps ignore-case table 583 (orderless--predicate-normalized-and 584 pred 585 (lambda (arg) 586 ;; Check if there is more than a single match (= many). 587 (when (and one (not (equal one arg))) 588 (throw 'orderless--many (cons string point))) 589 (setq one arg) 590 t))) 591 (when one 592 ;; Prepend prefix if the candidate does not already have the same 593 ;; prefix. This workaround is needed since the predicate may either 594 ;; receive an unprefixed or a prefixed candidate as argument. Most 595 ;; completion tables consistently call the predicate with unprefixed 596 ;; candidates, for example `completion-file-name-table'. In contrast, 597 ;; `completion-table-with-context' calls the predicate with prefixed 598 ;; candidates. This could be an unintended bug or oversight in 599 ;; `completion-table-with-context'. 600 (unless (or (equal prefix "") 601 (and (string-prefix-p prefix one) 602 (test-completion one table pred))) 603 (setq one (concat prefix one))) 604 (or (equal string one) ;; Return t for unique exact match 605 (cons one (length one)))))))) 606 607 ;;;###autoload 608 (add-to-list 'completion-styles-alist 609 '(orderless 610 orderless-try-completion orderless-all-completions 611 "Completion of multiple components, in any order.")) 612 613 (defmacro orderless-define-completion-style 614 (name &optional docstring &rest configuration) 615 "Define an orderless completion style with given CONFIGURATION. 616 The CONFIGURATION should be a list of bindings that you could use 617 with `let' to configure orderless. You can include bindings for 618 `orderless-matching-styles' and `orderless-style-dispatchers', 619 for example. 620 621 The completion style consists of two functions that this macro 622 defines for you, NAME-try-completion and NAME-all-completions. 623 This macro registers those in `completion-styles-alist' as 624 forming the completion style NAME. 625 626 The optional DOCSTRING argument is used as the documentation 627 string for the completion style." 628 (declare (doc-string 2) (indent 1)) 629 (unless (stringp docstring) 630 (push docstring configuration) 631 (setq docstring nil)) 632 (let* ((fn-name (lambda (string) (intern (concat (symbol-name name) string)))) 633 (try-completion (funcall fn-name "-try-completion")) 634 (all-completions (funcall fn-name "-all-completions")) 635 (doc-fmt "`%s' function for the %s style. 636 This function delegates to `orderless-%s'. 637 The orderless configuration is locally modified 638 specifically for the %s style.") 639 (fn-doc (lambda (fn) (format doc-fmt fn name fn name name)))) 640 `(progn 641 (defun ,try-completion (string table pred point) 642 ,(funcall fn-doc "try-completion") 643 (let ,configuration 644 (orderless-try-completion string table pred point))) 645 (defun ,all-completions (string table pred point) 646 ,(funcall fn-doc "all-completions") 647 (let ,configuration 648 (orderless-all-completions string table pred point))) 649 (add-to-list 'completion-styles-alist 650 '(,name ,try-completion ,all-completions ,docstring))))) 651 652 ;;; Ivy integration 653 654 ;;;###autoload 655 (defun orderless-ivy-re-builder (str) 656 "Convert STR into regexps for use with ivy. 657 This function is for integration of orderless with ivy, use it as 658 a value in `ivy-re-builders-alist'." 659 (or (mapcar (lambda (x) (cons x t)) (cdr (orderless-compile str))) "")) 660 661 (defvar ivy-regex) 662 (defun orderless-ivy-highlight (str) 663 "Highlight a match in STR of each regexp in `ivy-regex'. 664 This function is for integration of orderless with ivy." 665 (orderless--highlight (mapcar #'car ivy-regex) t str) str) 666 667 (provide 'orderless) 668 ;;; orderless.el ends here