If a list is provided, the types are tried in sequence until
there is a successful conversion.")
+(defvar selection-sets-clipboard nil
+ "Controls the selection's relationship to the clipboard.
+When non-nil, any operation that sets the primary selection will also
+set the clipboard.")
+
(defun copy-primary-selection ()
"Copy the selection to the Clipboard and the kill ring."
(interactive)
(defun yank-clipboard-selection ()
"Insert the current Clipboard selection at point."
(interactive "*")
- (case (device-type (selected-device))
- (x (x-yank-clipboard-selection))
- (mswindows (mswindows-paste-clipboard))
- (otherwise nil)))
+ (when (console-on-window-system-p)
+ (setq last-command nil)
+ (setq this-command 'yank) ; so that yank-pop works.
+ (let ((clip (get-clipboard)))
+ (or clip (error "there is no clipboard selection"))
+ (push-mark)
+ (insert clip))))
+
+(defun get-clipboard ()
+ "Return text pasted to the clipboard."
+ (get-selection 'CLIPBOARD))
(define-device-method get-cutbuffer
"Return the value of one of the cut buffers.
This will do nothing under anything other than X.")
+(defun get-selection-no-error (&optional type data-type)
+ "Return the value of a window-system selection.
+The argument TYPE (default `PRIMARY') says which selection,
+and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
+says how to convert the data. Returns NIL if there is no selection"
+ (condition-case err (get-selection type data-type) (t nil)))
+
(defun get-selection (&optional type data-type)
- "Return the value of a Windows selection.
+ "Return the value of a window-system selection.
The argument TYPE (default `PRIMARY') says which selection,
and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
-says how to convert the data."
+says how to convert the data. If there is no selection an error is signalled."
(or type (setq type 'PRIMARY))
(or data-type (setq data-type selected-text-type))
(let ((text
text))
;; FSFmacs calls this `x-set-selection', and reverses the
-;; arguments (duh ...). This order is more logical.
-(defun own-selection (data &optional type)
- "Make an Windows selection of type TYPE and value DATA.
+;; first two arguments (duh ...). This order is more logical.
+(defun own-selection (data &optional type append)
+ "Make a window-system selection of type TYPE and value DATA.
The argument TYPE (default `PRIMARY') says which selection,
and DATA specifies the contents. DATA may be a string,
a symbol, an integer (or a cons of two integers or list of two integers).
+If APPEND is non-nil, append the data to the existing selection data.
The selection may also be a cons of two markers pointing to the same buffer,
or an overlay. In these cases, the selection is considered to be the text
(interactive (if (not current-prefix-arg)
(list (read-string "Store text for pasting: "))
(list (substring (region-beginning) (region-end)))))
- ;FSFmacs huh?? It says:
- ;; "This is for temporary compatibility with pre-release Emacs 19."
- ;(if (stringp type)
- ; (setq type (intern type)))
- (or (valid-simple-selection-p data)
- (and (vectorp data)
- (let ((valid t)
- (i (1- (length data))))
- (while (>= i 0)
- (or (valid-simple-selection-p (aref data i))
- (setq valid nil))
- (setq i (1- i)))
- valid))
- (signal 'error (list "invalid selection" data)))
- (or type (setq type 'PRIMARY))
- (if data
- (own-selection-internal type data)
- (disown-selection-internal type))
- (cond ((eq type 'PRIMARY)
- (setq primary-selection-extent
- (select-make-extent-for-selection
- data primary-selection-extent)))
- ((eq type 'SECONDARY)
- (setq secondary-selection-extent
- (select-make-extent-for-selection
- data secondary-selection-extent))))
- (setq zmacs-region-stays t)
+ ;; calling own-selection-internal will mess this up, so preserve it.
+ (let ((zmacs-region-stays zmacs-region-stays))
+ ;FSFmacs huh?? It says:
+ ;; "This is for temporary compatibility with pre-release Emacs 19."
+ ;(if (stringp type)
+ ; (setq type (intern type)))
+ (or (valid-simple-selection-p data)
+ (and (vectorp data)
+ (let ((valid t)
+ (i (1- (length data))))
+ (while (>= i 0)
+ (or (valid-simple-selection-p (aref data i))
+ (setq valid nil))
+ (setq i (1- i)))
+ valid))
+ (signal 'error (list "invalid selection" data)))
+ (or type (setq type 'PRIMARY))
+ (flet ((own-selection-1
+ (type data append)
+ (when append
+ (unless (stringp data)
+ ;; kludge!
+ (setq data (select-convert-to-text type 'STRING data))
+ (if (stringp data)
+ (setq data (concat (get-selection type) data)))))
+ (own-selection-internal type data)))
+ (if (null data)
+ (disown-selection-internal type)
+ (own-selection-1 type data append)
+ (when (and (eq type 'PRIMARY)
+ selection-sets-clipboard)
+ (own-selection-internal 'CLIPBOARD data append))))
+ (cond ((eq type 'PRIMARY)
+ (setq primary-selection-extent
+ (select-make-extent-for-selection
+ data primary-selection-extent)))
+ ((eq type 'SECONDARY)
+ (setq secondary-selection-extent
+ (select-make-extent-for-selection
+ data secondary-selection-extent)))))
+ ;; zmacs-region-stays is for commands, not low-level functions.
+ ;; when behaving as the latter, we better not set it, or we will
+ ;; cause unwanted sticky-region behavior in kill-region and friends.
+ (if (interactive-p)
+ (setq zmacs-region-stays t))
data)
(defun dehilight-selection (selection)
(setq lost-selection-hooks 'dehilight-selection)
-(defun own-clipboard (string)
- "Paste the given string to the X Clipboard."
+(defun own-clipboard (string &optional append)
+ "Paste the given string to the window system Clipboard.
+If APPEND is non-nil, append the string to the existing contents."
(own-selection string 'CLIPBOARD))
(defun disown-selection (&optional secondary-p)
"Assuming we own the selection, disown it. With an argument, discard the
secondary selection instead of the primary selection."
- (disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)))
+ (disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))
+ (when (and selection-sets-clipboard
+ (or (not secondary-p)
+ (eq secondary-p 'PRIMARY)
+ (eq secondary-p 'CLIPBOARD)))
+ (disown-selection-internal 'CLIPBOARD)))
;; from x-init.el
;; selections and active regions