This commit was manufactured by cvs2svn to create branch 'XEmacs-21_4'.

[chise/xemacs-chise.git.1] / lisp / select.el

diff --git a/lisp/select.el b/lisp/select.el
index 338ea0c..ef3072e 100644 (file)
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -40,7 +40,7 @@ COMPOUND_TEXT and STRING are the most commonly used data types.
 If a list is provided, the types are tried in sequence until
 there is a successful conversion.")
 
-(defvar selection-is-clipboard-p nil 
+(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.")
@@ -66,30 +66,34 @@ set the clipboard.")
 (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 (&optional type data-type)
+(defun get-selection-no-error (&optional type data-type)
   "Return the value of a Windows 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. If there is no selection an error is signalled."
-  (let ((text (get-selection-no-error type data-type)))
-    (when (not (stringp text))
-      (error "Selection is not a string: %S" text))
-    text))
+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-no-error (&optional type data-type)
+(defun get-selection (&optional type data-type)
   "Return the value of a Windows 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"
+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
@@ -103,6 +107,8 @@ says how to convert the data. Returns NIL if there is no selection"
           (get-selection-internal type data-type))))
     (when (and (consp text) (symbolp (car text)))
       (setq text (cdr text)))
+    (when (not (stringp text))
+      (error "Selection is not a string: %S" text))
     text))
 
 ;; FSFmacs calls this `x-set-selection', and reverses the
@@ -144,7 +150,7 @@ Interactively, the text of the region is used as the selection value."
       (disown-selection-internal type)
     (own-selection-internal type data)
     (when (and (eq type 'PRIMARY)
-              selection-is-clipboard-p)
+              selection-sets-clipboard)
       (own-selection-internal 'CLIPBOARD data)))
   (cond ((eq type 'PRIMARY)
         (setq primary-selection-extent
@@ -179,13 +185,18 @@ Interactively, the text of the region is used as the selection value."
 (setq lost-selection-hooks 'dehilight-selection)
 
 (defun own-clipboard (string)
-  "Paste the given string to the X Clipboard."
+  "Paste the given string to the window system Clipboard."
   (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