(x-select-request-type): New variable.

(x-select-utf8-or-ctext): New function.
(x-selection-value): New function.
(x-cut-buffer-or-selection-value): Call x-selection-value to get
a selection data.  Set next-selection-coding-system to nil.

1 files changed, 104 insertions, 18 deletions

diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index e49836f0c2b..ac5d14d114d 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2138,6 +2138,105 @@ This is in addition to, but in preference to, the primary selection."
     (setq x-last-selected-text-clipboard text))
   )
 
+(defvar x-select-request-type nil
+  "*Data type request for X selection.
+The value is nil, one of the following data types, or a list of them:
+  `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
+
+If the value is nil, try `COMPOUND_TEXT' and `UTF8_STRING', and
+use the more appropriate result.  If both fail, try `STRING', and
+then `TEXT'.
+
+If the value is one of the above symbols, try only the specified
+type.
+
+If the value is a list of them, try each of them in the specified
+order until succeed.")
+
+;; Helper function for x-selection-value.  Select UTF8 or CTEXT
+;; whichever is more appropriate.  Here, we use this heurisitcs.
+;;
+;;   (1) If their lengthes are different, select the longer one.  This
+;;   is because an X client may just cut off unsupported characters.
+;;
+;;   (2) Otherwise, if the Nth character of CTEXT is an ASCII
+;;   character that is different from the Nth character of UTF8,
+;;   select UTF8.  This is because an X client may replace unsupported
+;;   characters with some ASCII character (typically ` ' or `?') in
+;;   CTEXT.
+;;
+;;   (3) Otherwise, select CTEXT.  This is because legacy charsets are
+;;   better for the current Emacs, especially when the selection owner
+;;   is also Emacs.
+
+(defun x-select-utf8-or-ctext (utf8 ctext)
+  (let ((len-utf8 (length utf8))
+	(len-ctext (length ctext))
+	(selected ctext)
+	(i 0)
+	char)
+    (if (/= len-utf8 len-ctext)
+	(if (> len-utf8 len-ctext) utf8 ctext)
+      (while (< i len-utf8)
+	(setq char (aref ctext i))
+	(if (and (< char 128) (/= char (aref utf8 i)))
+	    (setq selected utf8
+		  i len-utf8)
+	  (setq i (1+ i))))
+      selected)))
+
+(defun x-selection-value (type)
+  (let (text)
+    (cond ((null x-select-request-type)
+	   (let (utf8 ctext utf8-coding)
+	     ;; We try both UTF8_STRING and COMPOUND_TEXT, and choose
+	     ;; the more appropriate one.  If both fail, try STRING.
+
+	     ;; At first try UTF8_STRING.
+	     (setq utf8 (condition-case nil
+			    (x-get-selection type 'UTF8_STRING)
+			  (error nil))
+		   utf8-coding last-coding-system-used)
+	     (if utf8
+		 ;; If it is a locale selection, choose it.
+		 (or (get-text-property 0 'foreign-selection utf8)
+		     (setq text utf8)))
+	     ;; If not yet decided, try COMPOUND_TEXT.
+	     (if (not text)
+		 (if (setq ctext (condition-case nil
+				     (x-get-selection type 'COMPOUND_TEXT)
+				   (error nil)))
+		     ;; If UTF8_STRING was also successful, choose the
+		     ;; more appropriate one from UTF8 and CTEXT.
+		     (if utf8
+			 (setq text (x-select-utf8-or-ctext utf8 ctext))
+		       ;; Othewise, choose CTEXT.
+		       (setq text ctext))))
+	     ;; If not yet decided, try STRING.
+	     (or text
+		 (setq text (condition-case nil
+				(x-get-selection type 'STRING)
+			      (error nil))))
+	     (if (eq text utf8)
+		 (setq last-coding-system-used utf8-coding))))
+
+	  ((consp x-select-request-type)
+	   (let ((tail x-select-request-type))
+	     (while (and tail (not text))
+	       (condition-case nil
+		   (setq text (x-get-selection type (car tail)))
+		 (error nil))
+	       (setq tail (cdr tail)))))
+
+	  (t
+	   (condition-case nil
+	       (setq text (x-get-selection type x-select-request-type))
+	     (error nil))))
+
+    (if text
+	(remove-text-properties 0 (length text) '(foreign-selection nil) text))
+    text))
+      
 ;;; Return the value of the current X selection.
 ;;; Consult the selection, and the cut buffer.  Treat empty strings
 ;;; as if they were unset.
@@ -2147,15 +2246,7 @@ This is in addition to, but in preference to, the primary selection."
 (defun x-cut-buffer-or-selection-value ()
   (let (clip-text primary-text cut-text)
     (when x-select-enable-clipboard
-      ;; Don't die if x-get-selection signals an error.
-      (if (null clip-text)
-	  (condition-case c
-	      (setq clip-text (x-get-selection 'CLIPBOARD 'COMPOUND_TEXT))
-	    (error nil)))
-      (if (null clip-text)
-	  (condition-case c
-	      (setq clip-text (x-get-selection 'CLIPBOARD 'STRING))
-	    (error nil)))
+      (setq clip-text (x-selection-value 'CLIPBOARD))
       (if (string= clip-text "") (setq clip-text nil))
 
       ;; Check the CLIPBOARD selection for 'newness', is it different
@@ -2175,15 +2266,7 @@ This is in addition to, but in preference to, the primary selection."
 	      (setq x-last-selected-text-clipboard clip-text))))
       )
 
-    ;; Don't die if x-get-selection signals an error.
-    (if (null primary-text)
-	(condition-case c
-	    (setq primary-text (x-get-selection 'PRIMARY 'COMPOUND_TEXT))
-	  (error nil)))
-    (if (null primary-text)
-	(condition-case c
-	    (setq primary-text (x-get-selection 'PRIMARY 'STRING))
-	  (error nil)))
+    (setq primary-text (x-selection-value 'PRIMARY))
     ;; Check the PRIMARY selection for 'newness', is it different
     ;; from what we remebered them to be last time we did a
     ;; cut/paste operation.
@@ -2218,6 +2301,9 @@ This is in addition to, but in preference to, the primary selection."
      (t
 	    (setq x-last-selected-text-cut cut-text))))
 
+    ;; As we have done one selection, clear this now.
+    (setq next-selection-coding-system nil)
+
     ;; At this point we have recorded the current values for the
     ;; selection from clipboard (if we are supposed to) primary,
     ;; and cut buffer.  So return the first one that has changed