/[emacs]/emacs/lisp/international/utf-8.el
ViewVC logotype

Diff of /emacs/lisp/international/utf-8.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13.2.4 by miles, Tue May 11 02:35:18 2004 UTC revision 1.13.2.5 by miles, Tue Jul 6 10:10:49 2004 UTC
# Line 190  Setting this variable outside customize Line 190  Setting this variable outside customize
190    :type 'boolean    :type 'boolean
191    :group 'mule)    :group 'mule)
192    
193    
194    (defconst utf-translate-cjk-charsets '(chinese-gb2312
195                                           chinese-big5-1 chinese-big5-2
196                                           japanese-jisx0208 japanese-jisx0212
197                                           korean-ksc5601)
198      "List of charsets supported by `utf-translate-cjk-mode'.")
199    
200    (defconst utf-translate-cjk-unicode-range
201      '((#x2e80 . #xd7a3)
202        (#xff00 . #xffef))
203      "List of Unicode code ranges supported by `utf-translate-cjk-mode'.")
204    
205    ;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.
206    (defsubst utf-translate-cjk-substitutable-p (code-point)
207      (let ((tail utf-translate-cjk-unicode-range)
208            elt)
209        (while tail
210          (setq elt (car tail) tail (cdr tail))
211          (if (and (>= code-point (car elt)) (<= code-point (cdr elt)))
212              (setq tail nil)
213            (setq elt nil)))
214        elt))
215    
216    (defvar utf-translate-cjk-lang-env nil
217      "Language environment in which tables for `utf-translate-cjk-mode' is loaded.
218    The value nil means that the tables are not yet loaded.")
219    
220    (defun utf-translate-cjk-load-tables ()
221      "Load tables for `utf-translate-cjk-mode'."
222      ;; Fixme: Allow the use of the CJK charsets to be
223      ;; customized by reordering and possible omission.
224      (let ((redefined (< (hash-table-size ucs-mule-cjk-to-unicode) 43000)))
225        (if redefined
226            ;; Redefine them with realistic initial sizes and a
227            ;; smallish rehash size to avoid wasting significant
228            ;; space after they're built.
229            (setq ucs-mule-cjk-to-unicode
230                  (make-hash-table :test 'eq :size 43000 :rehash-size 1000)
231                  ucs-unicode-to-mule-cjk
232                  (make-hash-table :test 'eq :size 21500 :rehash-size 1000)))
233    
234        ;; Load the files explicitly, to avoid having to keep
235        ;; around the large tables they contain (as well as the
236        ;; ones which get built).
237        (cond ((string= "Korean" current-language-environment)
238               (load "subst-jis")
239               (load "subst-big5")
240               (load "subst-gb2312")
241               (load "subst-ksc"))
242              ((string= "Chinese-BIG5" current-language-environment)
243               (load "subst-jis")
244               (load "subst-ksc")
245               (load "subst-gb2312")
246               (load "subst-big5"))
247              ((string= "Chinese-GB" current-language-environment)
248               (load "subst-jis")
249               (load "subst-ksc")
250               (load "subst-big5")
251               (load "subst-gb2312"))
252              (t
253               (load "subst-ksc")
254               (load "subst-gb2312")
255               (load "subst-big5")
256               (load "subst-jis")))   ; jis covers as much as big5, gb2312
257    
258        (when redefined
259          (define-translation-hash-table 'utf-subst-table-for-decode
260            ucs-unicode-to-mule-cjk)
261          (define-translation-hash-table 'utf-subst-table-for-encode
262            ucs-mule-cjk-to-unicode)
263          (set-char-table-extra-slot (get 'utf-translation-table-for-encode
264                                          'translation-table)
265                                     1 ucs-mule-cjk-to-unicode))
266    
267        (setq utf-translate-cjk-lang-env current-language-environment)))
268    
269    (defun utf-lookup-subst-table-for-decode (code-point)
270      (if (and utf-translate-cjk-mode
271               (not utf-translate-cjk-lang-env)
272               (utf-translate-cjk-substitutable-p code-point))
273          (utf-translate-cjk-load-tables))
274      (gethash code-point
275               (get 'utf-subst-table-for-decode 'translation-hash-table)))
276      
277    
278    (defun utf-lookup-subst-table-for-encode (char)
279      (if (and utf-translate-cjk-mode
280               (not utf-translate-cjk-lang-env)
281               (memq (char-charset char) utf-translate-cjk-charsets))
282          (utf-translate-cjk-load-tables))
283      (gethash char
284               (get 'utf-subst-table-for-encode 'translation-hash-table)))
285      
286  (define-minor-mode utf-translate-cjk-mode  (define-minor-mode utf-translate-cjk-mode
287    "Whether the UTF based coding systems should decode/encode CJK characters.    "Whether the UTF based coding systems should decode/encode CJK characters.
288  Enabling this loads tables which allow the coding systems mule-utf-8,  Enabling this allows the coding systems mule-utf-8,
289  mule-utf-16le and mule-utf-16be to encode characters in the charsets  mule-utf-16le and mule-utf-16be to encode characters in the charsets
290  `korean-ksc5601', `chinese-gb2312', `chinese-big5-1',  `korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
291  `chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to  `chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to
# Line 203  according to the language environment in Line 296  according to the language environment in
296  turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for  turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
297  Chinese-Big5 and jisx for other environments.  Chinese-Big5 and jisx for other environments.
298    
299  The tables are large (over 40000 entries), so this option is not the  This option is on by default.  If you are not interested in CJK
300  default.  Also, installing them may be rather slow."  characters and want to avoid some overhead on encoding/decoding
301    :init-value nil  by the above coding systems, you can customize this option to nil."
302      :init-value t
303    :version "21.4"    :version "21.4"
304    :type 'boolean    :type 'boolean
   :set-after '(current-language-environment)  
305    :group 'mule    :group 'mule
306    :global t    :global t
307    (if utf-translate-cjk-mode    (if utf-translate-cjk-mode
       ;; Fixme: Allow the use of the CJK charsets to be  
       ;; customized by reordering and possible omission.  
308        (progn        (progn
         ;; Redefine them with realistic initial sizes and a  
         ;; smallish rehash size to avoid wasting significant  
         ;; space after they're built.  
         (setq ucs-mule-cjk-to-unicode  
               (make-hash-table :test 'eq :size 43000 :rehash-size 1000)  
               ucs-unicode-to-mule-cjk  
               (make-hash-table :test 'eq :size 21500 :rehash-size 1000))  
         ;; Load the files explicitly, to avoid having to keep  
         ;; around the large tables they contain (as well as the  
         ;; ones which get built).  
         (cond  
          ((string= "Korean" current-language-environment)  
           (load "subst-jis")  
           (load "subst-big5")  
           (load "subst-gb2312")  
           (load "subst-ksc"))  
          ((string= "Chinese-BIG5" current-language-environment)  
           (load "subst-jis")  
           (load "subst-ksc")  
           (load "subst-gb2312")  
           (load "subst-big5"))  
          ((string= "Chinese-GB" current-language-environment)  
           (load "subst-jis")  
           (load "subst-ksc")  
           (load "subst-big5")  
           (load "subst-gb2312"))  
          (t  
           (load "subst-ksc")  
           (load "subst-gb2312")  
           (load "subst-big5")  
           (load "subst-jis")))    ; jis covers as much as big5, gb2312  
309          (define-translation-hash-table 'utf-subst-table-for-decode          (define-translation-hash-table 'utf-subst-table-for-decode
310            ucs-unicode-to-mule-cjk)            ucs-unicode-to-mule-cjk)
311          (define-translation-hash-table 'utf-subst-table-for-encode          (define-translation-hash-table 'utf-subst-table-for-encode
# Line 259  default.  Also, installing them may be r Line 319  default.  Also, installing them may be r
319        (make-hash-table :test 'eq))        (make-hash-table :test 'eq))
320      (set-char-table-extra-slot (get 'utf-translation-table-for-encode      (set-char-table-extra-slot (get 'utf-translation-table-for-encode
321                                      'translation-table)                                      'translation-table)
322                                 1 nil)))                                 1 nil))
323    
324      ;; Update safe-chars of mule-utf-* coding systems.
325      (dolist (elt (coding-system-list t))
326        (if (string-match "^mule-utf" (symbol-name elt))
327            (let ((safe-charsets (coding-system-get elt 'safe-charsets))
328                  (safe-chars (coding-system-get elt 'safe-chars))
329                  (need-update nil))
330              (dolist (charset utf-translate-cjk-charsets)
331                (unless (eq utf-translate-cjk-mode (memq charset safe-charsets))
332                  (setq safe-charsets
333                        (if utf-translate-cjk-mode
334                            (cons charset safe-charsets)
335                          (delq charset safe-charsets))
336                        need-update t)
337                  (aset safe-chars (make-char charset) utf-translate-cjk-mode)))
338              (when need-update
339                (coding-system-put elt 'safe-charsets safe-charsets)
340                (define-coding-system-internal elt))))))
341    
342    (define-ccl-program ccl-mule-utf-untrans
343      ;; R0 is an untranslatable Unicode code-point (U+3500..U+DFFF or
344      ;; U+10000..U+10FFFF) or an invaid byte (#x00..#xFF).  Write
345      ;; eight-bit-control/graphic sequence (2 to 4 chars) representing
346      ;; UTF-8 sequence of r0.  Registers r4, r5, r6 are modified.
347      ;;
348      ;; This is a subrountine because we assume that this is called very
349      ;; rarely (so we don't have to worry about the overhead of the
350      ;; call).
351      `(0
352        ((r5 = ,(charset-id 'eight-bit-control))
353         (r6 = ,(charset-id 'eight-bit-graphic))
354         (if (r0 < #x100)
355             ((r4 = ((r0 >> 6) | #xC0))
356              (write-multibyte-character r6 r4))
357           ((if (r0 < #x10000)
358                ((r4 = ((r0 >> 12) | #xE0))
359                 (write-multibyte-character r6 r4))
360              ((r4 = ((r0 >> 18) | #xF0))
361               (write-multibyte-character r6 r4)
362               (r4 = (((r0 >> 12) & #x3F) | #x80))
363               (if (r4 < #xA0)
364                   (write-multibyte-character r5 r4)
365                 (write-multibyte-character r6 r4))))
366            (r4 = (((r0 >> 6) & #x3F) | #x80))
367            (if (r4 < #xA0)
368                (write-multibyte-character r5 r4)
369              (write-multibyte-character r6 r4))))
370         (r4 = ((r0 & #x3F) | #x80))
371         (if (r4 < #xA0)
372             (write-multibyte-character r5 r4)
373           (write-multibyte-character r6 r4)))))
374    
375  (define-ccl-program ccl-decode-mule-utf-8  (define-ccl-program ccl-decode-mule-utf-8
376    ;;    ;;
# Line 278  default.  Also, installing them may be r Line 389  default.  Also, installing them may be r
389    ;;        (>= 8000)       |                |    ;;        (>= 8000)       |                |
390    ;; mule-unicode-2500-33ff |       3        |       4    ;; mule-unicode-2500-33ff |       3        |       4
391    ;; mule-unicode-e000-ffff |       3        |       4    ;; mule-unicode-e000-ffff |       3        |       4
392      ;; -----------------------+----------------+---------------
393      ;;      invalid byte      |       1        |       2
394    ;;    ;;
395    ;; Thus magnification factor is two.    ;; Thus magnification factor is two.
396    ;;    ;;
397    `(2    `(2
398      ((r5 = ,(charset-id 'eight-bit-control))      ((r6 = ,(charset-id 'latin-iso8859-1))
399       (r6 = ,(charset-id 'eight-bit-graphic))       (read r0)
400       (loop       (loop
       (r0 = -1)  
       (read r0)  
   
       ;; 1byte encoding, i.e., ascii  
401        (if (r0 < #x80)        (if (r0 < #x80)
402            ((write r0))            ;; 1-byte encoding, i.e., ascii
403          (if (r0 < #xc0)             ; continuation byte (invalid here)            (write-read-repeat r0))
404              ((if (r0 < #xa0)        (if (r0 < #xc2)
405                   (write-multibyte-character r5 r0)            ;; continuation byte (invalid here) or 1st byte of overlong
406                 (write-multibyte-character r6 r0)))            ;; 2-byte sequence.
407            ;; 2 byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx            ((call ccl-mule-utf-untrans)
408            (if (r0 < #xe0)             (r6 = ,(charset-id 'latin-iso8859-1))
409                ((r1 = -1)             (read r0)
410                 (read r1)             (repeat)))
411    
412                 (if ((r1 & #b11000000) != #b10000000)        ;; Read the 2nd byte.
413                     ;; Invalid 2-byte sequence        (read r1)
414                     ((if (r0 < #xa0)        (if ((r1 & #b11000000) != #b10000000) ; Invalid 2nd byte
415                          (write-multibyte-character r5 r0)            ((call ccl-mule-utf-untrans)
416                        (write-multibyte-character r6 r0))             (r6 = ,(charset-id 'latin-iso8859-1))
417                      (if (r1 < #x80)             ;; Handle it in the next loop.
418                          (write r1)             (r0 = r1)
419                        (if (r1 < #xa0)             (repeat)))
420                            (write-multibyte-character r5 r1)  
421                          (write-multibyte-character r6 r1))))        (if (r0 < #xe0)
422              ;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
423                   ((r3 = r0)        ; save in case of overlong sequence            ((r1 &= #x3F)
424                    (r2 = r1)             (r1 |= ((r0 & #x1F) << 6))
425                    (r0 &= #x1f)             ;; Now r2 holds scalar value.  We don't have to check
426                    (r0 <<= 6)             ;; `overlong sequence' because r0 >= 0xC2.
427                    (r1 &= #x3f)  
428                    (r1 += r0)             (if (r1 >= 256)
429                    ;; Now r1 holds scalar value                 ;; mule-unicode-0100-24ff (< 0800)
430                   ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
431                    (if (r1 < 128)        ; `overlong sequence'                  (r1 -= #x0100)
432                        ((if (r3 < #xa0)                  (r2 = (((r1 / 96) + 32) << 7))
433                             (write-multibyte-character r5 r3)                  (r1 %= 96)
434                           (write-multibyte-character r6 r3))                  (r1 += (r2 + 32))
435                         (if (r2 < #x80)                  (translate-character
436                             (write r2)                   utf-translation-table-for-decode r0 r1)
437                           (if (r2 < #xa0)                  (write-multibyte-character r0 r1)
438                               (write-multibyte-character r5 r2)                  (read r0)
439                             (write-multibyte-character r6 r2))))                  (repeat))
440                 (if (r1 >= 160)
441                      ;; eight-bit-control                   ;; latin-iso8859-1
442                      (if (r1 < 160)                   ((r1 -= 128)
443                          ((write-multibyte-character r5 r1))                    (write-multibyte-character r6 r1)
444                      (read r0)
445                        ;; latin-iso8859-1                    (repeat))
446                        (if (r1 < 256)                 ;; eight-bit-control
447                            ((r0 = ,(charset-id 'latin-iso8859-1))                 ((r0 = ,(charset-id 'eight-bit-control))
448                             (r1 -= 128)                  (write-multibyte-character r0 r1)
449                             (write-multibyte-character r0 r1))                  (read r0)
450                    (repeat))))))
451                          ;; mule-unicode-0100-24ff (< 0800)  
452                          ((r0 = ,(charset-id 'mule-unicode-0100-24ff))        ;; Read the 3rd bytes.
453                           (r1 -= #x0100)        (read r2)
454                           (r2 = (((r1 / 96) + 32) << 7))        (if ((r2 & #b11000000) != #b10000000) ; Invalid 3rd byte
455                           (r1 %= 96)            ((call ccl-mule-utf-untrans)
456                           (r1 += (r2 + 32))             (r0 = r1)
457                           (translate-character             (call ccl-mule-utf-untrans)
458                            utf-translation-table-for-decode r0 r1)             (r6 = ,(charset-id 'latin-iso8859-1))
459                           (write-multibyte-character r0 r1))))))))             ;; Handle it in the next loop.
460               (r0 = r2)
461              ;; 3byte encoding             (repeat)))
462              ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx  
463              (if (r0 < #xf0)        (if (r0 < #xF0)
464                  ((r1 = -1)            ;; 3byte encoding
465                   (r2 = -1)            ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx
466                   (read r1 r2)            ((r3 = ((r0 & #xF) << 12))
467               (r3 |= ((r1 & #x3F) << 6))
468                   ;; This is set to 1 if the encoding is invalid.             (r3 |= (r2 & #x3F))
469                   (r4 = 0)  
470               (if (r3 < #x800)             ; `overlong sequence'
471                   (r3 = (r1 & #b11000000))                 ((call ccl-mule-utf-untrans)
472                   (r3 |= ((r2 >> 2) & #b00110000))                  (r0 = r1)
473                   (if (r3 != #b10100000)                  (call ccl-mule-utf-untrans)
474                       (r4 = 1)                  (r0 = r2)
475                     ((r3 = ((r0 & #x0f) << 12))                  (call ccl-mule-utf-untrans)
476                      (r3 += ((r1 & #x3f) << 6))                  (r6 = ,(charset-id 'latin-iso8859-1))
477                      (r3 += (r2 & #x3f))                  (read r0)
478                      (if (r3 < #x0800)                  (repeat)))
479                          (r4 = 1))))  
480               (if (r3 < #x2500)
481                   (if (r4 != 0)                 ;; mule-unicode-0100-24ff (>= 0800)
482                       ;; Invalid 3-byte sequence                 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
483                       ((if (r0 < #xa0)                  (r3 -= #x0100)
484                            (write-multibyte-character r5 r0)                  (r3 //= 96)
485                          (write-multibyte-character r6 r0))                  (r1 = (r7 + 32))
486                        (if (r1 < #x80)                  (r1 += ((r3 + 32) << 7))
487                            (write r1)                  (translate-character
488                          (if (r1 < #xa0)                   utf-translation-table-for-decode r0 r1)
489                              (write-multibyte-character r5 r1)                  (write-multibyte-character r0 r1)
490                            (write-multibyte-character r6 r1)))                  (read r0)
491                        (if (r2 < #x80)                  (repeat)))
492                            (write r2)  
493                          (if (r2 < #xa0)             (if (r3 < #x3400)
494                              (write-multibyte-character r5 r2)                 ;; mule-unicode-2500-33ff
495                            (write-multibyte-character r6 r2))))                 ((r0 = r3)               ; don't zap r3
496                    (lookup-integer utf-subst-table-for-decode r0 r1)
497                     ;; mule-unicode-0100-24ff (>= 0800)                  (if (r7 == 0)
498                     ((if (r3 < #x2500)                      ((r0 = ,(charset-id 'mule-unicode-2500-33ff))
499                          ((r0 = ,(charset-id 'mule-unicode-0100-24ff))                       (r3 -= #x2500)
500                           (r3 -= #x0100)                       (r3 //= 96)
501                           (r3 //= 96)                       (r1 = (r7 + 32))
502                           (r1 = (r7 + 32))                       (r1 += ((r3 + 32) << 7))))
503                           (r1 += ((r3 + 32) << 7))                  (write-multibyte-character r0 r1)
504                           (translate-character                  (read r0)
505                            utf-translation-table-for-decode r0 r1)                  (repeat)))
506                           (write-multibyte-character r0 r1))  
507               (if (r3 < #xE000)
508                        ;; mule-unicode-2500-33ff                 ;; Try to convert to CJK chars, else
509                        (if (r3 < #x3400)                 ;; keep them as eight-bit-{control|graphic}.
510                            ((r4 = r3)    ; don't zap r3                 ((r0 = r3)
511                             (lookup-integer utf-subst-table-for-decode r4 r5)                  (lookup-integer utf-subst-table-for-decode r3 r1)
512                             (if r7                  (if r7
513                                 ;; got a translation                      ;; got a translation
514                                 ((write-multibyte-character r4 r5)                      ((write-multibyte-character r3 r1)
515                                  ;; Zapped through register starvation.                       (read r0)
516                                  (r5 = ,(charset-id 'eight-bit-control)))                       (repeat))
517                               ((r0 = ,(charset-id 'mule-unicode-2500-33ff))                    ((call ccl-mule-utf-untrans)
518                                (r3 -= #x2500)                     (r6 = ,(charset-id 'latin-iso8859-1))
519                                (r3 //= 96)                     (read r0)
520                                (r1 = (r7 + 32))                     (repeat)))))
521                                (r1 += ((r3 + 32) << 7))  
522                                (write-multibyte-character r0 r1))))             ;; mule-unicode-e000-ffff
523               ;; Fixme: fffe and ffff are invalid.
524                          ;; U+3400 .. U+D7FF             (r0 = r3)            ; don't zap r3
525                          ;; Try to convert to CJK chars, else keep             (lookup-integer utf-subst-table-for-decode r0 r1)
526                          ;; them as eight-bit-{control|graphic}.             (if (r7 == 0)
527                          (if (r3 < #xd800)                 ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
528                              ((r4 = r3)  ; don't zap r3                  (r3 -= #xe000)
529                               (lookup-integer utf-subst-table-for-decode r4 r5)                  (r3 //= 96)
530                               (if r7                  (r1 = (r7 + 32))
531                                   ;; got a translation                  (r1 += ((r3 + 32) << 7))))
532                                   ((write-multibyte-character r4 r5)             (write-multibyte-character r0 r1)
533                                    ;; Zapped through register starvation.             (read r0)
534                                    (r5 = ,(charset-id 'eight-bit-control)))             (repeat)))
535                                 ;; #xe0 <= r0 < #xf0, so r0 is eight-bit-graphic  
536                                 ((r3 = r6)        ;; Read the 4th bytes.
537                                  (write-multibyte-character r3 r0)        (read r3)
538                                  (if (r1 < #xa0)        (if ((r3 & #b11000000) != #b10000000) ; Invalid 4th byte
539                                      (r3 = r5))            ((call ccl-mule-utf-untrans)
540                                  (write-multibyte-character r3 r1)             (r0 = r1)
541                                  (if (r2 < #xa0)             (call ccl-mule-utf-untrans)
542                                      (r3 = r5)             (r0 = r2)
543                                    (r3 = r6))             (call ccl-mule-utf-untrans)
544                                  (write-multibyte-character r3 r2))))             (r6 = ,(charset-id 'latin-iso8859-1))
545               ;; Handle it in the next loop.
546                            ;; Surrogates, U+D800 .. U+DFFF             (r0 = r3)
547                            (if (r3 < #xe000)             (repeat)))
548                                ((r3 = r6)  
549                                 (write-multibyte-character r3 r0) ; eight-bit-graphic        (if (r0 < #xF8)
550                                 (if (r1 < #xa0)            ;; 4-byte encoding:
551                                     (r3 = r5))            ;; wwwzzzzzzyyyyyyxxxxxx = 11110www 10zzzzzz 10yyyyyy 10xxxxxx
552                                 (write-multibyte-character r3 r1)            ;; keep those bytes as eight-bit-{control|graphic}
553                                 (if (r2 < #xa0)            ;; Fixme: allow lookup in utf-subst-table-for-decode.
554                                     (r3 = r5)            ((r4 = ((r0 & #x7) << 18))
555                                   (r3 = r6))             (r4 |= ((r1 & #x3F) << 12))
556                                 (write-multibyte-character r3 r2))             (r4 |= ((r2 & #x3F) << 6))
557               (r4 |= (r3 & #x3F))
558                              ;; mule-unicode-e000-ffff  
559                              ;; Fixme: fffe and ffff are invalid.             (if (r4 < #x10000)           ; `overlong sequence'
560                              ((r4 = r3)  ; don't zap r3                 ((call ccl-mule-utf-untrans)
561                               (lookup-integer utf-subst-table-for-decode r4 r5)                  (r0 = r1)
562                               (if r7                  (call ccl-mule-utf-untrans)
563                                   ;; got a translation                  (r0 = r2)
564                                   ((write-multibyte-character r4 r5)                  (call ccl-mule-utf-untrans)
565                                    ;; Zapped through register starvation.                  (r0 = r3)
566                                    (r5 = ,(charset-id 'eight-bit-control)))                  (call ccl-mule-utf-untrans))
567                                 ((r0 = ,(charset-id 'mule-unicode-e000-ffff))               ((r0 = r4)
568                                  (r3 -= #xe000)                (call ccl-mule-utf-untrans))))
569                                  (r3 //= 96)  
570                                  (r1 = (r7 + 32))          ;; Unsupported sequence.
571                                  (r1 += ((r3 + 32) << 7))          ((call ccl-mule-utf-untrans)
572                                  (write-multibyte-character r0 r1)))))))))))           (r0 = r1)
573             (call ccl-mule-utf-untrans)
574                (if (r0 < #xfe)           (r0 = r2)
575                    ;; 4byte encoding           (call ccl-mule-utf-untrans)
576                    ;; keep those bytes as eight-bit-{control|graphic}           (r0 = r3)
577                    ;; Fixme: allow lookup in utf-subst-table-for-decode.           (call ccl-mule-utf-untrans)))
578                    ((r1 = -1)        (r6 = ,(charset-id 'latin-iso8859-1))
579                     (r2 = -1)        (read r0)
                    (r3 = -1)  
                    (read r1 r2 r3)  
                    ;; r0 > #xf0, thus eight-bit-graphic  
                    (write-multibyte-character r6 r0)  
                    (if (r1 < #xa0)  
                        (if (r1 < #x80)  ; invalid byte  
                            (write r1)  
                          (write-multibyte-character r5 r1))  
                      (write-multibyte-character r6 r1))  
                    (if (r2 < #xa0)  
                        (if (r2 < #x80)  ; invalid byte  
                            (write r2)  
                          (write-multibyte-character r5 r2))  
                      (write-multibyte-character r6 r2))  
                    (if (r3 < #xa0)  
                        (if (r3 < #x80)  ; invalid byte  
                            (write r3)  
                          (write-multibyte-character r5 r3))  
                      (write-multibyte-character r6 r3))  
                    (if (r0 >= #xf8)     ; 5- or 6-byte encoding  
                        ((r0 = -1)  
                         (read r0)  
                         (if (r0 < #xa0)  
                             (if (r0 < #x80) ; invalid byte  
                                 (write r0)  
                               (write-multibyte-character r5 r0))  
                           (write-multibyte-character r6 r0))  
                         (if (r0 >= #xfc) ; 6-byte  
                             ((r0 = -1)  
                              (read r0)  
                              (if (r0 < #xa0)  
                                  (if (r0 < #x80) ; invalid byte  
                                      (write r0)  
                                    (write-multibyte-character r5 r0))  
                                (write-multibyte-character r6 r0)))))))  
                 ;; else invalid byte >= #xfe  
                 (write-multibyte-character r6 r0))))))  
580        (repeat)))        (repeat)))
581    
582    
583      ;; At EOF...      ;; At EOF...
584      (if (r0 >= 0)      (if (r0 >= 0)
585          ((if (r0 < #x80)          ;; r0 >= #x80
586               (write r0)          ((call ccl-mule-utf-untrans)
            (if (r0 < #xa0)  
                (write-multibyte-character r5 r0)  
              ((write-multibyte-character r6 r0))))  
587           (if (r1 >= 0)           (if (r1 >= 0)
588               ((if (r1 < #x80)               ((r0 = r1)
589                    (write r1)                (call ccl-mule-utf-untrans)
                 (if (r1 < #xa0)  
                     (write-multibyte-character r5 r1)  
                   ((write-multibyte-character r6 r1))))  
590                (if (r2 >= 0)                (if (r2 >= 0)
591                    ((if (r2 < #x80)                    ((r0 = r2)
592                         (write r2)                     (call ccl-mule-utf-untrans)
                      (if (r2 < #xa0)  
                          (write-multibyte-character r5 r2)  
                        ((write-multibyte-character r6 r2))))  
593                     (if (r3 >= 0)                     (if (r3 >= 0)
594                         (if (r3 < #x80)                         ((r0 = r3)
595                             (write r3)                          (call ccl-mule-utf-untrans))))))))))
                          (if (r3 < #xa0)  
                              (write-multibyte-character r5 r3)  
                            ((write-multibyte-character r6 r3))))))))))))  
596    
597    "CCL program to decode UTF-8.    "CCL program to decode UTF-8.
598  Basic decoding is done into the charsets ascii, latin-iso8859-1 and  Basic decoding is done into the charsets ascii, latin-iso8859-1 and
# Line 540  mule-unicode-*, but see also `utf-fragme Line 601  mule-unicode-*, but see also `utf-fragme
601  Encodings of un-representable Unicode characters are decoded asis into  Encodings of un-representable Unicode characters are decoded asis into
602  eight-bit-control and eight-bit-graphic characters.")  eight-bit-control and eight-bit-graphic characters.")
603    
604    (define-ccl-program ccl-mule-utf-8-encode-untrans
605      ;; UTF-8 decoder generates an UTF-8 sequence represented by a
606      ;; sequence eight-bit-control/graphic chars for an untranslatable
607      ;; character and an invalid byte.
608      ;;
609      ;; This CCL parses that sequence (the first byte is already in r1),
610      ;; writes out the original bytes of that sequence, and sets r5 to
611      ;; -1.
612      ;;
613      ;; If the eight-bit-control/graphic sequence is shorter than what r1
614      ;; suggests, it sets r5 and r6 to the last character read that
615      ;; should be handled by the next loop of a caller.
616      ;;
617      ;; Note: For UTF-8 validation, we only check if a character is
618      ;; eight-bit-control/graphic or not.  It may result in incorrect
619      ;; handling of random binary data, but such a data can't be encoded
620      ;; by UTF-8 anyway.  At least, UTF-8 decoders doesn't generate such
621      ;; a sequence even if a source contains invalid byte-sequence.
622      `(0
623        (;; Read the 2nd byte.
624         (read-multibyte-character r5 r6)
625         (r0 = (r5 != ,(charset-id 'eight-bit-control)))
626         (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
627             ((write r1)                    ; invalid UTF-8
628              (r1 = -1)
629              (end)))
630    
631         (if (r1 <= #xC3)
632             ;; 2-byte sequence for an originally invalid byte.
633             ((r6 &= #x3F)
634              (r6 |= ((r1 & #x1F) << 6))
635              (write r6)
636              (r5 = -1)
637              (end)))
638    
639         (write r1 r6)
640         (r2 = r1)
641         (r1 = -1)
642         ;; Read the 3rd byte.
643         (read-multibyte-character r5 r6)
644         (r0 = (r5 != ,(charset-id 'eight-bit-control)))          
645         (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
646             (end))                         ; invalid UTF-8
647         (write r6)
648         (if (r2 < #xF0)
649             ;; 3-byte sequence for an untranslated character.
650             ((r5 = -1)
651              (end)))
652         ;; Read the 4th byte.
653         (read-multibyte-character r5 r6)
654         (r0 = (r5 != ,(charset-id 'eight-bit-control)))          
655         (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
656             (end))                 ; invalid UTF-8
657         ;; 4-byte sequence for an untranslated character.
658         (write r6)
659         (r5 = -1)
660         (end))
661    
662        ;; At EOF...
663        ((r5 = -1)
664         (if (r1 >= 0)
665             (write r1)))))
666    
667  (define-ccl-program ccl-encode-mule-utf-8  (define-ccl-program ccl-encode-mule-utf-8
668    `(1    `(1
669      ((r5 = -1)      ((r5 = -1)
670       (loop       (loop
671        (if (r5 < 0)        (if (r5 < 0)
672            ((r1 = -1)            (read-multibyte-character r0 r1)
673             (read-multibyte-character r0 r1)          ;; Pre-read character is in r5 (charset-ID) and r6 (code-point).
674             (translate-character utf-translation-table-for-encode r0 r1))          ((r0 = r5)
         (;; We have already done read-multibyte-character.  
          (r0 = r5)  
675           (r1 = r6)           (r1 = r6)
676           (r5 = -1)))           (r5 = -1)))
677          (translate-character utf-translation-table-for-encode r0 r1)
678    
679        (if (r0 == ,(charset-id 'ascii))        (if (r0 == ,(charset-id 'ascii))
680            (write r1)            (write-repeat r1))
681    
682          (if (r0 == ,(charset-id 'latin-iso8859-1))        (if (r0 == ,(charset-id 'latin-iso8859-1))
683              ;; r1          scalar                  utf-8            ;; r1          scalar                  utf-8
684              ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx            ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx
685              ;; 20    0000 0000 1010 0000    1100 0010 1010 0000            ;; 20    0000 0000 1010 0000    1100 0010 1010 0000
686              ;; 7f    0000 0000 1111 1111    1100 0011 1011 1111            ;; 7f    0000 0000 1111 1111    1100 0011 1011 1111
687              ((r0 = (((r1 & #x40) >> 6) | #xc2))            ((r0 = (((r1 & #x40) >> 6) | #xc2))
688               (r1 &= #x3f)             (r1 &= #x3f)
689               (r1 |= #x80)
690               (write r0)
691               (write-repeat r1)))
692    
693          (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
694              ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
695               ;; #x3f80 == (0011 1111 1000 0000)b
696               (r1 &= #x7f)
697               (r1 += (r0 + 224))           ; 240 == -32 + #x0100
698               ;; now r1 holds scalar value
699               (if (r1 < #x0800)
700                   ;; 2byte encoding
701                   ((write ((r1 >> 6) | #xC0))
702                    (r1 &= #x3F)
703                    (r1 |= #x80)
704                    (write-repeat r1))
705                 ;; 3byte encoding
706                 ((write ((r1 >> 12) | #xE0))
707                  (write  (((r1 & #x0FC0) >> 6) | #x80))
708                  (r1 &= #x3F)
709                  (r1 |= #x80)
710                  (write-repeat r1)))))
711    
712          (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
713              ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
714               (r1 &= #x7f)
715               (r1 += (r0 + 9440))          ; 9440 == -32 + #x2500
716               ;; now r1 holds scalar value
717               (write ((r1 >> 12) | #xE0))
718               (write  (((r1 & #x0FC0) >> 6) | #x80))
719               (r1 &= #x3F)
720               (r1 |= #x80)
721               (write-repeat r1)))
722    
723          (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
724              ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
725               (r1 &= #x7f)
726               (r1 += (r0 + 57312))         ; 57312 == -32 + #xe000
727               ;; now r1 holds scalar value
728               (write ((r1 >> 12) | #xE0))
729               (write  (((r1 & #x0FC0) >> 6) | #x80))
730               (r1 &= #x3F)
731               (r1 |= #x80)
732               (write-repeat r1)))
733    
734          (if (r0 == ,(charset-id 'eight-bit-control))
735              ;; r1          scalar                  utf-8
736              ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx
737              ;; 80    0000 0000 1000 0000    1100 0010 1000 0000
738              ;; 9f    0000 0000 1001 1111    1100 0010 1001 1111
739              ((write #xC2)
740               (write-repeat r1)))
741    
742          (if (r0 == ,(charset-id 'eight-bit-graphic))
743              ;; r1          scalar                  utf-8
744              ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx
745              ;; a0    0000 0000 1010 0000    1100 0010 1010 0000
746              ;; ff    0000 0000 1111 1111    1101 1111 1011 1111
747              ((r0 = (r1 >= #xC0))
748               (r0 &= (r1 <= #xC3))
749               (r4 = (r1 >= #xE1))
750               (r4 &= (r1 <= #xF7))
751               (r0 |= r4)
752               (if r0
753                   ((call ccl-mule-utf-8-encode-untrans)
754                    (repeat))
755                 (write-repeat r1))))
756    
757          (lookup-character utf-subst-table-for-encode r0 r1)
758          (if r7            ; lookup succeeded
759              (if (r0 < #x800)
760                  ;; 2byte encoding
761                  ((write ((r0 >> 6) | #xC0))
762                   (r1 &= #x3F)
763                   (r1 |= #x80)
764                   (write-repeat r1))
765                ;; 3byte encoding
766                ((write ((r0 >> 12) | #xE0))
767                 (write  (((r0 & #x0FC0) >> 6) | #x80))
768                 (r1 &= #x3F)
769               (r1 |= #x80)               (r1 |= #x80)
770               (write r0 r1))               (write-repeat r1))))
   
           (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))  
               ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))  
                ;; #x3f80 == (0011 1111 1000 0000)b  
                (r1 &= #x7f)  
                (r1 += (r0 + 224))       ; 240 == -32 + #x0100  
                ;; now r1 holds scalar value  
                (if (r1 < #x0800)  
                    ;; 2byte encoding  
                    ((r0 = (((r1 & #x07c0) >> 6) | #xc0))  
                     ;; #x07c0 == (0000 0111 1100 0000)b  
                     (r1 &= #x3f)  
                     (r1 |= #x80)  
                     (write r0 r1))  
                  ;; 3byte encoding  
                  ((r0 = (((r1 & #xf000) >> 12) | #xe0))  
                   (r2 = ((r1 & #x3f) | #x80))  
                   (r1 &= #x0fc0)  
                   (r1 >>= 6)  
                   (r1 |= #x80)  
                   (write r0 r1 r2))))  
   
             (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))  
                 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))  
                  (r1 &= #x7f)  
                  (r1 += (r0 + 9440))    ; 9440 == -32 + #x2500  
                  (r0 = (((r1 & #xf000) >> 12) | #xe0))  
                  (r2 = ((r1 & #x3f) | #x80))  
                  (r1 &= #x0fc0)  
                  (r1 >>= 6)  
                  (r1 |= #x80)  
                  (write r0 r1 r2))  
   
               (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))  
                   ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))  
                    (r1 &= #x7f)  
                    (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000  
                    (r0 = (((r1 & #xf000) >> 12) | #xe0))  
                    (r2 = ((r1 & #x3f) | #x80))  
                    (r1 &= #x0fc0)  
                    (r1 >>= 6)  
                    (r1 |= #x80)  
                    (write r0 r1 r2))  
   
                 (if (r0 == ,(charset-id 'eight-bit-control))  
                     ;; r1          scalar                  utf-8  
                     ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx  
                     ;; 80    0000 0000 1000 0000    1100 0010 1000 0000  
                     ;; 9f    0000 0000 1001 1111    1100 0010 1001 1111  
                     ((write #xc2)  
                      (write r1))  
   
                   (if (r0 == ,(charset-id 'eight-bit-graphic))  
                       ;; r1          scalar                  utf-8  
                       ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx  
                       ;; a0    0000 0000 1010 0000    1100 0010 1010 0000  
                       ;; ff    0000 0000 1111 1111    1101 1111 1011 1111  
                       ((write r1)  
                        (r1 = -1)  
                        (read-multibyte-character r0 r1)  
                        (if (r0 != ,(charset-id 'eight-bit-graphic))  
                            (if (r0 != ,(charset-id 'eight-bit-control))  
                                ((r5 = r0)  
                                 (r6 = r1))))  
                        (if (r5 < 0)  
                            ((read-multibyte-character r0 r2)  
                             (if (r0 != ,(charset-id 'eight-bit-graphic))  
                                 (if (r0 != ,(charset-id 'eight-bit-control))  
                                     ((r5 = r0)  
                                      (r6 = r2))))  
                             (if (r5 < 0)  
                                 (write r1 r2)  
                               (if (r1 < #xa0)  
                                   (write r1)  
                                 ((write #xc2)  
                                  (write r1)))))))  
   
                     ((lookup-character utf-subst-table-for-encode r0 r1)  
                      (if r7             ; lookup succeeded  
                          ((r1 = (((r0 & #xf000) >> 12) | #xe0))  
                           (r2 = ((r0 & #x3f) | #x80))  
                           (r0 &= #x0fc0)  
                           (r0 >>= 6)  
                           (r0 |= #x80)  
                           (write r1 r0 r2))  
                        ;; Unsupported character.  
                        ;; Output U+FFFD, which is `ef bf bd' in UTF-8.  
                        ((write #xef)  
                         (write #xbf)  
                         (write #xbd)))))))))))  
       (repeat)))  
     (if (r1 >= #xa0)  
         (write r1)  
       (if (r1 >= #x80)  
           ((write #xc2)  
            (write r1)))))  
771    
772          ;; Unsupported character.
773          ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
774          (write #xef)
775          (write #xbf)
776          (write-repeat #xbd))))
777    "CCL program to encode into UTF-8.")    "CCL program to encode into UTF-8.")
778    
779    
780  (define-ccl-program ccl-untranslated-to-ucs  (define-ccl-program ccl-untranslated-to-ucs
781    `(0    `(0
782      (if (r0 < #xf0)                     ; 3-byte encoding, as above      (if (r1 == 0)
783          ((r4 = 0)          nil
784           (r3 = (r1 & #b11000000))        (if (r0 <= #xC3)                  ; 2-byte encoding
785           (r3 |= ((r2 >> 2) & #b00110000))            ((r0 = ((r0 & #x3) << 6))
786           (if (r3 != #b10100000)             (r0 |= (r1 & #x3F))
787               (r4 = 1)             (r1 = 2))
788             ((r3 = ((r0 & #x0f) << 12))          (if (r2 == 0)
789              (r3 += ((r1 & #x3f) << 6))              (r1 = 0)
790              (r3 += (r2 & #x3f))            (if (r0 < #xF0)               ; 3-byte encoding, as above
791              (if (r3 < #x0800)                ((r0 = ((r0 & #xF) << 12))
792                  (r4 = 1))))                 (r0 |= ((r1 & #x3F) << 6))
793           (if (r4 != 0)                 (r0 |= (r2 & #x3F))
794               (r0 = 0)                 (r1 = 3))
795             (r0 = r3)))              (if (r3 == 0)
796        (if (r0 < #xf8)                   ; 4-byte (Mule-UCS recipe)                  (r1 = 0)
797            ((r4 = (r1 >> 6))                ((r0 = ((r0 & #x7) << 18))
798             (if (r4 != #b10)                 (r0 |= ((r1 & #x3F) << 12))
799                 (r0 = 0)                 (r0 |= ((r2 & #x3F) << 6))
800               ((r4 = (r2 >> 6))                 (r0 |= (r3 & #x3F))
801                (if (r4 != #b10)                 (r1 = 4))))))))
802                    (r0 = 0)    "Decode 2-, 3-, or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
803                  ((r4 = (r3 >> 6))  Set r1 to the byte length.  r0 == 0 for invalid sequence.")
                  (if (r4 != #b10)  
                      (r0 = 0)  
                    ((r1 = ((r1  & #x3F) << 12))  
                     (r2 = ((r2  & #x3F) << 6))  
                     (r3 &= #x3F)  
                     (r0 = (((((r0 & #x07) << 18) | r1) | r2) | r3)))))))))  
         (r0 = 0))))  
   "Decode 3- or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.  
 r0 == 0 for invalid sequence.")  
804    
805  (defvar utf-8-ccl-regs (make-vector 8 0))  (defvar utf-8-ccl-regs (make-vector 8 0))
806    
# Line 708  Only for 3- or 4-byte sequences." Line 811  Only for 3- or 4-byte sequences."
811    (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))    (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
812    (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))    (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
813    (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))    (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
814    (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs)    (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs))
   (aref utf-8-ccl-regs 0))  
815    
816  (defun utf-8-help-echo (window object position)  (defun utf-8-help-echo (window object position)
817    (format "Untranslated Unicode U+%04X"    (format "Untranslated Unicode U+%04X"
818            (get-char-property position 'untranslated-utf-8 object)))            (get-char-property position 'untranslated-utf-8 object)))
819    
820  ;; We compose the untranslatable sequences into a single character.  ;; We compose the untranslatable sequences into a single character,
821    ;; and move point to the next character.
822  ;; This is infelicitous for editing, because there's currently no  ;; This is infelicitous for editing, because there's currently no
823  ;; mechanism for treating compositions as atomic, but is OK for  ;; mechanism for treating compositions as atomic, but is OK for
824  ;; display.  They are composed to U+FFFD with help-echo which  ;; display.  They are composed to U+FFFD with help-echo which
825  ;; indicates the unicodes they represent.  This function GCs too much.  ;; indicates the unicodes they represent.  This function GCs too much.
826  (defsubst utf-8-compose ()  
827    "Put a suitable composition on an untranslatable sequence.  ;; If utf-translate-cjk-mode is non-nil, this function is called with
828  Return the sequence's length."  ;; HASH-TABLE which translates CJK characters into some of CJK
829    (let* ((u (utf-8-untranslated-to-ucs))  ;; charsets.
830           (l (unless (zerop u)  
831                (if (>= u #x10000)  (defsubst utf-8-compose (hash-table)
832                         4    "Put a suitable composition on an untranslatable sequence at point.
833                       3))))  If HASH-TABLE is non-nil, try to translate CJK characters by it at first.
834      (when l  Move point to the end of the sequence."
835        (put-text-property (point) (min (point-max) (+ l (point)))    (utf-8-untranslated-to-ucs)
836                           'untranslated-utf-8 u)    (let ((l (aref utf-8-ccl-regs 1))
837        (put-text-property (point) (min (point-max) (+ l (point)))          ch)
838                           'help-echo 'utf-8-help-echo)      (if (> l 0)
839        (compose-region (point) (+ l (point)) ?$,3u=(B)          (if (and hash-table
840        l)))                   (setq ch (gethash (aref utf-8-ccl-regs 0)  hash-table)))
841                (progn
842                  (insert ch)
843                  (delete-region (point) (min (point-max) (+ l (point)))))
844              (setq ch (aref utf-8-ccl-regs 0))
845              (put-text-property (point) (min (point-max) (+ l (point)))
846                                 'untranslated-utf-8 ch)
847              (put-text-property (point) (min (point-max) (+ l (point)))
848                                 'help-echo 'utf-8-help-echo)
849              (if (= l 2)
850                  (put-text-property (point) (min (point-max) (+ l (point)))
851                                     'display (format "\\%03o" ch))
852                (compose-region (point) (+ l (point)) ?$,3u=(B))
853              (forward-char l))
854          (forward-char 1))))
855    
856  (defcustom utf-8-compose-scripts nil  (defcustom utf-8-compose-scripts nil
857    "*Non-nil means compose various scripts on decoding utf-8 text."    "*Non-nil means compose various scripts on decoding utf-8 text."
# Line 744  Return the sequence's length." Line 861  Return the sequence's length."
861    
862  (defun utf-8-post-read-conversion (length)  (defun utf-8-post-read-conversion (length)
863    "Compose untranslated utf-8 sequences into single characters.    "Compose untranslated utf-8 sequences into single characters.
864    If `utf-translate-cjk-mode' is non-nil, tries to translate CJK characters.
865  Also compose particular scripts if `utf-8-compose-scripts' is non-nil."  Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
866    (save-excursion    (save-excursion
867      ;; Can't do eval-when-compile to insert a multibyte constant      (save-restriction
868      ;; version of the string in the loop, since it's always loaded as        (narrow-to-region (point) (+ (point) length))
869      ;; unibyte from a byte-compiled file.        ;; Can't do eval-when-compile to insert a multibyte constant
870      (let ((range (string-as-multibyte "^\xe1-\xf7")))        ;; version of the string in the loop, since it's always loaded as
871        (while (and (skip-chars-forward range)        ;; unibyte from a byte-compiled file.
872                    (not (eobp)))        (let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7"))
873          (forward-char (utf-8-compose)))))              hash-table ch)
874    ;; Fixme: Takahashi-san implies it may not work this easily.  I          (when utf-translate-cjk-mode
875    ;; asked why but didn't get a reply. -- fx            (if (not utf-translate-cjk-lang-env)
876    (when (and utf-8-compose-scripts (> length 1))                ;; Check these characters:
877      ;; These currently have definitions which cover the relevant                ;;   "U+2e80-U+33ff", "U+ff00-U+ffef"
878      ;; unicodes.  We could avoid loading thai-util &c by checking                ;; We may have to translate them to CJK charsets.
879      ;; whether the region contains any characters with the appropriate                (let ((range2 "$,29@(B-$,2G$,3r`(B-$,3u/(B"))
880      ;; categories.  There aren't yet Unicode-based rules for Tibetan.                  (skip-chars-forward (concat range range2))
881      (save-excursion (setq length (diacritic-post-read-conversion length)))                  (unless (eobp)
882      (save-excursion (setq length (thai-post-read-conversion length)))                    (utf-translate-cjk-load-tables)
883      (save-excursion (setq length (lao-post-read-conversion length)))                    (setq range (concat range range2)))
884      (save-excursion (setq length (devanagari-post-read-conversion length)))            (setq hash-table (get 'utf-subst-table-for-decode
885      (save-excursion (setq length (malayalam-post-read-conversion length)))                                  'translation-hash-table)))))
886      (save-excursion (setq length (tamil-post-read-conversion length))))          (while (and (skip-chars-forward range)
887    length)                      (not (eobp)))
888              (setq ch (following-char))
889  ;; ucs-tables is preloaded            (if (< ch 256)
890  ;; (defun utf-8-pre-write-conversion (beg end)                (utf-8-compose hash-table)
891  ;;   "Semi-dummy pre-write function effectively to autoload ucs-tables."              (if (and hash-table
892  ;;   ;; Ensure translation-table is loaded.                       (setq ch (gethash (encode-char ch 'ucs) hash-table)))
893  ;;   (require 'ucs-tables)                  (progn
894  ;;   ;; Don't do this again.                    (insert ch)
895  ;;   (coding-system-put 'mule-utf-8 'pre-write-conversion nil)                    (delete-char 1))
896  ;;   nil)                (forward-char 1)))))
897    
898          (when (and utf-8-compose-scripts (> length 1))
899            ;; These currently have definitions which cover the relevant
900            ;; unicodes.  We could avoid loading thai-util &c by checking
901            ;; whether the region contains any characters with the appropriate
902            ;; categories.  There aren't yet Unicode-based rules for Tibetan.
903            (diacritic-compose-region (point-max) (point-min))
904            (thai-compose-region (point-max) (point-min))
905            (lao-compose-region (point-max) (point-min))
906            (devanagari-compose-region (point-max) (point-min))
907            (malayalam-compose-region (point-max) (point-min))
908            (tamil-compose-region (point-max) (point-min)))
909          (- (point-max) (point-min)))))
910    
911    (defun utf-8-pre-write-conversion (beg end)
912      "Prepare for `utf-translate-cjk-mode' to encode text between BEG and END.
913    This is used as a post-read-conversion of utf-8 coding system."
914      (if (and utf-translate-cjk-mode
915               (not utf-translate-cjk-lang-env)
916               (save-excursion
917                 (goto-char beg)
918                 (re-search-forward "\\cc\\|\\cj\\|\\ch" end t)))
919          (utf-translate-cjk-load-tables))
920      nil)
921    
922  (make-coding-system  (make-coding-system
923   'mule-utf-8 4 ?u   'mule-utf-8 4 ?u
# Line 797  any of the character sets listed above a Line 939  any of the character sets listed above a
939  sequence representing U+FFFD (REPLACEMENT CHARACTER)."  sequence representing U+FFFD (REPLACEMENT CHARACTER)."
940    
941   '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)   '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
942   '((safe-charsets   `((safe-charsets
943      ascii      ascii
944      eight-bit-control      eight-bit-control
945      eight-bit-graphic      eight-bit-graphic
946      latin-iso8859-1      latin-iso8859-1
947      mule-unicode-0100-24ff      mule-unicode-0100-24ff
948      mule-unicode-2500-33ff      mule-unicode-2500-33ff
949      mule-unicode-e000-ffff)      mule-unicode-e000-ffff
950        ,@(if utf-translate-cjk-mode
951              utf-translate-cjk-charsets))
952     (mime-charset . utf-8)     (mime-charset . utf-8)
953     (coding-category . coding-category-utf-8)     (coding-category . coding-category-utf-8)
954     (valid-codes (0 . 255))     (valid-codes (0 . 255))
955  ;;    (pre-write-conversion . utf-8-pre-write-conversion)     (pre-write-conversion . utf-8-pre-write-conversion)
956     (post-read-conversion . utf-8-post-read-conversion)     (post-read-conversion . utf-8-post-read-conversion)
957     (translation-table-for-encode . utf-translation-table-for-encode)     (translation-table-for-encode . utf-translation-table-for-encode)
958     (dependency unify-8859-on-encoding-mode     (dependency unify-8859-on-encoding-mode

Legend:
Removed from v.1.13.2.4  
changed lines
  Added in v.1.13.2.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26