diff --git a/modes/consult/evil-collection-consult.el b/modes/consult/evil-collection-consult.el index dc2ec5f7..677d15ba 100644 --- a/modes/consult/evil-collection-consult.el +++ b/modes/consult/evil-collection-consult.el @@ -64,46 +64,187 @@ (evil-declare-not-repeat cmd) (evil-set-command-property cmd :jump t))) -(defun evil-collection-consult--evil-mark-ring () - "Return alist of char & marker for evil markers in current buffer." - (sort (cl-remove-if (lambda (elem) - (or (evil-global-marker-p (car elem)) - (not (markerp (cdr-safe elem))))) - evil-markers-alist) - #'car-less-than-car)) - -(defun evil-collection-consult--mark-candidates (&optional markers) - "Return alist of lines containing markers from `evil-mark-alist'. -Opional MARKERS should be an alist containing (char . marker) pairs -as defined in `evil-collection-consult--evil-mark-ring'." +(defun evil-collection-consult--evil-mark-ring (show-local show-global) + "Return alist of char and marker based on SHOW-LOCAL and SHOW-GLOBAL." + (let* ((curbuf (current-buffer)) + (local (if show-local + (cl-remove-if-not + (lambda (elem) + (let ((char (car elem)) + (marker (cdr elem))) + (and (markerp marker) + (eq (marker-buffer marker) curbuf) + (>= char ?a) (<= char ?z)))) + evil-markers-alist) + nil)) + (global-marker-table (default-value 'evil-markers-alist)) + (global + (pcase show-global + ('all + ;; Include global marks from all live buffers. + (cl-remove-if-not + (lambda (elem) + (let ((char (car elem)) + (marker (cdr elem))) + (and (markerp marker) + (>= char ?A) (<= char ?Z) + (marker-buffer marker) ; live buffer + (buffer-live-p (marker-buffer marker))))) + global-marker-table)) + ('local + ;; Include global marks only within the current buffer. + (cl-remove-if-not + (lambda (elem) + (let ((char (car elem)) + (marker (cdr elem))) + (and (markerp marker) + (eq (marker-buffer marker) curbuf) + (>= char ?A) (<= char ?Z)))) + global-marker-table)) + (_ nil)))) ; nil -> don't include global + (append local global))) + +(defun evil-collection-consult--mark-candidates (markers scope) + "Format Evil MARKERS for use with consult. +SCOPE is a cons pair (SHOW-LOCAL . SHOW-GLOBAL). + +Markers from the current buffer are shown first (sorted by line number), +followed by markers from other buffers (sorted by buffer name and line number)." (consult--forbid-minibuffer) - (unless (evil-collection-consult--evil-mark-ring) - (user-error "No marks")) - (consult--fontify-all) - (let* ((candidates) - (current-buf (current-buffer))) + (let ((candidates) + (origin-buffer (current-buffer))) ;; capture origin buffer (save-excursion - (pcase-dolist (`(,char . ,marker) (or markers (evil-collection-consult--evil-mark-ring))) + (pcase-dolist (`(,char . ,marker) markers) (let ((pos (marker-position marker)) (buf (marker-buffer marker))) - (when (and (eq buf current-buf) - (consult--in-range-p pos)) - (goto-char pos) - (push (consult--location-candidate - (format "%s: %s" (char-to-string char) (consult--line-with-mark marker)) - marker - (line-number-at-pos pos consult-line-numbers-widen) - marker) - candidates))))) - (nreverse (delete-dups candidates)))) + (when (and pos buf (buffer-live-p buf)) + (with-current-buffer buf + (when (consult--in-range-p pos) + (goto-char pos) + (let* ((line (consult--line-with-mark marker)) + (line-num (line-number-at-pos pos consult-line-numbers-widen)) + (is-local (and (>= char ?a) (<= char ?z))) + (is-global (and (>= char ?A) (<= char ?Z))) + (same-buffer (eq buf origin-buffer)) + (show-local (car scope)) + (show-global (cdr scope)) + (title + (cond + ;; Local marker: simplified + ((and is-local show-local) + (format "%s: %s" (char-to-string char) line)) + ;; Global from current buffer: show filename only if (nil . 'all) + ((and is-global same-buffer + (not show-local) + (eq show-global 'all)) + (format "%c: %s %s" + char + (or (file-name-nondirectory (buffer-file-name buf)) + (buffer-name buf)) + line)) + ;; Global in current buffer: simplified + ((and is-global same-buffer) + (format "%s: %s" (char-to-string char) line)) + ;; Global from other buffers: full format + (t + (format "%c: %s %s" + char + (or (file-name-nondirectory (buffer-file-name buf)) + (buffer-name buf)) + line))))) + (push (list title marker line-num buf) candidates)))))))) + ;; Sort candidate list: current buffer first, then by buffer-name + line-number + (let ((sorted + (sort candidates + (lambda (a b) + (let ((buf-a (nth 3 a)) + (buf-b (nth 3 b)) + (line-a (nth 2 a)) + (line-b (nth 2 b))) + (cond + ;; If same buffer → sort by line number + ((eq buf-a buf-b) + (< line-a line-b)) + ;; Current buffer comes first + ((eq buf-a origin-buffer) t) + ((eq buf-b origin-buffer) nil) + ;; Otherwise lexicographically by buffer name + (t (string< (buffer-name buf-a) + (buffer-name buf-b))))))))) + ;; Create consult-location candidates from sorted entries + (mapcar (lambda (entry) + (let ((title (nth 0 entry)) + (marker (nth 1 entry)) + (line (nth 2 entry))) + (consult--location-candidate + title marker line marker))) + sorted)))) + +(defun evil-collection-consult--mark (show-local show-global) + "Jump to Evil markers based on SHOW-LOCAL and SHOW-GLOBAL. +SHOW-LOCAL is t or nil (include local a-z markers). +SHOW-GLOBAL is one of: + - nil => exclude global (A-Z) markers + - 'local => include global markers from current buffer only + - 'all => include global markers from all buffers + +Together, these selective flags decide what set of evil markers to include." + (interactive) + (let ((markers (evil-collection-consult--evil-mark-ring show-local show-global))) + (if (null markers) + (user-error "No marks") + (cl-letf (((symbol-function 'consult--mark-candidates) + (lambda (&optional _ignore) + (evil-collection-consult--mark-candidates + markers + (cons show-local show-global))))) + (consult-mark markers))))) + ;;;###autoload (defun evil-collection-consult-mark () - "Jump to an evil marker in the current buffer." + "Jump to a local/lowercase evil marker in the current buffer. +Same as `evil-collection-consult-mark-buffer-local'" + (interactive) + (evil-collection-consult--mark t nil)) + +;;;###autoload +(defun evil-collection-consult-mark-global () + "Jump to a global/uppercase evil marker in open buffers." + (interactive) + (evil-collection-consult--mark nil 'all)) + +;;;###autoload +(defun evil-collection-consult-mark-buffer () + "Jump to a local/lowercase or local/uppercase evil marker in the current buffer." (interactive) - (cl-letf (((symbol-function 'consult--mark-candidates) - #'evil-collection-consult--mark-candidates)) - (consult-mark (evil-collection-consult--evil-mark-ring)))) + (evil-collection-consult--mark t 'local)) + +;;;###autoload +(defun evil-collection-consult-mark-buffer-local () + "Jump to a local/lowercase evil marker in the current buffer." + (interactive) + (evil-collection-consult--mark t nil)) + +;;;###autoload +(defun evil-collection-consult-mark-buffer-global () + "Jump to a local/uppercase evil marker in the current buffer." + (interactive) + (evil-collection-consult--mark nil 'local)) + +;;;###autoload +(defun evil-collection-consult-mark-all () + "Jump to a alocal/lowercase, local/uppercase or global/uppercase evil marker. +Global/uppercase markers are shown for all open buffers." + (interactive) + (evil-collection-consult--mark t 'all)) + +;; TODO Update version +(define-obsolete-function-alias + 'evil-collection-consult-mark + 'evil-collection-consult-mark-local + "1.0.0") + ;;;###autoload (defun evil-collection-consult-jump-list ()