├── images └── example.gif ├── .gitignore ├── README.md ├── LICENSE.md └── consult-xref-stack.el /images/example.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/brett-lempereur/consult-xref-stack/HEAD/images/example.gif -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ### 2 | ### .gitignore 3 | ### 4 | 5 | # Compiled files 6 | *.elc 7 | *-autoloads.el 8 | *-pkg.el 9 | 10 | # Backup files 11 | *~ 12 | 13 | # Tags 14 | TAGS 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Consult Xref Stack 2 | 3 | Navigate the Xref stack with Consult. 4 | 5 | ![Example recording showing backward stack navigation](images/example.gif) 6 | 7 | ## Commands 8 | 9 | * `consult-xref-stack-backward` -- Navigate backwards through history. 10 | * `consult-xref-stack-forward` -- Navigate forwards through history. 11 | 12 | ## Installation 13 | 14 | Since the forward navigation commands have limited uses, you can get most of 15 | the functionality that you probably need by just finding the backward 16 | navigation command: 17 | 18 | ```emacs-lisp 19 | (use-package consult-xref-stack 20 | :vc 21 | (:url "https://github.com/brett-lempereur/consult-xref-stack" :branch "main") 22 | :bind 23 | (("C-," . consult-xref-stack-backward))) 24 | ``` 25 | 26 | ## Dependencies 27 | 28 | * [Consult](https://github.com/minad/consult) 29 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # The MIT License (MIT) 2 | 3 | Copyright © 2024 Brett Lempereur 4 | 5 | Permission is hereby granted, free of charge, to any person 6 | obtaining a copy of this software and associated documentation 7 | files (the “Software”), to deal in the Software without 8 | restriction, including without limitation the rights to use, 9 | copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the 11 | Software is furnished to do so, subject to the following 12 | conditions: 13 | 14 | The above copyright notice and this permission notice shall be 15 | included in all copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, 18 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 19 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 20 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 21 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 22 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 23 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 24 | OTHER DEALINGS IN THE SOFTWARE. 25 | -------------------------------------------------------------------------------- /consult-xref-stack.el: -------------------------------------------------------------------------------- 1 | ;;; consult-xref-stack --- Traverse the Xref stack. -*-lexical-binding:t-*- 2 | 3 | ;; Copyright (C) 2024 Brett Lempereur 4 | 5 | ;; Author: Brett Lempereur 6 | 7 | ;; Homepage: https://github.com/brett-lempereur/consult-xref-stack 8 | ;; Keywords: xref 9 | 10 | ;; Package-Version: 1.0.0 11 | ;; Package-Requires: ( 12 | ;; (emacs "28.1") 13 | ;; (consult "1.8")) 14 | 15 | ;; SPDX-License-Identifier: MIT 16 | 17 | ;; MIT License 18 | ;; 19 | ;; Copyright (c) 2024 Brett Lempereur 20 | ;; 21 | ;; Permission is hereby granted, free of charge, to any person obtaining a copy 22 | ;; of this software and associated documentation files (the "Software"), to 23 | ;; deal in the Software without restriction, including without limitation the 24 | ;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 25 | ;; sell copies of the Software, and to permit persons to whom the Software is 26 | ;; furnished to do so, subject to the following conditions: 27 | ;; 28 | ;; The above copyright notice and this permission notice (including the next 29 | ;; paragraph) shall be included in all copies or substantial portions of the 30 | ;; Software. 31 | ;; 32 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 33 | ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 34 | ;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 35 | ;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 36 | ;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 37 | ;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 38 | ;; IN THE SOFTWARE. 39 | 40 | ;;; Commentary: 41 | 42 | ;; Provides Xref stack navigation integration for Consult. 43 | 44 | ;;; Code: 45 | 46 | (require 'consult) 47 | (require 'consult-xref) 48 | (require 'xref) 49 | 50 | (defconst consult-xref-stack--narrow 51 | `((?f . "Forward") 52 | (?b . "Backward")) 53 | "Xref stack narrowing configuration.") 54 | 55 | (defun consult-xref-stack--history () 56 | "Return xref history using `xref-history-storage'." 57 | (funcall xref-history-storage)) 58 | 59 | (defun consult-xref-stack--backward-history () 60 | "Return the backward history stack." 61 | (car (consult-xref-stack--history))) 62 | 63 | (defun consult-xref-stack--forward-history () 64 | "Return the forward history stack." 65 | (cdr (consult-xref-stack--history))) 66 | 67 | (defun consult-xref-stack--backward-jump (pos) 68 | "Navigate backwards to POS and update the backward and forward stacks." 69 | (when pos 70 | (when (consp pos) (setq pos (car pos))) 71 | ;; Update the state of the source and target stacks. 72 | (let ((history (consult-xref-stack--history))) 73 | (if (not (member pos (car history))) 74 | (error "Marker is not in backwards stack") 75 | (while (not (equal (caar history) pos)) 76 | ;; Shift the backward history to the forward history. 77 | (push (pop (car history)) (cdr history))) 78 | (pop (car history)) 79 | (unless (equal (point-marker) (cadr history)) 80 | (push (point-marker) (cdr history))))) 81 | ;; Jump to the selected marker, ensuring the buffer exists and any narrowed 82 | ;; regions are visible. 83 | (when (consult--jump-ensure-buffer pos) 84 | (unless (= (goto-char pos) (point)) 85 | (widen) 86 | (goto-char pos))) 87 | (consult--invisible-open-permanently) 88 | (run-hooks 'consult-after-jump-hook)) 89 | nil) 90 | 91 | (defun consult-xref-stack--forward-jump (pos) 92 | "Navigate forwards to POS and update the backward and forward stacks." 93 | (when pos 94 | (when (consp pos) (setq pos (car pos))) 95 | ;; Update the state of the source and target stacks. 96 | (let ((history (consult-xref-stack--history))) 97 | (if (not (member pos (cdr history))) 98 | (error "Marker is not in forwards stack") 99 | (while (not (equal (cadr history) pos)) 100 | ;; Shift the forwards history to the backward history. 101 | (push (pop (cdr history)) (car history))) 102 | (pop (cdr history)) 103 | (unless (equal (point-marker) (caar history)) 104 | (push (point-marker) (car history))))) 105 | ;; Jump to the selected marker, ensuring the buffer exists and any narrowed 106 | ;; regions are visible. 107 | (when (consult--jump-ensure-buffer pos) 108 | (unless (= (goto-char pos) (point)) 109 | (widen) 110 | (goto-char pos))) 111 | (consult--invisible-open-permanently) 112 | (run-hooks 'consult-after-jump-hook)) 113 | nil) 114 | 115 | (defun consult-xref-stack--jump (pos) 116 | "Navigate backwards or forwards to POS and update the backward and 117 | forward stacks." 118 | (when pos 119 | (when (consp pos) (setq pos (car pos))) 120 | (let ((history (consult-xref-stack--history))) 121 | ;; Order is important if the selected candidate is present in 122 | ;; both stacks, because at the moment we don't know whether it 123 | ;; came from the backward or forward group. Forward history is 124 | ;; much shorter and truncated after every use of 125 | ;; `xref-find-definitions' , so lets start there. 126 | (if (member pos (cdr history)) 127 | (consult-xref-stack--forward-jump pos) 128 | (consult-xref-stack--backward-jump pos)))) 129 | nil) 130 | 131 | (defun consult-xref-stack--backward-state () 132 | "State function used to select a candidate position in the backward stack." 133 | (consult--state-with-return (consult--jump-preview) 134 | #'consult-xref-stack--backward-jump)) 135 | 136 | (defun consult-xref-stack--forward-state () 137 | "State function used to select a candidate position in the forward stack." 138 | (consult--state-with-return (consult--jump-preview) 139 | #'consult-xref-stack--forward-jump)) 140 | 141 | (defun consult-xref-stack--state () 142 | "State function used to select a candidate position in the forward or the 143 | backward stack." 144 | (consult--state-with-return (consult--jump-preview) 145 | #'consult-xref-stack--jump)) 146 | 147 | (defun consult-xref-stack--add-group (cands group) 148 | "Add text property `consult--type' with value GROUP to CANDS, to 149 | distinguish forward and backward xref history." 150 | (mapcar (lambda (cand) 151 | (add-text-properties 0 1 `(consult--type ,group) cand) 152 | cand) 153 | cands)) 154 | 155 | (defun consult-xref-stack--candidates () 156 | "Return list of candidates strings for forward and backward xref history 157 | together." 158 | (mapcan (lambda (pair) 159 | (when-let* ((markers (car pair)) 160 | (direction (cdr pair))) 161 | (consult-xref-stack--add-group 162 | (consult--global-mark-candidates markers) 163 | direction))) 164 | (list (cons (consult-xref-stack--backward-history) 165 | (car (rassoc "Backward" consult-xref-stack--narrow))) 166 | (cons (consult-xref-stack--forward-history) 167 | (car (rassoc "Forward" consult-xref-stack--narrow)))))) 168 | 169 | ;;;###autoload 170 | (defun consult-xref-stack-backward () 171 | "Jump to a marker in the Xref backward history stack. 172 | 173 | The command supports preview of the currently selected position." 174 | (interactive) 175 | (consult--read 176 | (consult--global-mark-candidates (consult-xref-stack--backward-history)) 177 | :prompt "Go to previous cross-reference: " 178 | :category 'consult-location 179 | :sort nil 180 | :require-match t 181 | :lookup #'consult--lookup-location 182 | :state (consult-xref-stack--backward-state))) 183 | 184 | ;;;###autoload 185 | (defun consult-xref-stack-forward () 186 | "Jump to a marker in the Xref forward history stack. 187 | 188 | The command supports preview of the currently selected position." 189 | (interactive) 190 | (consult--read 191 | (consult--global-mark-candidates (consult-xref-stack--forward-history)) 192 | :prompt "Go to following cross-reference: " 193 | :category 'consult-location 194 | :sort nil 195 | :require-match t 196 | :lookup #'consult--lookup-location 197 | :state (consult-xref-stack--forward-state))) 198 | 199 | ;;;###autoload 200 | (defun consult-xref-stack () 201 | "Jump to a marker in the Xref history stack in both directions. 202 | 203 | The command supports preview of the currently selected position, groups 204 | and narrowing." 205 | (interactive) 206 | (consult--read 207 | (consult-xref-stack--candidates) 208 | :prompt "Go to previous cross-reference: " 209 | :category 'consult-location 210 | :sort nil 211 | :require-match t 212 | :group (consult--type-group consult-xref-stack--narrow) 213 | :narrow (consult--type-narrow consult-xref-stack--narrow) 214 | :lookup #'consult--lookup-location 215 | :state (consult-xref-stack--state))) 216 | 217 | (provide 'consult-xref-stack) 218 | ;;; consult-xref-stack.el ends here 219 | --------------------------------------------------------------------------------