Download
(defvar yank-window-start)
(defcustom secondary-selection-ring-max 60
"*Maximum length of `secondary-selection-ring'.
After the ring is maximally filled, adding a new element replaces the
oldest element."
:type 'integer :group 'killing)
(defcustom secondary-selection-yank-commands (if (boundp 'browse-kill-ring-yank-commands)
browse-kill-ring-yank-commands
'(yank icicle-yank-maybe-completing))
"*Commands that `yank-pop-commands' recognizes as yanking text."
:type '(repeat (restricted-sexp :match-alternatives (symbolp commandp) :value ignore))
:group 'killing)
(defcustom secondary-selection-yank-secondary-commands '(mouse-yank-secondary
secondary-dwim
yank-secondary)
"*Commands that yank the secondary selection."
:type '(repeat (restricted-sexp :match-alternatives (symbolp commandp) :value ignore))
:group 'killing)
(defvar secondary-selection-ring nil
"History of secondary selections, as a ring.")
(defvar secondary-selection-ring-yank-pointer nil
"A tail of the secondary selection ring. It indicates the current entry.
This is the tail whose car is the last secondary selection yanked.")
(unless (boundp 'yank-undo-function)
(defvar yank-undo-function nil
"If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
Function is called with two parameters, START and END corresponding to
the value of the mark and point; it is guaranteed that START <= END.
Normally set from the UNDO element of a yank-handler; see `insert-for-yank'."))
(defun secondary-dwim (arg)
"Do-What-I-Mean with the secondary selection.
Prefix arg:
None: Yank secondary.
Zero: Select secondary as region.
> 0: Move secondary to region.
< 0: Swap region and secondary.
Details:
No prefix arg: Yank the secondary selection at point. Move point to
the end of the inserted text. Leave mark where it was.
Zero arg: Select the secondary selection and pop to its buffer.
Non-zero arg: Move the secondary selection to this buffer's region.
Negative arg: Also go to where the secondary selection was and select
it as the region. That is, swap the region and the secondary
selection."
(interactive "P")
(cond (arg
(setq arg (prefix-numeric-value arg))
(cond ((> arg 0) (call-interactively #'primary-to-secondary))
((< arg 0) (call-interactively #'secondary-swap-region))
((= arg 0) (call-interactively #'secondary-to-primary))))
(t
(setq this-command 'yank-secondary)
(when delete-selection-mode (delete-selection-pre-hook))
(call-interactively #'yank-secondary))))
(defun yank-secondary (&optional arg)
"Insert the secondary selection at point.
Moves point to the end of the inserted text. Does not change mark.
Numeric prefix arg N means insert the Nth most recently yanked
secondary selection. Plain `C-u' is the same as N=1.
You can also use `M-y' after this command to yank previous secondary
selections. With no prefix arg, this always yanks the active
secondary selection (the one that is highlighted), not the last
selection yanked."
(interactive "*P")
(setq yank-window-start (window-start)
this-command t)
(push-mark (point))
(let ((sel (if arg
(current-secondary-selection (cond ((consp arg) 0)
((eq arg '-) -2)
(t (1- arg))))
(x-get-selection 'SECONDARY))))
(unless sel (error "No secondary selection"))
(funcall (if (fboundp 'insert-for-yank) 'insert-for-yank 'insert) sel))
(when (consp arg)
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))
(when (eq this-command t) (setq this-command 'yank-secondary))
nil)
(defun isearch-yank-secondary ()
"Yank string from secondary-selection ring into search string."
(interactive)
(isearch-yank-string (current-secondary-selection 0)))
(put 'yank-secondary 'delete-selection 'yank)
(defun primary-to-secondary (beg end)
"Make the region in the current buffer into the secondary selection.
Deactivate the region. Do not move the cursor."
(interactive "r")
(setq mouse-secondary-start (make-marker))
(set-marker mouse-secondary-start beg)
(if mouse-secondary-overlay
(move-overlay mouse-secondary-overlay beg end (current-buffer))
(setq mouse-secondary-overlay (make-overlay beg end (current-buffer)))
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))
(let ((sel (if (fboundp 'filter-buffer-substring)
(filter-buffer-substring beg end)
(buffer-substring beg end))))
(add-secondary-to-ring sel)
(x-set-selection 'SECONDARY sel))
(when (> beg end) (exchange-point-and-mark))
(setq mark-active nil))
(defun secondary-swap-region (beg end)
"Make the region into the secondary selection, and vice versa.
Pop to the buffer that has the secondary selection, and change it to
the region. Leave behind the secondary selection in place of the
original buffer's region."
(interactive "r")
(let ((osecondary (x-get-selection 'SECONDARY))
osec-buf osec-start osec-end)
(unless (and osecondary (overlayp mouse-secondary-overlay))
(error "No secondary selection"))
(setq osec-buf (overlay-buffer mouse-secondary-overlay)
osec-start (overlay-start mouse-secondary-overlay)
osec-end (overlay-end mouse-secondary-overlay))
(setq mouse-secondary-start (make-marker))
(set-marker mouse-secondary-start beg)
(if mouse-secondary-overlay
(move-overlay mouse-secondary-overlay beg end (current-buffer))
(setq mouse-secondary-overlay (make-overlay beg end (current-buffer)))
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))
(let ((sel (if (fboundp 'filter-buffer-substring)
(filter-buffer-substring beg end)
(buffer-substring beg end))))
(add-secondary-to-ring sel)
(x-set-selection 'SECONDARY sel))
(setq mark-active nil)
(x-set-selection 'PRIMARY osecondary)
(pop-to-buffer osec-buf)
(select-window (get-buffer-window (current-buffer)))
(select-frame-set-input-focus (window-frame (selected-window)))
(push-mark osec-start 'nomsg 'activate)
(goto-char osec-end)
(setq deactivate-mark nil)))
(defun secondary-to-primary ()
"Convert the secondary selection into the active region.
Select the secondary selection and pop to its buffer."
(interactive)
(let ((secondary (x-get-selection 'SECONDARY)))
(unless (and secondary (overlayp mouse-secondary-overlay))
(error "No secondary selection"))
(x-set-selection 'PRIMARY secondary))
(pop-to-buffer (overlay-buffer mouse-secondary-overlay))
(select-window (get-buffer-window (current-buffer)))
(select-frame-set-input-focus (window-frame (selected-window)))
(push-mark (overlay-start mouse-secondary-overlay) 'nomsg 'activate)
(goto-char (overlay-end mouse-secondary-overlay))
(setq deactivate-mark nil))
(defun add-secondary-to-ring (string &optional replace yank-handler)
"Make STRING the latest entry in the secondary selection ring.
Set `secondary-selection-ring-yank-pointer' to point to it.
Optional second argument REPLACE non-nil means that STRING will
replace the front of the secondary selection ring, rather than being
added separately to the ring.
Optional third argument YANK-HANDLER is used only for Emacs version 22
or later. It controls how the STRING is later inserted into a buffer;
see `insert-for-yank' for details. When a yank handler is specified,
STRING must be non-empty (the yank handler, if non-nil, is stored as a
`yank-handler' text property on STRING).
When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a useful string for such uses."
(if (> (length string) 0)
(when yank-handler (put-text-property 0 (length string) 'yank-handler
yank-handler string))
(when yank-handler
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
(if (and replace secondary-selection-ring)
(setcar secondary-selection-ring string)
(push string secondary-selection-ring)
(when (> (length secondary-selection-ring) secondary-selection-ring-max)
(setcdr (nthcdr (1- secondary-selection-ring-max) secondary-selection-ring) nil)))
(setq secondary-selection-ring-yank-pointer secondary-selection-ring))
(defun yank-pop-commands (&optional arg)
"`yank-pop' or `yank-pop-secondary', depending on previous command.
If previous command was a yank-secondary command, then
`yank-pop-secondary'.
Else if previous command was a yank command, then `yank-pop'.
Else if `browse-kill-ring' is defined, then `browse-kill-ring'.
If in a `browse-kill-ring' selection-ring buffer, then browse the
other selection ring.
Suggestion: Bind this command to `M-y'."
(interactive "p")
(when (fboundp 'browse-kill-ring)
(condition-case nil
(ad-disable-advice 'yank-pop 'around 'kill-ring-browse-maybe)
(error nil)))
(cond ((memq last-command secondary-selection-yank-secondary-commands)
(when buffer-read-only (error "Buffer is read-only: %S" (current-buffer)))
(yank-pop-secondary arg))
((memq last-command secondary-selection-yank-commands)
(when buffer-read-only (error "Buffer is read-only: %S" (current-buffer)))
(yank-pop arg))
((boundp 'browse-kill-ring-alternative-ring)
(let ((use-alt-ring-p (or current-prefix-arg
(eq major-mode 'browse-kill-ring-mode))))
(browse-kill-ring use-alt-ring-p)))
((fboundp 'browse-kill-ring) (browse-kill-ring))))
(defun yank-pop-secondary (&optional arg)
"Replace just-yanked secondary selection with a different one.
You can use this only immediately after a `yank-secondary' or a
`yank-pop-secondary'.
At such a time, the region contains a stretch of reinserted
previously-killed text. `yank-pop-secondary' deletes that text and
inserts in its place a different stretch of killed text.
With no prefix argument, inserts the previous secondary selection.
With argument N, inserts the Nth previous (or Nth next, if negative).
The ring of secondary selections wraps around.
This command honors `yank-excluded-properties' and `yank-handler'."
(interactive "*p")
(unless (memq last-command secondary-selection-yank-secondary-commands)
(error "Previous command did not yank secondary selection"))
(setq this-command 'yank-secondary)
(unless arg (setq arg 1))
(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) (current-buffer))
(funcall (if (fboundp 'insert-for-yank) 'insert-for-yank 'insert)
(current-secondary-selection arg))
(set-window-start (selected-window) yank-window-start t)
(when before
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer))))))
nil)
(defun current-secondary-selection (n &optional do-not-move)
"Rotate yanking point by N places, then return that secondary selection.
If optional arg DO-NOT-MOVE is non-nil, then don't actually
move the yanking point; just return the Nth kill forward."
(or secondary-selection-ring (error "No secondary selection"))
(let ((secondary-elt (nthcdr (mod (- n (length secondary-selection-ring-yank-pointer))
(length secondary-selection-ring))
secondary-selection-ring)))
(unless do-not-move (setq secondary-selection-ring-yank-pointer secondary-elt))
(car secondary-elt)))
(defun rotate-secondary-selection-yank-pointer (arg)
"Rotate the yanking point in the secondary selection ring.
With prefix arg, rotate that many kills forward or backward."
(interactive "p")
(current-secondary-selection arg))
(defun second-sel-msg ()
"Show message about new secondary selection state."
(message "Second sel%s" (let ((beg (overlay-start mouse-secondary-overlay))
(end (overlay-end mouse-secondary-overlay)))
(if (and beg end (/= beg end))
(format ": %d chars" (abs (- beg end)))
" STARTED"))))
(defadvice mouse-drag-secondary (after populate-secondary-ring activate)
"Add secondary selection to `secondary-selection-ring'."
(prog1
(and (overlayp mouse-secondary-overlay)
(overlay-buffer mouse-secondary-overlay)
(add-secondary-to-ring
(x-set-selection 'SECONDARY
(buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))))
(when (interactive-p) (second-sel-msg))))
(defun mouse-save-then-kill-delete-region (beg end &optional ring)
"Delete text from BEG to END. Put text on undo list, sharing with RING.
RING defaults to `kill-ring'."
(unless ring (setq ring kill-ring))
(undo-boundary)
(if (or (= beg end) (eq buffer-undo-list t))
(delete-region beg end)
(let ((before-change-functions nil)
(after-change-functions nil))
(delete-region beg (+ beg (if (> end beg) 1 -1))))
(let ((buffer-undo-list buffer-undo-list))
(let (before-change-functions after-change-functions)
(primitive-undo 1 buffer-undo-list))
(setq buffer-undo-list t)
(when (/= (length (car ring)) (- (max end beg) (min end beg)))
(error "Lossage in `mouse-save-then-kill-delete-region'"))
(delete-region beg end))
(let ((tail buffer-undo-list))
(while (and tail (not (stringp (caar tail))))
(setq tail (cdr tail)))
(and tail (setcar tail (cons (car ring) (min beg end))))))
(undo-boundary))
(defun set-secondary-start (&optional msgp)
"Set start of the secondary selection at point.
Interactively, or with non-nil optional arg MSGP, display a message."
(interactive "p")
(when mouse-secondary-overlay (delete-overlay mouse-secondary-overlay))
(unless mouse-secondary-start (setq mouse-secondary-start (make-marker)))
(move-marker mouse-secondary-start (point))
(if mouse-secondary-overlay
(move-overlay mouse-secondary-overlay (point) (point) (current-buffer))
(setq mouse-secondary-overlay (make-overlay (point) (point) (current-buffer)))
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))
(x-set-selection 'SECONDARY nil)
(when msgp (second-sel-msg)))
(defun mouse-secondary-save-then-kill (click &optional msgp)
"Set or delete the secondary selection according to CLICK.
Add the updated secondary selection to `secondary-selection-ring'.
CLICK should be a mouse click event.
Interactively, or with non-nil optional arg MSGP, display a message.
If the secondary selection already exists in the clicked buffer,
extend or retract the end that is closest to the CLICK position to
that position. But if you have set the selection start position by
double- or triple-clicking, then extend or retract to the nearest word
or line boundary instead of exactly to the CLICK position.
If there is no secondary selection in the clicked buffer, but you have
used `\\[mouse-start-secondary]' or `\\[set-secondary-start]' there to define the start
position, set the secondary selection between the CLICK position and
that start position.
Invoking this command (or `\\[secondary-save-then-kill]') in the same location
immediately after invoking it (or `\\[secondary-save-then-kill]') there deletes the
text of the secondary selection.
In all cases, add the selected text to `secondary-selection-ring', or
if it is already at the start of that ring, update it there."
(interactive "e\np")
(mouse-minibuffer-check click)
(let* ((position (event-start click))
(window (posn-window position))
(buffer (window-buffer window)))
(secondary-save-then-kill-1 (posn-point position) window buffer msgp)))
(defun secondary-save-then-kill (&optional position msgp)
"Same as `mouse-secondary-save-then-kill', but invoked without the mouse.
POSITION (point, if interactive) plays the click-position role.
Interactively, or with non-nil optional arg MSGP, display a message."
(interactive "d\np")
(secondary-save-then-kill-1 (or position (point)) (selected-window) (window-buffer) msgp))
(defvar secondary-selection-save-posn nil
"Like `mouse-save-then-kill-posn', but for `secondary-selection-ring'.")
(defun secondary-save-then-kill-1 (position win buf msgp)
"Helper for `(mouse-)secondary-save-then-kill'."
(unless position (setq position (point)))
(let ((this-command this-command)
(click-count (if (eq (overlay-buffer mouse-secondary-overlay) buf)
mouse-secondary-click-count
0))
(beg (overlay-start mouse-secondary-overlay))
(end (overlay-end mouse-secondary-overlay)))
(cond ((not (numberp position)) nil)
((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
(and mouse-secondary-start (marker-buffer mouse-secondary-start)))))
(select-window win)
(setq mouse-secondary-start (make-marker))
(move-marker mouse-secondary-start (point))
(move-overlay mouse-secondary-overlay (point) position buf)
(add-secondary-to-ring (buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))
t)
(when msgp (second-sel-msg)))
((and (memq last-command '(mouse-secondary-save-then-kill secondary-save-then-kill))
(eq position secondary-selection-save-posn)
(eq win (selected-window)))
(mouse-save-then-kill-delete-region beg end secondary-selection-ring)
(delete-overlay mouse-secondary-overlay)
(setq mouse-secondary-click-count 0
secondary-selection-save-posn nil)
(when msgp (message "Second sel DELETED: %d chars" (abs (- beg end)))))
((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
(let ((range (mouse-start-end position position click-count)))
(if (< (abs (- position beg)) (abs (- position end)))
(move-overlay mouse-secondary-overlay (car range) end)
(move-overlay mouse-secondary-overlay beg (nth 1 range))))
(add-secondary-to-ring (buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))
(memq last-command '(mouse-secondary-save-then-kill
secondary-save-then-kill)))
(setq secondary-selection-save-posn position)
(when msgp (second-sel-msg)))
(t
(select-window win)
(when mouse-secondary-start
(let ((start (+ 0 mouse-secondary-start)))
(move-overlay mouse-secondary-overlay start position)
(add-secondary-to-ring (buffer-substring mouse-secondary-start position))))
(setq secondary-selection-save-posn position)
(when msgp (second-sel-msg))))
(when (overlay-buffer mouse-secondary-overlay)
(let ((str (buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))))
(when (> (length str) 0) (x-set-selection 'SECONDARY str))))))
(provide 'second-sel)