Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
361 lines (319 sloc) 13.1 KB
;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm.
;; Copyright (C) 2012 Thierry Volpiatto <>
;; This program 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.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <>.
;;; Code:
(eval-when-compile (require 'cl))
(require 'helm)
(require 'helm-utils)
(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
(defgroup helm-ring nil
"Ring related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-kill-ring-threshold 10
"Minimum length of a candidate to be listed by `helm-c-source-kill-ring'."
:type 'integer
:group 'helm-ring)
(defcustom helm-c-kill-ring-max-lines-number nil
"Max number of lines displayed per candidate in kill-ring browser.
If nil or zero, don't truncate candidate, show all."
:type 'integer
:group 'helm-ring)
(defcustom helm-c-register-max-offset 160
"Max size of string register entries before truncating."
:group 'helm-ring
:type 'integer)
;;; Kill ring
(defvar helm-kill-ring-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-y") 'helm-next-line)
(define-key map (kbd "M-u") 'helm-previous-line)
"Keymap for `helm-show-kill-ring'.")
(defvar helm-c-source-kill-ring
`((name . "Kill Ring")
(init . (lambda () (helm-attrset 'last-command last-command)))
(candidates . helm-c-kill-ring-candidates)
(filtered-candidate-transformer helm-c-kill-ring-transformer)
(action . helm-c-kill-ring-action)
(keymap . ,helm-kill-ring-map)
"Source for browse and insert contents of kill-ring.")
(defun helm-c-kill-ring-candidates ()
(loop for kill in (helm-fast-remove-dups kill-ring :test 'equal)
unless (or (< (length kill) helm-kill-ring-threshold)
(string-match "^\\(\\s-\\|\t\\)+$" kill))
collect kill))
(defun helm-c-kill-ring-transformer (candidates source)
"Display only the `helm-c-kill-ring-max-lines-number' lines of candidate."
(loop for i in candidates
for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
if (and helm-c-kill-ring-max-lines-number
(> nlines helm-c-kill-ring-max-lines-number))
collect (cons
(insert i)
(goto-char (point-min))
(forward-line helm-c-kill-ring-max-lines-number)
"[...]")) i)
else collect i))
(defun helm-c-kill-ring-action (str)
"Insert STR in `kill-ring' and set STR to the head.
If this action is executed just after `yank',
replace with STR as yanked string."
(setq kill-ring (delete str kill-ring))
(if (not (eq (helm-attr 'last-command) 'yank))
(with-helm-current-buffer (insert-for-yank str))
;; from `yank-pop'
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
(if before
(funcall (or yank-undo-function 'delete-region) (point) (mark t))
(funcall (or yank-undo-function 'delete-region) (mark t) (point)))
(setq yank-undo-function nil)
(set-marker (mark-marker) (point) helm-current-buffer)
(with-helm-current-buffer (insert-for-yank str))
;; Set the window start back where it was in the yank command,
;; if possible.
(set-window-start (selected-window) yank-window-start t)
(if before
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
;; loop would deactivate the mark because we inserted text.
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) helm-current-buffer))))))
(kill-new str))
;;;; <Mark ring>
;; DO NOT include these sources in `helm-sources' use
;; the commands `helm-mark-ring', `helm-global-mark-ring' or
;; `helm-all-mark-rings' instead.
(defun helm-mark-ring-get-marks (pos)
(goto-char pos)
(let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
(when (string= "" line)
(setq line "<EMPTY LINE>"))
(format "%7d: %s" (line-number-at-pos) line))))
(defun helm-mark-ring-get-candidates ()
(loop with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
with recip = nil
for i in marks
for m = (helm-mark-ring-get-marks i)
unless (member m recip)
collect m into recip
finally return recip)))
(defvar helm-mark-ring-cache nil)
(defvar helm-c-source-mark-ring
'((name . "mark-ring")
(init . (lambda ()
(setq helm-mark-ring-cache
(ignore-errors (helm-mark-ring-get-candidates)))))
(candidates . (lambda ()
(helm-aif helm-mark-ring-cache
(action . (("Goto line"
. (lambda (candidate)
(helm-goto-line (string-to-number candidate))
(push-mark nil 'nomsg)))))
(persistent-action . (lambda (candidate)
(helm-goto-line (string-to-number candidate))
(persistent-help . "Show this line")))
;;; Global-mark-ring
(defvar helm-c-source-global-mark-ring
'((name . "global-mark-ring")
(candidates . helm-global-mark-ring-get-candidates)
(action . (("Goto line"
. (lambda (candidate)
(let ((items (split-string candidate ":")))
(helm-c-switch-to-buffer (second items))
(helm-goto-line (string-to-number (car items))))))))
(persistent-action . (lambda (candidate)
(let ((items (split-string candidate ":")))
(helm-c-switch-to-buffer (second items))
(helm-goto-line (string-to-number (car items)))
(persistent-help . "Show this line")))
(defun helm-global-mark-ring-format-buffer (marker)
(with-current-buffer (marker-buffer marker)
(goto-char marker)
(let (line)
(if (string= "" line)
(setq line "<EMPTY LINE>")
(setq line (car (split-string (thing-at-point 'line)
(format "%7d:%s: %s"
(line-number-at-pos) (marker-buffer marker) line))))
(defun helm-global-mark-ring-get-candidates ()
(loop with marks = global-mark-ring
with recip = nil
for i in marks
for gm = (unless (or (string-match
"^ " (format "%s" (marker-buffer i)))
(null (marker-buffer i)))
(helm-global-mark-ring-format-buffer i))
when (and gm (not (member gm recip)))
collect gm into recip
finally return recip))
;;;; <Register>
;;; Insert from register
(defvar helm-c-source-register
'((name . "Registers")
(candidates . helm-c-register-candidates)
(action-transformer . helm-c-register-action-transformer)
"See (info \"(emacs)Registers\")")
(defun helm-c-register-candidates ()
"Collecting register contents and appropriate commands."
(loop for (char . val) in register-alist
for key = (single-key-description char)
for string-actions =
((numberp val)
(list (int-to-string val)
((markerp val)
(let ((buf (marker-buffer val)))
(if (null buf)
(list "a marker in no buffer")
(list (concat
"a buffer position:"
(buffer-name buf)
", position "
(int-to-string (marker-position val)))
((and (consp val) (window-configuration-p (car val)))
(list "window configuration."
((and (consp val) (frame-configuration-p (car val)))
(list "frame configuration."
((and (consp val) (eq (car val) 'file))
(list (concat "file:"
(prin1-to-string (cdr val))
((and (consp val) (eq (car val) 'file-query))
(list (concat "file:a file-query reference: file "
(car (cdr val))
", position "
(int-to-string (car (cdr (cdr val))))
((consp val)
(let ((lines (format "%4d" (length val))))
(list (format "%s: %s\n" lines
(mapconcat 'identity (list (car val))
"^J") (- (window-width) 15)))
((stringp val)
;; without properties
(concat (substring-no-properties
val 0 (min (length val) helm-c-register-max-offset))
(if (> (length val) helm-c-register-max-offset)
"[...]" ""))
((vectorp val)
"Undo-tree entry."
collect (cons (format "Register %3s:\n %s" key (car string-actions))
(cons char (cdr string-actions)))))
(defun helm-c-register-action-transformer (actions register-and-functions)
"Decide actions by the contents of register."
(loop with func-actions =
"Insert Register" .
(lambda (c) (insert-register (car c))))
"Jump to Register" .
(lambda (c) (jump-to-register (car c))))
"Append Region to Register" .
(lambda (c) (append-to-register
(car c) (region-beginning) (region-end))))
"Prepend Region to Register" .
(lambda (c) (prepend-to-register
(car c) (region-beginning) (region-end))))
"Increment Prefix Arg to Register" .
(lambda (c) (increment-register
helm-current-prefix-arg (car c))))
"Restore Undo-tree register"
(lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
(undo-tree-restore-state-from-register (car c))))))
for func in (cdr register-and-functions)
for cell = (assq func func-actions)
when cell
collect (cdr cell)))
(defun helm-mark-ring ()
"Preconfigured `helm' for `helm-c-source-mark-ring'."
(helm :sources 'helm-c-source-mark-ring))
(defun helm-global-mark-ring ()
"Preconfigured `helm' for `helm-c-source-global-mark-ring'."
(helm :sources 'helm-c-source-global-mark-ring))
(defun helm-all-mark-rings ()
"Preconfigured `helm' for `helm-c-source-global-mark-ring' and \
(helm :sources '(helm-c-source-mark-ring
(defun helm-register ()
"Preconfigured `helm' for Emacs registers."
(helm-other-buffer 'helm-c-source-register "*helm register*"))
(defun helm-show-kill-ring ()
"Preconfigured `helm' for `kill-ring'.
It is drop-in replacement of `yank-pop'.
First call open the kill-ring browser, next calls move to next line."
(helm :sources helm-c-source-kill-ring
:buffer "*helm kill-ring*"
:allow-nest t))
(provide 'helm-ring)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions obsolete)
;; coding: utf-8
;; indent-tabs-mode: nil
;; byte-compile-dynamic: t
;; End:
;;; helm-ring.el ends here
Something went wrong with that request. Please try again.