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

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

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

revision 1.8 by handa, Mon Mar 31 01:48:23 2003 UTC revision 1.9 by handa, Tue Apr 8 07:23:44 2003 UTC
# Line 69  Line 69 
69  (eval-and-compile  (eval-and-compile
70  (defconst utf-16-decode-ucs  (defconst utf-16-decode-ucs
71    ;; We have the unicode in r1.  Output is charset ID in r0, code    ;; We have the unicode in r1.  Output is charset ID in r0, code
72    ;; point in r1.  As r6 keeps endian information, the value should    ;; point in r1.
   ;; not be changed.  
73    `((lookup-integer utf-subst-table-for-decode r1 r3)    `((lookup-integer utf-subst-table-for-decode r1 r3)
74      (if r7                              ; got a translation      (if r7                              ; got a translation
75          ((r0 = r1) (r1 = r3))          ((r0 = r1) (r1 = r3))
# Line 111  Line 110 
110                       (r1 -= #xe000)                       (r1 -= #xe000)
111                       (r2 = (((r1 / 96) + 32) << 7))                       (r2 = (((r1 / 96) + 32) << 7))
112                       (r1 %= 96)                       (r1 %= 96)
113                       (r1 += (r2 + 32))))))))))))))                       (r1 += (r2 + 32)))))))))))))
114    
115    (defconst utf-16-le-decode-loop
116      `(loop
117        (read r3 r4)
118        (r1 = (r4 <8 r3))
119        ,utf-16-decode-ucs
120        (translate-character utf-translation-table-for-decode r0 r1)
121        (write-multibyte-character r0 r1)
122        (repeat)))
123    
124    (defconst utf-16-be-decode-loop
125      `(loop
126        (read r3 r4)
127        (r1 = (r3 <8 r4))
128        ,@utf-16-decode-ucs
129        (translate-character utf-translation-table-for-decode r0 r1)
130        (write-multibyte-character r0 r1)
131        (repeat)))
132    
133    )
134    
135  (define-ccl-program ccl-decode-mule-utf-16-le  (define-ccl-program ccl-decode-mule-utf-16-le
136    `(2                                   ; 2 bytes -> 1 to 4 bytes    `(2                                   ; 2 bytes -> 1 to 4 bytes
137      ((loop      ,utf-16-le-decode-loop)
       (read r3 r4)  
       (r1 = (r4 <8 r3))  
       ,utf-16-decode-ucs  
       (translate-character utf-translation-table-for-decode r0 r1)  
       (write-multibyte-character r0 r1)  
       (repeat))))  
138    "Decode UTF-16LE (little endian without signature bytes).    "Decode UTF-16LE (little endian without signature bytes).
139  Basic decoding is done into the charsets ascii, latin-iso8859-1 and  Basic decoding is done into the charsets ascii, latin-iso8859-1 and
140  mule-unicode-*.  Un-representable Unicode characters are decoded as  mule-unicode-*.  Un-representable Unicode characters are decoded as
# Line 130  U+fffd.  The result is run through the t Line 143  U+fffd.  The result is run through the t
143    
144  (define-ccl-program ccl-decode-mule-utf-16-be  (define-ccl-program ccl-decode-mule-utf-16-be
145    `(2                                   ; 2 bytes -> 1 to 4 bytes    `(2                                   ; 2 bytes -> 1 to 4 bytes
146      ((loop      ,utf-16-be-decode-loop)
       (read r3 r4)  
       (r1 = (r3 <8 r4))  
       ,utf-16-decode-ucs  
       (translate-character utf-translation-table-for-decode r0 r1)  
       (write-multibyte-character r0 r1)  
       (repeat))))  
147    "Decode UTF-16BE (big endian without signature bytes).    "Decode UTF-16BE (big endian without signature bytes).
148  Basic decoding is done into the charsets ascii, latin-iso8859-1 and  Basic decoding is done into the charsets ascii, latin-iso8859-1 and
149  mule-unicode-*.  Un-representable Unicode characters are  mule-unicode-*.  Un-representable Unicode characters are
150  decoded as U+fffd.  The result is run through the translation-table of  decoded as U+fffd.  The result is run through the translation-table of
151  name `utf-translation-table-for-decode'.")  name `utf-translation-table-for-decode'.")
152    
153    (define-ccl-program ccl-decode-mule-utf-16-le-with-signature
154      `(2
155        ((read r3 r4)
156         ,utf-16-le-decode-loop))
157      "Like ccl-decode-utf-16-le but skip the first 2-byte BOM.")
158    
159    (define-ccl-program ccl-decode-mule-utf-16-be-with-signature
160      `(2
161        ((read r3 r4)
162         ,utf-16-be-decode-loop))
163      "Like ccl-decode-utf-16-be but skip the first 2-byte BOM.")
164    
165    (define-ccl-program ccl-decode-mule-utf-16
166      `(2
167        ((read r3 r4)
168         (r1 = (r3 <8 r4))
169         (if (r1 == #xFFFE)
170             ;; R1 is a BOM for little endian.  We keep this character as
171             ;; is temporarily.  It is removed by post-read-conversion
172             ;; function.
173             (,@utf-16-decode-ucs
174              (write-multibyte-character r0 r1)
175              ,utf-16-le-decode-loop)
176           ((if (r1 == #xFEFF)
177                ;; R1 is a BOM for big endian, but we can't keep that
178                ;; character in the output because it can't be
179                ;; distinguished with the normal U+FEFF.  So, we keep
180                ;; #xFFFF instead.
181                ((r1 = #xFFFF)
182                 ,@utf-16-decode-ucs)
183              ;; R1 a normal Unicode character.
184              (,@utf-16-decode-ucs
185               (translate-character utf-translation-table-for-decode r0 r1)))
186            (write-multibyte-character r0 r1)
187            ,utf-16-be-decode-loop))))
188      "Like ccl-decode-utf-16-be/le but check the first BOM.")
189    
190  (makunbound 'utf-16-decode-ucs)         ; done with it  (makunbound 'utf-16-decode-ucs)         ; done with it
191    (makunbound 'utf-16-le-decode-loop)
192    (makunbound 'utf-16-be-decode-loop)
193    
194  (eval-and-compile  (eval-and-compile
195  (defconst utf-16-decode-to-ucs  (defconst utf-16-decode-to-ucs
# Line 168  name `utf-translation-table-for-decode'. Line 214  name `utf-translation-table-for-decode'.
214                    (r0 = (r3 + #x2500))                    (r0 = (r3 + #x2500))
215                  (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))                  (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
216                      (r0 = (r3 + #xe000))                      (r0 = (r3 + #xe000))
217                    (r0 = #xfffd)))))))))))                    (r0 = #xfffd))))))))))
218    
219    (defconst utf-16-le-encode-loop
220      `(loop
221        (read-multibyte-character r0 r1)
222        (lookup-character utf-subst-table-for-encode r0 r1)
223        (if (r7 == 0)
224            ((translate-character utf-translation-table-for-encode r0 r1)
225             ,utf-16-decode-to-ucs))
226        (write (r0 & 255))
227        (write (r0 >> 8))
228        (repeat)))
229    
230    (defconst utf-16-be-encode-loop
231      `(loop
232        (read-multibyte-character r0 r1)
233        (lookup-character utf-subst-table-for-encode r0 r1)
234        (if (r7 == 0)
235            ((translate-character utf-translation-table-for-encode r0 r1)
236             ,utf-16-decode-to-ucs))
237        (write (r0 >> 8))
238        (write (r0 & 255))
239        (repeat)))
240    )
241    
242  (define-ccl-program ccl-encode-mule-utf-16-le  (define-ccl-program ccl-encode-mule-utf-16-le
243    `(1    `(1
244      ((loop      ,utf-16-le-encode-loop)
       (read-multibyte-character r0 r1)  
       (lookup-character utf-subst-table-for-encode r0 r1)  
       (if (r7 == 0)  
           ((translate-character utf-translation-table-for-encode r0 r1)  
            ,utf-16-decode-to-ucs))  
       (write (r0 & 255))  
       (write (r0 >> 8))  
       (repeat))))  
245    "Encode to UTF-16LE (little endian without signature).    "Encode to UTF-16LE (little endian without signature).
246  Characters from the charsets ascii, eight-bit-control,  Characters from the charsets ascii, eight-bit-control,
247  eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded  eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
# Line 190  Others are encoded as U+FFFD.") Line 251  Others are encoded as U+FFFD.")
251    
252  (define-ccl-program ccl-encode-mule-utf-16-be  (define-ccl-program ccl-encode-mule-utf-16-be
253    `(1    `(1
254      ((loop      ,utf-16-be-encode-loop)
       (read-multibyte-character r0 r1)  
       (lookup-character utf-subst-table-for-encode r0 r1)  
       (if (r7 == 0)  
           ((translate-character utf-translation-table-for-encode r0 r1)  
            ,utf-16-decode-to-ucs))  
       (write (r0 >> 8))  
       (write (r0 & 255))  
       (repeat))))  
255    "Encode to UTF-16BE (big endian without signature).    "Encode to UTF-16BE (big endian without signature).
256  Characters from the charsets ascii, eight-bit-control,  Characters from the charsets ascii, eight-bit-control,
257  eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded  eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
# Line 206  after translation through the translatio Line 259  after translation through the translatio
259  `utf-translation-table-for-encode'.  `utf-translation-table-for-encode'.
260  Others are encoded as U+FFFD.")  Others are encoded as U+FFFD.")
261    
262    (define-ccl-program ccl-encode-mule-utf-16-le-with-signature
263      `(1
264        ((write #xFF)
265         (write #xFE)
266         ,utf-16-le-encode-loop))
267      "Encode to UTF-16 (little endian with signature).
268    Characters from the charsets ascii, eight-bit-control,
269    eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
270    after translation through the translation-table of name
271    `utf-translation-table-for-encode'.
272    Others are encoded as U+FFFD.")
273    
274    (define-ccl-program ccl-encode-mule-utf-16-be-with-signature
275      `(1
276        ((write #xFE)
277         (write #xFF)
278         ,utf-16-be-encode-loop))
279      "Encode to UTF-16 (big endian with signature).
280    Characters from the charsets ascii, eight-bit-control,
281    eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
282    after translation through the translation-table named
283    `utf-translation-table-for-encode'.
284    Others are encoded as U+FFFD.")
285    
286  (makunbound 'utf-16-decode-to-ucs)  (makunbound 'utf-16-decode-to-ucs)
287    (makunbound 'utf-16-le-encode-loop)
288    (makunbound 'utf-16-be-encode-loop)
289    
290    (defun mule-utf-16-post-read-conversion (length)
291      (when (> length 0)
292        (let ((char (following-char)))
293          (cond ((= char (decode-char 'ucs #xFFFE))
294                 (delete-char 1)
295                 (setq last-coding-system-used
296                       (coding-system-change-text-conversion
297                        last-coding-system-used
298                        'mule-utf-16-le-with-signature))
299                 (setq length (1- length)))
300                ((= char (decode-char 'ucs #xFFFF))
301                 (delete-char 1)
302                 (setq last-coding-system-used
303                       (coding-system-change-text-conversion
304                        last-coding-system-used
305                        'mule-utf-16-be-with-signature))
306                 (setq length (1- length)))
307                (t
308                 (setq last-coding-system-used 'mule-utf-16-be)))))
309      length)
310    
311  (let ((doc "  (let ((doc "
312    
# Line 239  sequence representing U+FFFD (REPLACEMEN Line 339  sequence representing U+FFFD (REPLACEMEN
339        mule-unicode-2500-33ff        mule-unicode-2500-33ff
340        mule-unicode-e000-ffff)        mule-unicode-e000-ffff)
341       (mime-charset . utf-16le)       (mime-charset . utf-16le)
      (coding-category . coding-category-utf-16-le)  
342       (valid-codes (0 . 255))       (valid-codes (0 . 255))
343       (dependency unify-8859-on-encoding-mode       (dependency unify-8859-on-encoding-mode
344                   unify-8859-on-decoding-mode                   unify-8859-on-decoding-mode
# Line 261  sequence representing U+FFFD (REPLACEMEN Line 360  sequence representing U+FFFD (REPLACEMEN
360        mule-unicode-2500-33ff        mule-unicode-2500-33ff
361        mule-unicode-e000-ffff)        mule-unicode-e000-ffff)
362       (mime-charset . utf-16be)       (mime-charset . utf-16be)
363         (valid-codes (0 . 255))
364         (dependency unify-8859-on-encoding-mode
365                     unify-8859-on-decoding-mode
366                     utf-fragment-on-decoding
367                     utf-translate-cjk)))
368    
369      (make-coding-system
370       'mule-utf-16-le-with-signature 4 ?u
371       (concat
372        "Little endian UTF-16 (with BOM) for Emacs-supported Unicode characters."
373        doc)
374    
375       '(ccl-decode-mule-utf-16-le-with-signature
376         . ccl-encode-mule-utf-16-le-with-signature)
377       '((safe-charsets
378          ascii
379          eight-bit-control
380          latin-iso8859-1
381          mule-unicode-0100-24ff
382          mule-unicode-2500-33ff
383          mule-unicode-e000-ffff)
384         (coding-category . coding-category-utf-16-le)
385         (mime-charset . utf-16)
386         (valid-codes (0 . 255))
387         (dependency unify-8859-on-encoding-mode
388                     unify-8859-on-decoding-mode
389                     utf-fragment-on-decoding
390                     utf-translate-cjk)))
391    
392      (make-coding-system
393       'mule-utf-16-be-with-signature 4 ?u
394       (concat
395        "Big endian UTF-16 (with BOM) for Emacs-supported Unicode characters."
396        doc)
397    
398       '(ccl-decode-mule-utf-16-be-with-signature
399         . ccl-encode-mule-utf-16-be-with-signature)
400       '((safe-charsets
401          ascii
402          eight-bit-control
403          latin-iso8859-1
404          mule-unicode-0100-24ff
405          mule-unicode-2500-33ff
406          mule-unicode-e000-ffff)
407         (coding-category . coding-category-utf-16-be)
408         (mime-charset . utf-16)
409         (valid-codes (0 . 255))
410         (dependency unify-8859-on-encoding-mode
411                     unify-8859-on-decoding-mode
412                     utf-fragment-on-decoding
413                     utf-translate-cjk)))
414    
415      (make-coding-system
416       'mule-utf-16 4 ?u
417       (concat
418        "UTF-16 (with or without BOM) for Emacs-supported Unicode characters."
419        doc)
420    
421       '(ccl-decode-mule-utf-16 . ccl-encode-mule-utf-16-be-with-signature)
422       '((safe-charsets
423          ascii
424          eight-bit-control
425          latin-iso8859-1
426          mule-unicode-0100-24ff
427          mule-unicode-2500-33ff
428          mule-unicode-e000-ffff)
429       (coding-category . coding-category-utf-16-be)       (coding-category . coding-category-utf-16-be)
430         (mime-charset . utf-16)
431       (valid-codes (0 . 255))       (valid-codes (0 . 255))
432       (dependency unify-8859-on-encoding-mode       (dependency unify-8859-on-encoding-mode
433                   unify-8859-on-decoding-mode                   unify-8859-on-decoding-mode
434                   utf-fragment-on-decoding                   utf-fragment-on-decoding
435                   utf-translate-cjk))))                   utf-translate-cjk)
436         (post-read-conversion . mule-utf-16-post-read-conversion)))
437    )
438    
439  (define-coding-system-alias 'utf-16-le 'mule-utf-16-le)  (define-coding-system-alias 'utf-16-le 'mule-utf-16-le)
440  (define-coding-system-alias 'utf-16-be 'mule-utf-16-be)  (define-coding-system-alias 'utf-16-be 'mule-utf-16-be)
441    (define-coding-system-alias 'utf-16-le-with-signature
442      'mule-utf-16-le-with-signature)
443    (define-coding-system-alias 'utf-16-be-with-signature
444      'mule-utf-16-be-with-signature)
445    (define-coding-system-alias 'utf-16 'mule-utf-16)
446    
447  ;;; utf-16.el ends here  ;;; utf-16.el ends here

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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