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