Download Git Homepage
;;; browse-kill-ring+.el --- Extensions to `browse-kill-ring.el'.
;;
;; Filename: browse-kill-ring+.el
;; Description: Extensions to `browse-kill-ring.el'.
;; Author: Drew Adams
;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
;; Copyright (C) 2006-2018, Drew Adams, all rights reserved.
;; Created: Tue May 25 16:35:05 2004
;; Version: 0
;; Package-Requires: ((browse-kill-ring "0"))
;; Last-Updated: Fri Sep 21 12:09:20 2018 (-0700)
;; By: dradams
;; Update #: 976
;; URL: https://www.emacswiki.org/emacs/download/browse-kill-ring%2b.el
;; Doc URL: https://www.emacswiki.org/emacs/BrowseKillRing
;; Keywords: convenience
;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x, 25.x, 26.x
;;
;; Features that might be required by this library:
;;
;; `browse-kill-ring', `second-sel'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Extensions to `browse-kill-ring.el'.
;;
;; Put this in your init file (~/.emacs):
;;
;; (require 'browse-kill-ring+)
;;
;;
;; Option `browse-kill-ring-alternative-ring' is an alternative
;; selection ring to use, in addition to the `kill-ring'. You can
;; customize the value to any ring of strings you like.
;;
;; `browse-kill-ring' lets you use either ring as the selection ring
;; to browse and paste. You can even use both rings, in different
;; `browse-kill-ring' display buffers. In such a buffer (in
;; `browse-kill-ring-mode'), `o' pops to the list for the other ring.
;;
;; If you have library `second-sel.el' in your `load-path'
;; (recommended) it is loaded automatically when you load
;; `browse-kill-ring+.el'. In this case, by default
;; `browse-kill-ring-alternative-ring' is the secondary selection
;; ring.
;;
;; You can customize the set of commands to be recognized as yank
;; commands and alternative yank commands - see options
;; `browse-kill-ring-yank-commands' and
;; `browse-kill-ring-alternative-yank-commands'. The alternative
;; yank commands are commands that yank using a different selection
;; ring, for example, the secondary yank commands defined by library
;; `second-sel.el'.
;;
;; Following a yank command or alternative yank command, `M-y' pops
;; and yanks the appropriate type of selection. A prefix arg N
;; chooses the Nth previous selection in the ring.
;;
;; Otherwise (not following a yank or alternative yank), `M-y'
;; browses the current selection ring. A prefix arg switches to the
;; other selection ring. If you are in a `browse-kill-ring' buffer,
;; then `M-y' switches to the other ring even without a prefix arg.
;;
;; If there is no alternative selection ring (e.g., you do not use
;; library `second-sel.el'), then `M-y' either pops (following a
;; yank) or browses (not following a yank) the `kill-ring'.
;;
;; FWIW, I customize `browse-kill-ring-quit-action' to be
;; `browse-kill-ring-quit-deletes-window/frame'. This is similar to
;; the default behavior, except that if the window is dedicated, then
;; the frame is deleted.
;;
;; Icicles offers an alternative: completion vs browsing.
;;
;; You might want to use the Icicles (library `icicles.el') binding
;; of `M-y' as an alternative to the `browse-kill-ring+.el'
;; behavior of `M-y'. If you do that you can of course still use
;; `browse-kill-ring+.el' to browse the selection rings. Just bind
;; `browse-kill-ring'.
;;
;; What Icicles offers is the ability to yank by completing against
;; the selection rings, instead of browsing them.
;;
;;
;; Commands defined here:
;;
;; `browse-kill-ring-copy-to-other-ring',
;; `browse-kill-ring-switch-to-other-kill-ring',
;; `toggle-browse-kill-ring-display-style'.
;;
;; User options defined here:
;;
;; `browse-kill-ring-alternative-push-function',
;; `browse-kill-ring-alternative-ring',
;; `browse-kill-ring-alternative-yank-commands',
;; `browse-kill-ring-yank-commands'.
;;
;; Non-interactive functions defined here:
;;
;; `browse-kill-ring-current-ring',
;; `browse-kill-ring-quit-deletes-window/frame',
;; `browse-kill-ring-remove-dups',
;; `browse-kill-ring-target-overlay-at'.
;;
;; Internal variables defined here:
;;
;; `browse-kill-ring-current-ring', `browse-kill-ring-mode-map'.
;;
;;
;; ***** NOTE: The following functions defined in `browse-kill-ring.el'
;; have been REDEFINED HERE:
;;
;; `browse-kill-ring', `browse-kill-ring-append-insert-and-move',
;; `browse-kill-ring-current-string',
;; `browse-kill-ring-default-keybindings',
;; `browse-kill-ring-delete', `browse-kill-ring-do-append-insert',
;; `browse-kill-ring-do-insert',
;; `browse-kill-ring-insert-and-move',
;; `browse-kill-ring-do-prepend-insert', `browse-kill-ring-edit',
;; `browse-kill-ring-edit-finish', `browse-kill-ring-forward',
;; `browse-kill-ring-prepend-insert-and-move',
;; `browse-kill-ring-mode' `browse-kill-ring-setup'.
;;
;;
;; ***** NOTE: The following functions defined in `second-sel.el'
;; have been ADVISED HERE:
;;
;; `add-secondary-to-ring'.
;;
;; Key bindings defined here for `browse-kill-ring-mode-map':
;;
;; `t' - `toggle-browse-kill-ring-display-style'
;; `TAB' - `browse-kill-ring-forward'
;; `S-TAB' - `browse-kill-ring-previous'
;;
;; NOTE: This library automatically calls
;; `browse-kill-ring-default-keybindings'. If you do not want that,
;; then comment out this call (at the end of the file).
;;
;;
;; TO DO:
;;
;; `browse-kill-ring-edit': membership of selection text is not
;; sufficient, since there can be duplicates.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change Log:
;;
;; 2018/09/21 dadams
;; browse-kill-ring-edit: Use pop-to-buffer-same-window, not switch-to-buffer.
;; 2012/02/08 dadams
;; browse-kill-ring-remove-dups: Redefined to use a hash table.
;; 2012/01/15 dadams
;; browse-kill-ring-mode: Call font-lock-refresh-defaults.
;; 2012/01/07 dadams
;; Added: browse-kill-ring-copy-to-other-ring. Bound to c in browser buffer.
;; Added: browse-kill-ring-current-ring (function).
;; Added autoload cookies.
;; browse-kill-ring-delete: Removed extra progn and extra let.
;; browse-kill-ring, *-delete, *-insert-and-move, *-mode, *-edit(-finish), *-setup:
;; Use the function, not the var, browse-kill-ring-current-ring.
;; 2011/12/23 dadams
;; browse-kill-ring-do-insert: Delete active region before inserting, if in delete-seletion-mode.
;; 2011/03/22 dadams
;; Added: browse-kill-ring(-append|-prepend)-insert-and-move,
;; browse-kill-ring-alternative-push-function.
;; Replace advice of kill-new with advice of add-secondary-to-ring.
;; browse-kill-ring-insert-and-move: Use browse-kill-ring-alternative-push-function.
;; Soft-require second-sel.el.
;; 2011/03/20 dadams
;; Added: browse-kill-ring-mode-map (defconst, so could move it out of the mode definition).
;; Added: browse-kill-ring-target-overlay-at, browse-kill-ring-current-string,
;; browse-kill-ring-do(-append|-prepend)-insert, browse-kill-ring-forward,
;; browse-kill-ring-mode, browse-kill-ring-switch-to-other-kill-ring,
;; browse-kill-ring-kill-number (commented out).
;; browse-kill-ring-do-insert: Added optional arg, so can factor out common code.
;; Use with-current-buffer. Use yank-excluded-properties.
;; (Bug fix) Set window point after inserting. This makes the inserted text be the region.
;; browse-kill-ring-do-(append|prepend)-insert: Define using browse-kill-ring-do-insert.
;; browse-kill-ring-current-string, browse-kill-ring-do-insert, browse-kill-ring-delete,
;; browse-kill-ring-forward, browse-kill-ring-edit:
;; Move to bol first, so can use it at eol.
;; browse-kill-ring-delete, browse-kill-ring-forward, browse-kill-ring-edit:
;; Use browse-kill-ring-target-overlay-at.
;; browse-kill-ring-forward: Bug fixes.
;; browse-kill-ring-mode: Derive from text mode. Don't define keymap here. Use the right ring.
;; browse-kill-ring:
;; Calling it in b-k-r-mode: Chooses the right ring instead of switching to the other ring.
;; Uses browse-kill-ring-original-window, not selected window.
;; Removed read-only message. Changed buffer name: Selection Ring.
;; Bindings: Bind o to browse-kill-ring-switch-to-other-kill-ring.
;; Bind 1 to browse-kill-ring-insert-and-move.
;; Removed bindings at top level - use defconst of browse-kill-ring-mode-map instead.
;; toggle-browse-kill-ring-display-style: Call browse-kill-ring.
;; 2011/03/17 dadams
;; browse-kill-ring-quit-deletes-window/frame:
;; If dedicated window, pass BUF to bury-buffer, to avoid sole-window error.
;; 2009/06/25 dadams
;; Added: browse-kill-ring-quit-deletes-window/frame.
;; Added key bindings for TAB, S-TAB.
;; browse-kill-ring:
;; select-frame-set-input-focus, for MS Windows workaround.
;; Don't show an empty buffer (for empty ring).
;; 2009/06/24 dadams
;; Added: browse-kill-ring(-alternative)-yank-commands, browse-kill-ring-remove-dups,
;; browse-kill-ring-default-keybindings (redefinition),
;; browse-kill-ring (redefinition), browse-kill-ring-alternative-ring.
;; browse-kill-ring-setup:
;; Don't set browse-kill-ring-current-ring here. Do it in browse-kill-ring.
;; Use browse-kill-ring-remove-dups instead of requiring cl.el's delete-duplicates.
;; 2008/??/?? dadams
;; Added: browse-kill-ring-current-ring, browse-kill-ring-delete,
;; browse-kill-ring-edit(-finish), browse-kill-ring-setup.
;; 2008/??/?? dadams
;; Created.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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 2, 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
;; 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (require 'cl)) ;; case
(require 'browse-kill-ring)
(require 'second-sel nil t) ;; (no error if not found)
;; add-secondary-to-ring, secondary-selection-ring, secondary-selection-yank-commands,
;; secondary-selection-yank-secondary-commands
;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defcustom browse-kill-ring-yank-commands (if (boundp 'secondary-selection-yank-commands)
secondary-selection-yank-commands
'(yank icicle-yank-maybe-completing))
"*Commands that yank.
Used by `yank-pop' to tell whether the previous command was a yank command.
Used only if `browse-kill-ring-default-keybindings' has been called,
so `yank-pop' is advised."
:type '(repeat (restricted-sexp :tag "Command that yanks text"
:match-alternatives (symbolp commandp) :value ignore))
:group 'browse-kill-ring :group 'killing)
;;;###autoload
(defcustom browse-kill-ring-alternative-yank-commands
(and (boundp 'secondary-selection-yank-secondary-commands)
secondary-selection-yank-secondary-commands)
"*Commands that yank using the alternative selection ring.
Used by `browse-kill-ring-setup' to tell whether the previous command
yanked from `browse-kill-ring-alternative-ring'."
:type '(repeat (restricted-sexp :match-alternatives (symbolp commandp) :value ignore))
:group 'browse-kill-ring :group 'killing)
;;;###autoload
(defcustom browse-kill-ring-alternative-ring
(and (boundp 'secondary-selection-ring) ; Defined in `second-sel.el'.
'secondary-selection-ring)
"*Selection ring to use as an alternative to `kill-ring'.
A value of nil means there is no alternative selection ring; that is,
`kill-ring' is used always."
:type '(restricted-sexp :tag "Selection ring variable"
:match-alternatives (symbolp boundp) :value ignore)
:group 'browse-kill-ring :group 'killing)
;;;###autoload
(defcustom browse-kill-ring-alternative-push-function
(and (boundp 'secondary-selection-ring) ; Defined in `second-sel.el'.
'add-secondary-to-ring)
"*Function that adds item to the front of alternative selection ring.
This is analogous to `kill-new' for the alternative ring.
It must accept the same same arguments as `kill-new'."
:type 'function
:group 'browse-kill-ring :group 'killing)
(defvar browse-kill-ring-current-ring 'kill-ring
"Symbol whose value is the current selection ring for `browse-kill-ring'.")
;; These bindings are additional - not in `browse-kill-ring.el':
;;
;; `1' - `browse-kill-ring-insert-and-move'
;; `t' - `toggle-browse-kill-ring-display-style'
;; `TAB' - `browse-kill-ring-forward'
;; `S-TAB' - `browse-kill-ring-previous'
;;
;; This binding is a difference from `browse-kill-ring.el':
;;
;; `o' - `browse-kill-ring-switch-to-other-kill-ring' instead of
;; `browse-kill-ring-insert-and-move'
;;
(defconst browse-kill-ring-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<tab>") 'browse-kill-ring-forward)
(define-key map [(control ?i)] 'browse-kill-ring-forward)
(define-key map (kbd "<S-tab>") 'browse-kill-ring-previous)
(define-key map (kbd "RET") 'browse-kill-ring-insert-and-quit)
(define-key map [(mouse-2)] 'browse-kill-ring-mouse-insert)
(define-key map (kbd "?") 'describe-mode)
(define-key map (kbd "1") 'browse-kill-ring-insert-and-move)
(define-key map (kbd "a") 'browse-kill-ring-append-insert)
(define-key map (kbd "b") 'browse-kill-ring-prepend-insert)
(define-key map (kbd "c") 'browse-kill-ring-copy-to-other-ring)
(define-key map (kbd "d") 'browse-kill-ring-delete)
(define-key map (kbd "e") 'browse-kill-ring-edit)
(define-key map (kbd "g") 'browse-kill-ring-update)
(define-key map (kbd "h") 'describe-mode)
(define-key map (kbd "i") 'browse-kill-ring-insert)
(define-key map (kbd "l") 'browse-kill-ring-occur)
(define-key map (kbd "n") 'browse-kill-ring-forward)
(define-key map (kbd "o") 'browse-kill-ring-switch-to-other-kill-ring)
(define-key map (kbd "p") 'browse-kill-ring-previous)
(define-key map (kbd "q") 'browse-kill-ring-quit)
(define-key map (kbd "r") 'browse-kill-ring-search-backward)
(define-key map (kbd "s") 'browse-kill-ring-search-forward)
(define-key map (kbd "t") 'toggle-browse-kill-ring-display-style)
(define-key map (kbd "u") 'browse-kill-ring-insert-move-and-quit)
(define-key map (kbd "U") 'browse-kill-ring-undo-other-window)
(define-key map (kbd "x") 'browse-kill-ring-insert-and-delete)
(define-key map (kbd "y") 'browse-kill-ring-insert)
map)
"Keymap for `browse-kill-ring-mode'.")
(defun browse-kill-ring-current-ring ()
"Current selection ring (the symbol whose value is the ring).
When in a selection-ring buffer, update variable
`browse-kill-ring-current-ring'. Return its value, in any case.
Use this instead of the variable, because the user might have switched
to a window showing the buffer for the other ring."
(if (not (eq major-mode 'browse-kill-ring-mode))
browse-kill-ring-current-ring
(setq browse-kill-ring-current-ring ; Use the correct ring for this `browse-kill-ring' buffer.
(if (or (not browse-kill-ring-alternative-ring)
(string= (buffer-name) "*Selection Ring: `kill-ring'*"))
'kill-ring
browse-kill-ring-alternative-ring))))
(when (and (fboundp 'cl-puthash) (not (fboundp 'puthash))) ; Emacs 20 with `cl-extra.el' loaded.
(defalias 'puthash 'cl-puthash))
(if (fboundp 'puthash) ; Emacs 21+, or Emacs 20 with `cl-extra.el' loaded.
(defun browse-kill-ring-remove-dups (sequence &optional test)
"Copy of SEQUENCE with duplicate elements removed.
Optional arg TEST is the test function. If nil, test with `equal'.
See `make-hash-table' for possible values of TEST."
(setq test (or test #'equal))
(let ((htable (make-hash-table :test test)))
(loop for elt in sequence
unless (gethash elt htable)
do (puthash elt elt htable)
finally return (loop for i being the hash-values in htable collect i))))
(defun browse-kill-ring-remove-dups (list &optional use-eq)
"Copy of LIST with duplicate elements removed.
Test using `equal' by default, or `eq' if optional USE-EQ is non-nil."
(let ((tail list)
new)
(while tail
(unless (if use-eq (memq (car tail) new) (member (car tail) new))
(push (car tail) new))
(pop tail))
(nreverse new))))
;; ADVISES ORIGINAL in `second-sel.el'.
;;
(when (fboundp 'add-secondary-to-ring)
(defadvice add-secondary-to-ring (around bkr-no-second-sel-new-dups)
"Advice for not adding duplicate elements to the secondary selection ring.
Even after being \"activated\", this advice will modify the behavior
of `add-secondary-to-ring' only if `browse-kill-ring-no-duplicates' is
non-nil."
(when browse-kill-ring-no-duplicates
(setq add-secondary-to-ring (delete (ad-get-arg 0) add-secondary-to-ring)))
ad-do-it))
(defun browse-kill-ring-target-overlay-at (position)
"Return overlay at POSITION that has property `browse-kill-ring-target'.
If no such overlay, raise an error."
(let ((ovs (overlays-at (point))))
(catch 'browse-kill-ring-target-overlay-at
(dolist (ov ovs)
(when (overlay-get ov 'browse-kill-ring-target)
(throw 'browse-kill-ring-target-overlay-at ov)))
(error "No selection-ring item here"))))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Use `browse-kill-ring-current-ring', not `kill-ring'.
;; 2. Move to bol first, so can use this at eol (after the selection's overlay).
;;
;;;###autoload
(defun browse-kill-ring-delete () ; Bound to `d' in selection-ring buffer.
"Remove all occurrences of selection at point from current selection ring."
(interactive)
(forward-line 0)
(unwind-protect
(let* ((ov (browse-kill-ring-target-overlay-at (point)))
(target (overlay-get ov 'browse-kill-ring-target)))
(setq buffer-read-only nil)
(delete-region (overlay-start ov) (1+ (overlay-end ov)))
(set browse-kill-ring-current-ring
(delete target (symbol-value (browse-kill-ring-current-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))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Move to bol first, so can use this at eol (after the selection's overlay).
(defun browse-kill-ring-current-string (buffer position)
"Selection entry in BUFFER that is nearest POSITION."
(with-current-buffer buffer
(save-excursion
(goto-char position)
;; The overlay is at bol but not at eol. This ensures we can get the string from eol.
(forward-line 0)
(overlay-get (browse-kill-ring-target-overlay-at (point)) 'browse-kill-ring-target))))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Put error test first.
;; 2. Added optional arg APPEND/PREPEND, to factor out common code.
;; 3. Move to bol first, so can use this at eol (after the selection's overlay).
;; 4. Just use `with-current-buffer'. No need for explicit `unwind-protect' etc.
;; 5. Let `yank-excluded-properties' reflect `browse-kill-ring-depropertize'. Emacs 22+.
;; 6. Delete active region before inserting, if in `delete-seletion-mode'.
;; 7. (Bug fix) Set window point after inserting.
;;
(defun browse-kill-ring-do-insert (bkr-buf sel-pos &optional append/prepend)
"Insert the selection that is at position SEL-POS in buffer BKR-BUF.
BKR-BUF is a selection-ring buffer, with a list of selections.
Insert the selection at point unless optional arg APPEND/PREPEND is:
`append' - insert at eob, not at point
`prepend' - insert at bob, not at point"
(unless (window-live-p browse-kill-ring-original-window)
(error "Window `%s' was deleted. Use `browse-kill-ring' again"
browse-kill-ring-original-window))
;;; ;; Move to bol first, so can use this at eol (after the overlay).
;;; (forward-line 0)
(let ((sel-string (browse-kill-ring-current-string bkr-buf sel-pos)))
(with-current-buffer (window-buffer browse-kill-ring-original-window)
(save-excursion
(let ((yank-excluded-properties (and browse-kill-ring-depropertize t))
(insert-pos (case append/prepend
(append (point-max))
(prepend (point-min))
(t (point)))))
(goto-char insert-pos)
(when (and delete-selection-mode (not buffer-read-only) transient-mark-mode mark-active
(not (memq append/prepend '(append prepend))))
(delete-active-region))
(insert (if browse-kill-ring-depropertize
(browse-kill-ring-depropertize-string sel-string)
sel-string))
;; Put point after insertion (mark is before insertion).
(set-window-point browse-kill-ring-original-window (point))
(when browse-kill-ring-highlight-inserted-item
(let ((ov (make-overlay insert-pos (point))))
(overlay-put ov 'face 'highlight)
(sit-for 0.5)
(delete-overlay ov))))))))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Use new `browse-kill-ring-do-insert'.
;;
(defun browse-kill-ring-do-prepend-insert (bkr-buf sel-pos)
"`browse-kill-ring-do-insert', with insertion at bob."
(browse-kill-ring-do-insert bkr-buf sel-pos 'prepend))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Use new `browse-kill-ring-do-insert'.
;;
(defun browse-kill-ring-do-append-insert (bkr-buf sel-pos)
"`browse-kill-ring-do-insert', with insertion at eob."
(browse-kill-ring-do-insert bkr-buf sel-pos 'append))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Added optional arg APPEND/PREPEND, to factor out common code.
;; 2. Use `browse-kill-ring-current-ring', not `kill-ring'.
;; 3. Use `browse-kill-ring-alternative-push-function' for alternative ring.
;;
;;;###autoload
(defun browse-kill-ring-insert-and-move (&optional quit append/prepend)
; Bound to `1' in selection-ring buffer.
"Like `browse-kill-ring-insert', but move selection to front of ring.
Insert the selection at point unless optional arg
APPEND/PREPEND is:
`append' - insert at eob, not at point
`prepend' - insert at bob, not at point"
(interactive "P")
(let* ((bkr-buf (current-buffer))
(sel-pos (point))
(str (browse-kill-ring-current-string bkr-buf sel-pos)))
(browse-kill-ring-do-insert bkr-buf sel-pos append/prepend)
(browse-kill-ring-delete)
(if (eq 'kill-ring (browse-kill-ring-current-ring))
(kill-new str)
(funcall browse-kill-ring-alternative-push-function str)))
(if quit (browse-kill-ring-quit) (browse-kill-ring-update)))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Use new `browse-kill-ring-do-insert-and-move'.
;;
;;;###autoload
(defun browse-kill-ring-prepend-insert-and-move (&optional quit) ; Not bound.
"`browse-kill-ring-prepend-insert', but move selection to front of ring."
(interactive "P")
(browse-kill-ring-insert-and-move quit 'prepend))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Use new `browse-kill-ring-do-insert-and-move'.
;;
;;;###autoload
(defun browse-kill-ring-append-insert-and-move (&optional quit) ; Not bound.
"`browse-kill-ring-append-insert', but move selection to front of ring."
(interactive "P")
(browse-kill-ring-insert-and-move quit 'append))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Move to bol first, so can use this at eol (after the selection's overlay).
;; 2. Bug fixes.
;;
;;;###autoload
(defun browse-kill-ring-forward (&optional arg) ; Bound to `TAB', `n' in selection-ring buffer.
"Move forward by ARG selection-ring entries."
(interactive "p")
(forward-line 0)
(while (not (zerop arg))
(if (< arg 0)
(progn (incf arg)
(if (overlays-at (point))
(progn
(goto-char (overlay-start (browse-kill-ring-target-overlay-at (point))))
(goto-char (previous-overlay-change (point)))
(goto-char (previous-overlay-change (point))))
(goto-char (previous-overlay-change (point)))
(goto-char (previous-overlay-change (point)))
(when (and (overlays-at (point)) (not (bobp)))
(goto-char (overlay-start (browse-kill-ring-target-overlay-at (point))))))
(forward-line 0))
(decf arg)
(if (overlays-at (point))
(progn (goto-char (overlay-end (browse-kill-ring-target-overlay-at (point))))
(goto-char (next-overlay-change (point)))
;; Don't let, for example, overlay from `show-paren-mode' interfere here.
(while (not (bolp)) (goto-char (next-overlay-change (point)))))
(goto-char (next-overlay-change (point)))
(unless (eobp) (goto-char (overlay-start (browse-kill-ring-target-overlay-at (point))))))))
(when (and browse-kill-ring-highlight-current-entry (overlays-at (point)))
(let ((ovs (overlay-lists))
(current-ov (browse-kill-ring-target-overlay-at (point))))
(mapcar #'(lambda (ov) (overlay-put ov 'face nil)) (nconc (car ovs) (cdr ovs)))
(overlay-put current-ov 'face 'highlight)))
(when browse-kill-ring-recenter (recenter 1)))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Derive from Text Mode, so typical movement keys, search keys, etc. work as expected.
;; 2. Don't define the keymap here, just use it.
;; 3. Use the appropriate ring for this `browse-kill-ring' buffer. Update
;; `browse-kill-ring-current-ring'.
;;
(define-derived-mode browse-kill-ring-mode text-mode
"Selection-Ring"
"Major mode for browsing selection rings such as the `kill-ring'.
Do not call `browse-kill-ring-mode' directly - use `browse-kill-ring'.
\\{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)))
(when (fboundp 'font-lock-refresh-defaults) (font-lock-refresh-defaults))
(use-local-map browse-kill-ring-mode-map)
(browse-kill-ring-current-ring)) ; Use the correct ring for this `browse-kill-ring' buffer.
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Use `browse-kill-ring-yank-commands', not necessarily `yank'.
;;
;;;###autoload
(defun browse-kill-ring-default-keybindings () ; Not bound.
"Set up `M-y' so that it can invoke `browse-kill-ring'.
See also option `browse-kill-ring-yank-commands'."
(interactive)
(defadvice yank-pop (around kill-ring-browse-maybe (arg))
"If last action was not a yank, run `browse-kill-ring' instead."
;; `yank-pop' has (interactive "*p"), which does not allow it to run in a read-only buffer.
;; `browse-kill-ring' needs to work in read-only buffers also, so we change the
;; interactive form here. But we `barf-if-buffer-read-only' when invoking original `yank-pop'.
(interactive "p")
(if (not (memq last-command browse-kill-ring-yank-commands))
(call-interactively #'browse-kill-ring)
(barf-if-buffer-read-only)
ad-do-it))
(ad-activate 'yank-pop))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Move to bol first, so can use this at eol (after the selection's overlay).
;; 2. Use `browse-kill-ring-current-ring', not `kill-ring'.
;;
;;;###autoload
(defun browse-kill-ring-edit () ; Bound to `e' in selection-ring buffer.
"Edit the current selection ring entry at point."
(interactive)
(forward-line 0)
(let ((ovs (overlays-at (point))))
;; $$$$$$ FIXME - membership of the text is not a sufficient test, to get the correct cell.
(let* ((target (overlay-get (browse-kill-ring-target-overlay-at (point))
'browse-kill-ring-target))
(target-cell (member target (symbol-value (browse-kill-ring-current-ring)))))
(unless target-cell (error "Item deleted from the current selection ring"))
(if (fboundp 'pop-to-buffer-same-window)
(pop-to-buffer-same-window (get-buffer-create "*Kill Ring Edit*"))
(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 (substitute-command-keys "Use `\\[browse-kill-ring-edit-finish]' to finish editing."))
(setq browse-kill-ring-edit-target target-cell))))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; Use `browse-kill-ring-current-ring', not `kill-ring'.
;;
;;;###autoload
(defun browse-kill-ring-edit-finish () ; Bound to `C-c C-c' in `browse-kill-ring-edit-mode-map'
"Commit the changes to the current selection 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; add to front? ")
(push (buffer-string) (symbol-value (browse-kill-ring-current-ring)))))
(bury-buffer)
(when (eq major-mode 'browse-kill-ring-mode) ; The user might have rearranged the windows
(browse-kill-ring-setup (current-buffer) browse-kill-ring-original-window nil
browse-kill-ring-original-window-config)
(browse-kill-ring-resize-window)))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Use `browse-kill-ring-current-ring', not `kill-ring'.
;; 2. Don't require `cl.el' - use local function `browse-kill-ring-remove-dups'.
;;
(defun browse-kill-ring-setup (bkr-buf window &optional regexp window-config)
"Set up buffer BKR-BUF as the selection-ring display buffer.
Turn on `browse-kill-ring-mode'.
Record `browse-kill-ring-original-window' and
`browse-kill-ring-original-window-config'.
Fill buffer with items from current selection ring, respecting REGEXP,
`browse-kill-ring-display-duplicates', and
`browse-kill-ring-display-style'."
(with-current-buffer bkr-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 ((items (mapcar (if browse-kill-ring-depropertize
#'browse-kill-ring-depropertize-string
#'copy-sequence)
(symbol-value (browse-kill-ring-current-ring))))
(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)))
(unless browse-kill-ring-display-duplicates
(setq items (browse-kill-ring-remove-dups items)))
(when (stringp regexp)
(setq items (delq nil (mapcar #'(lambda (item) (and (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* ((len (length (symbol-value browse-kill-ring-current-ring)))
(entry (if (= 1 len) "entry" "entries")))
(concat
(if (and (not regexp) browse-kill-ring-display-duplicates)
(format "%s %s in `%s'" len entry browse-kill-ring-current-ring)
(format "%s (of %s) %s in `%s' shown" (length items) len entry
browse-kill-ring-current-ring))
(substitute-command-keys " Use `\\[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 "Selection-Ring [" regexp "]")))
(run-hooks 'browse-kill-ring-hook)
(when (and (featurep 'xemacs) font-lock-mode)
(browse-kill-ring-fontify-region (point-min) (point-max)))))
(setq buffer-read-only t))))
;; REPLACES ORIGINAL in `browse-kill-ring.el'.
;;
;; 1. Added prefix arg.
;; 2. Added current ring name to name of buffer: *Selection Ring: `<NAME>'*.
;; 3. Choose right ring if buffer already in `browse-kill-ring-mode'.
;; 4. Use `browse-kill-ring-original-window' if already in `browse-kill-ring-mode'.
;; 5. Removed unused `let' binding of `orig-buf'.
;; 6. Message if ring is empty.
;; 7. Updated doc string to mention `browse-kill-ring-alternative-ring'.
;;
;;;###autoload
(defun browse-kill-ring (&optional other-ring-p)
"Browse the current selection ring.
With a prefix arg, browse the alternative selection ring instead.
\(If `browse-kill-ring-alternative-ring' is nil, then a prefix arg has
no effect.)"
(interactive "P")
(browse-kill-ring-current-ring) ; If a selection-ring buffer, use its ring by default.
;; Respect prefix arg to change to other ring, if there is one.
(when (and other-ring-p browse-kill-ring-alternative-ring)
(setq browse-kill-ring-current-ring (if (eq browse-kill-ring-current-ring 'kill-ring)
browse-kill-ring-alternative-ring
'kill-ring)))
(let ((bkr-buf (get-buffer-create (format "*Selection Ring: `%s'*"
browse-kill-ring-current-ring))))
;; $$$$$$ Should I do something special if only one selection in ring?
(unless (symbol-value browse-kill-ring-current-ring)
(message "`%s' is empty" browse-kill-ring-current-ring))
(browse-kill-ring-setup bkr-buf (if (eq major-mode 'browse-kill-ring-mode)
browse-kill-ring-original-window ; Keep same dest window.
(selected-window)))
(pop-to-buffer bkr-buf)
(select-frame-set-input-focus (window-frame (selected-window))) ; MS Windows workaround
(browse-kill-ring-resize-window))
nil)
;;;###autoload
(defun browse-kill-ring-switch-to-other-kill-ring () ; Bound to `o' in selection-ring buffer.
"Browse the other selection ring.
If the current ring is `kill-ring' then browse the alternative ring
\(e.g. `secondary-selection-ring'), and vice versa. The alternative
ring is the value of `browse-kill-ring-alternative-ring'."
(interactive)
(unless browse-kill-ring-alternative-ring (error "No alternative selection ring"))
(browse-kill-ring 'OTHER))
(defun browse-kill-ring-quit-deletes-window/frame ()
"Bury buffer. Delete window or, if dedicated, frame.
Useful as customized value of `browse-kill-ring-quit-action'."
(let ((buf (current-buffer))
(sole-window-p (eq (selected-window) (frame-root-window))))
(cond ((and sole-window-p (window-dedicated-p (selected-window)))
(delete-frame)
(bury-buffer buf))
(t
(unless sole-window-p (delete-window))
;; Avoid BUF as explicit arg to `bury-buffer', since we want to undisplay it.
(with-current-buffer buf (bury-buffer))))))
;;;###autoload
(defun toggle-browse-kill-ring-display-style () ; Bound to `t' in selection-ring buffer.
"Toggle browse-kill-ring-display-style between `separated' and `one-line'."
(interactive)
(setq browse-kill-ring-display-style (case browse-kill-ring-display-style
(separated 'one-line)
(otherwise 'separated)))
(browse-kill-ring)
(browse-kill-ring-update)
(message "Display style is now %s" (upcase (symbol-name browse-kill-ring-display-style))))
;;;###autoload
(defun browse-kill-ring-copy-to-other-ring (&optional movep) ; Bound to `c' in selection-ring buffer.
"Copy the selection at point from current selection ring to other ring.
With a prefix arg, move it instead of copying it.
If the other ring is also displayed, then its displayed is updated."
(interactive "P")
(forward-line 0)
(unwind-protect
(let* ((ov (browse-kill-ring-target-overlay-at (point)))
(seln (overlay-get ov 'browse-kill-ring-target)))
(setq buffer-read-only nil)
(when browse-kill-ring-depropertize
(setq seln (browse-kill-ring-depropertize-string seln)))
;; Add selection to the front of the other ring.
(if (eq 'kill-ring (browse-kill-ring-current-ring))
(funcall browse-kill-ring-alternative-push-function seln)
(kill-new seln))
(when movep ; Delete selection from this ring.
(delete-region (overlay-start ov) (1+ (overlay-end ov)))
(set browse-kill-ring-current-ring
(delete seln (symbol-value browse-kill-ring-current-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)
(let* ((other-ring (if (eq browse-kill-ring-current-ring 'kill-ring)
browse-kill-ring-alternative-ring
'kill-ring))
(other-buf (and other-ring (format "*Selection Ring: `%s'*" other-ring))))
(when (and other-buf (get-buffer-window other-buf 0))
(with-current-buffer other-buf (browse-kill-ring-update)))))
;;; ----------------------------------------------------
;;;
;;; Currently not used for anything.
;;; (defun browse-kill-ring-kill-number (pos)
;;; "Return the selection-ring index to use for this selection."
;;; (save-excursion
;;; (goto-char pos)
;;; (if (= (point-min) (previous-overlay-change (point)))
;;; 0
;;; (let ((count 1))
;;; (while (and (condition-case nil (progn (browse-kill-ring-forward -1) t) (error nil))
;;; (not (bobp)))
;;; (setq count (1+ count)))
;;; count))))
;;; Key Bindings
(browse-kill-ring-default-keybindings)
;;;;;;;;;;;;;;;;;;;;;
(provide 'browse-kill-ring+)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; browse-kill-ring+.el ends here