-
Notifications
You must be signed in to change notification settings - Fork 33
Useful Commands
okamsn edited this page May 28, 2021
·
100 revisions
When creating commands, which are supposed to work with Selectrum, use the completing-read API. This way your command is compatible with every Emacs completion system. The private selectrum--read can be used under very special circumstances, but it is generally discouraged. Note that some of the commands on this page do not obey this guideline and can be considered obsolete. They have been superseded by the Consult package.
The Consult package provides many of the commands presented on this wiki page. It can be used as a supplement to Selectrum. Consult is compatible with completion systems based on completing-read like in particular Selectrum and Icomplete. If you have useful commands, we encourage you to propose them for inclusion in Consult.
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 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 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 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 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.
The default candidate is a non-empty line closest to point.
This command obeys narrowing."
(interactive)
(let ((selectrum-should-sort nil)
;; Get the current line number for determining the travel distance.
(current-line-number (line-number-at-pos (point) t)))
(cl-destructuring-bind (default-candidate formatted-candidates)
(cl-loop
with buffer-lines = (split-string (buffer-string) "\n")
with number-format = (concat "L%0"
(number-to-string
(length (number-to-string
(length buffer-lines))))
"d: ")
with formatted-candidates = nil
for line-text in buffer-lines
for line-num = (line-number-at-pos (point-min) t) then (1+ line-num)
with default-candidate = nil
with prev-distance-to-default-cand = 1.0e+INF ; This updated later.
for distance-to-default-cand = (abs (- current-line-number line-num))
unless (string-empty-p line-text) ; Just skip empty lines.
do
;; Find if we’ve started to move away from the current line.
(when (null default-candidate)
(when (> distance-to-default-cand
prev-distance-to-default-cand)
(setq default-candidate (cl-first formatted-candidates)))
(setq prev-distance-to-default-cand distance-to-default-cand))
;; Format current line and collect candidate.
(push (propertize line-text
'selectrum-candidate-display-prefix
(propertize (format number-format line-num)
'face 'completions-annotations)
'line-num line-num)
formatted-candidates)
finally return (list default-candidate
(nreverse formatted-candidates)))
(let ((chosen-line-number
(get-text-property
0 'line-num
(selectrum--read "Jump to matching line: "
formatted-candidates
:default-candidate default-candidate
:history 'selectrum-swiper-history
:require-match t
:no-move-default-candidate t))))
(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.
(autoload 'selectrum--read "selectrum")
((defvar selectrum-outline-history nil
"History of chosen headings for `selectrum-outline'.")
(defcustom selectrum-outline-formats
;; 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
. "^\\*\\(?1:\\**\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
;; For Org, see also `org-goto'.
(org-mode
. "^\\*\\(?1:\\**\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'")
(python-mode
. "^##\\(?1:\\**\\|#*\\)[[:blank:]]*\\(?2:[[:alnum:]][^z-a]*\\)\\'"))
"An alist of regexps to use for identifying outline headings, one for each major mode.
The `car' of an item in the list should be a symbol of the major mode.
The `cdr' should be a regular expression with two required match groups:
1. Match group 1, whose length determines the outline level of that heading.
For best formatting, the top level should be level 0 for zero length.
2. Match group 2, which is the actual heading text.
A heading is assumed to be on only one line. "
:group 'selectrum
:type '(alist
:key-type (symbol :tag "Major mode symbol")
:value-type (string :tag "Regexp")))
;;;###autoload
(defun selectrum-outline ()
"Jump to a heading. Regexps are pre-defined. Obeys narrowing."
(interactive)
;; Signal a `user-error' if we don't have a regexp for this major mode.
(if-let ((heading-regexp (alist-get major-mode selectrum-outline-formats)))
(let ((selectrum-should-sort nil) ; Headings should stay in order of appearance.
;; Get the basic information of each heading in the accessible
;; portion of the buffer.
(buffer-lines (split-string (buffer-string) "\n"))
(line-number 0)
(line-number-format)
;; Finding the default heading
(default-heading)
(current-line-number (line-number-at-pos (point)))
;; Keeping track of the tree.
(backwards-prefix-list)
(prev-heading-text)
(prev-heading-level)
;; Backwards result of the `dolist'. Will `nreverse'.
(formatted-headings))
(setq line-number-format
(concat "L%0"
(number-to-string
(length (number-to-string (length buffer-lines))))
"d: "))
(save-match-data
(dolist (text-line buffer-lines)
;; Increment line number when moving to next.
(cl-incf line-number)
(when (string-match heading-regexp text-line)
(let ((heading-text (match-string-no-properties 2 text-line))
(heading-level
(length (match-string-no-properties 1 text-line)))
(formatted-heading))
;; Want to make sure this has a correct value.
(when (null prev-heading-level)
(setq prev-heading-level heading-level))
;; Decide whether to update the prefix list and the previous
;; heading level.
(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))
;; Regardless of what happens, update the previous heading text.
(setq prev-heading-text heading-text)
;; Decide whether the previous formatted heading was the
;; default.
(when (and (null default-heading)
(> line-number current-line-number))
(setq default-heading (car formatted-headings)))
;; Finally, add to list of formatted headings.
;; 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'.
(push (propertize
(concat (string-join (reverse backwards-prefix-list) "/")
(and backwards-prefix-list "/")
heading-text)
'line-number line-number
'selectrum-candidate-display-prefix
(propertize
(format line-number-format line-number)
'face 'completions-annotations))
formatted-headings)))))
;; Use the last heading as the default candidate, if the current heading
;; wasn't found (such as if we're at the end of the file.
(unless default-heading
(setq default-heading (car formatted-headings)))
;; Now that candidates formatted, select from candidates.
(let ((chosen-heading
(selectrum--read "Jump to heading: "
(nreverse formatted-headings)
:default-candidate default-heading
:history 'selectrum-outline-history
:require-match t
:no-move-default-candidate t)))
;; Push mark, in case we want to return to current location. This
;; needs to happen /after/ the user has made it clear that they want
;; to go somewhere.
(push-mark (point) t)
;; Move to beginning of chosen line.
(forward-line (- (get-text-property 0 'line-number chosen-heading)
current-line-number))
(beginning-of-line-text 1)))
(user-error "selectrum-outline: No headings defined for %s." major-mode)))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.
(defvar kmacro-ring)
(defvar kmacro-counter)
(defvar kmacro-counter-format)
(declare-function kmacro-call-macro "kmacro")
(defvar selectrum-kmacro-history nil "History for `selectrum-kmacro'.")
;;;###autoload
(defun selectrum-kmacro (arg)
"Run a chosen keyboard macro. With prefix ARG, 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 nil)
(numbered-kmacros
(cl-loop
;; The most recent macro is not on the ring, so it must be
;; explicitly included.
for kmacro in (cons (if (listp last-kbd-macro)
last-kbd-macro
(list last-kbd-macro
kmacro-counter
kmacro-counter-format))
kmacro-ring)
;; 1. Format the macros. Mouse clicks are removed
;; by the format function.
;;
;; 2. Give the macros with non-empty strings a number, which
;; we use for rotating the ring.
for index = 0 then (1+ index)
for formatted-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)
(propertize (concat
(number-to-string (cl-second kmacro))
"," (cl-third kmacro) ": ")
'face 'completions-annotations)))
unless (string-empty-p formatted-kmacro)
collect (cons formatted-kmacro index)))
;; The index corresponding to the chosen kmacro.
(chosen-kmacro-index (alist-get
(completing-read "Select kmacro: "
numbered-kmacros nil t
nil 'selectrum-kmacro-history)
numbered-kmacros
nil nil #'string=)))
(if (= chosen-kmacro-index 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-index)))
;; Temporarily change the variables to retrieve the correct
;; settings. Mainly, we 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 (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 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 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 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 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 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")
(defvar selectrum-info-history nil
"Completion history for `selectrum-info' and derived commands.")
(defun selectrum--info-section-candidates (top-node)
"Return an alist of sections and candidates in the Info buffer TOP-NODE.
Candidates are returned in the order that their links are listed
in the Info buffer, which might be different from how the
sections are actually ordered."
(let ((sub-topic-format
;; Node links look like "* Some Thing:: Description" or
;; "* Some Thing: actual link. Description", where descriptions
;; are optional and might continue on the next line.
;;
;; The `info' library states:
;; Note that nowadays we expect Info files to be made using makeinfo.
;; In particular we make these assumptions:
;; - a menu item MAY contain colons but not colon-space ": "
;; - a menu item ending with ": " (but not ":: ") is an index entry
;; - a node name MAY NOT contain a colon
;; This distinction is to support indexing of computer programming
;; language terms that may contain ":" but not ": ".
(rx "* " (group (+? (not ?:))) ":"
(or ":" (seq " " (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.
"\n" (not blank))))))
(save-match-data
(save-selected-window
(with-temp-buffer
;; Some nodes created from multiple files, so we need to create a
;; buffer to make sure that we see everything.
(info top-node (current-buffer))
(goto-char (point-min))
(let ((candidates-alist))
(while (re-search-forward sub-topic-format nil t)
(forward-line 0) ; Go back to start of line.
(let* ((node-display-name (match-string 1))
(node-actual-name (or (match-string 2) node-display-name)))
(push (cons (concat node-display-name
(if-let ((node-description (match-string 3)))
(propertize
(thread-last node-description
(replace-regexp-in-string "\n" "")
(replace-regexp-in-string " +" " ")
(concat " - "))
'face 'completions-annotations)))
node-actual-name)
candidates-alist)))
(nreverse candidates-alist)))))))
(defun selectrum--info-top-dir-menu-items ()
(let ((sub-topic-format
;; The `info' library states:
;; Note that nowadays we expect Info files to be made using makeinfo.
;; In particular we make these assumptions:
;; - a menu item MAY contain colons but not colon-space ": "
;; - a menu item ending with ": " (but not ":: ") is an index entry
;; - a node name MAY NOT contain a colon
;; This distinction is to support indexing of computer programming
;; language terms that may contain ":" but not ": ".
(rx (seq "* " (group (+? anything))
": "
(group "(" (+? anything) ")" (*? (not ".")))
"."
(zero-or-one (seq (any "\n" " " "\t")
(group (+? anychar))))
"\n" (or "\n" "*")))))
(let ((candidates-alist))
;; Go through nodes in Info buffer "(dir)Top".
(save-match-data
(save-selected-window
(with-temp-buffer
;; Some nodes created from multiple files, so we need to create a
;; buffer to make sure that we see everything.
(info "(dir)Top" (current-buffer))
(goto-char (point-min))
(search-forward "Menu:\n")
(while (re-search-forward sub-topic-format nil t)
(forward-line 0) ; Go back to start of line.
(let* ((node-display-name (match-string-no-properties 1))
(node-actual-name (or (match-string-no-properties 2) node-display-name)))
(push (cons (concat node-display-name
(if-let ((node-description (match-string-no-properties 3)))
(propertize
(thread-last node-description
(replace-regexp-in-string "\n" "")
(replace-regexp-in-string " +" " ")
(concat " - "))
'face 'completions-annotations)))
node-actual-name)
candidates-alist))))))
;; In case something isn't listed (Emacs might just insert itself?), also
;; add in files from the Info directories as nodes themselves.
(dolist (file (save-match-data
(thread-last (append (or Info-directory-list
Info-default-directory-list)
Info-additional-directory-list)
(mapcan (lambda (directory)
(when (file-directory-p directory)
(directory-files directory nil "\\.info" t))))
(mapcar (lambda (file)
(string-match "\\(.+?\\)\\." file)
(match-string 1 file)))
seq-uniq)))
;; TODO: Node should actually come from opening the file.
(let ((node (concat "(" file ")")))
(unless (rassoc node candidates-alist)
(push (cons file node) candidates-alist))))
(nreverse candidates-alist))))
;;;###autoload
(defun selectrum-info (&optional top-node)
"Use `completing-read' to jump to an Info topic.
Select from the available Info top-level nodes, then one of the sub-nodes.
If TOP-NODE is provided, then just select from its sub-nodes."
(interactive)
(unless top-node
(setq top-node
(let* ((items (selectrum--info-top-dir-menu-items))
(key (completing-read "Info node: "
(lambda (input predicate action)
(if (eq action 'metadata)
`(metadata
;; (display-sort-function . identity)
(category . info))
(complete-with-action action
items
input
predicate)))
nil
t)))
(cdr (assoc key items)))))
;; If looking at a base node (e.g., "(emacs)"), then select from list of
;; optional sub-nodes. If looking at a normal node (e.g., "(emacs)Intro"),
;; then just go there instead of asking for more sub-nodes.
(if (string-match-p "(.*?)\\'" top-node)
(let* ((section-candidates-alist (selectrum--info-section-candidates top-node))
(section (completing-read "Info section: "
(lambda (input predicate action)
(if (eq action 'metadata)
`(metadata
(display-sort-function . identity)
(category . info))
(complete-with-action action
section-candidates-alist
input
predicate)))
nil
t nil 'selectrum-info-history)))
(info (concat
top-node
(cdr (assoc section section-candidates-alist)))))
(info top-node)))
;;;###autoload
(defun selectrum-info-elisp-manual ()
"Like ‘selectrum-info’, but choose nodes from the Elisp reference manual. "
(interactive)
(selectrum-info "(elisp)"))
;;;###autoload
(defun selectrum-info-emacs-manual ()
"Like ‘selectrum-info’, but directly choose nodes from the Emacs manual."
(interactive)
(selectrum-info "(emacs)"))
;;;###autoload
(defun selectrum-info-org-manual ()
"Like ‘selectrum-info’, but directly choose nodes from the Org manual."
(interactive)
(selectrum-info "(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 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
: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 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 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 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)))))))))