aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2007-11-18 09:12:14 +0000
committerKenichi Handa2007-11-18 09:12:14 +0000
commit502597985dd9803c03f74fb08071b0a5f3e1e02a (patch)
treede10f96a15f49430ac51121fb3034f465af2dcdb
parent82e0280c804d3d762af1b5ecae3a61b85c1c5d9e (diff)
downloademacs-502597985dd9803c03f74fb08071b0a5f3e1e02a.tar.gz
emacs-502597985dd9803c03f74fb08071b0a5f3e1e02a.zip
(selection-coding-system)
(next-selection-coding-system): Declaration moded from xselect.c. (x-get-selection): Decode by selection-coding-system if it is non-nil. If it is nil, decode by a proper coding system. Handle C_STRING. (ccl-check-utf-8, string-utf-8-p): Delete them. (xselect-convert-to-string): Fix determining data-type in the case that TEXT is requested. Don't use selection-coding-system if it's not proper for the data-type.
-rw-r--r--lisp/select.el174
1 files changed, 91 insertions, 83 deletions
diff --git a/lisp/select.el b/lisp/select.el
index 60259142522..14e53f75daa 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -28,6 +28,37 @@
28 28
29;;; Code: 29;;; Code:
30 30
31(defvar selection-coding-system nil
32 "Coding system for communicating with other X clients.
33
34When sending text via selection and clipboard, if the target
35data-type matches with the type of this coding system, it is used
36for encoding the text. Otherwise (including the case that this
37variable is nil), a proper coding system is used as below:
38
39data-type coding system
40--------- -------------
41UTF8_STRING utf-8
42COMPOUND_TEXT compound-text-with-extensions
43STRING iso-latin-1
44C_STRING no-conversion
45
46When receiving text, if this coding system is non-nil, it is used
47for decoding regardless of the data-type. If this is nil, a
48proper coding system is used according to the data-type as above.
49
50See also the documentation of the variable `x-select-request-type' how
51to control which data-type to request for receiving text.
52
53The default value is nil.")
54
55(defvar next-selection-coding-system nil
56 "Coding system for the next communication with other X clients.
57Usually, `selection-coding-system' is used for communicating with
58other X clients. But, if this variable is set, it is used for
59the next communication only. After the communication, this
60variable is set to nil.")
61
31;; This is for temporary compatibility with pre-release Emacs 19. 62;; This is for temporary compatibility with pre-release Emacs 19.
32(defalias 'x-selection 'x-get-selection) 63(defalias 'x-selection 'x-get-selection)
33(defun x-get-selection (&optional type data-type) 64(defun x-get-selection (&optional type data-type)
@@ -48,11 +79,21 @@ in `selection-converter-alist', which see."
48 coding) 79 coding)
49 (when (and (stringp data) 80 (when (and (stringp data)
50 (setq data-type (get-text-property 0 'foreign-selection data))) 81 (setq data-type (get-text-property 0 'foreign-selection data)))
51 (setq coding (if (eq data-type 'UTF8_STRING) 82 (setq coding (or next-selection-coding-system
52 'utf-8 83 selection-coding-system
53 (or next-selection-coding-system 84 (cond ((eq data-type 'UTF8_STRING)
54 selection-coding-system)) 85 'utf-8)
55 data (decode-coding-string data coding)) 86 ((eq data-type 'COMPOUND-TEXT)
87 'compound-text-with-extensions)
88 ((eq data-type 'C_STRING)
89 nil)
90 ((eq data-type 'STRING)
91 'iso-8859-1)
92 (t
93 (error "Unknow selection data type: %S" type))))
94 data (if coding (decode-coding-string data coding)
95 (string-to-multibyte data)))
96 (setq next-selection-coding-system nil)
56 (put-text-property 0 (length data) 'foreign-selection data-type data)) 97 (put-text-property 0 (length data) 'foreign-selection data-type data))
57 data)) 98 data))
58 99
@@ -152,41 +193,6 @@ Cut buffers are considered obsolete; you should use selections instead."
152;;; Every selection type that Emacs handles is implemented this way, except 193;;; Every selection type that Emacs handles is implemented this way, except
153;;; for TIMESTAMP, which is a special case. 194;;; for TIMESTAMP, which is a special case.
154 195
155(eval-when-compile (require 'ccl))
156
157(define-ccl-program ccl-check-utf-8
158 '(0
159 ((r0 = 1)
160 (loop
161 (read-if (r1 < #x80) (repeat)
162 ((r0 = 0)
163 (if (r1 < #xC2) (end))
164 (read r2)
165 (if ((r2 & #xC0) != #x80) (end))
166 (if (r1 < #xE0) ((r0 = 1) (repeat)))
167 (read r2)
168 (if ((r2 & #xC0) != #x80) (end))
169 (if (r1 < #xF0) ((r0 = 1) (repeat)))
170 (read r2)
171 (if ((r2 & #xC0) != #x80) (end))
172 (if (r1 < #xF8) ((r0 = 1) (repeat)))
173 (read r2)
174 (if ((r2 & #xC0) != #x80) (end))
175 (if (r1 == #xF8) ((r0 = 1) (repeat)))
176 (end))))))
177 "Check if the input unibyte string is a valid UTF-8 sequence or not.
178If it is valid, set the register `r0' to 1, else set it to 0.")
179
180(defun string-utf-8-p (string)
181 "Return non-nil if STRING is a unibyte string of valid UTF-8 sequence."
182 (if (or (not (stringp string))
183 (multibyte-string-p string))
184 (error "Not a unibyte string: %s" string))
185 (let ((status (make-vector 9 0)))
186 (ccl-execute-on-string ccl-check-utf-8 status string)
187 (= (aref status 0) 1)))
188
189
190(defun xselect-convert-to-string (selection type value) 196(defun xselect-convert-to-string (selection type value)
191 (let (str coding) 197 (let (str coding)
192 ;; Get the actual string from VALUE. 198 ;; Get the actual string from VALUE.
@@ -219,52 +225,54 @@ If it is valid, set the register `r0' to 1, else set it to 0.")
219 str 225 str
220 (setq coding (or next-selection-coding-system selection-coding-system)) 226 (setq coding (or next-selection-coding-system selection-coding-system))
221 (if coding 227 (if coding
222 (setq coding (coding-system-base coding)) 228 (setq coding (coding-system-base coding)))
223 (setq coding 'raw-text))
224 (let ((inhibit-read-only t)) 229 (let ((inhibit-read-only t))
225 ;; Suppress producing escape sequences for compositions. 230 ;; Suppress producing escape sequences for compositions.
226 (remove-text-properties 0 (length str) '(composition nil) str) 231 (remove-text-properties 0 (length str) '(composition nil) str)
227 (cond 232 (if (not (multibyte-string-p str))
228 ((eq type 'TEXT) 233 ;; Don't have to encode unibyte string.
229 (if (not (multibyte-string-p str)) 234 (setq type 'C_STRING)
230 ;; Don't have to encode unibyte string. 235 (if (eq type 'TEXT)
231 (setq type 'STRING) 236 ;; TEXT is a polimorphic target. We must select the
232 ;; If STR contains only ASCII, Latin-1, and raw bytes, 237 ;; actual type from `UTF8_STRING', `COMPOUND_TEXT',
233 ;; encode STR by iso-latin-1, and return it as type 238 ;; `STRING', and `C_STRING'.
234 ;; `STRING'. Otherwise, encode STR by CODING. In that 239 (let (non-latin-1 non-unicode eight-bit)
235 ;; case, the returing type depends on CODING. 240 (mapc #'(lambda (x)
236 (let ((charsets (find-charset-string str))) 241 (if (>= x #x100)
237 (setq charsets 242 (if (< x #x110000)
238 (delq 'ascii 243 (setq non-latin-1 t)
239 (delq 'latin-iso8859-1 244 (if (< x #x3FFF80)
240 (delq 'eight-bit-control 245 (setq non-unicode t)
241 (delq 'eight-bit-graphic charsets))))) 246 (setq eight-bit t)))))
242 (if charsets 247 str)
243 (setq str (encode-coding-string str coding) 248 (setq type (if non-unicode 'COMPOUND_TEXT
244 type (if (memq coding '(compound-text 249 (if non-latin-1 'UTF8_STRING
245 compound-text-with-extensions)) 250 (if eight-bit 'C_STRING 'STRING))))))
246 'COMPOUND_TEXT 251 (cond
247 'STRING)) 252 ((eq type 'UTF8_STRING)
248 (setq type 'STRING 253 (if (or (not coding)
249 str (encode-coding-string str 'iso-latin-1)))))) 254 (not (eq (coding-system-type coding) 'utf-8)))
250 255 (setq coding 'utf-8))
251 ((eq type 'COMPOUND_TEXT) 256 (setq str (encode-coding-string str coding)))
252 (setq str (encode-coding-string str coding))) 257
253 258 ((eq type 'STRING)
254 ((eq type 'STRING) 259 (if (or (not coding)
255 (if (memq coding '(compound-text 260 (not (eq (coding-system-type coding) 'charset)))
256 compound-text-with-extensions)) 261 (setq coding 'iso-8859-1))
257 (setq str (string-make-unibyte str)) 262 (setq str (encode-coding-string str coding)))
258 (setq str (encode-coding-string str coding)))) 263
259 264 ((eq type 'COMPOUND_TEXT)
260 ((eq type 'UTF8_STRING) 265 (if (or (not coding)
261 (if (multibyte-string-p str) 266 (not (eq (coding-system-type coding) 'iso-2022)))
262 (setq str (encode-coding-string str 'utf-8))) 267 (setq coding 'compound-text-with-extensions))
263 (if (not (string-utf-8-p str)) 268 (setq str (encode-coding-string str coding)))
264 (setq str nil))) ;; Decline request as we don't have UTF-8 data. 269
265 (t 270 ((eq type 'C_STRING)
266 (error "Unknow selection type: %S" type)) 271 (setq str (string-make-unibyte str)))
267 ))) 272
273 (t
274 (error "Unknow selection type: %S" type))
275 ))))
268 276
269 (setq next-selection-coding-system nil) 277 (setq next-selection-coding-system nil)
270 (cons type str)))) 278 (cons type str))))