-
Notifications
You must be signed in to change notification settings - Fork 33
/
selectrum.el
3531 lines (3283 loc) · 151 KB
/
selectrum.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; selectrum.el --- Easily select item from list -*- lexical-binding: t -*-
;; Copyright (C) 2019-2022 Radian LLC and contributors
;; Author: Radian LLC <[email protected]>
;; Created: 8 Dec 2019
;; Homepage: https://github.com/radian-software/selectrum
;; Keywords: extensions
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: MIT
;; Version: 3.1
;;; Commentary:
;; Selectrum is a better solution for incremental narrowing in Emacs,
;; replacing Helm, Ivy, and IDO. Its design philosophy is based on
;; choosing the right abstractions and prioritizing consistency and
;; predictability over special-cased improvements for particular
;; cases. As such, Selectrum follows existing Emacs conventions where
;; they exist and are reasonable, and it declines to implement
;; features which have marginal benefit compared to the additional
;; complexity of a new interface.
;; Getting started: Selectrum provides a global minor mode,
;; `selectrum-mode', which enhances `completing-read' and all related
;; functions automatically without the need for further configuration.
;; Please see https://github.com/radian-software/selectrum for more
;; information.
;;; Code:
(require 'cl-lib)
(require 'crm)
(require 'minibuf-eldef)
(require 'regexp-opt)
(require 'seq)
(require 'subr-x)
;;; Faces
(defface selectrum-quick-keys-highlight
'((t :inherit lazy-highlight))
"Face used for `selectrum-quick-keys'."
:group 'selectrum-faces)
(defface selectrum-quick-keys-match
'((t :inherit isearch))
"Face used for matches of `selectrum-quick-keys'."
:group 'selectrum-faces)
(defface selectrum-group-title
'((t :inherit shadow :slant italic))
"Face used for the title text of the candidate group headlines."
:group 'selectrum-faces)
(defface selectrum-group-separator
'((t :inherit shadow :strike-through t))
"Face used for the separator lines of the candidate groups."
:group 'selectrum-faces)
(defface selectrum-current-candidate
'((t :inherit highlight :extend t))
"Face used to highlight the currently selected candidate.
In Emacs 27 and greater, this face is assumed to have the
`:extend' attribute set to a non-nil value (the default).
This is expected by user options like
`selectrum-extend-current-candidate-highlight'."
:group 'selectrum-faces)
(defface selectrum-completion-annotation
'((t :inherit completions-annotations))
"Face used to display annotations of completion tables."
:group 'selectrum-faces)
(defface selectrum-completion-docsig
'((t :inherit selectrum-completion-annotation :slant italic))
"Face used to display docsigs of completion tables."
:group 'selectrum-faces)
(defface selectrum-mouse-highlight
'((t :inherit selectrum-current-candidate :underline t))
"Face used for candidates during mouse hovering."
:group 'selectrum-faces)
;;; User options
(defgroup selectrum nil
"Simple incremental narrowing framework with sane API."
:group 'convenience
:prefix "selectrum-"
:link '(url-link "https://github.com/radian-software/selectrum"))
(defcustom selectrum-default-value-format
(propertize " [default: %s]" 'face 'minibuffer-prompt)
"Format string for the default value in the minibuffer."
:type '(choice (const nil) string))
(defcustom selectrum-quick-keys '(?a ?s ?d ?f ?j ?k ?l ?i ?g ?h)
"Keys for quick selection.
Used by `selectrum-quick-select' and `selectrum-quick-insert'."
:type '(repeat character))
(defcustom selectrum-group-format
(concat
#(" " 0 4 (face selectrum-group-separator))
#(" %s " 0 4 (face selectrum-group-title))
#(" " 0 1 (face selectrum-group-separator display (space :align-to right))))
"Format string used for the group title."
:type '(choice (const nil) string))
(defcustom selectrum-should-sort t
"Non-nil if preprocessing function should sort.
This should be respected by user functions for optimal results."
:type 'boolean)
(defcustom selectrum-max-window-height 10
"Maximal window height to expand to.
The display window or minibuffer window will expand up to this
height when it is to small to show the candidates. If this option
is nil it defaults to `max-mini-window-height'. See its docstring
for further information of possible values."
:type 'number)
(defcustom selectrum-num-candidates-displayed 'auto
"Configures how many candidates are displayed.
When `auto' the appropriate number will be determined
automatically according to the available space of the displaying
window and the height allowed by `selectrum-max-window-height'.
To configure a constant height for vertical display see
`selectrum-fix-vertical-window-height'."
:type '(choice (const :tag "Automatic" auto) integer))
(defcustom selectrum-fix-vertical-window-height nil
"Configure a fixed window height for vertical display.
If candidates are displayed vertically and this option is non-nil
the height will be determined by `selectrum-max-window-height'."
:type 'boolean)
(defun selectrum-display-full-frame (buf _alist)
"Display BUF in full frame.
Can be used as `selectrum-display-action' to display candidates
in a single window spanning the current frame:
(setq selectrum-display-action
\\='(selectrum-display-full-frame)."
(delete-other-windows)
(set-window-buffer (selected-window) buf)
(selected-window))
(defcustom selectrum-display-action nil
"Display action to show the candidates buffer.
If this is nil the candidates are shown in the minibuffer.
Otherwise the candidates are shown in the window as determined
from the display action. Note that if you specify a window height
lower than `selectrum-max-window-height' the window will be
resized if needed to display that number of candidates.
For the format see the ACTION argument of `display-buffer'. For
example to display candidates in some available window use:
\\='(display-buffer-use-some-window)
Or to display them in a bottom side window:
\\='(display-buffer-in-side-window
(side . bottom)
(slot . -1))
Display buffer actions can also spawn a separate frame where
candidates can be displayed. To display candidates in the current
frame you can use the provided action function
`selectrum-display-full-frame'."
:type '(cons (choice function (repeat :tag "Functions" function))
alist))
(defcustom selectrum-display-action-hook nil
"Hook to run when initializing the candidates buffer.
See `selectrum-display-action'."
:type 'hook)
(defcustom selectrum-display-style
'(vertical)
"Current display style for candidates.
The car is a symbol of the current display style. Currently
available styles are `vertical' and `horizontal'. The cdr is a
plist of settings. Currently there are only settings for the
`horizontal' style:
`:prompt-separator' for the string to display after the prompt if
the candidates are displayed in the minibuffer,
`:before-candidates' for the string to insert before the
candidate listing, `:candidates-separator' for the string to
insert between candidates, `:more-candidates' for the string to
indicate that more candidates are following after the currently
displayed ones and `:after-candidates' for a string to display
after the displayed candidates."
:type 'list)
(defcustom selectrum-display-style-cycle-list
'((vertical)
(horizontal))
"List of `selectrum-display-style' styles.
Use `selectrum-cycle-display-style' to cycle through these."
:type 'list)
(defcustom selectrum-refine-candidates-function
#'selectrum-refine-candidates-using-completions-styles
"Function used to decide which candidates should be displayed.
The function receives two arguments, the user input (a string)
and the list of candidates (strings). Returns a new list of
candidates. Should not modify the input list. The returned list
may be modified by Selectrum, so a copy of the input should be
made. (Beware that `cl-remove-if' doesn't make a copy if there's
nothing to remove.)"
:type 'function)
(defcustom selectrum-completion-in-region-styles nil
"The `completion-styles' used by `selectrum-completion-in-region'.
These are used for the initial filtering of candidates according
to the text around point. The initial filtering styles for
completion in region might generally differ from the styles you
want to use for usual completion. If this option is nil the
candidates will be filtered by `all-completions' first and if
that doesn't reveal any matches the completion is retried using
`completion-styles', honoring adjustments according to
`completion-category-overrides' and
`completion-category-defaults'."
:type completion--styles-type)
(defcustom selectrum-preprocess-candidates-function
#'selectrum-default-candidate-preprocess-function
"Function used to preprocess the list of candidates.
Receive one argument, the list of candidates. Return a new list.
May modify the input list. The returned list may be modified by
Selectrum. Note that if you sort a list of candidates, you should
use a stable sort. That way, candidates which differ only in text
properties will retain their ordering, which may be significant
\(e.g. for `load-path' shadows in `read-library-name')."
:type 'function)
(defun selectrum-candidates-identity (_input candidates)
"Return CANDIDATES unchanged."
candidates)
(defcustom selectrum-highlight-candidates-function
#'selectrum-candidates-identity
"Function used to highlight matched candidates for display.
The function receives two arguments, the input string and the
list of candidates (strings) that are going to be displayed.
Return a list of propertized candidates. Do not modify the input
list or strings."
:type 'function)
(defcustom selectrum-candidate-selected-hook nil
"Normal hook run when the user selects a candidate.
It gets the string the user selected as argument."
:type 'hook)
(defcustom selectrum-candidate-inserted-hook nil
"Normal hook run when the user inserts a candidate.
\(This happens by typing \\[selectrum-insert-current-candidate].)
It gets the string the user inserted as argument."
:type 'hook)
(defcustom selectrum-count-style 'matches
"The style to use for displaying count information before the prompt.
Possible values are:
- `matches': Show the total number of matches.
- `current/matches': Show the index of current match and the
total number of matches.
- nil: Show nothing."
:type '(choice
(const :tag "Disabled" nil)
(const :tag "Count matches" matches)
(const :tag "Count matches and show current match"
current/matches)))
(defcustom selectrum-show-indices nil
"Non-nil means to add indices to the displayed candidates.
If this is a function, it should take in the row number of the
displayed candidate (starting from 1) as a parameter and it
should return the string to be displayed representing the index
of the candidate. If this is some other non-nil value, it is
treated as if it were (lambda (i) (format \"%2d \" i))."
:type '(choice function boolean))
(defcustom selectrum-completing-read-multiple-show-help t
"Non-nil means to show help for `selectrum-completing-read-multiple'.
This options controls insertion of additional usage information
into the prompt when using commands which use
`completing-read-multiple'."
:type 'boolean)
(defcustom selectrum-right-margin-padding 1
"The number of spaces to add after right margin text.
This only takes effect when the
`selectrum-candidate-display-right-margin' property is presented
in candidates.
This option is a workaround for 2 problems:
- Some terminals will wrap the last character of a line when it
exactly fits.
- Emacs doesn't provide a method to calculate the exact pixel
width of a unicode char, so a wide char can cause line
wrapping."
:type 'integer)
(defcustom selectrum-multiline-display-settings
'((match ":" success)
(line-count "%d lines" success)
(newline "\\n" warning)
(truncation "..." shadow)
(whitespace " " shadow))
"Settings used to configure the formatting of multi-line candidates.
Currently, multi-line candidates are flattened, stripped of
repeated whitespace, and, if need be, truncated. The first line
is displayed truncated followed by a line count and trunctated
matches. This option configures how the formatting is done.
When customizing this option, a setting for each transformation
\(defined below) must be present in the list.
There are three values that make a setting:
1. A symbol from the following list:
- `newline' determines the string used to replace line breaks in the
candidate, which flattens the candidate into one line.
- `whitespace' determines the string used to replace repeated
whitespace, which shortens the candidate.
- `truncation' determines the string to append to a flattened and
truncated candidate.
- `match' determines the string to insert between the first
line and the matched lines.
- `line-count' determines the string for displaying the line count.
2. A string to indicate the display change. For `line-count' it should
be a format string for a decimal or the empty string for no display.
3. A face to assign to the indicator string.
Therefore, a setting is represented as a list with three
elements: a symbol, a string, and a face, in that order.
This option is itself a list of 4 sub-lists, one for each
setting."
:type '(repeat (list :tag "Display settings"
(choice (const :tag "Matching line"
match)
(const :tag "Line truncation"
truncation)
(const :tag "New lines"
newline)
(const :tag "Repeated whitespace"
whitespace)
(const :tag "Line count"
line-count))
(string :tag "Indicator string")
(face :tag "Indicator face"))))
(defcustom selectrum-extend-current-candidate-highlight 'auto
"Whether to extend highlighting of the current candidate until the margin.
When set to nil, only highlight the displayed text. When set to
`auto' (the default), the highlighting is automatically extended
when the session defines any annotations. Any other non-nil value
means to always extend the highlighting.
In Emacs 27 and greater, this option requires that the face
`selectrum-current-candidate' have a non-nil value for the
`:extend' attribute (the default)."
:type '(choice (const :tag "Automatic" auto) boolean))
(defcustom selectrum-files-select-input-dirs nil
"Whether to select the input for directories.
When this is non-nil the input in file completions will get
selected when it contains a directory name."
:type 'boolean)
;;;###autoload
(defcustom selectrum-complete-in-buffer t
"If non-nil, use Selectrum for `completion-in-region'.
This option needs to be set before activating `selectrum-mode'."
:type 'boolean
:group 'selectrum)
(defcustom selectrum-cycle-movement nil
"Whether commands that move past the last candidate move to the first.
See also the user option `selectrum-count-style' for displaying
the position of the currently selected candidate."
:type 'boolean
:group 'selectrum)
;;; Variables
(defvar selectrum-minibuffer-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
;; Previously, we needed to explicitly bind `abort-recursive-edit'
;; to handle recursive minibuffers, but the new function
;; `abort-minibuffers' already handles them.
;; `minibuffer-keyboard-quit' now uses this function.
(unless (fboundp 'abort-minibuffers)
(define-key map [remap keyboard-quit] #'abort-recursive-edit)
;; This is bound in `minibuffer-local-map' by loading `delsel', so
;; we have to account for it too.
(define-key map [remap minibuffer-keyboard-quit]
#'abort-recursive-edit))
;; Next/prev cand:
;; Override both the arrow keys and C-n/C-p.
(define-key map [remap previous-line]
#'selectrum-previous-candidate)
(define-key map [remap next-line]
#'selectrum-next-candidate)
(define-key map [remap previous-line-or-history-element]
#'selectrum-previous-candidate)
(define-key map [remap next-line-or-history-element]
#'selectrum-next-candidate)
;; Next/prev page:
(define-key map [remap scroll-down-command]
#'selectrum-previous-page)
(define-key map [remap scroll-up-command]
#'selectrum-next-page)
;; First/last cand:
;; Use `minibuffer-beginning-of-buffer' for Emacs >=27 and
;; `beginning-of-buffer' for Emacs <=26.
(define-key map [remap minibuffer-beginning-of-buffer]
#'selectrum-goto-beginning)
(define-key map [remap beginning-of-buffer]
#'selectrum-goto-beginning)
(define-key map [remap end-of-buffer]
#'selectrum-goto-end)
;; Next/prev group:
(define-key map (kbd "C-M-n")
#'selectrum-next-group)
(define-key map (kbd "C-M-p")
#'selectrum-previous-group)
(define-key map [remap forward-paragraph]
#'selectrum-next-group)
(define-key map [remap backward-paragraph]
#'selectrum-previous-group)
;; Other:
(define-key map [remap exit-minibuffer]
#'selectrum-select-current-candidate)
(define-key map [remap kill-ring-save]
#'selectrum-kill-ring-save)
(define-key map [remap previous-matching-history-element]
#'selectrum-select-from-history)
(define-key map [remap backward-kill-sexp]
#'selectrum-backward-kill-sexp)
(define-key map (kbd "C-M-DEL") #'selectrum-backward-kill-sexp)
(define-key map (kbd "C-M-<backspace>") #'selectrum-backward-kill-sexp)
(define-key map (kbd "C-j") #'selectrum-submit-exact-input)
(define-key map (kbd "TAB") #'selectrum-insert-current-candidate)
(define-key map (kbd "M-q") 'selectrum-cycle-display-style)
(define-key map (kbd "M-i") 'selectrum-quick-insert)
(define-key map (kbd "M-m") 'selectrum-quick-select)
;; Return the map.
map)
"Keymap used by Selectrum in the minibuffer.")
(defvar-local selectrum-move-default-candidate t
"Non-nil means move default candidate to start of list.
Nil means select the default candidate initially even if it's not
at the start of the list.")
(defvar selectrum--display-action-buffer " *selectrum*"
"Buffer to display candidates using `selectrum-display-action'.")
(defvar selectrum--quick-fun nil
"Function for quick selection.
Used by `selectrum-quick-select' and `selectrum-quick-insert'.
Receives the display index and candidate and should return the
new candidate string used for display.")
(defvar selectrum--crm-separator-alist
'((":\\|,\\|\\s-" . ",")
("[ \t]*:[ \t]*" . ":")
("[ \t]*,[ \t]*" . ",")
("\\s-*&\\s-*" . " & ")
(" " . " "))
"Values of `crm-separator' mapped to separator strings.
If current `crm-separator' has a mapping the separator gets
inserted automatically when using
`selectrum-insert-current-candidate'.")
(defvar selectrum--minibuffer-default-in-prompt-regexps
(let ((minibuffer-eldef-shorten-default nil))
(minibuffer-default--in-prompt-regexps))
"Regexps for determining if the prompt message includes the default value.
See `minibuffer-default-in-prompt-regexps', from which this is derived.")
(defvar selectrum--minibuffer-local-filename-syntax
(let ((table (copy-syntax-table minibuffer-local-filename-syntax)))
(modify-syntax-entry ?\s "_" table)
table)
"Syntax table for reading file names.
Same as `minibuffer-local-filename-syntax' but considers spaces
as symbol constituents.")
(defvar selectrum--old-completing-read-function nil
"Previous value of `completing-read-function'.")
(defvar selectrum--old-completion-in-region-function nil
"Previous value of `completion-in-region-function'.")
(defvar selectrum--old-read-buffer-function nil
"Previous value of `read-buffer-function'.")
(defvar selectrum--old-read-file-name-function nil
"Previous value of `read-file-name-function'.")
;;; Session state
(defvar-local selectrum--history-hash nil
"History hash table.")
(defvar-local selectrum--last-buffer nil
"The buffer that was current before the active session.")
(defvar-local selectrum--candidates-overlay nil
"Overlay used to display current candidates.")
(defvar-local selectrum--count-overlay nil
"Overlay used to display count information before prompt.")
(defvar-local selectrum--dynamic-candidates-function nil
"The dynamic candidate function passed to `selectrum--read'.
When set the dynamic candidate function is called on each input
change. The results are subsequently preprocessed by
`selectrum-preprocess-candidates-function' and saved as
`selectrum--preprocessed-candidates'. See `selectrum--read' for
more details on function collections.")
(defvar-local selectrum--preprocessed-candidates nil
"Preprocessed list of candidates.
This list contains the candidates of the current session after
preprocessing them with
`selectrum-preprocess-candidates-function'. The list is
subsequently passed to `selectrum-refine-candidates-function'.
For the refined candidates see `selectrum--refined-candidates'.")
(defvar-local selectrum--refined-candidates nil
"Refined list of candidates to be displayed.
This is derived from `selectrum--preprocessed-candidates' by
`selectrum-refine-candidates-function' every time the user input
changes, and is subsequently passed to
`selectrum-highlight-candidates-function'.")
(defvar-local selectrum--current-candidate-index nil
"Index of currently selected candidate, or nil if no candidates.
The value -1 means prompt selection.")
(defvar-local selectrum--first-index-displayed nil
"Index of the first displayed candidate.")
(defvar-local selectrum--actual-num-candidates-displayed nil
"The actual number of candidates displayed.")
(defvar-local selectrum--previous-input-string nil
"Previous user input string in the minibuffer.
Used to check if the user input has changed and candidates need
to be re-filtered.")
(defvar-local selectrum--virtual-input nil
"Input used for refinement and highlighting.
What is considered the current input can be changed by
`selectrum--dynamic-candidates-function'.")
(defvar-local selectrum--match-is-required nil
"Non-nil if the user must select one of the candidates.
Equivalently, nil if the user is allowed to submit their own
input that does not match any of the displayed candidates.")
(defvar-local selectrum--is-crm-session nil
"Non-nil for `selectrum-completing-read-multiple' sessions.")
(defvar-local selectrum--default-candidate nil
"Default candidate, or nil if none given.")
(defvar-local selectrum--last-command nil
"Name of last interactive command that invoked Selectrum.")
(defvar-local selectrum--last-prefix-arg nil
"Prefix argument given to last interactive command that invoked Selectrum.")
(defvar-local selectrum--last-input nil
"Input of last Selectrum session.
This is different from `selectrum--previous-input-string' which
reflects the previous input within a session.")
(defvar-local selectrum--repeat nil
"Non-nil means try to restore the minibuffer state during setup.
This is used to implement `selectrum-repeat' and also to restore
a candidate index on next computation.")
(defvar-local selectrum-is-active nil
"Non-nil means Selectrum is currently active.")
(defvar-local selectrum--is-initializing nil
"Non-nil means the current session is initializing.
This is non-nil during the first call of
`selectrum--update'.")
(defvar-local selectrum--virtual-default-file nil
"If set used as a virtual file to prompt with.")
(defvar-local selectrum--get-full-prompt-prefix nil
"Cons of prompt and cached prefix for `selectrum--get-full'.")
(defvar-local selectrum--line-height nil
"The `line-pixel-height' of current session.")
(defvar-local selectrum--inserted-file-completion nil
"Non-nil when command should trigger refresh.")
;;; Utility functions
(defun selectrum--select-active-minibuffer-window ()
"Select the active minibuffer window.
This function is added locally to `pre-command-hook' in buffers
displayed via `selectrum-display-action'. This is important for
using the mouse in such displayed buffers, since otherwise focus
would move away from the minibuffer window when clicking on
candidates."
(select-window (active-minibuffer-window)))
(defun selectrum-refine-candidates-using-completions-styles (input candidates)
"Use INPUT to filter and highlight CANDIDATES.
Uses `completion-styles'."
(nconc
(completion-all-completions
input candidates nil (length input))
nil))
(defun selectrum--pred (x y)
"Compare X and Y."
(or (< (cdr x) (cdr y))
(and (= (cdr x) (cdr y))
(string< (car x) (car y)))))
(defun selectrum-default-candidate-preprocess-function (candidates)
"Sort CANDIDATES by history position, length and alphabetically.
See `selectrum-preprocess-candidates-function'."
(when selectrum-should-sort
(unless selectrum--history-hash
;; History disabled if `minibuffer-history-variable' eq `t'.
(let ((list (and (not (eq minibuffer-history-variable t))
(symbol-value minibuffer-history-variable)))
(hist-idx 0))
(setq-local selectrum--history-hash
(make-hash-table :test #'equal
:size (length list)))
;; Store the history position first in a hashtable in order to
;; allow O(1) history lookup.
(dolist (elem list)
(unless (gethash elem selectrum--history-hash)
(puthash elem hist-idx selectrum--history-hash))
(setq hist-idx (1+ hist-idx)))))
;; Decorate each candidate with (hist-idx<<13) + length. This way we
;; sort first by hist-idx and then by length. We assume that the
;; candidates are shorter than 2**13 characters and that the history
;; is shorter than 2**16 entries.
(let ((cand candidates))
(while cand
(setcar cand
(cons (car cand)
(+ (lsh (gethash (car cand)
selectrum--history-hash #xFFFF)
13)
(length (car cand)))))
(setq cand (cdr cand))))
(setq candidates (sort candidates #'selectrum--pred))
;; Drop decoration from the candidates
(let ((cand candidates))
(while cand
(setcar cand (caar cand))
(setq cand (cdr cand)))))
candidates)
(defun selectrum--clamp (x lower upper)
"Constrain X to be between LOWER and UPPER inclusive.
If X < LOWER, return LOWER. If X > UPPER, return UPPER. Else
return X.
See the function `selectrum--cycle' for a wrapping version of
this function."
(min (max x lower) upper))
(defun selectrum--cycle (x max-index selectable-prompt)
"Wrap around index X to be inclusively between the min and MAX-INDEX.
If SELECTABLE-PROMPT is non-nil, the min is -1. Otherwise, it is 0.
For example:
(selectrum--cycle 8 6 nil) ; => 1
(selectrum--cycle -3 6 nil) ; => 4
(selectrum--cycle -14 4 t) ; => 4
(selectrum--cycle 12 4 t) ; => 0
See the function `selectrum--clamp' for a non-wrapping version of
this function."
(let ((step) (min))
(if selectable-prompt
(setq step (+ 2 max-index)
min -1)
(setq step (1+ max-index)
min 0))
(cond
;; If no candidates, stay on prompt.
((= max-index -1) -1)
;; If only one candidate, move to that or input line.
((zerop max-index)
(cond ((not selectable-prompt) 0)
((cl-oddp x) -1)
(t 0)))
;; If past the limits, wrap around. Maybe include the input line.
((> x max-index)
(while (> x max-index)
(cl-decf x step))
x)
((< x min)
(while (< x min)
(cl-incf x step))
x)
;; Otherwise, if within limits, return x.
(t x))))
(defun selectrum--move-to-front-destructive (elt lst)
"Move ELT to front of LST, if present.
Make comparisons using `equal'. Modify the input list
destructively and return the modified list."
;; We can't use something like "(cons elt (filter elt lst))"
;; in case there are multiple instances of `elt' in `lst'.
(let ((matches)
(others))
(dolist (i lst)
(if (equal i elt)
(push i matches)
(push i others)))
;; Maintain the order of the list.
(nconc (nreverse matches) (nreverse others))))
(defmacro selectrum--minibuffer-with-setup-hook (fun &rest body)
"Variant of `minibuffer-with-setup-hook' using a symbol and `fset'.
This macro is only needed to prevent memory leaking issues with
the upstream `minibuffer-with-setup-hook' macro. FUN is the hook
function and BODY opens the minibuffer."
;; Copied from https://github.com/minad/consult/commit/27e055e.
(declare (indent 1) (debug ([&or (":append" form) [&or symbolp form]] body)))
(let ((hook (make-symbol "hook"))
(append))
(when (eq (car-safe fun) :append)
(setq append '(t) fun (cadr fun)))
`(let ((,hook (make-symbol "selectrum--minibuffer-setup")))
(fset ,hook (lambda ()
(remove-hook 'minibuffer-setup-hook ,hook)
(funcall ,fun)))
(unwind-protect
(progn
(add-hook 'minibuffer-setup-hook ,hook ,@append)
,@body)
(remove-hook 'minibuffer-setup-hook ,hook)))))
(defun selectrum--match-strictly-required-p ()
"Return non-nil if a match is strictly required."
(and selectrum--match-is-required
(not (memq selectrum--match-is-required
'(confirm confirm-after-completion)))))
(defun selectrum--normalize-collection (collection &optional predicate)
"Normalize COLLECTION into a list of strings.
COLLECTION may be a list of strings or symbols or cons cells, an
obarray, a hash table, or a function, as per the docstring of
`all-completions'. The returned list may be mutated without
damaging the original COLLECTION.
If PREDICATE is non-nil, then it filters the collection as in
`all-completions'."
;; Making the last buffer current avoids the cost of potential
;; buffer switching for each candidate within the predicate (see
;; `describe-variable').
(with-current-buffer (if (and (eq collection 'help--symbol-completion-table)
(buffer-live-p selectrum--last-buffer))
selectrum--last-buffer
(current-buffer))
(let ((completion-regexp-list nil))
(all-completions "" collection predicate))))
(defun selectrum--remove-default-from-prompt (prompt)
"Remove the indication of the default value from PROMPT.
Selectrum has its own methods for indicating the default value,
making other methods redundant."
(save-match-data
(let ((regexps selectrum--minibuffer-default-in-prompt-regexps))
(cl-dolist (matcher regexps prompt)
(let ((regex (if (stringp matcher) matcher (car matcher))))
(when (string-match regex prompt)
(cl-return
(replace-match "" nil nil prompt
(if (consp matcher)
(cadr matcher)
0)))))))))
(defun selectrum-get-current-candidate (&optional notfull)
"Return currently selected Selectrum candidate if there is one.
If NOTFULL is non-nil don't use canonical representation of
candidate and return the candidate as displayed."
(when (and selectrum-is-active
selectrum--current-candidate-index
(or selectrum--refined-candidates
(< selectrum--current-candidate-index 0)))
(if notfull
(selectrum--get-candidate
selectrum--current-candidate-index)
(selectrum--get-full
(selectrum--get-candidate
selectrum--current-candidate-index)))))
(defun selectrum-get-current-candidates (&optional notfull)
"Get list of current Selectrum candidates.
If NOTFULL is non-nil don't use canonical representation of
candidate and return the candidate as displayed."
(when (and selectrum-is-active
selectrum--refined-candidates)
(if notfull
selectrum--refined-candidates
(mapcar #'selectrum--get-full selectrum--refined-candidates))))
(defun selectrum-get-current-input ()
"Get current Selectrum user input."
(when selectrum-is-active
(with-selected-window (active-minibuffer-window)
(minibuffer-contents))))
(make-obsolete 'selectrum-get-current-input nil "3.1")
(defun selectrum-set-selected-candidate (&optional string)
"Set currently selected candidate to STRING.
STRING defaults to `minibuffer-contents'. Computation of
candidates is skipped from there on. This is useful for injecting
a candidate in `minibuffer-setup-hook' and immediately exit with
it afterwards. With default completion there is no computation
triggered initially and this function can be used to mimic this
behavior."
(when selectrum-is-active
(with-selected-window (active-minibuffer-window)
(let ((string (or string (minibuffer-contents))))
(setq-local selectrum--refined-candidates
(list string))
(setq-local selectrum--current-candidate-index 0)
;; Skip updates.
(remove-hook 'post-command-hook #'selectrum--update 'local)))))
(defun selectrum--get-full (candidate)
"Get full form of CANDIDATE."
(or (get-text-property 0 'selectrum--candidate-full candidate)
(get-text-property 0 'selectrum-candidate-full candidate)
(when minibuffer-completing-file-name
(if (and selectrum--current-candidate-index
(< selectrum--current-candidate-index 0))
candidate
(let ((input (minibuffer-contents)))
(if (and selectrum--get-full-prompt-prefix
(string-equal (car selectrum--get-full-prompt-prefix)
input))
(concat (cdr selectrum--get-full-prompt-prefix) candidate)
(let* ((path (substitute-in-file-name input))
(dirlen (length (file-name-directory path)))
(prefixlen (car (completion--sifn-requote dirlen input)))
(prefix (substring input 0 prefixlen)))
(setq-local selectrum--get-full-prompt-prefix
(cons input prefix))
(concat prefix candidate))))))
candidate))
(defun selectrum--get-candidate (index)
"Get candidate at given INDEX. Negative means get the current user input."
(if (and index (>= index 0))
(nth index selectrum--refined-candidates)
(buffer-substring-no-properties
(minibuffer-prompt-end)
(point-max))))
(defun selectrum--metadata ()
"Get completion metadata.
Demotes any errors to messages."
(condition-case-unless-debug err
(completion-metadata (minibuffer-contents)
minibuffer-completion-table
minibuffer-completion-predicate)
(error (message (error-message-string err)) nil)))
(defun selectrum--get-meta (setting)
"Get metadata SETTING from completion table."
(completion-metadata-get (selectrum--metadata) setting))
(defun selectrum-exhibit (&optional keep-selection)
"Trigger an update of Selectrum's completion UI.
If KEEP-SELECTION is non-nil keep the current candidate selected
when possible (it is still a member of the candidate set)."
(when-let ((mini (active-minibuffer-window)))
(with-selected-window mini
(when (and minibuffer-completion-table
(not selectrum--dynamic-candidates-function))
(setq-local selectrum--preprocessed-candidates nil))
(setq-local selectrum--previous-input-string nil)
(selectrum--update
(and keep-selection
(selectrum-get-current-candidate))))))
;;; Hook functions
(defun selectrum--count-info ()
"Return a string of count information to be prepended to prompt."
(let ((total (length selectrum--refined-candidates))
(current (1+ (or selectrum--current-candidate-index -1))))
(pcase selectrum-count-style
('matches (format "%-4d " total))
('current/matches (format "%-6s " (format "%d/%d" current total)))
(_ ""))))
(defun selectrum--create-display-buffer ()
"Create and return a buffer named by `selectrum--display-action-buffer'."
(with-current-buffer
(get-buffer-create selectrum--display-action-buffer)
(setq cursor-type nil)
(setq-local cursor-in-non-selected-windows nil)
(setq display-line-numbers nil)
(setq buffer-undo-list t)
(setq buffer-read-only t)
(setq show-trailing-whitespace nil)
(goto-char (point-min))
(run-hooks 'selectrum-display-action-hook)
;; We want to prevent interacting with the buffer.
;; Ideally, users only interact with the
;; minibuffer, but we need to reselect the
;; minibuffer window in case the user clicks on a
;; candidate.
(add-hook
'pre-command-hook
#'selectrum--select-active-minibuffer-window
nil t)
(current-buffer)))
(defun selectrum--get-display-window ()
"Get candidate display window.
Window will be created by `selectrum-display-action'."
(let ((buf (get-buffer selectrum--display-action-buffer))
(action selectrum-display-action))
(or (get-buffer-window buf 'visible)
(with-selected-window (minibuffer-selected-window)
(let* ((frame (selected-frame))
(window (display-buffer buf action)))
(select-frame-set-input-focus frame)
window)))))
(defun selectrum--expand-window-for-content-p (window)
"Return non-nil if WINDOW should be expanded.
This is the case when the height of WINDOW fits in the range as
determined by `selectrum--max-num-candidate-lines' and the
content height is greater than the window height."
(and (<= (window-body-height window)
(selectrum--max-num-candidate-lines window))
(>= (cdr (window-text-pixel-size window))
(window-body-height window 'pixelwise))))
(defun selectrum--group-by (fun elems)
"Group ELEMS by FUN."
(when elems
(let ((group-list)
(group-hash (make-hash-table :test #'equal)))
(while elems
(let* ((key (funcall fun (car elems) nil))
(group (gethash key group-hash)))
(if group
;; Append to tail of group
(setcdr group (setcdr (cdr group) elems))
(setq group (cons elems elems)) ;; (head . tail)
(push group group-list)
(puthash key group group-hash))
(setq elems (cdr elems))))
(setcdr (cdar group-list) nil) ;; Unlink last tail
(setq group-list (nreverse group-list))
(prog1 (caar group-list)
(while (cdr group-list) ;; Link groups
(setcdr (cdar group-list) (caadr group-list))
(setq group-list (cdr group-list)))))))