Download
(eval-when-compile
(require 'cl)
(require 'derived))
(when (featurep 'xemacs)
(require 'overlay))
(defun browse-kill-ring-depropertize-string (str)
"Return a copy of STR with text properties removed."
(let ((str (copy-sequence str)))
(set-text-properties 0 (length str) nil str)
str))
(cond ((fboundp 'propertize)
(defalias 'browse-kill-ring-propertize 'propertize))
((fboundp 'ibuffer-propertize)
(defalias 'browse-kill-ring-propertize 'ibuffer-propertize))
(t
(defun browse-kill-ring-propertize (string &rest properties)
"Return a copy of STRING with text properties added.
[Note: this docstring has been copied from the Emacs 21 version]
First argument is the string to copy.
Remaining arguments form a sequence of PROPERTY VALUE pairs for text
properties to add to the result."
(let ((str (copy-sequence string)))
(add-text-properties 0 (length str)
properties
str)
str))))
(defgroup browse-kill-ring nil
"A package for browsing and inserting the items in `kill-ring'."
:link '(url-link "http://freedom.cis.ohio-state.edu/~hurley/")
:group 'convenience)
(defvar browse-kill-ring-display-styles
'((separated . browse-kill-ring-insert-as-separated)
(one-line . browse-kill-ring-insert-as-one-line)))
(defcustom browse-kill-ring-display-style 'separated
"How to display the kill ring items.
If `one-line', then replace newlines with \"\\n\" for display.
If `separated', then display `browse-kill-ring-separator' between
entries."
:type '(choice (const :tag "One line" one-line)
(const :tag "Separated" separated))
:group 'browse-kill-ring)
(defcustom browse-kill-ring-quit-action 'bury-and-delete-window
"What action to take when `browse-kill-ring-quit' is called.
If `bury-buffer', then simply bury the *Kill Ring* buffer, but keep
the window.
If `bury-and-delete-window', then bury the buffer, and (if there is
more than one window) delete the window. This is the default.
If `save-and-restore', then save the window configuration when
`browse-kill-ring' is called, and restore it at quit.
If `kill-and-delete-window', then kill the *Kill Ring* buffer, and
delete the window on close.
Otherwise, it should be a function to call."
:type '(choice (const :tag "Bury buffer" :value bury-buffer)
(const :tag "Delete window" :value delete-window)
(const :tag "Save and restore" :value save-and-restore)
(const :tag "Bury buffer and delete window" :value bury-and-delete-window)
(const :tag "Kill buffer and delete window" :value kill-and-delete-window)
function)
:group 'browse-kill-ring)
(defcustom browse-kill-ring-resize-window nil
"Whether to resize the `browse-kill-ring' window to fit its contents.
Value is either t, meaning yes, or a cons pair of integers,
(MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to
the window size chosen by `pop-to-buffer'
`window-min-height'."
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t)
(cons (integer :tag "Maximum") (integer :tag "Minimum")))
:group 'browse-kill-ring)
(defcustom browse-kill-ring-separator "-------"
"The string separating entries in the `separated' style.
See `browse-kill-ring-display-style'."
:type 'string
:group 'browse-kill-ring)
(defcustom browse-kill-ring-recenter nil
"If non-nil, then always keep the current entry at the top of the window."
:type 'boolean
:group 'browse-kill-ring)
(defcustom browse-kill-ring-highlight-current-entry nil
"If non-nil, highlight the currently selected `kill-ring' entry."
:type 'boolean
:group 'browse-kill-ring)
(defcustom browse-kill-ring-highlight-inserted-item browse-kill-ring-highlight-current-entry
"If non-nil, temporarily highlight the inserted `kill-ring' entry."
:type 'boolean
:group 'browse-kill-ring)
(defcustom browse-kill-ring-separator-face 'bold
"The face in which to highlight the `browse-kill-ring-separator'."
:type 'face
:group 'browse-kill-ring)
(defcustom browse-kill-ring-maximum-display-length nil
"Whether or not to limit the length of displayed items.
If this variable is an integer, the display of `kill-ring' will be
limited to that many characters.
Setting this variable to nil means no limit."
:type '(choice (const :tag "None" nil)
integer)
:group 'browse-kill-ring)
(defcustom browse-kill-ring-display-duplicates t
"If non-nil, then display duplicate items in `kill-ring'."
:type 'boolean
:group 'browse-kill-ring)
(defadvice kill-new (around browse-kill-ring-no-kill-new-duplicates)
"An advice for not adding duplicate elements to `kill-ring'.
Even after being \"activated\", this advice will only modify the
behavior of `kill-new' when `browse-kill-ring-no-duplicates'
is non-nil."
(if browse-kill-ring-no-duplicates
(setq kill-ring (delete (ad-get-arg 0) kill-ring)))
ad-do-it)
(defcustom browse-kill-ring-no-duplicates nil
"If non-nil, then the `b-k-r-no-kill-new-duplicates' advice will operate.
This means that duplicate entries won't be added to the `kill-ring'
when you call `kill-new'.
If you set this variable via customize, the advice will be activated
or deactivated automatically. Otherwise, to enable the advice, add
(ad-enable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicates)
(ad-activate 'kill-new)
to your init file."
:type 'boolean
:set (lambda (symbol value)
(set symbol value)
(if value
(ad-enable-advice 'kill-new 'around
'browse-kill-ring-no-kill-new-duplicates)
(ad-disable-advice 'kill-new 'around
'browse-kill-ring-no-kill-new-duplicates))
(ad-activate 'kill-new))
:group 'browse-kill-ring)
(defcustom browse-kill-ring-depropertize nil
"If non-nil, remove text properties from `kill-ring' items.
This only changes the items for display and insertion from
`browse-kill-ring'
inserted with properties."
:type 'boolean
:group 'browse-kill-ring)
(defcustom browse-kill-ring-hook nil
"A list of functions to call after `browse-kill-ring'."
:type 'hook
:group 'browse-kill-ring)
(defvar browse-kill-ring-original-window-config nil
"The window configuration to restore for `browse-kill-ring-quit'.")
(make-variable-buffer-local 'browse-kill-ring-original-window-config)
(defvar browse-kill-ring-original-window nil
"The window in which chosen kill ring data will be inserted.
It is probably not a good idea to set this variable directly
call `browse-kill-ring' again.")
(defun browse-kill-ring-mouse-insert (e)
"Insert the chosen text, and close the *Kill Ring* buffer afterwards."
(interactive "e")
(let* ((data (save-excursion
(mouse-set-point e)
(cons (current-buffer) (point))))
(buf (car data))
(pt (cdr data)))
(browse-kill-ring-do-insert buf pt))
(browse-kill-ring-quit))
(if (fboundp 'fit-window-to-buffer)
(defalias 'browse-kill-ring-fit-window 'fit-window-to-buffer)
(defun browse-kill-ring-fit-window (window max-height min-height)
(setq min-height (or min-height window-min-height))
(setq max-height (or max-height (- (frame-height) (window-height) 1)))
(let* ((window-min-height min-height)
(windows (count-windows))
(config (current-window-configuration)))
(enlarge-window (- max-height (window-height)))
(when (> windows (count-windows))
(set-window-configuration config))
(if (/= (point-min) (point-max))
(shrink-window-if-larger-than-buffer window)
(shrink-window (- (window-height) window-min-height))))))
(defun browse-kill-ring-resize-window ()
(when browse-kill-ring-resize-window
(apply #'browse-kill-ring-fit-window (selected-window)
(if (consp browse-kill-ring-resize-window)
(list (car browse-kill-ring-resize-window)
(or (cdr browse-kill-ring-resize-window)
window-min-height))
(list nil window-min-height)))))
(defun browse-kill-ring-undo-other-window ()
"Undo the most recent change in the other window's buffer.
You most likely want to use this command for undoing an insertion of
yanked text from the *Kill Ring* buffer."
(interactive)
(with-current-buffer (window-buffer browse-kill-ring-original-window)
(undo)))
(defun browse-kill-ring-insert (&optional quit)
"Insert the kill ring item at point into the last selected buffer.
If optional argument QUIT is non-nil, close the *Kill Ring* buffer as
well."
(interactive "P")
(browse-kill-ring-do-insert (current-buffer)
(point))
(when quit
(browse-kill-ring-quit)))
(defun browse-kill-ring-insert-and-delete (&optional quit)
"Insert the kill ring item at point, and remove it from the kill ring.
If optional argument QUIT is non-nil, close the *Kill Ring* buffer as
well."
(interactive "P")
(browse-kill-ring-do-insert (current-buffer)
(point))
(browse-kill-ring-delete)
(when quit
(browse-kill-ring-quit)))
(defun browse-kill-ring-insert-and-quit ()
"Like `browse-kill-ring-insert', but close the *Kill Ring* buffer afterwards."
(interactive)
(browse-kill-ring-insert t))
(defun browse-kill-ring-insert-and-move (&optional quit)
"Like `browse-kill-ring-insert', but move the entry to the front."
(interactive "P")
(let ((buf (current-buffer))
(pt (point)))
(browse-kill-ring-do-insert buf pt)
(let ((str (browse-kill-ring-current-string buf pt)))
(browse-kill-ring-delete)
(kill-new str)))
(if quit
(browse-kill-ring-quit)
(browse-kill-ring-update)))
(defun browse-kill-ring-insert-move-and-quit ()
"Like `browse-kill-ring-insert-and-move', but close the *Kill Ring* buffer."
(interactive)
(browse-kill-ring-insert-and-move t))
(defun browse-kill-ring-prepend-insert (&optional quit)
"Like `browse-kill-ring-insert', but it places the entry at the beginning
of the buffer as opposed to point."
(interactive "P")
(browse-kill-ring-do-prepend-insert (current-buffer)
(point))
(when quit
(browse-kill-ring-quit)))
(defun browse-kill-ring-prepend-insert-and-quit ()
"Like `browse-kill-ring-prepend-insert', but close the *Kill Ring* buffer."
(interactive)
(browse-kill-ring-prepend-insert t))
(defun browse-kill-ring-prepend-insert-and-move (&optional quit)
"Like `browse-kill-ring-prepend-insert', but move the entry to the front
of the *Kill Ring*."
(interactive "P")
(let ((buf (current-buffer))
(pt (point)))
(browse-kill-ring-do-prepend-insert buf pt)
(let ((str (browse-kill-ring-current-string buf pt)))
(browse-kill-ring-delete)
(kill-new str)))
(if quit
(browse-kill-ring-quit)
(browse-kill-ring-update)))
(defun browse-kill-ring-prepend-insert-move-and-quit ()
"Like `browse-kill-ring-prepend-insert-and-move', but close the
*Kill Ring* buffer."
(interactive)
(browse-kill-ring-prepend-insert-and-move t))
(defun browse-kill-ring-do-prepend-insert (buf pt)
(let ((str (browse-kill-ring-current-string buf pt)))
(let ((orig (current-buffer)))
(unwind-protect
(progn
(unless (window-live-p browse-kill-ring-original-window)
(error "Window %s has been deleted
browse-kill-ring-original-window))
(set-buffer (window-buffer browse-kill-ring-original-window))
(save-excursion
(let ((pt (point)))
(goto-char (point-min))
(insert (if browse-kill-ring-depropertize
(browse-kill-ring-depropertize-string str)
str))
(when browse-kill-ring-highlight-inserted-item
(let ((o (make-overlay (point-min) (point))))
(overlay-put o 'face 'highlight)
(sit-for 0.5)
(delete-overlay o)))
(goto-char pt))))
(set-buffer orig)))))
(defun browse-kill-ring-append-insert (&optional quit)
"Like `browse-kill-ring-insert', but places the entry at the end of the
buffer as opposed to point."
(interactive "P")
(browse-kill-ring-do-append-insert (current-buffer)
(point))
(when quit
(browse-kill-ring-quit)))
(defun browse-kill-ring-append-insert-and-quit ()
"Like `browse-kill-ring-append-insert', but close the *Kill Ring* buffer."
(interactive)
(browse-kill-ring-append-insert t))
(defun browse-kill-ring-append-insert-and-move (&optional quit)
"Like `browse-kill-ring-append-insert', but move the entry to the front
of the *Kill Ring*."
(interactive "P")
(let ((buf (current-buffer))
(pt (point)))
(browse-kill-ring-do-append-insert buf pt)
(let ((str (browse-kill-ring-current-string buf pt)))
(browse-kill-ring-delete)
(kill-new str)))
(if quit
(browse-kill-ring-quit)
(browse-kill-ring-update)))
(defun browse-kill-ring-append-insert-move-and-quit ()
"Like `browse-kill-ring-append-insert-and-move', but close the
*Kill Ring* buffer."
(interactive)
(browse-kill-ring-append-insert-and-move t))
(defun browse-kill-ring-do-append-insert (buf pt)
(let ((str (browse-kill-ring-current-string buf pt)))
(let ((orig (current-buffer)))
(unwind-protect
(progn
(unless (window-live-p browse-kill-ring-original-window)
(error "Window %s has been deleted
browse-kill-ring-original-window))
(set-buffer (window-buffer browse-kill-ring-original-window))
(save-excursion
(let ((pt (point))
(begin-pt (point-max)))
(goto-char begin-pt)
(insert (if browse-kill-ring-depropertize
(browse-kill-ring-depropertize-string str)
str))
(when browse-kill-ring-highlight-inserted-item
(let ((o (make-overlay begin-pt (point-max))))
(overlay-put o 'face 'highlight)
(sit-for 0.5)
(delete-overlay o)))
(goto-char pt))))
(set-buffer orig)))))
(defun browse-kill-ring-delete ()
"Remove the item at point from the `kill-ring'."
(interactive)
(let ((over (car (overlays-at (point)))))
(unless (overlayp over)
(error "No kill ring item here"))
(unwind-protect
(progn
(setq buffer-read-only nil)
(let ((target (overlay-get over 'browse-kill-ring-target)))
(delete-region (overlay-start over)
(1+ (overlay-end over)))
(setq kill-ring (delete target kill-ring)))
(when (get-text-property (point) 'browse-kill-ring-extra)
(let ((prev (previous-single-property-change (point)
'browse-kill-ring-extra))
(next (next-single-property-change (point)
'browse-kill-ring-extra)))
(when prev
(incf prev))
(when next
(incf next))
(delete-region (or prev (point-min))
(or next (point-max))))))
(setq buffer-read-only t)))
(browse-kill-ring-resize-window)
(browse-kill-ring-forward 0))
(defun browse-kill-ring-current-string (buf pt)
(with-current-buffer buf
(let ((overs (overlays-at pt)))
(or (and overs
(overlay-get (car overs) 'browse-kill-ring-target))
(error "No kill ring item here")))))
(defun browse-kill-ring-do-insert (buf pt)
(let ((str (browse-kill-ring-current-string buf pt)))
(let ((orig (current-buffer)))
(unwind-protect
(progn
(unless (window-live-p browse-kill-ring-original-window)
(error "Window %s has been deleted
browse-kill-ring-original-window))
(set-buffer (window-buffer browse-kill-ring-original-window))
(save-excursion
(let ((pt (point)))
(insert (if browse-kill-ring-depropertize
(browse-kill-ring-depropertize-string str)
str))
(when browse-kill-ring-highlight-inserted-item
(let ((o (make-overlay pt (point))))
(overlay-put o 'face 'highlight)
(sit-for 0.5)
(delete-overlay o))))))
(set-buffer orig)))))
(defun browse-kill-ring-forward (&optional arg)
"Move forward by ARG `kill-ring' entries."
(interactive "p")
(beginning-of-line)
(while (not (zerop arg))
(if (< arg 0)
(progn
(incf arg)
(if (overlays-at (point))
(progn
(goto-char (overlay-start (car (overlays-at (point)))))
(goto-char (previous-overlay-change (point)))
(goto-char (previous-overlay-change (point))))
(progn
(goto-char (1- (previous-overlay-change (point))))
(unless (bobp)
(goto-char (overlay-start (car (overlays-at (point)))))))))
(progn
(decf arg)
(if (overlays-at (point))
(progn
(goto-char (overlay-end (car (overlays-at (point)))))
(goto-char (next-overlay-change (point))))
(goto-char (next-overlay-change (point)))
(unless (eobp)
(goto-char (overlay-start (car (overlays-at (point))))))))))
(when (and browse-kill-ring-highlight-current-entry
(overlays-at (point)))
(let ((overs (overlay-lists))
(current-overlay (car (overlays-at (point)))))
(mapcar #'(lambda (o)
(overlay-put o 'face nil))
(nconc (car overs) (cdr overs)))
(overlay-put current-overlay 'face 'highlight)))
(when browse-kill-ring-recenter
(recenter 1)))
(defun browse-kill-ring-previous (&optional arg)
"Move backward by ARG `kill-ring' entries."
(interactive "p")
(browse-kill-ring-forward (- arg)))
(defun browse-kill-ring-read-regexp (msg)
(let* ((default (car regexp-history))
(input
(read-from-minibuffer
(if default
(format "%s for regexp (default `%s'): "
msg
default)
(format "%s (regexp): " msg))
nil
nil
nil
'regexp-history)))
(if (equal input "")
default
input)))
(defun browse-kill-ring-search-forward (regexp &optional backwards)
"Move to the next `kill-ring' entry matching REGEXP from point.
If optional arg BACKWARDS is non-nil, move to the previous matching
entry."
(interactive
(list (browse-kill-ring-read-regexp "Search forward")
current-prefix-arg))
(let ((orig (point)))
(browse-kill-ring-forward (if backwards -1 1))
(let ((overs (overlays-at (point))))
(while (and overs
(not (if backwards (bobp) (eobp)))
(not (string-match regexp
(overlay-get (car overs)
'browse-kill-ring-target))))
(browse-kill-ring-forward (if backwards -1 1))
(setq overs (overlays-at (point))))
(unless (and overs
(string-match regexp
(overlay-get (car overs)
'browse-kill-ring-target)))
(progn
(goto-char orig)
(message "No more `kill-ring' entries matching %s" regexp))))))
(defun browse-kill-ring-search-backward (regexp)
"Move to the previous `kill-ring' entry matching REGEXP from point."
(interactive
(list (browse-kill-ring-read-regexp "Search backward")))
(browse-kill-ring-search-forward regexp t))
(defun browse-kill-ring-quit ()
"Take the action specified by `browse-kill-ring-quit-action'."
(interactive)
(case browse-kill-ring-quit-action
(save-and-restore
(let (buf (current-buffer))
(set-window-configuration browse-kill-ring-original-window-config)
(kill-buffer buf)))
(kill-and-delete-window
(kill-buffer (current-buffer))
(unless (= (count-windows) 1)
(delete-window)))
(bury-and-delete-window
(bury-buffer)
(unless (= (count-windows) 1)
(delete-window)))
(t
(funcall browse-kill-ring-quit-action))))
(put 'browse-kill-ring-mode 'mode-class 'special)
(define-derived-mode browse-kill-ring-mode fundamental-mode
"Kill Ring"
"A major mode for browsing the `kill-ring'.
You most likely do not want to call `browse-kill-ring-mode' directly
`browse-kill-ring' instead.
\\{browse-kill-ring-mode-map}"
(set (make-local-variable 'font-lock-defaults)
'(nil t nil nil nil
(font-lock-fontify-region-function . browse-kill-ring-fontify-region)))
(define-key browse-kill-ring-mode-map (kbd "q") 'browse-kill-ring-quit)
(define-key browse-kill-ring-mode-map (kbd "U") 'browse-kill-ring-undo-other-window)
(define-key browse-kill-ring-mode-map (kbd "d") 'browse-kill-ring-delete)
(define-key browse-kill-ring-mode-map (kbd "s") 'browse-kill-ring-search-forward)
(define-key browse-kill-ring-mode-map (kbd "r") 'browse-kill-ring-search-backward)
(define-key browse-kill-ring-mode-map (kbd "g") 'browse-kill-ring-update)
(define-key browse-kill-ring-mode-map (kbd "l") 'browse-kill-ring-occur)
(define-key browse-kill-ring-mode-map (kbd "e") 'browse-kill-ring-edit)
(define-key browse-kill-ring-mode-map (kbd "n") 'browse-kill-ring-forward)
(define-key browse-kill-ring-mode-map (kbd "p") 'browse-kill-ring-previous)
(define-key browse-kill-ring-mode-map [(mouse-2)] 'browse-kill-ring-mouse-insert)
(define-key browse-kill-ring-mode-map (kbd "?") 'describe-mode)
(define-key browse-kill-ring-mode-map (kbd "h") 'describe-mode)
(define-key browse-kill-ring-mode-map (kbd "y") 'browse-kill-ring-insert)
(define-key browse-kill-ring-mode-map (kbd "u") 'browse-kill-ring-insert-move-and-quit)
(define-key browse-kill-ring-mode-map (kbd "i") 'browse-kill-ring-insert)
(define-key browse-kill-ring-mode-map (kbd "o") 'browse-kill-ring-insert-and-move)
(define-key browse-kill-ring-mode-map (kbd "x") 'browse-kill-ring-insert-and-delete)
(define-key browse-kill-ring-mode-map (kbd "RET") 'browse-kill-ring-insert-and-quit)
(define-key browse-kill-ring-mode-map (kbd "b") 'browse-kill-ring-prepend-insert)
(define-key browse-kill-ring-mode-map (kbd "a") 'browse-kill-ring-append-insert))
(defun browse-kill-ring-default-keybindings ()
"Set up M-y (`yank-pop') so that it can invoke `browse-kill-ring'.
Normally, if M-y was not preceeded by C-y, then it has no useful
behavior. This function sets things up so that M-y will invoke
`browse-kill-ring'."
(interactive)
(defadvice yank-pop (around kill-ring-browse-maybe (arg))
"If last action was not a yank, run `browse-kill-ring' instead."
(interactive "p")
(if (not (eq last-command 'yank))
(browse-kill-ring)
(barf-if-buffer-read-only)
ad-do-it))
(ad-activate 'yank-pop))
(define-derived-mode browse-kill-ring-edit-mode fundamental-mode
"Kill Ring Edit"
"A major mode for editing a `kill-ring' entry.
You most likely do not want to call `browse-kill-ring-edit-mode'
directly
\\{browse-kill-ring-edit-mode-map}"
(define-key browse-kill-ring-edit-mode-map (kbd "C-c C-c")
'browse-kill-ring-edit-finish))
(defvar browse-kill-ring-edit-target nil)
(make-variable-buffer-local 'browse-kill-ring-edit-target)
(defun browse-kill-ring-edit ()
"Edit the `kill-ring' entry at point."
(interactive)
(let ((overs (overlays-at (point))))
(unless overs
(error "No kill ring entry here"))
(let* ((target (overlay-get (car overs)
'browse-kill-ring-target))
(target-cell (member target kill-ring)))
(unless target-cell
(error "Item deleted from the kill-ring"))
(switch-to-buffer (get-buffer-create "*Kill Ring Edit*"))
(setq buffer-read-only nil)
(erase-buffer)
(insert target)
(goto-char (point-min))
(browse-kill-ring-resize-window)
(browse-kill-ring-edit-mode)
(message "%s"
(substitute-command-keys
"Use \\[browse-kill-ring-edit-finish] to finish editing."))
(setq browse-kill-ring-edit-target target-cell))))
(defun browse-kill-ring-edit-finish ()
"Commit the changes to the `kill-ring'."
(interactive)
(if browse-kill-ring-edit-target
(setcar browse-kill-ring-edit-target (buffer-string))
(when (y-or-n-p "The item has been deleted)
(push (buffer-string) kill-ring)))
(bury-buffer)
(when (eq major-mode 'browse-kill-ring-mode)
(browse-kill-ring-setup (current-buffer)
browse-kill-ring-original-window
nil
browse-kill-ring-original-window-config)
(browse-kill-ring-resize-window)))
(defmacro browse-kill-ring-add-overlays-for (item &rest body)
(let ((beg (gensym "browse-kill-ring-add-overlays-"))
(end (gensym "browse-kill-ring-add-overlays-")))
`(let ((,beg (point))
(,end
(progn
,@body
(point))))
(let ((o (make-overlay ,beg ,end)))
(overlay-put o 'browse-kill-ring-target ,item)
(overlay-put o 'mouse-face 'highlight)))))
(defun browse-kill-ring-elide (str)
(if (and browse-kill-ring-maximum-display-length
(> (length str)
browse-kill-ring-maximum-display-length))
(concat (substring str 0 (- browse-kill-ring-maximum-display-length 3))
(browse-kill-ring-propertize "..." 'browse-kill-ring-extra t))
str))
(defun browse-kill-ring-insert-as-one-line (items)
(dolist (item items)
(browse-kill-ring-add-overlays-for item
(let* ((item (browse-kill-ring-elide item))
(len (length item))
(start 0)
(newl (browse-kill-ring-propertize "\\n" 'browse-kill-ring-extra t)))
(while (and (< start len)
(string-match "\n" item start))
(insert (substring item start (match-beginning 0))
newl)
(setq start (match-end 0)))
(insert (substring item start len))))
(insert "\n")))
(defun browse-kill-ring-insert-as-separated (items)
(while (cdr items)
(browse-kill-ring-insert-as-separated-1 (car items) t)
(setq items (cdr items)))
(when items
(browse-kill-ring-insert-as-separated-1 (car items) nil)))
(defun browse-kill-ring-insert-as-separated-1 (origitem separatep)
(let* ((item (browse-kill-ring-elide origitem))
(len (length item)))
(browse-kill-ring-add-overlays-for origitem
(insert item))
(let ((inhibit-read-only t))
(insert "\n")
(when separatep
(insert (browse-kill-ring-propertize browse-kill-ring-separator
'browse-kill-ring-extra t
'browse-kill-ring-separator t))
(insert "\n")))))
(defun browse-kill-ring-occur (regexp)
"Display all `kill-ring' entries matching REGEXP."
(interactive
(list
(browse-kill-ring-read-regexp "Display kill ring entries matching")))
(assert (eq major-mode 'browse-kill-ring-mode))
(browse-kill-ring-setup (current-buffer)
browse-kill-ring-original-window
regexp)
(browse-kill-ring-resize-window))
(defun browse-kill-ring-fontify-on-property (prop face beg end)
(save-excursion
(goto-char beg)
(let ((prop-end nil))
(while
(setq prop-end
(let ((prop-beg (or (and (get-text-property (point) prop) (point))
(next-single-property-change (point) prop nil end))))
(when (and prop-beg (not (= prop-beg end)))
(let ((prop-end (next-single-property-change prop-beg prop nil end)))
(when (and prop-end (not (= prop-end end)))
(put-text-property prop-beg prop-end 'face face)
prop-end)))))
(goto-char prop-end)))))
(defun browse-kill-ring-fontify-region (beg end &optional verbose)
(when verbose (message "Fontifying..."))
(let ((buffer-read-only nil))
(browse-kill-ring-fontify-on-property 'browse-kill-ring-extra 'bold beg end)
(browse-kill-ring-fontify-on-property 'browse-kill-ring-separator
browse-kill-ring-separator-face beg end))
(when verbose (message "Fontifying...done")))
(defun browse-kill-ring-update ()
"Update the buffer to reflect outside changes to `kill-ring'."
(interactive)
(assert (eq major-mode 'browse-kill-ring-mode))
(browse-kill-ring-setup (current-buffer)
browse-kill-ring-original-window)
(browse-kill-ring-resize-window))
(defun browse-kill-ring-setup (buf window &optional regexp window-config)
(with-current-buffer buf
(unwind-protect
(progn
(browse-kill-ring-mode)
(setq buffer-read-only nil)
(when (eq browse-kill-ring-display-style
'one-line)
(setq truncate-lines t))
(let ((inhibit-read-only t))
(erase-buffer))
(setq browse-kill-ring-original-window window
browse-kill-ring-original-window-config
(or window-config
(current-window-configuration)))
(let ((browse-kill-ring-maximum-display-length
(if (and browse-kill-ring-maximum-display-length
(<= browse-kill-ring-maximum-display-length 3))
4
browse-kill-ring-maximum-display-length))
(items (mapcar
(if browse-kill-ring-depropertize
#'browse-kill-ring-depropertize-string
#'copy-sequence)
kill-ring)))
(when (not browse-kill-ring-display-duplicates)
(require 'cl)
(setq items (delete-duplicates items :test #'equal)))
(when (stringp regexp)
(setq items (delq nil
(mapcar
#'(lambda (item)
(when (string-match regexp item)
item))
items))))
(funcall (or (cdr (assq browse-kill-ring-display-style
browse-kill-ring-display-styles))
(error "Invalid `browse-kill-ring-display-style': %s"
browse-kill-ring-display-style))
items)
(message
(let ((entry (if (= 1 (length kill-ring)) "entry" "entries")))
(concat
(if (and (not regexp)
browse-kill-ring-display-duplicates)
(format "%s %s in the kill ring."
(length kill-ring) entry)
(format "%s (of %s) %s in the kill ring shown."
(length items) (length kill-ring) entry))
(substitute-command-keys
(concat " Type \\[browse-kill-ring-quit] to quit. "
"\\[describe-mode] for help.")))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(browse-kill-ring-forward 0)
(when regexp
(setq mode-name (concat "Kill Ring [" regexp "]")))
(run-hooks 'browse-kill-ring-hook)
(when (and (featurep 'xemacs)
font-lock-mode)
(browse-kill-ring-fontify-region (point-min) (point-max)))))
(progn
(setq buffer-read-only t)))))
(defun browse-kill-ring ()
"Display items in the `kill-ring' in another buffer."
(interactive)
(if (eq major-mode 'browse-kill-ring-mode)
(message "Already viewing the kill ring")
(let ((orig-buf (current-buffer))
(buf (get-buffer-create "*Kill Ring*")))
(browse-kill-ring-setup buf (selected-window))
(pop-to-buffer buf)
(browse-kill-ring-resize-window)
nil)))
(provide 'browse-kill-ring)