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