diff options
| author | Jan Djärv | 2006-10-19 07:16:27 +0000 |
|---|---|---|
| committer | Jan Djärv | 2006-10-19 07:16:27 +0000 |
| commit | 1df04e22ca58fe4051743a16d2ddf46ba4283c08 (patch) | |
| tree | b6a55cc3bd810048fe9bf4a0d58dd7db029ecd09 | |
| parent | 2a28cace3d899e9b3d4a547fee3fde6e80e1eb12 (diff) | |
| download | emacs-1df04e22ca58fe4051743a16d2ddf46ba4283c08.tar.gz emacs-1df04e22ca58fe4051743a16d2ddf46ba4283c08.zip | |
* select.el (ccl-check-utf-8, string-utf-8-p): New functions
(by Kenichi Handa).
(xselect-convert-to-string): Decline requests for UTF8_STRING if
the selection is not UTF-8.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/select.el | 44 |
2 files changed, 46 insertions, 5 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 89a00314048..ef70b48a191 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2006-10-19 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> | ||
| 2 | |||
| 3 | * select.el (ccl-check-utf-8, string-utf-8-p): New functions | ||
| 4 | (by Kenichi Handa). | ||
| 5 | (xselect-convert-to-string): Decline requests for UTF8_STRING if | ||
| 6 | the selection is not UTF-8. | ||
| 7 | |||
| 1 | 2006-10-18 Juanma Barranquero <lekktu@gmail.com> | 8 | 2006-10-18 Juanma Barranquero <lekktu@gmail.com> |
| 2 | 9 | ||
| 3 | * progmodes/ada-mode.el (ada-83-string-keywords) | 10 | * progmodes/ada-mode.el (ada-83-string-keywords) |
diff --git a/lisp/select.el b/lisp/select.el index cbdeaf12fe3..9b711ee1d7f 100644 --- a/lisp/select.el +++ b/lisp/select.el | |||
| @@ -152,6 +152,41 @@ Cut buffers are considered obsolete; you should use selections instead." | |||
| 152 | ;;; Every selection type that Emacs handles is implemented this way, except | 152 | ;;; Every selection type that Emacs handles is implemented this way, except |
| 153 | ;;; for TIMESTAMP, which is a special case. | 153 | ;;; for TIMESTAMP, which is a special case. |
| 154 | 154 | ||
| 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. | ||
| 178 | If 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 iff 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 | |||
| 155 | (defun xselect-convert-to-string (selection type value) | 190 | (defun xselect-convert-to-string (selection type value) |
| 156 | (let (str coding) | 191 | (let (str coding) |
| 157 | ;; Get the actual string from VALUE. | 192 | ;; Get the actual string from VALUE. |
| @@ -223,11 +258,10 @@ Cut buffers are considered obsolete; you should use selections instead." | |||
| 223 | (setq str (encode-coding-string str coding)))) | 258 | (setq str (encode-coding-string str coding)))) |
| 224 | 259 | ||
| 225 | ((eq type 'UTF8_STRING) | 260 | ((eq type 'UTF8_STRING) |
| 226 | (let ((charsets (find-charset-string str))) | 261 | (if (multibyte-string-p str) |
| 227 | (if (or (memq 'eight-bit-control charsets) | 262 | (setq str (encode-coding-string str 'utf-8))) |
| 228 | (memq 'eight-bit-graphic charsets)) | 263 | (if (not (string-utf-8-p str)) |
| 229 | (setq type 'STRING) | 264 | (setq str nil))) ;; Decline request as we don't have UTF-8 data. |
| 230 | (setq str (encode-coding-string str 'utf-8))))) | ||
| 231 | (t | 265 | (t |
| 232 | (error "Unknow selection type: %S" type)) | 266 | (error "Unknow selection type: %S" type)) |
| 233 | ))) | 267 | ))) |