354 lines
14 KiB
EmacsLisp
354 lines
14 KiB
EmacsLisp
;;; evil-jumps.el --- Jump list implementation -*- lexical-binding: t -*-
|
|
|
|
;; Author: Bailey Ling <bling at live.ca>
|
|
|
|
;; Version: 1.14.0
|
|
|
|
;;
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;;; License:
|
|
|
|
;; This file is part of Evil.
|
|
;;
|
|
;; Evil is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; Evil is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with Evil. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(require 'cl-lib)
|
|
(require 'evil-core)
|
|
(require 'evil-states)
|
|
|
|
;;; Code:
|
|
|
|
(defgroup evil-jumps nil
|
|
"Evil jump list configuration options."
|
|
:prefix "evil-jumps"
|
|
:group 'evil)
|
|
|
|
(defcustom evil-jumps-cross-buffers t
|
|
"When non-nil, the jump commands can cross borders between buffers, otherwise the jump commands act only within the current buffer."
|
|
:type 'boolean
|
|
:group 'evil-jumps)
|
|
|
|
(defcustom evil-jumps-max-length 100
|
|
"The maximum number of jumps to keep track of."
|
|
:type 'integer
|
|
:group 'evil-jumps)
|
|
|
|
(defcustom evil-jumps-pre-jump-hook nil
|
|
"Hooks to run just before jumping to a location in the jump list."
|
|
:type 'hook
|
|
:group 'evil-jumps)
|
|
|
|
(defcustom evil-jumps-post-jump-hook nil
|
|
"Hooks to run just after jumping to a location in the jump list."
|
|
:type 'hook
|
|
:group 'evil-jumps)
|
|
|
|
(defcustom evil-jumps-ignored-file-patterns '("COMMIT_EDITMSG$" "TAGS$")
|
|
"A list of pattern regexps to match on the file path to exclude from being included in the jump list."
|
|
:type '(repeat string)
|
|
:group 'evil-jumps)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defvar savehist-additional-variables)
|
|
|
|
(defvar evil--jumps-jumping nil)
|
|
|
|
(defvar evil--jumps-jumping-backward nil
|
|
"Set by `evil--jump-backward', used and cleared in the
|
|
`post-command-hook' by `evil--jump-handle-buffer-crossing'")
|
|
|
|
(eval-when-compile (defvar evil--jumps-debug nil))
|
|
|
|
(defvar evil--jumps-buffer-targets "\\*\\(new\\|scratch\\)\\*"
|
|
"Regexp to match against `buffer-name' to determine whether it's a valid jump target.")
|
|
|
|
(defvar evil--jumps-window-jumps (make-hash-table)
|
|
"Hashtable which stores all jumps on a per window basis.")
|
|
|
|
(defvar evil-jumps-history nil
|
|
"History of `evil-mode' jumps that are persisted with `savehist'.")
|
|
|
|
(cl-defstruct evil-jumps-struct
|
|
ring
|
|
(idx -1)
|
|
previous-pos)
|
|
|
|
;; Is inlining this really worth it?
|
|
(defsubst evil--jumps-message (format &rest args)
|
|
(when (eval-when-compile evil--jumps-debug)
|
|
(with-current-buffer (get-buffer-create "*evil-jumps*")
|
|
(goto-char (point-max))
|
|
(insert (apply #'format format args) "\n"))))
|
|
|
|
(defun evil--jumps-get-current (&optional window)
|
|
(unless window
|
|
(setq window (frame-selected-window)))
|
|
(let* ((jump-struct (gethash window evil--jumps-window-jumps)))
|
|
(unless jump-struct
|
|
(setq jump-struct (make-evil-jumps-struct))
|
|
(puthash window jump-struct evil--jumps-window-jumps))
|
|
jump-struct))
|
|
|
|
(defun evil--jumps-get-jumps (struct)
|
|
(let ((ring (evil-jumps-struct-ring struct)))
|
|
(unless ring
|
|
(setq ring (make-ring evil-jumps-max-length))
|
|
(setf (evil-jumps-struct-ring struct) ring))
|
|
ring))
|
|
|
|
(defun evil--jumps-get-window-jump-list ()
|
|
(let ((struct (evil--jumps-get-current)))
|
|
(evil--jumps-get-jumps struct)))
|
|
|
|
(defun evil--jumps-savehist-load ()
|
|
(add-to-list 'savehist-additional-variables 'evil-jumps-history)
|
|
(let ((ring (make-ring evil-jumps-max-length)))
|
|
(cl-loop for jump in (reverse evil-jumps-history)
|
|
do (ring-insert ring jump))
|
|
(setf (evil-jumps-struct-ring (evil--jumps-get-current)) ring))
|
|
(add-hook 'savehist-save-hook #'evil--jumps-savehist-sync)
|
|
(remove-hook 'savehist-mode-hook #'evil--jumps-savehist-load))
|
|
|
|
(defun evil--jumps-savehist-sync ()
|
|
"Updates the printable value of window jumps for `savehist'."
|
|
(setq evil-jumps-history
|
|
(delq nil (mapcar #'(lambda (jump)
|
|
(let* ((mark (car jump))
|
|
(pos (if (markerp mark)
|
|
(marker-position mark)
|
|
mark))
|
|
(file-name (cadr jump)))
|
|
(when (and (not (file-remote-p file-name))
|
|
(file-exists-p file-name)
|
|
pos)
|
|
(list pos file-name))))
|
|
(ring-elements (evil--jumps-get-window-jump-list))))))
|
|
|
|
(defun evil--jumps-jump (idx shift)
|
|
(let ((target-list (evil--jumps-get-window-jump-list)))
|
|
(evil--jumps-message "jumping from %s by %s" idx shift)
|
|
(evil--jumps-message "target list = %s" target-list)
|
|
(setq idx (+ idx shift))
|
|
(let* ((current-file-name (or (buffer-file-name) (buffer-name)))
|
|
(size (ring-length target-list)))
|
|
(unless evil-jumps-cross-buffers
|
|
;; skip jump marks pointing to other buffers
|
|
(while (and (< idx size) (>= idx 0)
|
|
(not (string= current-file-name (cadr (ring-ref target-list idx)))))
|
|
(setq idx (+ idx shift))))
|
|
(when (and (< idx size) (>= idx 0))
|
|
;; actual jump
|
|
(run-hooks 'evil-jumps-pre-jump-hook)
|
|
(let* ((place (ring-ref target-list idx))
|
|
(pos (car place))
|
|
(file-name (cadr place)))
|
|
(setq evil--jumps-jumping t)
|
|
(if (string-match-p evil--jumps-buffer-targets file-name)
|
|
(switch-to-buffer file-name)
|
|
(find-file file-name))
|
|
(setq evil--jumps-jumping nil)
|
|
(goto-char pos)
|
|
(setf (evil-jumps-struct-idx (evil--jumps-get-current)) idx)
|
|
(run-hooks 'evil-jumps-post-jump-hook))))))
|
|
|
|
(defun evil--jumps-push ()
|
|
"Pushes the current cursor/file position to the jump list."
|
|
(let ((target-list (evil--jumps-get-window-jump-list)))
|
|
(let ((file-name (buffer-file-name))
|
|
(buffer-name (buffer-name))
|
|
(current-pos (point-marker))
|
|
(first-pos nil)
|
|
(first-file-name nil)
|
|
(excluded nil))
|
|
(when (and (not file-name)
|
|
(string-match-p evil--jumps-buffer-targets buffer-name))
|
|
(setq file-name buffer-name))
|
|
(when file-name
|
|
(dolist (pattern evil-jumps-ignored-file-patterns)
|
|
(when (string-match-p pattern file-name)
|
|
(setq excluded t)))
|
|
(unless excluded
|
|
(unless (ring-empty-p target-list)
|
|
(setq first-pos (car (ring-ref target-list 0)))
|
|
(setq first-file-name (car (cdr (ring-ref target-list 0)))))
|
|
(unless (and (equal first-pos current-pos)
|
|
(equal first-file-name file-name))
|
|
(evil--jumps-message "pushing %s on %s" current-pos file-name)
|
|
(ring-insert target-list `(,current-pos ,file-name))))))
|
|
(evil--jumps-message "%s %s"
|
|
(selected-window)
|
|
(and (not (ring-empty-p target-list))
|
|
(ring-ref target-list 0)))))
|
|
|
|
(evil-define-command evil-show-jumps ()
|
|
"Display the contents of the jump list."
|
|
:repeat nil
|
|
(evil-with-view-list
|
|
:name "evil-jumps"
|
|
:mode "Evil Jump List"
|
|
:format [("Jump" 5 nil)
|
|
("Marker" 8 nil)
|
|
("File/text" 1000 t)]
|
|
:entries (let* ((jumps (evil--jumps-savehist-sync))
|
|
(count 0))
|
|
(cl-loop for jump in jumps
|
|
collect `(nil [,(number-to-string (cl-incf count))
|
|
,(number-to-string (car jump))
|
|
(,(cadr jump))])))
|
|
:select-action #'evil--show-jumps-select-action))
|
|
|
|
(defun evil--show-jumps-select-action (jump)
|
|
(let ((position (string-to-number (elt jump 1)))
|
|
(file (car (elt jump 2))))
|
|
(kill-buffer)
|
|
(switch-to-buffer (find-file file))
|
|
(goto-char position)))
|
|
|
|
(defun evil-set-jump (&optional pos)
|
|
"Set jump point at POS.
|
|
POS defaults to point."
|
|
(save-excursion
|
|
(when (markerp pos)
|
|
(set-buffer (marker-buffer pos)))
|
|
|
|
(unless (or (region-active-p) (evil-visual-state-p))
|
|
(push-mark pos t))
|
|
|
|
(unless evil--jumps-jumping
|
|
;; clear out intermediary jumps when a new one is set
|
|
(let* ((struct (evil--jumps-get-current))
|
|
(target-list (evil--jumps-get-jumps struct))
|
|
(idx (evil-jumps-struct-idx struct)))
|
|
(cl-loop repeat idx
|
|
do (ring-remove target-list))
|
|
(setf (evil-jumps-struct-idx struct) -1))
|
|
(when pos
|
|
(goto-char pos))
|
|
(evil--jumps-push))))
|
|
|
|
(defun evil--jump-backward (count)
|
|
(setq evil--jumps-jumping-backward t)
|
|
(let ((count (or count 1)))
|
|
(evil-motion-loop (nil count)
|
|
(let* ((struct (evil--jumps-get-current))
|
|
(idx (evil-jumps-struct-idx struct)))
|
|
(evil--jumps-message "jumping back %s" idx)
|
|
(when (= idx -1)
|
|
(setq idx 0)
|
|
(setf (evil-jumps-struct-idx struct) 0)
|
|
(evil--jumps-push))
|
|
(evil--jumps-jump idx 1)))))
|
|
|
|
(defun evil--jump-forward (count)
|
|
(let ((count (or count 1)))
|
|
(evil-motion-loop (nil count)
|
|
(let* ((struct (evil--jumps-get-current))
|
|
(idx (evil-jumps-struct-idx struct)))
|
|
(when (= idx -1)
|
|
(setq idx 0)
|
|
(setf (evil-jumps-struct-idx struct) 0)
|
|
(evil--jumps-push))
|
|
(evil--jumps-jump idx -1)))))
|
|
|
|
(defun evil--jumps-window-configuration-hook (&rest _args)
|
|
(let* ((window-list (window-list-1 nil nil t))
|
|
(existing-window (selected-window))
|
|
(new-window (previous-window)))
|
|
(when (and (not (eq existing-window new-window))
|
|
(> (length window-list) 1))
|
|
(let* ((target-jump-struct (evil--jumps-get-current new-window)))
|
|
(if (not (ring-empty-p (evil--jumps-get-jumps target-jump-struct)))
|
|
(evil--jumps-message "target window %s already has %s jumps" new-window
|
|
(ring-length (evil--jumps-get-jumps target-jump-struct)))
|
|
(evil--jumps-message "new target window detected; copying %s to %s" existing-window new-window)
|
|
(let* ((source-jump-struct (evil--jumps-get-current existing-window))
|
|
(source-list (evil--jumps-get-jumps source-jump-struct)))
|
|
(when (= (ring-length (evil--jumps-get-jumps target-jump-struct)) 0)
|
|
(setf (evil-jumps-struct-previous-pos target-jump-struct) (evil-jumps-struct-previous-pos source-jump-struct))
|
|
(setf (evil-jumps-struct-idx target-jump-struct) (evil-jumps-struct-idx source-jump-struct))
|
|
(setf (evil-jumps-struct-ring target-jump-struct) (ring-copy source-list)))))))
|
|
;; delete obsolete windows
|
|
(maphash (lambda (key _val)
|
|
(unless (member key window-list)
|
|
(evil--jumps-message "removing %s" key)
|
|
(remhash key evil--jumps-window-jumps)))
|
|
evil--jumps-window-jumps)))
|
|
|
|
(defun evil--jump-hook (&optional command)
|
|
"`pre-command-hook' for evil-jumps.
|
|
Set jump point if COMMAND has a non-nil `:jump' property. Otherwise,
|
|
save the current position in case the command being executed will
|
|
change the current buffer."
|
|
(setq command (or command this-command))
|
|
(if (evil-get-command-property command :jump)
|
|
(evil-set-jump)
|
|
(setf (evil-jumps-struct-previous-pos (evil--jumps-get-current))
|
|
(point-marker))))
|
|
|
|
(defun evil--jump-handle-buffer-crossing ()
|
|
(let ((jumping-backward evil--jumps-jumping-backward))
|
|
(setq evil--jumps-jumping-backward nil)
|
|
(dolist (frame (frame-list))
|
|
(dolist (window (window-list frame))
|
|
(let* ((struct (evil--jumps-get-current window))
|
|
(previous-pos (evil-jumps-struct-previous-pos struct)))
|
|
(when previous-pos
|
|
(setf (evil-jumps-struct-previous-pos struct) nil)
|
|
(if (and
|
|
;; `evil-jump-backward' (and other backward jumping
|
|
;; commands) needs to be handled specially. When
|
|
;; jumping backward multiple times, calling
|
|
;; `evil-set-jump' is always wrong: If you jump back
|
|
;; twice and we call `evil-set-jump' after the second
|
|
;; time, we clear the forward jump list and
|
|
;; `evil--jump-forward' won't work.
|
|
|
|
;; The first time you jump backward, setting a jump
|
|
;; point is sometimes correct. But we don't do it
|
|
;; here because this function is called after
|
|
;; `evil--jump-backward' has updated our position in
|
|
;; the jump list so, again, `evil-set-jump' would
|
|
;; break `evil--jump-forward'.
|
|
(not jumping-backward)
|
|
(let ((previous-buffer (marker-buffer previous-pos)))
|
|
(and previous-buffer
|
|
(not (eq previous-buffer (window-buffer window))))))
|
|
(evil-set-jump previous-pos)
|
|
(set-marker previous-pos nil))))))))
|
|
|
|
(if (bound-and-true-p savehist-loaded)
|
|
(evil--jumps-savehist-load)
|
|
(add-hook 'savehist-mode-hook #'evil--jumps-savehist-load))
|
|
|
|
(defun evil--jumps-install-or-uninstall ()
|
|
(if evil-local-mode
|
|
(progn
|
|
(add-hook 'pre-command-hook #'evil--jump-hook nil t)
|
|
(add-hook 'post-command-hook #'evil--jump-handle-buffer-crossing nil t)
|
|
(add-hook 'next-error-hook #'evil-set-jump nil t)
|
|
(add-hook 'window-configuration-change-hook #'evil--jumps-window-configuration-hook nil t))
|
|
(remove-hook 'pre-command-hook #'evil--jump-hook t)
|
|
(remove-hook 'post-command-hook #'evil--jump-handle-buffer-crossing t)
|
|
(remove-hook 'next-error-hook #'evil-set-jump t)
|
|
(remove-hook 'window-configuration-change-hook #'evil--jumps-window-configuration-hook t)
|
|
(evil--jump-handle-buffer-crossing)))
|
|
|
|
(add-hook 'evil-local-mode-hook #'evil--jumps-install-or-uninstall)
|
|
|
|
(provide 'evil-jumps)
|
|
|
|
;;; evil-jumps.el ends here
|