orderless.el (29540B)
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) 289 (let ((case-fold-search completion-ignore-case)) 290 (string-match-p regexp str))))) 291 292 (defun orderless-not (pred regexp) 293 "Match strings that do *not* match PRED and REGEXP." 294 (lambda (str) 295 (not (orderless--match-p pred regexp str)))) 296 297 (defun orderless--metadata () 298 "Return completion metadata iff inside minibuffer." 299 (when-let (((minibufferp)) 300 (table minibuffer-completion-table)) 301 ;; Return non-nil metadata iff inside minibuffer 302 (or (completion-metadata (buffer-substring-no-properties 303 (minibuffer-prompt-end) (point)) 304 table minibuffer-completion-predicate) 305 '((nil . nil))))) 306 307 (defun orderless-annotation (pred regexp) 308 "Match candidates where the annotation matches PRED and REGEXP." 309 (when-let ((metadata (orderless--metadata)) 310 (fun (or (completion-metadata-get 311 metadata 'annotation-function) 312 (plist-get completion-extra-properties 313 :annotation-function) 314 (when-let ((aff (or (completion-metadata-get 315 metadata 'affixation-function) 316 (plist-get completion-extra-properties 317 :affixation-function)))) 318 (lambda (cand) (caddr (funcall aff (list cand)))))))) 319 (lambda (str) 320 (orderless--match-p pred regexp (funcall fun str))))) 321 322 ;;; Highlighting matches 323 324 (defun orderless--highlight (regexps ignore-case string) 325 "Destructively propertize STRING to highlight a match of each of the REGEXPS. 326 The search is case insensitive if IGNORE-CASE is non-nil." 327 (cl-loop with case-fold-search = ignore-case 328 with n = (length orderless-match-faces) 329 for regexp in regexps and i from 0 330 when (string-match regexp string) do 331 (cl-loop 332 for (x y) on (let ((m (match-data))) (or (cddr m) m)) by #'cddr 333 when x do 334 (add-face-text-property 335 x y 336 (aref orderless-match-faces (mod i n)) 337 nil string))) 338 string) 339 340 (defun orderless-highlight-matches (regexps strings) 341 "Highlight a match of each of the REGEXPS in each of the STRINGS. 342 Warning: only use this if you know all REGEXPs match all STRINGS! 343 For the user's convenience, if REGEXPS is a string, it is 344 converted to a list of regexps according to the value of 345 `orderless-matching-styles'." 346 (when (stringp regexps) 347 (setq regexps (cdr (orderless-compile regexps)))) 348 (cl-loop with ignore-case = (orderless--ignore-case-p regexps) 349 for str in strings 350 collect (orderless--highlight regexps ignore-case (substring str)))) 351 352 ;;; Compiling patterns to lists of regexps 353 354 (defun orderless-escapable-split-on-space (string) 355 "Split STRING on spaces, which can be escaped with backslash." 356 (mapcar 357 (lambda (piece) (replace-regexp-in-string (string 0) " " piece)) 358 (split-string (replace-regexp-in-string 359 "\\\\\\\\\\|\\\\ " 360 (lambda (x) (if (equal x "\\ ") (string 0) x)) 361 string 'fixedcase 'literal) 362 " +" t))) 363 364 (define-obsolete-function-alias 'orderless-dispatch 'orderless--dispatch "1.0") 365 (defun orderless--dispatch (dispatchers default string index total) 366 "Run DISPATCHERS to compute matching styles for STRING. 367 368 A style dispatcher is a function that takes a STRING, component 369 INDEX and the TOTAL number of components. It should either 370 return (a) nil to indicate the dispatcher will not handle the 371 string, (b) a new string to replace the current string and 372 continue dispatch, or (c) the matching styles to use and, if 373 needed, a new string to use in place of the current one (for 374 example, a dispatcher can decide which style to use based on a 375 suffix of the string and then it must also return the component 376 stripped of the suffix). 377 378 More precisely, the return value of a style dispatcher can be of 379 one of the following forms: 380 381 - nil (to continue dispatching) 382 383 - a string (to replace the component and continue dispatching), 384 385 - a matching style or non-empty list of matching styles to 386 return, 387 388 - a `cons' whose `car' is either as in the previous case or 389 nil (to request returning the DEFAULT matching styles), and 390 whose `cdr' is a string (to replace the current one). 391 392 This function tries all DISPATCHERS in sequence until one returns 393 a list of styles. When that happens it returns a `cons' of the 394 list of styles and the possibly updated STRING. If none of the 395 DISPATCHERS returns a list of styles, the return value will use 396 DEFAULT as the list of styles." 397 (cl-loop for dispatcher in dispatchers 398 for result = (funcall dispatcher string index total) 399 if (stringp result) 400 do (setq string result result nil) 401 else if (and (consp result) (null (car result))) 402 do (setf (car result) default) 403 else if (and (consp result) (stringp (cdr result))) 404 do (setq string (cdr result) result (car result)) 405 when result return (cons result string) 406 finally (return (cons default string)))) 407 408 (defun orderless--compile-component (component index total styles dispatchers) 409 "Compile COMPONENT at INDEX of TOTAL components with STYLES and DISPATCHERS." 410 (cl-loop 411 with pred = nil 412 with (newsty . newcomp) = (orderless--dispatch dispatchers styles 413 component index total) 414 for style in (if (functionp newsty) (list newsty) newsty) 415 for res = (condition-case nil 416 (funcall style newcomp) 417 (wrong-number-of-arguments 418 (when-let ((res (orderless--compile-component 419 newcomp index total styles dispatchers))) 420 (funcall style (car res) (cdr res))))) 421 if (functionp res) do (cl-callf orderless--predicate-and pred res) 422 else if res collect (if (stringp res) `(regexp ,res) res) into regexps 423 finally return 424 (when (or pred regexps) 425 (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)) t)))))) 426 427 (defun orderless-compile (pattern &optional styles dispatchers) 428 "Build regexps to match the components of PATTERN. 429 Split PATTERN on `orderless-component-separator' and compute 430 matching styles for each component. For each component the style 431 DISPATCHERS are run to determine the matching styles to be used; 432 they are called with arguments the component, the 0-based index 433 of the component and the total number of components. If the 434 DISPATCHERS decline to handle the component, then the list of 435 matching STYLES is used. See `orderless--dispatch' for details 436 on dispatchers. 437 438 The STYLES default to `orderless-matching-styles', and the 439 DISPATCHERS default to `orderless-dipatchers'. Since nil gets 440 you the default, if you want no dispatchers to be run, use 441 \\='(ignore) as the value of DISPATCHERS. 442 443 The return value is a pair of a predicate function and a list of 444 regexps. The predicate function can also be nil. It takes a 445 string as argument." 446 (unless styles (setq styles orderless-matching-styles)) 447 (unless dispatchers (setq dispatchers orderless-style-dispatchers)) 448 (cl-loop 449 with predicate = nil 450 with components = (if (functionp orderless-component-separator) 451 (funcall orderless-component-separator pattern) 452 (split-string pattern orderless-component-separator t)) 453 with total = (length components) 454 for comp in components and index from 0 455 for (pred . regexp) = (orderless--compile-component 456 comp index total styles dispatchers) 457 when regexp collect regexp into regexps 458 when pred do (cl-callf orderless--predicate-and predicate pred) 459 finally return (cons predicate regexps))) 460 461 (defun orderless-pattern-compiler (pattern &optional styles dispatchers) 462 "Obsolete function, use `orderless-compile' instead. 463 See `orderless-compile' for the arguments PATTERN, STYLES and DISPATCHERS." 464 (cdr (orderless-compile pattern styles dispatchers))) 465 (make-obsolete 'orderless-pattern-compiler 'orderless-compile "1.0") 466 467 ;;; Completion style implementation 468 469 (defun orderless--predicate-normalized-and (p q) 470 "Combine two predicate functions P and Q with `and'. 471 The first function P is a completion predicate which can receive 472 up to two arguments. The second function Q always receives a 473 normalized string as argument." 474 (cond 475 ((and p q) 476 (lambda (k &rest v) ;; v for hash table 477 (when (if v (funcall p k (car v)) (funcall p k)) 478 (setq k (if (consp k) (car k) k)) ;; alist 479 (funcall q (if (symbolp k) (symbol-name k) k))))) 480 (q 481 (lambda (k &optional _) ;; _ for hash table 482 (setq k (if (consp k) (car k) k)) ;; alist 483 (funcall q (if (symbolp k) (symbol-name k) k)))) 484 (p))) 485 486 (defun orderless--predicate-and (p q) 487 "Combine two predicate functions P and Q with `and'." 488 (or (and p q (lambda (x) (and (funcall p x) (funcall q x)))) p q)) 489 490 (defun orderless--compile (string table pred) 491 "Compile STRING to a prefix and a list of regular expressions. 492 The predicate PRED is used to constrain the entries in TABLE." 493 (pcase-let* ((limit (car (completion-boundaries string table pred ""))) 494 (prefix (substring string 0 limit)) 495 (pattern (substring string limit)) 496 (`(,fun . ,regexps) (orderless-compile pattern))) 497 (list prefix regexps (orderless--ignore-case-p regexps) 498 (orderless--predicate-normalized-and pred fun)))) 499 500 ;; Thanks to @jakanakaevangeli for writing a version of this function: 501 ;; https://github.com/oantolin/orderless/issues/79#issuecomment-916073526 502 (defun orderless--literal-prefix-p (regexp) 503 "Determine if REGEXP is a quoted regexp anchored at the beginning. 504 If REGEXP is of the form \"\\`q\" for q = (regexp-quote u), 505 then return (cons REGEXP u); else return nil." 506 (when (and (string-prefix-p "\\`" regexp) 507 (not (string-match-p "[$*+.?[\\^]" 508 (replace-regexp-in-string 509 "\\\\[$*+.?[\\^]" "" regexp 510 'fixedcase 'literal nil 2)))) 511 (cons regexp 512 (replace-regexp-in-string "\\\\\\([$*+.?[\\^]\\)" "\\1" 513 regexp 'fixedcase nil nil 2)))) 514 515 (defun orderless--ignore-case-p (regexps) 516 "Return non-nil if case should be ignored for REGEXPS." 517 (if orderless-smart-case 518 (cl-loop for regexp in regexps 519 always (isearch-no-upper-case-p regexp t)) 520 completion-ignore-case)) 521 522 (defun orderless--filter (prefix regexps ignore-case table pred) 523 "Filter TABLE by PREFIX, REGEXPS and PRED. 524 The matching should be case-insensitive if IGNORE-CASE is non-nil." 525 ;; If there is a regexp of the form \`quoted-regexp then 526 ;; remove the first such and add the unquoted form to the prefix. 527 (pcase (cl-loop for r in regexps 528 thereis (orderless--literal-prefix-p r)) 529 (`(,regexp . ,literal) 530 (setq prefix (concat prefix literal) 531 regexps (remove regexp regexps)))) 532 (let ((completion-regexp-list regexps) 533 (completion-ignore-case ignore-case)) 534 (all-completions prefix table pred))) 535 536 (defun orderless-filter (string table &optional pred) 537 "Split STRING into components and find entries TABLE matching all. 538 The predicate PRED is used to constrain the entries in TABLE." 539 (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) 540 (orderless--compile string table pred))) 541 (orderless--filter prefix regexps ignore-case table pred))) 542 543 ;;;###autoload 544 (defun orderless-all-completions (string table pred _point) 545 "Split STRING into components and find entries TABLE matching all. 546 The predicate PRED is used to constrain the entries in TABLE. The 547 matching portions of each candidate are highlighted. 548 This function is part of the `orderless' completion style." 549 (defvar completion-lazy-hilit-fn) 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 (bound-and-true-p 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 (catch 'orderless--many 570 (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) 571 (orderless--compile string table pred)) 572 (one nil)) 573 ;; Abuse all-completions/orderless--filter as a fast search loop. 574 ;; Should be almost allocation-free since our "predicate" is not 575 ;; called more than two times. 576 (orderless--filter 577 prefix regexps ignore-case table 578 (orderless--predicate-normalized-and 579 pred 580 (lambda (arg) 581 ;; Check if there is more than a single match (= many). 582 (when (and one (not (equal one arg))) 583 (throw 'orderless--many (cons string point))) 584 (setq one arg) 585 t))) 586 (when one 587 ;; Prepend prefix if the candidate does not already have the same 588 ;; prefix. This workaround is needed since the predicate may either 589 ;; receive an unprefixed or a prefixed candidate as argument. Most 590 ;; completion tables consistently call the predicate with unprefixed 591 ;; candidates, for example `completion-file-name-table'. In contrast, 592 ;; `completion-table-with-context' calls the predicate with prefixed 593 ;; candidates. This could be an unintended bug or oversight in 594 ;; `completion-table-with-context'. 595 (unless (or (equal prefix "") 596 (and (string-prefix-p prefix one) 597 (test-completion one table pred))) 598 (setq one (concat prefix one))) 599 (or (equal string one) ;; Return t for unique exact match 600 (cons one (length one))))))) 601 602 ;;;###autoload 603 (add-to-list 'completion-styles-alist 604 '(orderless 605 orderless-try-completion orderless-all-completions 606 "Completion of multiple components, in any order.")) 607 608 (defmacro orderless-define-completion-style 609 (name &optional docstring &rest configuration) 610 "Define an orderless completion style with given CONFIGURATION. 611 The CONFIGURATION should be a list of bindings that you could use 612 with `let' to configure orderless. You can include bindings for 613 `orderless-matching-styles' and `orderless-style-dispatchers', 614 for example. 615 616 The completion style consists of two functions that this macro 617 defines for you, NAME-try-completion and NAME-all-completions. 618 This macro registers those in `completion-styles-alist' as 619 forming the completion style NAME. 620 621 The optional DOCSTRING argument is used as the documentation 622 string for the completion style." 623 (declare (doc-string 2) (indent 1)) 624 (unless (stringp docstring) 625 (push docstring configuration) 626 (setq docstring nil)) 627 (let* ((fn-name (lambda (string) (intern (concat (symbol-name name) string)))) 628 (try-completion (funcall fn-name "-try-completion")) 629 (all-completions (funcall fn-name "-all-completions")) 630 (doc-fmt "`%s' function for the %s style. 631 This function delegates to `orderless-%s'. 632 The orderless configuration is locally modified 633 specifically for the %s style.") 634 (fn-doc (lambda (fn) (format doc-fmt fn name fn name name)))) 635 `(progn 636 (defun ,try-completion (string table pred point) 637 ,(funcall fn-doc "try-completion") 638 (let ,configuration 639 (orderless-try-completion string table pred point))) 640 (defun ,all-completions (string table pred point) 641 ,(funcall fn-doc "all-completions") 642 (let ,configuration 643 (orderless-all-completions string table pred point))) 644 (add-to-list 'completion-styles-alist 645 '(,name ,try-completion ,all-completions ,docstring))))) 646 647 ;;; Ivy integration 648 649 ;;;###autoload 650 (defun orderless-ivy-re-builder (str) 651 "Convert STR into regexps for use with ivy. 652 This function is for integration of orderless with ivy, use it as 653 a value in `ivy-re-builders-alist'." 654 (or (mapcar (lambda (x) (cons x t)) (cdr (orderless-compile str))) "")) 655 656 (defvar ivy-regex) 657 (defun orderless-ivy-highlight (str) 658 "Highlight a match in STR of each regexp in `ivy-regex'. 659 This function is for integration of orderless with ivy." 660 (orderless--highlight (mapcar #'car ivy-regex) t str) str) 661 662 (provide 'orderless) 663 ;;; orderless.el ends here