Mercurial > hg > xemacs-beta
diff lisp/select.el @ 286:57709be46d1b r21-0b41
Import from CVS: tag r21-0b41
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:35:03 +0200 |
parents | 558f606b08ae |
children | 3cc9f0ebfbd1 |
line wrap: on
line diff
--- a/lisp/select.el Mon Aug 13 10:34:15 2007 +0200 +++ b/lisp/select.el Mon Aug 13 10:35:03 2007 +0200 @@ -35,26 +35,20 @@ (defun copy-primary-selection () "Copy the selection to the Clipboard and the kill ring." (interactive) - (case (device-type (selected-device)) - (x (x-copy-primary-selection)) - (mswindows (mswindows-copy-clipboard)) - (otherwise nil))) + (and (console-on-window-system-p) + (cut-copy-clear-internal 'copy))) (defun kill-primary-selection () "Copy the selection to the Clipboard and the kill ring, then delete it." (interactive "*") - (case (device-type (selected-device)) - (x (x-kill-primary-selection)) - (mswindows (mswindows-cut-clipboard)) - (otherwise nil))) + (and (console-on-window-system-p) + (cut-copy-clear-internal 'cut))) (defun delete-primary-selection () "Delete the selection without copying it to the Clipboard or the kill ring." (interactive "*") - (case (device-type (selected-device)) - (x (x-delete-primary-selection)) - (mswindows (mswindows-clear-clipboard)) - (otherwise nil))) + (and (console-on-window-system-p) + (cut-copy-clear-internal 'clear))) (defun yank-clipboard-selection () "Insert the current Clipboard selection at point." @@ -85,7 +79,7 @@ (interactive) (case (device-type (selected-device)) (x (x-selection-exists-p selection)) - (mswindows t) + (mswindows (mswindows-selection-exists-p)) (otherwise nil))) (defun own-selection (data &optional type) @@ -111,6 +105,13 @@ (mswindows (mswindows-own-selection data type)) (otherwise nil))) +(defun own-clipboard (string) + "Paste the given string to the Clipboard." + (case (device-type (selected-device)) + (x (x-own-clipboard string)) + (mswindows (mswindows-own-clipboard string)) + (otherwise nil))) + (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." @@ -119,6 +120,7 @@ (mswindows (mswindows-disown-selection secondary-p)) (otherwise nil))) + ;; from x-init.el ;; selections and active regions @@ -229,4 +231,46 @@ (buffer-live-p (marker-buffer (car data))) (buffer-live-p (marker-buffer (cdr data)))))) +(defun cut-copy-clear-internal (mode) + (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) + (or (selection-owner-p) + (error "emacs does not own the primary selection")) + (setq last-command nil) + (or primary-selection-extent + (error "the primary selection is not an extent?")) + (save-excursion + (let (rect-p b s e) + (cond + ((consp primary-selection-extent) + (setq rect-p t + b (extent-object (car primary-selection-extent)) + s (extent-start-position (car primary-selection-extent)) + e (extent-end-position (car (reverse primary-selection-extent))))) + (t + (setq rect-p nil + b (extent-object primary-selection-extent) + s (extent-start-position primary-selection-extent) + e (extent-end-position primary-selection-extent)))) + (set-buffer b) + (cond ((memq mode '(cut copy)) + (if rect-p + (progn + ;; why is killed-rectangle free? Is it used somewhere? + ;; should it be defvarred? + (setq killed-rectangle (extract-rectangle s e)) + (kill-new (mapconcat 'identity killed-rectangle "\n"))) + (copy-region-as-kill s e)) + ;; Maybe killing doesn't own clipboard. Make sure it happens. + ;; This memq is kind of grody, because they might have done it + ;; some other way, but owning the clipboard twice in that case + ;; wouldn't actually hurt anything. + (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks)) + (own-clipboard (car kill-ring))))) + (cond ((memq mode '(cut clear)) + (if rect-p + (delete-rectangle s e) + (delete-region s e)))) + (disown-selection nil) + ))) + ;;; select.el ends here