X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/deae888e00d26ee67beae8ec9ad2b30d31dbcd71..f3f4e600399fdd8bf0a23e50b7704825145fddc4:/lisp/select.el

diff --git a/lisp/select.el b/lisp/select.el
index d6a18fee70..9b711ee1d7 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -3,7 +3,8 @@
 ;; Maintainer: FSF
 ;; Keywords: internal
 
-;; Copyright (c) 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 ;; Based partially on earlier release by Lucid.
 
 ;; This file is part of GNU Emacs.
@@ -20,8 +21,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -35,7 +36,11 @@ The argument TYPE (default `PRIMARY') says which selection,
 and the argument DATA-TYPE (default `STRING') says
 how to convert the data.
 
-TYPE may be `SECONDARY' or `CLIPBOARD', in addition to `PRIMARY'.
+TYPE may be any symbol \(but nil stands for `PRIMARY').  However,
+only a few symbols are commonly used.  They conventionally have
+all upper-case names.  The most often used ones, in addition to
+`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
+
 DATA-TYPE is usually `STRING', but can also be one of the symbols
 in `selection-converter-alist', which see."
   (let ((data (x-get-selection-internal (or type 'PRIMARY)
@@ -57,9 +62,11 @@ in `selection-converter-alist', which see."
 
 (defun x-set-selection (type data)
   "Make an X Windows 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).
+The argument TYPE (nil means `PRIMARY') says which selection, and
+DATA specifies the contents.  TYPE must be a symbol.  \(It can also
+be a string, which stands for the symbol with that name, but this
+is considered obsolete.)  DATA may be a string, a symbol, an
+integer (or a cons of two integers or list of two integers).
 
 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
@@ -69,8 +76,11 @@ can alter the effective value of the selection.
 
 The data may also be a vector of valid non-vector selection values.
 
-Interactively, the text of the region is used as the selection value
-if the prefix arg is set."
+The return value is DATA.
+
+Interactively, this command sets the primary selection.  Without
+prefix argument, it reads the selection in the minibuffer.  With
+prefix argument, it uses the text of the region as the selection value ."
   (interactive (if (not current-prefix-arg)
 		   (list 'PRIMARY (read-string "Set text for pasting: "))
 		 (list 'PRIMARY (buffer-substring (region-beginning) (region-end)))))
@@ -142,6 +152,41 @@ Cut buffers are considered obsolete; you should use selections instead."
 ;;; Every selection type that Emacs handles is implemented this way, except
 ;;; for TIMESTAMP, which is a special case.
 
+(eval-when-compile (require 'ccl))
+
+(define-ccl-program ccl-check-utf-8
+  '(0
+    ((r0 = 1)
+     (loop
+      (read-if (r1 < #x80) (repeat)
+	((r0 = 0)
+	 (if (r1 < #xC2) (end))
+	 (read r2)
+	 (if ((r2 & #xC0) != #x80) (end))
+	 (if (r1 < #xE0) ((r0 = 1) (repeat)))
+	 (read r2)
+	 (if ((r2 & #xC0) != #x80) (end))
+	 (if (r1 < #xF0) ((r0 = 1) (repeat)))
+	 (read r2)
+	 (if ((r2 & #xC0) != #x80) (end))
+	 (if (r1 < #xF8) ((r0 = 1) (repeat)))
+	 (read r2)
+	 (if ((r2 & #xC0) != #x80) (end))
+	 (if (r1 == #xF8) ((r0 = 1) (repeat)))
+	 (end))))))
+  "Check if the input unibyte string is a valid UTF-8 sequence or not.
+If it is valid, set the register `r0' to 1, else set it to 0.")
+
+(defun string-utf-8-p (string)
+  "Return non-nil iff STRING is a unibyte string of valid UTF-8 sequence."
+  (if (or (not (stringp string))
+	  (multibyte-string-p string))
+      (error "Not a unibyte string: %s" string))
+  (let ((status (make-vector 9 0)))
+    (ccl-execute-on-string ccl-check-utf-8 status string)
+    (= (aref status 0) 1)))
+
+
 (defun xselect-convert-to-string (selection type value)
   (let (str coding)
     ;; Get the actual string from VALUE.
@@ -176,8 +221,8 @@ Cut buffers are considered obsolete; you should use selections instead."
 	(if coding
 	    (setq coding (coding-system-base coding))
 	  (setq coding 'raw-text))
-	;; Suppress producing escape sequences for compositions.
 	(let ((inhibit-read-only t))
+	  ;; Suppress producing escape sequences for compositions.
 	  (remove-text-properties 0 (length str) '(composition nil) str)
 	  (cond
 	   ((eq type 'TEXT)
@@ -213,8 +258,10 @@ Cut buffers are considered obsolete; you should use selections instead."
 	      (setq str (encode-coding-string str coding))))
 
 	   ((eq type 'UTF8_STRING)
-	    (setq str (encode-coding-string str 'utf-8)))
-
+	    (if (multibyte-string-p str)
+		(setq str (encode-coding-string str 'utf-8)))
+	    (if (not (string-utf-8-p str))
+		(setq str nil))) ;; Decline request as we don't have UTF-8 data.
 	   (t
 	    (error "Unknow selection type: %S" type))
 	   )))