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