-
Notifications
You must be signed in to change notification settings - Fork 33
Useful Commands
Daniel Mendler edited this page Oct 29, 2020
·
100 revisions
When creating commands based on Selectrum, try to think about whether they actually need to use selectrum-read specifically. Can you make them work using just completing-read? If so, your commands will be useful to everybody, not just Selectrum users!
Note: all commands on this page expect lexical binding to be enabled, and may fail otherwise. Add -*- lexical-binding: t -*- at the top fo the file!
Table of Contents
- Fonts
- Kill Ring
- Isearch
- Jumping to Lines
- Keyboard Macros
- Markers
- Org
- Registers
- Switching buffers / files
- Info
- Misc (by lorniu)
Select the xfont for set for the system. This should be improved by displaying the fonts in a more friendly format. And (like counsel-fonts) providing a preview of the fonts next to the candidates.
(defun void/set-font ()
"Select xfont."
(interactive)
(set-frame-font (completing-read "Choose font:" (x-list-fonts "*"))))- yank-ring-pop behaves just like yank-pop. If there was no recent yank it opens a yank menu and inserts the chosen text.
- yank-ring-replace opens a yank menu and replaces the recent yank with a chosen text.
- yank-ring-insert opens a yank menu and inserts the chosen text.
- this commands work nicely together with a hydra if desired.
(defun yank-ring-pop ()
"If there is a recent yank act like `yank-pop'.
Otherwise choose text from the kill ring and insert it."
(interactive)
(if (eq last-command 'yank) (yank-pop) (call-interactively 'yank-ring-insert)))
(defun yank-ring-read ()
"Open kill ring menu and return chosen text."
(completing-read "Ring: "
(cl-remove-duplicates kill-ring :test #'equal :from-end t)
nil ':require-match))
;; Replace just-yanked text with chosen text.
;; Adapted from the Emacs yank-pop function.
(defun yank-ring-replace (text)
"Choose TEXT from the kill ring.
If there was no recent yank, insert the text.
Otherwise replace the just-yanked text with the chosen text."
(interactive (list (yank-ring-read)))
(if (not (eq last-command 'yank)) (yank-ring-insert text)
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
(setq this-command 'yank)
(if before
(funcall (or yank-undo-function 'delete-region) (point) (mark t))
(funcall (or yank-undo-function 'delete-region) (mark t) (point)))
(setq yank-undo-function nil)
(set-marker (mark-marker) (point) (current-buffer))
(insert-for-yank text)
(set-window-start (selected-window) yank-window-start t)
(if before
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))))
nil)
;; Insert chosen text.
;; Adapted from the Emacs yank function.
(defun yank-ring-insert (text)
"Choose TEXT from the kill ring and insert it."
(interactive (list (yank-ring-read)))
(setq yank-window-start (window-start))
(push-mark)
(insert-for-yank text)
(setq this-command 'yank)
nil)
(defhydra hydra-yank ()
"yank"
("C-y" yank nil)
("y" yank-ring-pop "yank")
("r" yank-ring-replace "ring" :color blue)
("q" nil "quit"))This is a command to replace the default yank-pop. It lets you choose in the kill-ring:
;; Ref: https://www.gnu.org/software/emacs/manual/html_node/eintr/yank.html
(defun my-yank-pop (&optional arg)
"Paste a previously killed string.
With just \\[universal-argument] as ARG, put point at beginning,
and mark at end. Otherwise, put point at the end, and mark at
the beginning without activating it.
This is like `yank-pop'. The differences are:
- This let you manually choose a candidate to paste.
- This doesn't delete the text just pasted if the previous
command is `yank'."
(interactive "P")
(let* ((selectrum-should-sort-p nil)
(text nil))
(setq text
(completing-read "Yank: "
(cl-remove-duplicates
kill-ring :test #'equal :from-end t)
nil 'require-match))
(unless (eq last-command 'yank)
(push-mark))
(setq last-command 'yank)
(setq yank-window-start (window-start))
(when (and delete-selection-mode (use-region-p))
(delete-region (region-beginning) (region-end)))
(insert-for-yank text)
(if (consp arg)
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))))This command also provides completion, but otherwise acts as close to the original yank-pop as possible.
(defun yank-pop+ (&optional arg)
"Call `yank-pop' with ARG when appropriate, or offer completion."
(interactive "*P")
(if arg (yank-pop arg)
(let* ((old-last-command last-command)
(selectrum-should-sort-p nil)
(enable-recursive-minibuffers t)
(text (completing-read
"Yank: "
(cl-remove-duplicates
kill-ring :test #'string= :from-end t)
nil t nil nil))
;; Find `text' in `kill-ring'.
(pos (cl-position text kill-ring :test #'string=))
;; Translate relative to `kill-ring-yank-pointer'.
(n (+ pos (length kill-ring-yank-pointer))))
(unless (string= text (current-kill n t))
(error "Could not setup for `current-kill'"))
;; Restore `last-command' over Selectrum commands.
(setq last-command old-last-command)
;; Delegate to `yank-pop' if appropriate or just insert.
(if (eq last-command 'yank)
(yank-pop n) (insert-for-yank text)))))You can use these commands to pick an element from isearch history and drop back into search:
(defun isearch--switch-direction-on-fail+ ()
(when (isearch-fail-pos)
(isearch-repeat-backward)))
(define-key isearch-mode-map (kbd "C-c r") 'isearch-history-from-isearch+)
(defun isearch-history-from-isearch+ ()
(interactive)
(with-isearch-suspended
(let* ((history (if isearch-regexp
regexp-search-ring
search-ring))
(selectrum-should-sort-p nil)
(x (completing-read "Isearch History: " history)))
(setq isearch-new-string x)
(setq isearch-new-message x)))
(isearch--switch-direction-on-fail+))
(global-set-key (kbd "C-c r") 'isearch-history+)
(defun isearch-history+ ()
(interactive)
(let* ((history (append (list (car search-ring)
(car regexp-search-ring))
(cdr search-ring)
(cdr regexp-search-ring)))
(selectrum-should-sort-p nil)
(x (completing-read "Isearch History: " history)))
(isearch-forward (member x regexp-search-ring) t)
(setq isearch-yank-flag t)
(isearch-process-search-string
x
(mapconcat 'isearch-text-char-description x ""))
(isearch--switch-direction-on-fail+)))Note: Previous versions of the commands selectrum-swiper and selectrum-outline had a more generic approach which used the standard completing-read function. To bypass some of Emacs's built-in limitations (which may change in the future) and to improve the experience regarding sorting and the default candidate, these commands were changed to use selectrum-read. If you wish to see/use the more generic versions, they are still accessible via the Page History button.
For those who want it, here is a command to jump to the beginning of a matching line. See also Using swiper in an org buffer.
(defvar selectrum-swiper-history nil "Submission history for `selectrum-swiper'.")
(autoload 'selectrum-read "selectrum")
(defun selectrum-swiper ()
"Search for a matching line and jump to the beginning of its text. Obeys narrowing."
(interactive)
(let* ((selectrum-should-sort-p nil)
;; Get the current line number for determining the travel distance.
(current-line-number (line-number-at-pos (point) t))
(default-cand-and-line-choices
(cl-loop
with minimum-line-number = (line-number-at-pos (point-min) t)
with buffer-text-lines = (split-string (buffer-string) "\n")
with number-format = (concat
"L%0"
(number-to-string
(length (number-to-string
(length buffer-text-lines))))
"d: ")
with closest-candidate = nil
with distance-to-current-line = nil
with smallest-distance-to-current-line = most-positive-fixnum
with formatted-line = nil
with formatted-lines = nil
for txt in buffer-text-lines
for num = minimum-line-number then (1+ num)
unless (string-empty-p txt) ; Just skip empty lines.
do
(setq formatted-line (propertize
txt
'selectrum-candidate-display-prefix
(propertize
(format number-format num)
'face 'completions-annotations)
'line-num num)
distance-to-current-line (abs (- current-line-number num)))
(push formatted-line formatted-lines)
(when (< distance-to-current-line
smallest-distance-to-current-line)
(setq smallest-distance-to-current-line distance-to-current-line
closest-candidate formatted-line))
finally return (cons closest-candidate
(nreverse formatted-lines))))
(default-cand (car default-cand-and-line-choices))
(line-choices (cdr default-cand-and-line-choices))
;; Get the matching line.
(chosen-line (selectrum-read "Jump to matching line: "
line-choices
:default-candidate default-cand
:history 'selectrum-swiper-history
:require-match t
:no-move-default-candidate t))
(chosen-line-number (get-text-property 0 'line-num chosen-line)))
(push-mark (point) t)
(forward-line (- chosen-line-number current-line-number))
(beginning-of-line-text 1)))Except for formatting the headings, this command is very similar to the above selectrum-swiper. It is functionally similar to counsel-outline. The current heading is the default candidate.
(defvar selectrum-outline-history nil "History of chosen headings for `selectrum-outline'.")
(autoload 'selectrum-read "selectrum")
(defun selectrum-outline ()
"Jump to a heading. Regexps are pre-defined. Obeys narrowing."
(interactive)
(let ((selectrum-should-sort-p nil)) ; Headings should stay in order of appearance.
(let* ((heading-regexp
(cl-case major-mode
;; Groups: (1) level determinant, (2) heading text.
;; The top level is 0, for a zero-length determinant.
(emacs-lisp-mode
"^;;;\\(?1:;*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(markdown-mode
"^#\\(?1:#*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
((outline-mode org-mode) ; See also `org-goto', which is specific to Org mode.
"^\\*\\(?1:\\**\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(python-mode
"^##\\(?1:\\**\\|#*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(t
(user-error "selectrum-outline: No headings defined for %s."
major-mode))))
;; Get the basic information of each heading in the accessible
;; portion of the buffer.
(buffer-contents (split-string (buffer-string) "\n"))
(number-of-lines (length buffer-contents))
;; Get the basic heading information from the text lines in the
;; buffer.
;;
;; TODO: Getting the heading information, formatting the headings and
;; finding the default candidate can all be done inside the
;; same the loop, but so far I find that a lot less readable.
(headings
(cl-loop for text-line in buffer-contents
for line-num from 1 to number-of-lines
;; Only get the heading lines.
when (string-match heading-regexp text-line)
;; Heading text, Outline level, Line number
collect (list (match-string-no-properties 2 text-line)
(length (match-string-no-properties 1 text-line))
line-num)))
;; Create the prefix headings ("H1", "H1/h2", etc.) and get the
;; default candidate, as in `(default . formatted-headings)'.
;; We do this in the same step to avoid having to iterate through
;; the list more than once.
(default-and-formatted-headings
(cl-loop
;; Get current line, used to find closest heading.
;; We're not moving point, so `save-excursion' isn't needed
;; anywhere.
with current-line-number = (line-number-at-pos (point))
with number-format = (format "L%%0%dd: "
(length (number-to-string number-of-lines)))
;; Find the current heading by locating the first heading after
;; point. The current heading (in the buffer), chosen as the
;; default candidate, is therefore the previous heading (in the
;; list) after we pass point.
with default-heading = ""
with default-not-found = t
with prev-formatted-heading = ""
;; Variables for keeping track of heading "path".
with backwards-prefix-list = ()
with prev-heading-level = (cadar headings) ; Get the first level.
for prev-heading-text = nil then heading-text
for (heading-text heading-level line-num) in headings
;; Decide whether to update the prefix list and the previous
;; heading level.
do (cond
;; If we've moved to a greater level (further down the tree),
;; add the previous heading to the heading prefix list so
;; that we can prepend it to the current heading when
;; formatting.
((> heading-level prev-heading-level)
(setq backwards-prefix-list (cons prev-heading-text
backwards-prefix-list)
prev-heading-level heading-level))
;; Otherwise, if we've moved to a lower level (higher up the
;; tree), and need to remove the most recently added prefix
;; from the list (i.e., go from '(c b a) back to '(b a)).
((< heading-level prev-heading-level)
(setq backwards-prefix-list (last backwards-prefix-list
heading-level)
prev-heading-level heading-level))
;; Otherwise, do nothing.
(t nil))
;; Create heading of form "L#: a/b/c" as:
;; - having a text property holding the line number
;; - prepended with a formatted line number,
;; with the face `completions-annotations'.
for formatted-heading = (propertize
(concat
(string-join
(reverse backwards-prefix-list)
"/")
(and backwards-prefix-list "/")
heading-text)
'line-number line-num
'selectrum-candidate-display-prefix
(propertize
(format number-format line-num)
'face 'completions-annotations))
collect formatted-heading into formatted-headings
;; Decide whether the previous heading was the default.
do (when default-not-found
(if (> (- line-num current-line-number) 0)
(setq default-heading prev-formatted-heading
default-not-found nil)
(setq prev-formatted-heading formatted-heading)))
finally return (cons default-heading
formatted-headings)))
(default-candidate (car default-and-formatted-headings))
(formatted-headings (cdr default-and-formatted-headings))
;; Get the desired heading.
(chosen-heading (selectrum-read "Jump to heading: "
formatted-headings
:default-candidate default-candidate
:history 'selectrum-outline-history
:require-match t
:no-move-default-candidate t))
(chosen-line-number
(get-text-property 0 'line-number chosen-heading))
;; Get the current line number to determine the travel distance.
(current-line-number (line-number-at-pos (point))))
;; Push mark, in case we want to return to current location.
(push-mark (point) t)
;; Go to the chosen line, and then the beginning of that line.
(forward-line (- chosen-line-number current-line-number))
(beginning-of-line-text 1))))The formatting of macros is a bit different in different Emacs versions. In Emacs 26, the function
edmacro-fix-menu-commands throws an error when it tries to handle a mouse click. In Emacs 27.0.91,
it looks like mouse clicks are silently removed from the formatting.
(defun selectrum-kmacro (arg)
"Run a chosen keyboard macro. With a prefix argument, run the macro that many times.
Macros containing mouse clicks can't be displayed properly. To keep things simple,
macros with an empty display string (e.g., ones made entirely of mouse clicks)
are not shown."
(interactive "p")
(if (or last-kbd-macro kmacro-ring)
(let* ((selectrum-should-sort-p nil)
;; The most recent macro is not on the ring,so must include it explicitly.
(all-kmacros (cons (if (listp last-kbd-macro)
last-kbd-macro
(list last-kbd-macro
kmacro-counter
kmacro-counter-format))
kmacro-ring))
;; Give the actual kmacro a number, which we use for rotating/cycling the ring.
;; Mouse clicks are removed by the format function. Decided to remove resulting
;; empty strings, since their meaning would be confusing.
(formatted-kmacros
(mapcar (lambda (kmacro)
(propertize (condition-case nil
(format-kbd-macro (if (listp kmacro) (car kmacro) kmacro) 1)
;; Recover from error from `edmacro-fix-menu-commands'.
;; In Emacs 27, it looks like mouse events are silently skipped over.
(error "Warning: Cannot display macros containing mouse clicks"))
'selectrum-candidate-display-prefix
(when (consp kmacro)
(concat (number-to-string (cadr kmacro))
"," (caddr kmacro) ": "))))
all-kmacros))
(numbered-kmacros
(seq-remove #'null (seq-map-indexed (lambda (kmacro index)
(unless (string-empty-p kmacro)
(cons kmacro index)))
formatted-kmacros)))
;; The index corresponding to the chosen kmacro.
(chosen-kmacro-number (alist-get
(completing-read "Select kmacro: " numbered-kmacros)
numbered-kmacros)))
(if (= chosen-kmacro-number 0)
;; If 0, just run the current (last) macro.
(kmacro-call-macro (or arg 1) t nil)
;; Otherwise, run a kmacro from the ring.
;; Get actual index, since we prepended `kmacro-ring'
;; with `last-kbd-macro' in selection.
(let ((actual-index (1- chosen-kmacro-number)))
;; Temporarily change the variables to retrieve the correct
;; settings. Mainly, want the macro counter to persist, which
;; automatically happens when cycling the ring.
(seq-let (last-kbd-macro kmacro-counter kmacro-counter-format-start)
(nth actual-index kmacro-ring)
(kmacro-call-macro (or arg 1) t)
;; Once done, put updated variables back into the ring.
(setf (seq-elt kmacro-ring actual-index)
(list last-kbd-macro
kmacro-counter
kmacro-counter-format))))))
(user-error "selectrum-kmacro: No keyboard macros defined.")))While pop-to-mark-command is good for quickly returning to a previous location, it is nice to have more context when trying to go further back in the mark ring. The following command shows the line and position of each mark in mark-ring, representing the mark location as a highlighted |. The | is highlighted using the face selectrum-marks-highlight, which by default inherits from the face highlight.
(defface selectrum-marks-highlight '((t :inherit highlight))
"Face used to highlight the position of the mark in `selectrum-marks'."
:group 'selectrum)
(defvar selectrum--marks-history ()
"History for the command `selectrum-marks'.
This is probably not so useful, since marks can move with text.")
;;;###autoload
(defun selectrum-marks ()
"Jump to a marker in `mark-ring', signified by a highlighted \"|\" (the vertical bar character).
Currently truncates line if longer than window body width."
(interactive)
(if (null (marker-position (mark-marker)))
;; If the first marker is not placed (though it probably exists),
;; assume that no valid marks exist.
(user-error "selectrum-marks: No marks currently exist.")
(let* ((selectrum-should-sort-p nil)
(formatted-candidates
(save-excursion
(cl-loop with window-width = (window-body-width (minibuffer-window))
for marker in (cons (mark-marker)
;; Some markers have the same position,
;; so we skip them.
(cl-remove-duplicates
mark-ring
:test (lambda (m1 m2)
(= (marker-position m1)
(marker-position m2)))))
;; Since we need to go to the marker's position anyway,
;; we get and go to the position in one step.
;; Since `mark-ring' is buffer local, we assume that
;; all markers in it have a valid position.
for pos = (goto-char (marker-position marker))
for line-beg-pos = (line-beginning-position)
;; Get where we'll show the marker in the candidate.
;; NOTE: At some point, we'll want to make sure this
;; is actually visible for long lines.
for str-pos = (- pos line-beg-pos)
;; Get the marker's context.
for line-string = (buffer-substring
line-beg-pos (line-end-position))
;; Display the marker in the candidate.
for highlighted-candidate = (concat (substring line-string 0 str-pos)
(propertize
"|"
'face 'selectrum-marks-highlight)
(substring line-string str-pos))
;; Create the final formatting of each candidate.
;; Need to do formatting at end to make sure things are properly aligned.
collect pos into marker-positions
collect highlighted-candidate into highlighted-candidates
for line-number = (line-number-at-pos pos t)
collect line-number into line-numbers
maximize line-number into max-line-number
collect str-pos into column-numbers
maximize str-pos into max-col-number
finally return
(cl-loop with form = (concat "%0" (number-to-string (length (number-to-string max-line-number)))
"d,%0" (number-to-string (length (number-to-string max-col-number)))
"d: %s")
for marker-pos in marker-positions
for line-num in line-numbers
for col-num in column-numbers
for cand in highlighted-candidates
for str = (format form line-num col-num cand)
collect (cons (if (> (length str) window-width)
(concat (substring str 0 (- window-width 10)) "...")
str)
marker-pos)))))
;; Get the desired marker from the user.
(chosen-cand (completing-read "Go to marker: " formatted-candidates nil
t nil selectrum--marks-history)))
;; Go to the chosen marker.
(goto-char (cdr (assoc chosen-cand formatted-candidates))))))There aren't many changes needed to create a version for Evil marks (created with m in normal state). Only formatting really changes from the above selectrum-marks.
(defface selectrum-marks-highlight '((t :inherit highlight))
"Face used to highlight the position of the mark in `selectrum-marks'."
:group 'selectrum)
(defvar evil-markers-alist)
(defun selectrum-evil-marks ()
"Jump to a marker in `evil-marker-alist', signified by a highlighted \"|\".
Currently truncates line if longer than window body width."
(interactive)
(if-let ((placed-markers
(sort (cl-remove-if (lambda (elem)
(not (markerp (cdr-safe elem))))
evil-markers-alist)
#'car-less-than-car)))
(let* ((selectrum-should-sort-p nil)
(formatted-candidates
(save-excursion
(cl-loop with window-width = (window-body-width (minibuffer-window))
for (char-key . marker) in placed-markers
for pos = (goto-char (marker-position marker))
for line-beg-pos = (line-beginning-position)
for str-pos = (- pos line-beg-pos)
for line-string = (buffer-substring
line-beg-pos (line-end-position))
for highlighted-candidate = (concat (substring line-string 0 str-pos)
(propertize
"|"
'face 'selectrum-marks-highlight)
(substring line-string str-pos))
;; Final formatting.
collect char-key into char-keys
collect pos into marker-positions
collect highlighted-candidate into highlighted-candidates
for line-number = (line-number-at-pos pos t)
collect line-number into line-numbers
maximize line-number into max-line-number
collect str-pos into column-numbers
maximize str-pos into max-col-number
finally return
(cl-loop with form = (concat "%0" (number-to-string (length (number-to-string max-line-number)))
"d,%0" (number-to-string (length (number-to-string max-col-number)))
"d: %s")
for marker-pos in marker-positions
for line-num in line-numbers
for col-num in column-numbers
for cand in highlighted-candidates
for str = (format form line-num col-num cand)
for key in char-keys
collect (cons (propertize
(if (> (length str) window-width)
(concat (substring str 0 (- window-width 10)) "...")
str)
'selectrum-candidate-display-prefix (format "%c: " key))
marker-pos)))))
(chosen-cand (completing-read "Go to position: " formatted-candidates nil
t nil selectrum--marks-history)))
(goto-char (cdr (assoc chosen-cand formatted-candidates))))
(user-error "selectrum-evil-marks: No Evil marks placed.")))In an org mode buffer, when you search for text that is in a fold Selectrum swiper doesn't take care of opening the folds so you can see the text you're at. You can call the following function at the end of selectrum swiper.
(defun org:show-subtree-headlines ()
"Show headlines surrounding point."
(save-excursion
(let ((points nil) (count 0))
(unless (org-at-heading-p) (org-back-to-heading t))
(push (point) points)
(while (org-up-heading-safe)
(push (point) points))
(dolist (point points)
(goto-char point)
(when (org:heading-folded-p)
(outline-toggle-children))))))
(defun selectrum:reveal-if-in-org-folds (orig-fn &rest args)
(prog1 (apply orig-fn args)
(when (eq major-mode 'org-mode)
(org:show-subtree-headlines))))
(advice-add #'selectrum-swiper :around #'selectrum:reveal-if-in-org-folds)This code is based on counsel-org-capture. It allows you to use selectrum to select an org capture template.
(defun selectrum/select-capture-template ()
"Select capture template."
(interactive)
(let (prefixes)
(alet (mapcan (lambda (x)
(let ((x-keys (car x)))
;; Remove prefixed keys until we get one that matches the current item.
(while (and prefixes
(let ((p1-keys (caar prefixes)))
(or
(<= (length x-keys) (length p1-keys))
(not (string-prefix-p p1-keys x-keys)))))
(pop prefixes))
(if (> (length x) 2)
(let ((desc (mapconcat #'cadr (reverse (cons x prefixes)) " | ")))
(list (format "%-5s %s" x-keys desc)))
(push x prefixes)
nil)))
(-> org-capture-templates
(org-capture-upgrade-templates)
(org-contextualize-keys org-capture-templates-contexts)))
(funcall #'org-capture nil (car (split-string (completing-read "Capture template: " it nil t)))) )))Select a register, then perform the appropriate action (inserting text, jumping to a position, or activating a window or frame configuration).
Register contents and types are searchable. Therefore, to only browse registers containing basic text, search for registers matching "Text: ". For numbers, search "Number: ".
(require 'kmacro)
(require 'frameset)
(require 'register)
;;;###autoload
(defun selectrum-registers ()
"Use a register, such as jumping to a buffer location or inserting text.
Each kind of register is prefixed with it's type, so that types are also
searchable. Displayed type names are:
- \"File\": file names
- \"Frame configuration\": configurations of framesets
- \"Keyboard macro\": keyboard macros
- \"Position\": buffer makers and files queries (positions in closed files)
- \"Number\": numbers
- \"Rectangle\": rectangles of text
Basic text, rectangle of text, and numbers are inserted into the
current buffer at point. Positions are moved to. Frame and
window configurations are applied."
(interactive)
(let* ((selectrum-should-sort-p nil)
(formatted-registers
;; Want to combine formatting and action function, so that we only
;; have to check the type of the register contents once.
;; Therefore, we create a list of lists, each inner list being of the
;; form ("Text form of candidate" #'action-function key-event).
;; Next, the text form is propertized.
(mapcar
(lambda (reg)
(append (let ((val (cdr reg)))
;; Many of these description strings are copied from
;; their respective Emacs library.
(pcase val
;; File Names
(`(file . ,file-name)
(list (concat "File: " file-name)
#'jump-to-register))
;; File Queries
;; Registered markers of file buffers are turned
;; into file queries after their respective
;; buffer is closed.
(`(file-query ,file-name ,position)
(list (concat "Position: " file-name
" at " (number-to-string position))
#'jump-to-register))
;; Frame Configurations or Frame Set
((pred frameset-register-p)
(list
(let* ((fs (frameset-register-frameset val))
(ns (length (frameset-states fs))))
(format
"Frame configuration: %d frame%s, saved on %s."
ns
(if (= 1 ns) "" "s")
(format-time-string "%c"
(frameset-timestamp fs))))
#'jump-to-register))
;; Keyboard Macros
((pred kmacro-register-p)
(list
(concat
"Keyboard macro: "
(condition-case nil
(format-kbd-macro
(kmacro-register-macro val)
1)
;; Recover from error from
;; `edmacro-fix-menu-commands'. In Emacs
;; 27, it looks like mouse events are
;; silently skipped over.
(error "Warning: Cannot display macros containing mouse clicks")))
#'jump-to-register))
;; Markers
((pred markerp)
(list
(concat "Position: "
(if-let ((buf (marker-buffer val)))
(concat
(buffer-name buf)
" at "
(number-to-string
(marker-position val)))
"Buffer no longer exists."))
#'jump-to-register))
;; Numbers
((pred numberp)
(list (concat "Number: " (number-to-string val))
#'insert-register))
;; Rectangles
((and `(,elem1 . ,_)
(guard (stringp elem1)))
(list (concat "Rectangle: " (string-join val "\n"))
#'insert-register))
;; Strings
((pred stringp)
(list (concat "Text: " val)
#'insert-register))
;; Window Configurations
((and `(,window-config ,_)
(guard (window-configuration-p window-config)))
(list
(let* ((stored-window-config window-config)
(window-config-frame
(window-configuration-frame stored-window-config))
(current-frame (selected-frame)))
;; These mostly copied from register.el.
(format
"Window configuration: %s."
(if (frame-live-p window-config-frame)
(with-selected-frame window-config-frame
(save-window-excursion
(set-window-configuration stored-window-config)
(concat
(mapconcat
(lambda (w)
(buffer-name (window-buffer w)))
(window-list (selected-frame)) ", ")
(unless (eq current-frame
window-config-frame)
" in another frame"))))
"dead frame")))
#'jump-to-register))
;; For anything else, just mark it as garbage.
(_ '(garbage))))
;; The register key.
(list (car reg))))
;; Destructively sort a copy of the alist by ordering the keys.
(sort (copy-sequence register-alist) #'car-less-than-car)))
;; Remove anything marked as garbage.
(filtered-choices (seq-remove (lambda (choice)
(eq (car choice) 'garbage))
formatted-registers))
;; Create candidates as a list of strings.
(actual-candidates (mapcar (lambda (choice)
(propertize
(car choice)
'selectrum-candidate-display-prefix
(concat
(single-key-description (caddr choice))
": ")))
filtered-choices))
;; Use the selected string to match the desired register.
(chosen-register (assoc (completing-read "Select register: "
actual-candidates
nil t)
filtered-choices)))
;; Apply the correct action function to the register key.
(funcall (cadr chosen-register) (caddr chosen-register))))(defvar selectrum--toggle-project-data+ nil)
(push (cons "C-," 'selectrum-toggle-project-file-scope+)
selectrum-minibuffer-bindings)
(defun selectrum-toggle-project-file-scope+ ()
"Toggle to project scope when reading file names.
Depends on `projectile'."
(interactive)
(unless minibuffer-completing-file-name
(user-error "Not reading file names"))
(require 'projectile)
(setq selectrum--previous-input-string nil)
(cond ((and selectrum--toggle-project-data+
(string-match "in project: \\'"
(buffer-substring
(point-min) (minibuffer-prompt-end))))
(let ((inhibit-read-only t))
(save-excursion
(goto-char (minibuffer-prompt-end))
(search-backward " in project")
(delete-region (match-beginning 0)
(match-end 0)))
(delete-minibuffer-contents))
(insert (car selectrum--toggle-project-data+))
(setq selectrum--preprocessed-candidates
(cdr selectrum--toggle-project-data+))
(setq selectrum--toggle-project-data+ nil))
(t
(if-let ((input (selectrum-get-current-input))
(project (projectile-project-root
(file-name-directory input))))
(let* ((inhibit-read-only t)
(ematch (file-name-nondirectory input))
(cands
(mapcar
(lambda (i)
(add-text-properties
0 (length i)
`(selectrum-candidate-full
,(concat project i))
i)
i)
(projectile-project-files project))))
(save-excursion
(goto-char (minibuffer-prompt-end))
(search-backward ":")
(insert
(apply #'propertize
" in project"
(text-properties-at (point)))))
(setq selectrum--toggle-project-data+
(cons
input
selectrum--preprocessed-candidates))
(delete-minibuffer-contents)
(insert
(concat (abbreviate-file-name project) ematch))
(setq selectrum--preprocessed-candidates
(lambda (input)
(let ((ematch (file-name-nondirectory input)))
`((input . ,ematch)
(candidates . ,cands))))))
(user-error "Not in project")))))Simple function to list recent files using Selectrum. I bind to C-x C-r.
(defun recentf-open-files+ ()
"Use `completing-read' to open a recent file."
(interactive)
(let ((files (mapcar 'abbreviate-file-name recentf-list)))
(find-file (completing-read "Find recent file: " files nil t))))Below is an example of including files recently used by Linux desktop environments, such as GNOME, KDE, MATE, Xfce, etc. This command uses functions introduced in Emacs 26. It can be finicky to evaluate and compile.
This is based on the same feature found in Counsel.
(eval-and-compile
(require 'dom)
(require 'xdg))
(declare-function dom-attr "dom")
(declare-function dom-by-tag "dom")
(defvar recentf-list)
(defun selectrum--recentf-get-xdg ()
(let ((file-of-recent-files
(expand-file-name "recently-used.xbel" (xdg-data-home))))
(if (not (file-readable-p file-of-recent-files))
(user-error "List of XDG recent files not found.")
(delq
nil
(mapcar
(lambda (bookmark-node)
(let ((local-path
(string-remove-prefix "file://"
(dom-attr bookmark-node
'href))))
(when local-path
(let ((full-file-name
(decode-coding-string
(url-unhex-string local-path)
'utf-8)))
(when (file-exists-p full-file-name)
full-file-name)))))
(nreverse (dom-by-tag (with-temp-buffer
(insert-file-contents file-of-recent-files)
(libxml-parse-xml-region (point-min)
(point-max)))
'bookmark)))))))
(defun selectrum-recentf ()
"Open a recently used file (including XDG)."
(interactive)
(let* ((selectrum-should-sort-p nil)
(all-recent-files
(append (mapcar #'substring-no-properties
recentf-list)
(seq-filter #'recentf-include-p
(selectrum--recentf-get-xdg))))
(files-with-times
(mapcar (lambda (file)
(cons file
;; Use modification time, since getting file access time
;; seems to count as accessing the file, ruining future uses.
(file-attribute-modification-time (file-attributes file))))
all-recent-files))
(sorted-files
(delete-dups (sort files-with-times
(lambda (file1 file2)
;; Want existing most recent local files first.
(cond ((or (not (file-exists-p (car file1)))
(file-remote-p (car file1)))
nil)
((or (not (file-exists-p (car file2)))
(file-remote-p (car file2)))
t)
(t (time-less-p (cdr file2)
(cdr file1))))))))
(propertized-files (mapcar (lambda (f)
(propertize (abbreviate-file-name (car f))
'selectrum-candidate-display-right-margin
(propertize (current-time-string (cdr f))
'face 'completions-annotations)))
sorted-files)))
(find-file (completing-read "Select recent file: " propertized-files
nil t nil 'file-name-history
(car propertized-files)))))Switch to open buffer or recent file. Narrow to hidden buffer with " " prefix, to files with "f " prefix and to buffers with "b " prefix. (See https://github.com/raxod502/selectrum/issues/9#issuecomment-631325725)
;; -*- lexical-binding: t -*-
(defun selectrum-switch-buffer+ ()
(interactive)
(let* ((selectrum-should-sort-p nil)
(candidates
(let* ((cb (window-buffer
(minibuffer-selected-window)))
(bf (or (buffer-file-name cb) "")))
(lambda (input)
(let* ((buffers (mapcar #'buffer-name
(cl-delete-if
(lambda (buf)
(eq buf cb))
(buffer-list))))
(files (cl-delete-if (lambda (f) (string= f bf))
(copy-sequence recentf-list)))
(candidates ()))
(cond ((string-prefix-p " " input)
(setq input (substring input 1))
(setq candidates
(cl-delete-if-not
(lambda (name)
(string-prefix-p " " name))
buffers)))
((string-prefix-p "b " input)
(setq input (substring input 2))
(setq candidates
(cl-delete-if
(lambda (name)
(string-prefix-p " " name))
buffers)))
((string-prefix-p "f " input)
(setq input (substring input 2))
(setq candidates files))
(t
(setq candidates
(append
(cl-delete-if
(lambda (name)
(string-prefix-p " " name))
buffers)
files))))
`((candidates . ,candidates)
(input . ,input))))))
(cand (selectrum-read "Switch to: " candidates)))
(cond ((member cand recentf-list)
(find-file cand))
(t
(switch-to-buffer cand)))))The command selectrum-info has you select a top-level node, like "emacs" or "elisp", and then select a sub-level node. You can also just pass in a top-level node as an argument, like in the example commands selectrum-info-emacs-manual or selectrum-info-elisp-manual. This is based on the work of the user Luis-Henriquez-Perez, who wrote a similar feature for Counsel.
(defvar Info-directory-list)
(defvar Info-additional-directory-list)
(defvar Info-default-directory-list)
(declare-function info-initialize "info")
(declare-function cl-mapcar "cl-lib")
(defcustom selectrum-info-default-other-window t
"Whether `selectrum-info' (and derived commands) should display
the Info buffer in the other window by default. Use a prefix argument to
do the opposite."
:type 'boolean
:group 'selectrum)
(defun selectrum--info-get-child-node (top-node)
"Create and select from a list of Info nodes found in the parent node TOP-NODE."
(let (;; It's reasonable to assume that sections are intentionally
;; ordered in a certain way, so we preserve that order.
(selectrum-should-sort-p nil)
;; Headers look like "* Some Thing:: Description",
;; where descriptions are optional and might continue on
;; the next line.
(sub-topic-format (rx "* "
(group (+? (not ?:)))
"::"
;; Include the description, if one exists.
;; If it doesn't, the line ends immediately.
(or "\n"
(seq
(0+ blank)
(group (+? anychar))
;; Sometimes a heading follows on the next line,
;; and sometimes there's any empty blank line
;; (such as before a section title). For now,
;; assume continuation lines use indentation and
;; other lines don't.
;; (or "\n\n" "\n*")
"\n" (not blank))))))
(save-match-data
(save-selected-window
(completing-read
"Info Sub-Topic: "
(with-temp-buffer
;; Some nodes created from multiple files.
(info top-node (current-buffer))
(goto-char (point-min))
(cl-loop while (re-search-forward sub-topic-format nil t)
do (forward-line 0) ; Go back to start of line.
collect (match-string 1) into node-names
collect (match-string 2) into descriptions
;; If a node has a description, it helps if that description is
;; also searchable. For the normal `*Completions*' buffer, that
;; can be done using regular annotation data. For Selectrum,
;; (in which annotations can't currently be matched against),
;; this can be done by including the annotation in the
;; displayed text and setting the `selectrum-candidate-full'
;; property to be the actual node name.
finally return
(if selectrum-mode
(cl-mapcar (lambda (node-name description)
(propertize
(concat
node-name
(when description
(propertize
(concat " - "
(replace-regexp-in-string
"\n" ""
(replace-regexp-in-string
" +" " " description)))
'face 'completions-annotations)))
'selectrum-candidate-full
node-name))
node-names descriptions)
(let ((name-desc-pairs
(cl-mapcar (lambda (node-name description)
(cons node-name
(when description
(concat
" - "
(replace-regexp-in-string
"\n" ""
(replace-regexp-in-string
" +" " " description))))))
node-names descriptions)))
(lambda (input predicate action)
(if (eq action 'metadata)
`(metadata
(annotation-function
. ,(lambda (cand)
(cdr (assoc cand name-desc-pairs)))))
(complete-with-action action
name-desc-pairs
input
predicate))))))))))))
;;;###autoload
(defun selectrum-info (other-window-opposite-p &optional top-node)
"Go to a node of an Info topic.
With a prefix argument, do the opposite
of `selectrum-info-default-other-window'.
For example, you can go to \"(magit)Notes\" by selecting \"magit\", then \"Notes\" ."
(interactive "P")
;; Initialize Info information so that the proper directories
;; can be found.
(info-initialize)
(save-match-data
(let* ((use-other-window (if other-window-opposite-p
(not selectrum-info-default-other-window)
selectrum-info-default-other-window))
;; Get all Info files.
(node-files
(cl-loop for directory in (append (or Info-directory-list
Info-default-directory-list)
Info-additional-directory-list)
;; If the directory exists
when (file-directory-p directory)
;; get all files with ".info" in their name.
append (directory-files directory nil "\\.info" t)))
;; Get the names of the Info nodes, based on the file names.
(node-names (cl-remove-duplicates
(cl-loop for file in node-files
do (string-match "\\(.+?\\)\\." file)
collect (match-string 1 file))
:test #'equal))
;; Select a top node/topic.
(chosen-top-node (cond
((null top-node)
(completing-read "Info Topic: " node-names nil t))
((member top-node node-names)
top-node)
(t (error "Top-level Info node does not exist: %s"
top-node))))
;; Select a child node.
(chosen-child-node (selectrum--info-get-child-node chosen-top-node)))
;; Go to the chosen child node.
(funcall (if use-other-window
#'info-other-window
#'info)
(format "(%s)%s" chosen-top-node chosen-child-node)))))
;;;###autoload
(defun selectrum-info-elisp-manual (other-window-opposite-p)
"Like `selectrum-info', but directly choose nodes from the Emacs Lisp (Elisp) manual."
(interactive "P")
(selectrum-info other-window-opposite-p "elisp"))
;;;###autoload
(defun selectrum-info-emacs-manual (other-window-opposite-p)
"Like `selectrum-info', but directly choose nodes from the Emacs manual."
(interactive "P")
(selectrum-info other-window-opposite-p "emacs"))
;;;###autoload
(defun selectrum-info-org-manual (other-window-opposite-p)
"Like `selectrum-info', but directly choose nodes from the Org manual."
(interactive "P")
(selectrum-info other-window-opposite-p "org"))Use this helper macro to add action support.
(cl-defmacro selectrum-make-action ((&rest args) &body body)
(declare (indent 1))
`(lambda ()
(interactive)
(put 'quit 'error-message "")
(run-at-time nil nil
(lambda (,@args)
(put 'quit 'error-message "Quit")
(with-demoted-errors "Error: %S"
,@body))
,@(seq-take
`((if selectrum--refined-candidates (nth selectrum--current-candidate-index selectrum--refined-candidates))
selectrum--refined-candidates
(selectrum-get-current-input)
selectrum--current-candidate-index)
(length args)))
(abort-recursive-edit)))(defvar selectrum-search-rg-history nil)
(defun im/search-rg+ ()
"Search like 'counsel-rg'.
Default, search for current directory, if the input begin with 'p ' then
will search current project, if begin with 'o ' then will search org-directory.
'C-c C-o' to pop the rg.el's Occur view, make sure package `rg' is installed."
(interactive)
(unless (executable-find "rg")
(user-error "ripgrep must be installed."))
(let* (type
input
(dir default-directory)
(word (if (use-region-p)
(buffer-substring-no-properties (region-beginning) (region-end))
(let* ((sym (symbol-at-point)) (symn (symbol-name sym)))
(if (and sym (> 50 (length symn) 3)) symn nil))))
(command (if (memq system-type '(ms-dos windows-nt))
"rg -M 240 --with-filename --no-heading --line-number --color never -S -e <R> ."
"rg -M 240 --with-filename --no-heading --line-number --color never -S -e <R>"))
(cands (lambda (in)
(let ((msg)
(prop (lambda (cs)
(mapcar (lambda (c)
(when (string-match "\\`\\([^:]+\\):\\([^:]+\\):" c)
(add-face-text-property (match-beginning 1) (match-end 1) 'compilation-info nil c)
(add-face-text-property (match-beginning 2) (match-end 2) '(:underline t :inherit compilation-line-number) nil c))
c)
cs))))
(cond
;; search current project
((string-prefix-p "p " in)
(cond ((not (project-current))
(setq msg "This is not in a project."))
((< (length in) 5)
(setq msg "Search in current project, input should more than 3."))
(t
(setq type 'project)
(setq dir (cdr (project-current)))
(setq in (cl-subseq in 2)))))
;; search org-directory
((string-prefix-p "o " in)
(cond ((not (file-exists-p org-directory))
(setq msg "Org Directory not exist?"))
((< (length in) 5)
(setq msg "Search in org-directory, input should more than 3."))
(t
(setq type 'org)
(setq dir org-directory)
(setq in (cl-subseq in 2)))))
;; search current directory
(t (if (< (length in) 3)
(setq msg "Input should more than 3."))
(setq type nil)
(setq dir default-directory)))
;; take space in INPUT as .*?
;; take m-space as [[:blank:]]
(setq input
(replace-regexp-in-string
" +" "[[:blank:]]"
(replace-regexp-in-string
"\\([^ ]\\) \\([^ ]\\)" "\\1.+?\\2"
(string-trim in))))
(if msg
(prog1 nil
(setq-local selectrum-refine-candidates-function
(lambda (_ __) (list msg))))
(kill-local-variable 'selectrum-refine-candidates-function)
(let* ((default-directory dir)
(cs (split-string
(shell-command-to-string (grep-expand-template command input)) "\n")))
`((candidates . ,(funcall prop cs))
(input . ,input)))))))
(cand (let ((selectrum-should-sort-p nil)
(selectrum-minibuffer-bindings
(append
selectrum-minibuffer-bindings
`(("C-c C-o" . ,(selectrum-make-action (c)
;; use rg.el to show the results in Occur buffer
(require 'rg)
(require 'compile)
;; jump to current candidate in the *rg* buffer.
;; rg implemented with `compile', so I make it work like below.
;; let-bound method not working, unkown reason.
(let ((old-compilation-finish-functions compilation-finish-functions))
(setq compilation-finish-functions
(list
(lambda (_a _b)
(unwind-protect
(progn
(pop-to-buffer (current-buffer))
(when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" c)
(let ((file-name (match-string-no-properties 1 c))
(line-number (match-string-no-properties 2 c)))
(if rg-group-result
(progn
(re-search-forward (format "^File: %s" file-name) nil t)
(re-search-forward (format "^ *%s" line-number) nil t)
(re-search-forward input (point-at-eol) t))
(re-search-forward (format "%s:%s:" file-name line-number) nil t)
(re-search-forward input (point-at-eol) t)))))
(setq compilation-finish-functions old-compilation-finish-functions)))))
;; dispatch to rg.el search.
(cond ((eq type 'project) (rg-project input "*"))
(t (rg input "*" dir))))))))))
(selectrum-read "rg: " cands
:initial-input word
:may-modify-candidates t
:history 'selectrum-search-rg-history
:require-match t))))
(if (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" cand)
(let ((file-name (match-string-no-properties 1 cand))
(line-number (match-string-no-properties 2 cand)))
(xref-push-marker-stack) ; use M-, to go back!
(find-file (expand-file-name file-name dir))
(goto-char (point-min))
(forward-line (1- (string-to-number line-number)))
(re-search-forward input (point-at-eol) t)
(recenter))
(message "Bad candidate?"))))(defvar selectrum-imenu+ nil)
(defun im/imenu+ ()
"Choose from `imenu' just like `counsel-imenu'."
(interactive)
(require 'imenu)
(let* ((selectrum-should-sort-p nil)
(candidates (let* ((imenu-auto-rescan t)
(items (imenu--make-index-alist t)))
;; remove *Rescan*
(setq items (delete (assoc "*Rescan*" items) items))
;; special mode
(when (eq major-mode 'emacs-lisp-mode)
(let ((fns (cl-remove-if #'listp items :key #'cdr)))
(if fns (setq items (nconc (cl-remove-if #'nlistp items :key #'cdr) `(("Functions" ,@fns)))))))
;; refine
(cl-labels ((get-candidates (alist &optional prefix)
(cl-mapcan
(lambda (elm)
(if (imenu--subalist-p elm)
(get-candidates
(cl-loop for (e . v) in (cdr elm)
collect (cons e (if (integerp v) (copy-marker v) v)))
(concat prefix (if prefix ".") (car elm)))
(let ((key (concat (if prefix (concat (propertize prefix 'face 'font-lock-keyword-face) ": "))
(car elm))))
(list (cons key (cons key (if (overlayp (cdr elm)) (overlay-start (cdr elm)) (cdr elm))))))))
alist)))
(setq items (get-candidates items)))
;; sort
(cl-sort items #'string< :key #'car)))
(cand (completing-read "Imenu: " (mapcar #'car candidates) nil t nil selectrum-imenu+)))
(imenu (cdr (cl-find cand candidates :test #'string= :key #'car)))))(defvar selectrum-pages+ nil)
(defun im/pages+ ()
"Fast jump to position just like package `counsel-page'."
(interactive)
(let* ((selectrum-should-sort-p nil)
(cands (let ((lst)
(delim "^\014")
(current-line (lambda ()
(skip-chars-forward " \t\n")
(let ((str (buffer-substring (point) (line-end-position)))
(value (number-to-string (point))))
(add-text-properties 0 (length str) (list 'selectrum-candidate-full value) str)
str))))
(save-excursion
(goto-char (point-min))
(save-restriction
(if (and (save-excursion (re-search-forward delim nil t))
(= 1 (match-beginning 0)))
(goto-char (match-end 0)))
(push (funcall current-line) lst)
(while (re-search-forward delim nil t)
(push (funcall current-line) lst))))
(nreverse lst)))
(cand (completing-read "Pages: " cands nil t nil selectrum-pages+)))
(goto-char (string-to-number cand))
(recenter-top-bottom 1)))(defvar selectrum-views nil)
(defun im/views+ ()
"Toggle the window layout with this single command.
You will see the candidates after invoke this command.
Select a candidate can:
- Add the current window configuration to the candidates
- Update the current window configuration
- Toggle to the choosen window layout.
'C-d' to delete current candidate, and 'C-S-d' to delete all.
"
(interactive)
(cl-labels ((view-exist-p (name)
(assoc name selectrum-views))
(view-config ()
"Get the window configuration (layout)"
(dolist (w (window-list))
(set-window-parameter
w 'view-data
(with-current-buffer (window-buffer w)
(cond (buffer-file-name
(list 'file buffer-file-name (point)))
((eq major-mode 'dired-mode)
(list 'file default-directory (point)))
(t (list 'buffer (buffer-name) (point)))))))
(let ((window-persistent-parameters
(append window-persistent-parameters (list (cons 'view-data t)))))
(current-window-configuration)))
(restore-view (view)
"Restore the window configuration (layout)."
(cond ((window-configuration-p view) ; window
(set-window-configuration view)
(dolist (w (window-list))
(with-selected-window w
(restore-view (window-parameter w 'view-data)))))
((eq (car view) 'file) ; file
(let* ((name (nth 1 view)) buffer)
(cond ((setq buffer (get-buffer name))
(switch-to-buffer buffer nil 'force-same-window))
((file-exists-p name)
(find-file name))))
(goto-char (nth 2 view)))
((eq (car view) 'buffer) ; buffer
(switch-to-buffer (nth 1 view))
(goto-char (nth 2 view))))))
(let* ((selectrum-minibuffer-bindings (append
selectrum-minibuffer-bindings
`(("C-d" . ,(selectrum-make-action (c)
(when (y-or-n-p (format "Delete this item `%s' ? " c))
(setq selectrum-views
(cl-remove c selectrum-views :test 'string-equal :key 'car)))
(im/views+)))
("C-S-d" . ,(selectrum-make-action ()
(if (y-or-n-p (format "Clear *ALL* views? "))
(progn (setq selectrum-views nil)
(message "Clear Done!"))
(message "Nothing Done.")))))))
(face 'font-lock-builtin-face)
(selectrum-should-sort-p nil)
(current (concat "{} " (mapconcat #'identity
(sort
(mapcar (lambda (w)
(let* ((b (window-buffer w)) (f (buffer-file-name b)))
(if f (file-name-nondirectory f) (buffer-name b))))
(window-list))
#'string-lessp)
" ")))
(views (if (view-exist-p current)
(mapcar (lambda (view)
(if (string-equal (car view) current)
(propertize (car view) 'face face)
(car view)))
selectrum-views)
(cons (propertize current 'face `(:underline t :inherit ,face)) (mapcar #'car selectrum-views))))
(view (completing-read "Views: " views nil nil nil nil current)))
(cond
;; check
((not (string-match-p "^{} " (or view "")))
(message "Error view-name detected."))
;; update/add
((or (string-equal current view)
(not (view-exist-p view)))
(let ((x (assoc view selectrum-views))
(config (view-config)))
(if x (setcdr x (list config))
(push (list (substring-no-properties view) config) selectrum-views))))
;; switch
((view-exist-p view)
(let ((inhibit-message t))
(delete-other-windows)
(restore-view (cadr (assoc view selectrum-views)))))))))