about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/evil-20180912.957/evil-jumps.el
blob: cce75cd087c004fe6be9dbbbdf4fda43ff50e5b7 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
;;; evil-jumps.el --- Jump list implementation

;; Author: Bailey Ling <bling at live.ca>

;; Version: 1.2.13

;;
;; 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)

(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))

(defmacro evil--jumps-message (format &rest args)
  (when 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
        (cl-remove-if-not #'identity
                          (mapcar #'(lambda (jump)
                                      (let* ((mark (car jump))
                                             (pos (if (markerp mark)
                                                      (marker-position mark)
                                                    mark))
                                             (file-name (cadr jump)))
                                        (if (and (not (file-remote-p file-name))
                                                 (file-exists-p file-name)
                                                 pos)
                                            (list pos file-name)
                                          nil)))
                                  (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
                                  (let* ((place (ring-ref target-list idx))
                                         (pos (car place)))
                                    (cadr place)))))
          (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."
  (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))
    (save-excursion
      (when pos
        (goto-char pos))
      (evil--jumps-push))))

(defun evil--jump-backward (count)
  (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))
             (target-jump-count (ring-length (evil--jumps-get-jumps target-jump-struct))))
        (if (not (ring-empty-p (evil--jumps-get-jumps target-jump-struct)))
            (evil--jumps-message "target window %s already has %s jumps" new-window target-jump-count)
          (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-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)
  "Set jump point if COMMAND has a non-nil :jump property."
  (setq command (or command this-command))
  (when (evil-get-command-property command :jump)
    (evil-set-jump)))

(defadvice switch-to-buffer (before evil-jumps activate)
  (evil-set-jump))

(defadvice split-window-internal (before evil-jumps activate)
  (evil-set-jump))

(eval-after-load 'etags
  '(defadvice find-tag-noselect (before evil-jumps activate)
     (evil-set-jump)))

(if (bound-and-true-p savehist-loaded)
    (evil--jumps-savehist-load)
  (add-hook 'savehist-mode-hook #'evil--jumps-savehist-load))

(add-hook 'evil-local-mode-hook
          (lambda ()
            (if evil-local-mode
                (progn
                  (add-hook 'pre-command-hook #'evil--jump-hook 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))
              (progn
                (remove-hook 'pre-command-hook #'evil--jump-hook t)
                (remove-hook 'next-error-hook #'evil-set-jump t)
                (remove-hook 'window-configuration-change-hook #'evil--jumps-window-configuration-hook t)))))

(provide 'evil-jumps)

;;; evil-jumps.el ends here