comparison lisp/unicode.el @ 4083:a3f8bb07ab38

[xemacs-hg @ 2007-07-28 08:02:15 by aidan] Make ccl-encode-to-ucs-2 more robust.
author aidan
date Sat, 28 Jul 2007 08:02:16 +0000
parents aa28d959af41
children 1abf84db2c7f
comparison
equal deleted inserted replaced
4082:232b07b6d09c 4083:a3f8bb07ab38
39 ;; spirit and the letter of standard ISO 2022 character sets. Instead of 39 ;; spirit and the letter of standard ISO 2022 character sets. Instead of
40 ;; this, we have the jit-ucs-charset-N Mule character sets, created in 40 ;; this, we have the jit-ucs-charset-N Mule character sets, created in
41 ;; unicode.c on encountering a Unicode code point that we don't recognise, 41 ;; unicode.c on encountering a Unicode code point that we don't recognise,
42 ;; and saved in ISO 2022 coding systems using the UTF-8 escape described in 42 ;; and saved in ISO 2022 coding systems using the UTF-8 escape described in
43 ;; ISO-IR 196. 43 ;; ISO-IR 196.
44
45 (eval-when-compile (when (featurep 'mule) (require 'ccl)))
44 46
45 ;; accessed in loadup.el, mule-cmds.el; see discussion in unicode.c 47 ;; accessed in loadup.el, mule-cmds.el; see discussion in unicode.c
46 (defvar load-unicode-tables-at-dump-time (eq system-type 'windows-nt) 48 (defvar load-unicode-tables-at-dump-time (eq system-type 'windows-nt)
47 "[INTERNAL] Whether to load the Unicode tables at dump time. 49 "[INTERNAL] Whether to load the Unicode tables at dump time.
48 Setting this at run-time does nothing.") 50 Setting this at run-time does nothing.")
282 (assert (eq quote-ucs 'ucs) t 284 (assert (eq quote-ucs 'ucs) t
283 "Sorry, encode-char doesn't yet support anything but the UCS. ") 285 "Sorry, encode-char doesn't yet support anything but the UCS. ")
284 (char-to-unicode char)) 286 (char-to-unicode char))
285 287
286 (when (featurep 'mule) 288 (when (featurep 'mule)
287 ;; This CCL program is used for displaying the fallback UCS character set, 289 (let ((prog
288 ;; and can be repurposed to lao and the IPA, all going well. 290 (eval-when-compile
289 ;; 291 (let ((pre-existing
290 ;; define-ccl-program is available after mule-ccl is loaded, much later 292 ;; This is the compiled CCL program from the assert
291 ;; than this file in the build process. The below is the result of 293 ;; below. Since this file is dumped and ccl.el isn't (and
292 ;; 294 ;; even when it was, it was dumped much later than this
293 ;; (macroexpand 295 ;; one), we can't compile the program at dump time. We can
294 ;; '(define-ccl-program ccl-encode-to-ucs-2 296 ;; check at byte compile time that the program is as
295 ;; `(1 297 ;; expected, though.
296 ;; ((r1 = (r1 << 7)) 298 [1 16 131127 7 98872 65823 1307 5 -65536 65313 64833 1028 147513
297 ;; (r1 = (r1 | r2)) 299 8 82009 255 22]))
298 ;; (mule-to-unicode r0 r1) 300 (when (featurep 'mule)
299 ;; (r1 = (r0 >> 8)) 301 ;; Check that the pre-existing constant reflects the intended
300 ;; (r2 = (r0 & #xff)))) 302 ;; CCL program.
301 ;; "CCL program to transform Mule characters to UCS-2.")) 303 (assert
302 ;; 304 (equal pre-existing
303 ;; and it should occasionally be confirmed that the correspondence still 305 (ccl-compile
304 ;; holds. 306 `(1
305 307 (;; mule-to-unicode's first argument is the
306 (let ((prog [1 10 131127 7 98872 65823 147513 8 82009 255 22])) 308 ;; charset ID, the second its first byte
307 (defconst ccl-encode-to-ucs-2 309 ;; left shifted by 7 bits masked with its
308 prog 310 ;; second byte.
311 (r1 = (r1 << 7))
312 (r1 = (r1 | r2))
313 (mule-to-unicode r0 r1)
314 (if (r0 & ,(lognot #xFFFF))
315 ;; Redisplay looks in r1 and r2 for the first
316 ;; and second bytes of the X11 font,
317 ;; respectively. For non-BMP characters we
318 ;; display U+FFFD.
319 ((r1 = #xFF)
320 (r2 = #xFD))
321 ((r1 = (r0 >> 8))
322 (r2 = (r0 & #xFF))))))))
323 nil
324 "The pre-compiled CCL program appears broken. "))
325 pre-existing))))
326 (defconst ccl-encode-to-ucs-2 prog
309 "CCL program to transform Mule characters to UCS-2.") 327 "CCL program to transform Mule characters to UCS-2.")
310 (put 'ccl-encode-to-ucs-2 328 (put 'ccl-encode-to-ucs-2 'ccl-program-idx
311 'ccl-program-idx 329 (register-ccl-program 'ccl-encode-to-ucs-2 prog))))
312 (register-ccl-program 'ccl-encode-to-ucs-2 prog))
313 nil))
314 330
315 ;; #### UTF-7 is not yet implemented, and it's tricky to do. There's 331 ;; #### UTF-7 is not yet implemented, and it's tricky to do. There's
316 ;; an implementation in appendix A.1 of the Unicode Standard, Version 332 ;; an implementation in appendix A.1 of the Unicode Standard, Version
317 ;; 2.0, but I don't know its licensing characteristics. 333 ;; 2.0, but I don't know its licensing characteristics.
318 334