Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 361 lines (319 sloc) 13.381 kb
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
1 ;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm.
2
3 ;; Copyright (C) 2012 Thierry Volpiatto <thierry.volpiatto@gmail.com>
4
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
9
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
14
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
17
18 ;;; Code:
19
20 (eval-when-compile (require 'cl))
21 (require 'helm)
ba17f09 @thierryvolpiatto Move all defcustoms and faces in their respectives groups and files.
thierryvolpiatto authored
22 (require 'helm-utils)
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
23
7d8197a @thierryvolpiatto Fix warnings at compilation.
thierryvolpiatto authored
24 (declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
25
ba17f09 @thierryvolpiatto Move all defcustoms and faces in their respectives groups and files.
thierryvolpiatto authored
26
27 (defgroup helm-ring nil
28 "Ring related Applications and libraries for Helm."
29 :group 'helm)
30
31 (defcustom helm-kill-ring-threshold 10
7a50627 @thierryvolpiatto Fix some default values for user vars.
thierryvolpiatto authored
32 "Minimum length of a candidate to be listed by `helm-c-source-kill-ring'."
ba17f09 @thierryvolpiatto Move all defcustoms and faces in their respectives groups and files.
thierryvolpiatto authored
33 :type 'integer
34 :group 'helm-ring)
35
36 (defcustom helm-c-kill-ring-max-lines-number nil
37 "Max number of lines displayed per candidate in kill-ring browser.
38 If nil or zero, don't truncate candidate, show all."
39 :type 'integer
40 :group 'helm-ring)
41
42 (defcustom helm-c-register-max-offset 160
43 "Max size of string register entries before truncating."
44 :group 'helm-ring
45 :type 'integer)
46
47
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
48 ;;; Kill ring
49 ;;
50 ;;
6399b42 @thierryvolpiatto * helm-config.el: Move keymaps to related file.
thierryvolpiatto authored
51 (defvar helm-kill-ring-map
52 (let ((map (make-sparse-keymap)))
53 (set-keymap-parent map helm-map)
54 (define-key map (kbd "M-y") 'helm-next-line)
55 (define-key map (kbd "M-u") 'helm-previous-line)
56 map)
57 "Keymap for `helm-show-kill-ring'.")
58
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
59 (defvar helm-c-source-kill-ring
60 `((name . "Kill Ring")
61 (init . (lambda () (helm-attrset 'last-command last-command)))
62 (candidates . helm-c-kill-ring-candidates)
63 (filtered-candidate-transformer helm-c-kill-ring-transformer)
64 (action . helm-c-kill-ring-action)
65 (keymap . ,helm-kill-ring-map)
66 (last-command)
bec9d22 @thierryvolpiatto Revert changes for migemo, add migemo attr to multi-occur.
thierryvolpiatto authored
67 (migemo)
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
68 (multiline))
69 "Source for browse and insert contents of kill-ring.")
70
71 (defun helm-c-kill-ring-candidates ()
72 (loop for kill in (helm-fast-remove-dups kill-ring :test 'equal)
73 unless (or (< (length kill) helm-kill-ring-threshold)
cb576f8 @thierryvolpiatto * helm-ring.el (helm-c-kill-ring-candidates): Fix empty line regexp.
thierryvolpiatto authored
74 (string-match "^\\(\\s-\\|\t\\)+$" kill))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
75 collect kill))
76
77 (defun helm-c-kill-ring-transformer (candidates source)
78 "Display only the `helm-c-kill-ring-max-lines-number' lines of candidate."
79 (loop for i in candidates
80 for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
81 if (and helm-c-kill-ring-max-lines-number
82 (> nlines helm-c-kill-ring-max-lines-number))
83 collect (cons
84 (with-temp-buffer
85 (insert i)
86 (goto-char (point-min))
87 (concat
88 (buffer-substring
89 (point-min)
90 (save-excursion
91 (forward-line helm-c-kill-ring-max-lines-number)
92 (point)))
93 "[...]")) i)
94 else collect i))
95
96 (defun helm-c-kill-ring-action (str)
97 "Insert STR in `kill-ring' and set STR to the head.
98 If this action is executed just after `yank',
99 replace with STR as yanked string."
100 (setq kill-ring (delete str kill-ring))
101 (if (not (eq (helm-attr 'last-command) 'yank))
f462a93 @thierryvolpiatto * helm-ring.el: Fix use of kill-ring browser in a running helm session.
thierryvolpiatto authored
102 (with-helm-current-buffer (insert-for-yank str))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
103 ;; from `yank-pop'
104 (let ((inhibit-read-only t)
105 (before (< (point) (mark t))))
106 (if before
107 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
108 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
109 (setq yank-undo-function nil)
f462a93 @thierryvolpiatto * helm-ring.el: Fix use of kill-ring browser in a running helm session.
thierryvolpiatto authored
110 (set-marker (mark-marker) (point) helm-current-buffer)
111 (with-helm-current-buffer (insert-for-yank str))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
112 ;; Set the window start back where it was in the yank command,
113 ;; if possible.
114 (set-window-start (selected-window) yank-window-start t)
115 (if before
116 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
117 ;; It is cleaner to avoid activation, even though the command
118 ;; loop would deactivate the mark because we inserted text.
119 (goto-char (prog1 (mark t)
f462a93 @thierryvolpiatto * helm-ring.el: Fix use of kill-ring browser in a running helm session.
thierryvolpiatto authored
120 (set-marker (mark-marker) (point) helm-current-buffer))))))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
121 (kill-new str))
122
123
124
125 ;;;; <Mark ring>
126 ;; DO NOT include these sources in `helm-sources' use
127 ;; the commands `helm-mark-ring', `helm-global-mark-ring' or
128 ;; `helm-all-mark-rings' instead.
129
46d9ec0 @thierryvolpiatto Remove flet in some places.
thierryvolpiatto authored
130 (defun helm-mark-ring-get-marks (pos)
131 (save-excursion
132 (goto-char pos)
133 (beginning-of-line)
134 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
135 (when (string= "" line)
136 (setq line "<EMPTY LINE>"))
137 (format "%7d: %s" (line-number-at-pos) line))))
138
139 (defun helm-mark-ring-get-candidates ()
140 (with-helm-current-buffer
141 (loop with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
142 with recip = nil
143 for i in marks
144 for m = (helm-mark-ring-get-marks i)
145 unless (member m recip)
146 collect m into recip
147 finally return recip)))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
148
149 (defvar helm-mark-ring-cache nil)
150 (defvar helm-c-source-mark-ring
151 '((name . "mark-ring")
152 (init . (lambda ()
153 (setq helm-mark-ring-cache
46d9ec0 @thierryvolpiatto Remove flet in some places.
thierryvolpiatto authored
154 (ignore-errors (helm-mark-ring-get-candidates)))))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
155 (candidates . (lambda ()
156 (helm-aif helm-mark-ring-cache
157 it)))
158 (action . (("Goto line"
159 . (lambda (candidate)
f75353f @thierryvolpiatto * helm-ring.el (helm-c-source-mark-ring): Push mark when jumping to mark...
thierryvolpiatto authored
160 (helm-goto-line (string-to-number candidate))
161 (push-mark nil 'nomsg)))))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
162 (persistent-action . (lambda (candidate)
163 (helm-goto-line (string-to-number candidate))
164 (helm-match-line-color-current-line)))
165 (persistent-help . "Show this line")))
166
167
168 ;;; Global-mark-ring
169 (defvar helm-c-source-global-mark-ring
170 '((name . "global-mark-ring")
46d9ec0 @thierryvolpiatto Remove flet in some places.
thierryvolpiatto authored
171 (candidates . helm-global-mark-ring-get-candidates)
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
172 (action . (("Goto line"
173 . (lambda (candidate)
174 (let ((items (split-string candidate ":")))
175 (helm-c-switch-to-buffer (second items))
176 (helm-goto-line (string-to-number (car items))))))))
177 (persistent-action . (lambda (candidate)
178 (let ((items (split-string candidate ":")))
179 (helm-c-switch-to-buffer (second items))
180 (helm-goto-line (string-to-number (car items)))
181 (helm-match-line-color-current-line))))
182 (persistent-help . "Show this line")))
183
46d9ec0 @thierryvolpiatto Remove flet in some places.
thierryvolpiatto authored
184 (defun helm-global-mark-ring-format-buffer (marker)
185 (with-current-buffer (marker-buffer marker)
186 (goto-char marker)
187 (beginning-of-line)
188 (let (line)
189 (if (string= "" line)
190 (setq line "<EMPTY LINE>")
191 (setq line (car (split-string (thing-at-point 'line)
192 "[\n\r]"))))
193 (format "%7d:%s: %s"
194 (line-number-at-pos) (marker-buffer marker) line))))
195
196 (defun helm-global-mark-ring-get-candidates ()
197 (loop with marks = global-mark-ring
198 with recip = nil
199 for i in marks
200 for gm = (unless (or (string-match
201 "^ " (format "%s" (marker-buffer i)))
202 (null (marker-buffer i)))
203 (helm-global-mark-ring-format-buffer i))
204 when (and gm (not (member gm recip)))
205 collect gm into recip
206 finally return recip))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
207
208
209 ;;;; <Register>
210 ;;; Insert from register
211 (defvar helm-c-source-register
212 '((name . "Registers")
213 (candidates . helm-c-register-candidates)
214 (action-transformer . helm-c-register-action-transformer)
215 (multiline)
216 (action))
217 "See (info \"(emacs)Registers\")")
218
219 (defun helm-c-register-candidates ()
220 "Collecting register contents and appropriate commands."
221 (loop for (char . val) in register-alist
222 for key = (single-key-description char)
223 for string-actions =
224 (cond
225 ((numberp val)
226 (list (int-to-string val)
227 'insert-register
228 'increment-register))
229 ((markerp val)
230 (let ((buf (marker-buffer val)))
231 (if (null buf)
232 (list "a marker in no buffer")
233 (list (concat
234 "a buffer position:"
235 (buffer-name buf)
236 ", position "
237 (int-to-string (marker-position val)))
238 'jump-to-register
239 'insert-register))))
240 ((and (consp val) (window-configuration-p (car val)))
241 (list "window configuration."
242 'jump-to-register))
243 ((and (consp val) (frame-configuration-p (car val)))
244 (list "frame configuration."
245 'jump-to-register))
246 ((and (consp val) (eq (car val) 'file))
247 (list (concat "file:"
248 (prin1-to-string (cdr val))
249 ".")
250 'jump-to-register))
251 ((and (consp val) (eq (car val) 'file-query))
252 (list (concat "file:a file-query reference: file "
253 (car (cdr val))
254 ", position "
255 (int-to-string (car (cdr (cdr val))))
256 ".")
257 'jump-to-register))
258 ((consp val)
259 (let ((lines (format "%4d" (length val))))
260 (list (format "%s: %s\n" lines
261 (truncate-string-to-width
262 (mapconcat 'identity (list (car val))
263 "^J") (- (window-width) 15)))
264 'insert-register)))
265 ((stringp val)
266 (list
267 ;; without properties
268 (concat (substring-no-properties
269 val 0 (min (length val) helm-c-register-max-offset))
270 (if (> (length val) helm-c-register-max-offset)
271 "[...]" ""))
272 'insert-register
273 'append-to-register
274 'prepend-to-register))
275 ((vectorp val)
276 (list
277 "Undo-tree entry."
278 'undo-tree-restore-state-from-register))
279 (t
280 "GARBAGE!"))
3af2d90 @thierryvolpiatto * helm-ring.el (helm-c-register-candidates): Separate title and contents...
thierryvolpiatto authored
281 collect (cons (format "Register %3s:\n %s" key (car string-actions))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
282 (cons char (cdr string-actions)))))
283
284 (defun helm-c-register-action-transformer (actions register-and-functions)
285 "Decide actions by the contents of register."
286 (loop with func-actions =
287 '((insert-register
288 "Insert Register" .
289 (lambda (c) (insert-register (car c))))
290 (jump-to-register
291 "Jump to Register" .
292 (lambda (c) (jump-to-register (car c))))
293 (append-to-register
294 "Append Region to Register" .
295 (lambda (c) (append-to-register
296 (car c) (region-beginning) (region-end))))
297 (prepend-to-register
298 "Prepend Region to Register" .
299 (lambda (c) (prepend-to-register
300 (car c) (region-beginning) (region-end))))
301 (increment-register
302 "Increment Prefix Arg to Register" .
303 (lambda (c) (increment-register
304 helm-current-prefix-arg (car c))))
305 (undo-tree-restore-state-from-register
306 "Restore Undo-tree register"
307 (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
308 (undo-tree-restore-state-from-register (car c))))))
309 for func in (cdr register-and-functions)
310 for cell = (assq func func-actions)
311 when cell
312 collect (cdr cell)))
313
314 ;;;###autoload
315 (defun helm-mark-ring ()
316 "Preconfigured `helm' for `helm-c-source-mark-ring'."
317 (interactive)
318 (helm :sources 'helm-c-source-mark-ring))
319
320 ;;;###autoload
321 (defun helm-global-mark-ring ()
322 "Preconfigured `helm' for `helm-c-source-global-mark-ring'."
323 (interactive)
324 (helm :sources 'helm-c-source-global-mark-ring))
325
326 ;;;###autoload
327 (defun helm-all-mark-rings ()
328 "Preconfigured `helm' for `helm-c-source-global-mark-ring' and \
329 `helm-c-source-mark-ring'."
330 (interactive)
331 (helm :sources '(helm-c-source-mark-ring
332 helm-c-source-global-mark-ring)))
333
334 ;;;###autoload
335 (defun helm-register ()
336 "Preconfigured `helm' for Emacs registers."
337 (interactive)
338 (helm-other-buffer 'helm-c-source-register "*helm register*"))
339
340 ;;;###autoload
341 (defun helm-show-kill-ring ()
342 "Preconfigured `helm' for `kill-ring'.
343 It is drop-in replacement of `yank-pop'.
80ba78f @thierryvolpiatto * helm-ring.el (helm-show-kill-ring): Improve.
thierryvolpiatto authored
344
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
345 First call open the kill-ring browser, next calls move to next line."
346 (interactive)
a7ee65b @thierryvolpiatto Disable compile warnings and add new keyword to helm.
thierryvolpiatto authored
347 (helm :sources helm-c-source-kill-ring
348 :buffer "*helm kill-ring*"
349 :allow-nest t))
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
350
351 (provide 'helm-ring)
352
37b4201 @thierryvolpiatto Fix dependencies and autoloads. Reorder.
thierryvolpiatto authored
353 ;; Local Variables:
a7ee65b @thierryvolpiatto Disable compile warnings and add new keyword to helm.
thierryvolpiatto authored
354 ;; byte-compile-warnings: (not cl-functions obsolete)
37b4201 @thierryvolpiatto Fix dependencies and autoloads. Reorder.
thierryvolpiatto authored
355 ;; coding: utf-8
356 ;; indent-tabs-mode: nil
357 ;; byte-compile-dynamic: t
358 ;; End:
359
dc93109 @thierryvolpiatto * helm-config.el Move kill-ring, mark-ring and register to helm-ring.el
thierryvolpiatto authored
360 ;;; helm-ring.el ends here
Something went wrong with that request. Please try again.