/[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.8 by miles, Sat Sep 4 09:26:22 2004 UTC revision 1.13.2.9 by miles, Fri Oct 29 02:05:07 2004 UTC
# Line 194  Setting this variable outside customize Line 194  Setting this variable outside customize
194  (defconst utf-translate-cjk-charsets '(chinese-gb2312  (defconst utf-translate-cjk-charsets '(chinese-gb2312
195                                         chinese-big5-1 chinese-big5-2                                         chinese-big5-1 chinese-big5-2
196                                         japanese-jisx0208 japanese-jisx0212                                         japanese-jisx0208 japanese-jisx0212
197                                           katakana-jisx0201
198                                         korean-ksc5601)                                         korean-ksc5601)
199    "List of charsets supported by `utf-translate-cjk-mode'.")    "List of charsets supported by `utf-translate-cjk-mode'.")
200    
201  (defconst utf-translate-cjk-unicode-range  (defvar utf-translate-cjk-lang-env nil
202    '((#x2e80 . #xd7a3)    "Language environment in which tables for `utf-translate-cjk-mode' is loaded.
203      (#xff00 . #xffef))  The value nil means that the tables are not yet loaded.")
204    "List of Unicode code ranges supported by `utf-translate-cjk-mode'.")  
205    (defvar utf-translate-cjk-unicode-range)
206    
207    ;; String generated from utf-translate-cjk-unicode-range.  It is
208    ;; suitable for an argument to skip-chars-forward.
209    (defvar utf-translate-cjk-unicode-range-string nil)
210    
211    (defun utf-translate-cjk-set-unicode-range (range)
212      (setq utf-translate-cjk-unicode-range range)
213      (setq utf-translate-cjk-unicode-range-string
214            (let ((decode-char-no-trans
215                   #'(lambda (x)
216                       (cond ((< x #x100) (make-char 'latin-iso8859-1 x))
217                             ((< x #x2500)
218                              (setq x (- x #x100))
219                              (make-char 'mule-unicode-0100-24ff
220                                         (+ (/ x 96) 32) (+ (% x 96) 32)))
221                             ((< x #x3400)
222                              (setq x (- x #x2500))
223                              (make-char 'mule-unicode-2500-33ff
224                                         (+ (/ x 96) 32) (+ (% x 96) 32)))
225                             (t
226                              (setq x (- x #xe000))
227                              (make-char 'mule-unicode-e000-ffff
228                                         (+ (/ x 96) 32) (+ (% x 96) 32))))))
229                  ranges from to)
230              (dolist (elt range)
231                (setq from (max #xA0 (car elt)) to (min #xffff (cdr elt)))
232                (if (and (>= to #x3400) (< to #xE000))
233                    (setq to #x33FF))
234                (cond ((< from #x100)
235                       (if (>= to #xE000)
236                           (setq ranges (cons (cons #xE000 to) ranges)
237                                 to #x33FF))
238                       (if (>= to #x2500)
239                           (setq ranges (cons (cons #x2500 to) ranges)
240                                 to #x24FF))
241                       (if (>= to #x100)
242                           (setq ranges (cons (cons #x100 to) ranges)
243                                 to #xFF)))
244                      ((< from #x2500)
245                       (if (>= to #xE000)
246                           (setq ranges (cons (cons #xE000 to) ranges)
247                                 to #x33FF))
248                       (if (>= to #x2500)
249                           (setq ranges (cons (cons #x2500 to) ranges)
250                                 to #x24FF)))
251                      ((< from #x3400)
252                       (if (>= to #xE000)
253                           (setq ranges (cons (cons #xE000 to) ranges)
254                                 to #x33FF))))
255                (if (<= from to)
256                    (setq ranges (cons (cons from to) ranges))))
257              (mapconcat #'(lambda (x)
258                             (format "%c-%c"
259                                     (funcall decode-char-no-trans (car x))
260                                     (funcall decode-char-no-trans (cdr x))))
261                         ranges "")))
262      ;; These forces loading and settting tables for
263      ;; utf-translate-cjk-mode.
264      (setq utf-translate-cjk-lang-env nil
265            ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
266            ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)))
267    
268    (defcustom utf-translate-cjk-unicode-range '((#x2e80 . #xd7a3)
269                                                 (#xff00 . #xffef))
270      "List of Unicode code ranges supported by `utf-translate-cjk-mode'.
271    Setting this variable directly does not take effect;
272    use either \\[customize] or the function
273    `utf-translate-cjk-set-unicode-range'."
274      :version "21.4"
275      :type '(repeat (cons integer integer))
276      :set (lambda (symbol value)
277             (utf-translate-cjk-set-unicode-range value))
278      :group 'mule)
279    
280  ;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.  ;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.
281  (defsubst utf-translate-cjk-substitutable-p (code-point)  (defsubst utf-translate-cjk-substitutable-p (code-point)
# Line 213  Setting this variable outside customize Line 288  Setting this variable outside customize
288          (setq elt nil)))          (setq elt nil)))
289      elt))      elt))
290    
 (defvar utf-translate-cjk-lang-env nil  
   "Language environment in which tables for `utf-translate-cjk-mode' is loaded.  
 The value nil means that the tables are not yet loaded.")  
   
291  (defun utf-translate-cjk-load-tables ()  (defun utf-translate-cjk-load-tables ()
292    "Load tables for `utf-translate-cjk-mode'."    "Load tables for `utf-translate-cjk-mode'."
293    ;; Fixme: Allow the use of the CJK charsets to be    ;; Fixme: Allow the use of the CJK charsets to be
# Line 425  by the above coding systems, you can cus Line 496  by the above coding systems, you can cus
496            ;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx            ;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
497            ((r1 &= #x3F)            ((r1 &= #x3F)
498             (r1 |= ((r0 & #x1F) << 6))             (r1 |= ((r0 & #x1F) << 6))
499             ;; Now r2 holds scalar value.  We don't have to check             ;; Now r1 holds scalar value.  We don't have to check
500             ;; `overlong sequence' because r0 >= 0xC2.             ;; `overlong sequence' because r0 >= 0xC2.
501    
502             (if (r1 >= 256)             (if (r1 >= 256)
503                 ;; mule-unicode-0100-24ff (< 0800)                 ;; mule-unicode-0100-24ff (< 0800)
504                 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))                 ((r0 = r1)
505                  (r1 -= #x0100)                  (lookup-integer utf-subst-table-for-decode r0 r1)
506                  (r2 = (((r1 / 96) + 32) << 7))                  (if (r7 == 0)
507                  (r1 %= 96)                      ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
508                  (r1 += (r2 + 32))                       (r1 -= #x0100)
509                  (translate-character                       (r2 = (((r1 / 96) + 32) << 7))
510                   utf-translation-table-for-decode r0 r1)                       (r1 %= 96)
511                         (r1 += (r2 + 32))
512                         (translate-character
513                          utf-translation-table-for-decode r0 r1)))
514                  (write-multibyte-character r0 r1)                  (write-multibyte-character r0 r1)
515                  (read r0)                  (read r0)
516                  (repeat))                  (repeat))
517               (if (r1 >= 160)               (if (r1 >= 160)
518                   ;; latin-iso8859-1                   ;; latin-iso8859-1
519                   ((r1 -= 128)                   ((r0 = r1)
520                    (write-multibyte-character r6 r1)                    (lookup-integer utf-subst-table-for-decode r0 r1)
521                      (if (r7 == 0)
522                          ((r1 -= 128)
523                           (write-multibyte-character r6 r1))
524                        ((write-multibyte-character r0 r1)))
525                    (read r0)                    (read r0)
526                    (repeat))                    (repeat))
527                 ;; eight-bit-control                 ;; eight-bit-control
# Line 482  by the above coding systems, you can cus Line 560  by the above coding systems, you can cus
560    
561             (if (r3 < #x2500)             (if (r3 < #x2500)
562                 ;; mule-unicode-0100-24ff (>= 0800)                 ;; mule-unicode-0100-24ff (>= 0800)
563                 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))                 ((r0 = r3)
564                  (r3 -= #x0100)                  (lookup-integer utf-subst-table-for-decode r0 r1)
565                  (r3 //= 96)                  (if (r7 == 0)
566                  (r1 = (r7 + 32))                      ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
567                  (r1 += ((r3 + 32) << 7))                       (r3 -= #x0100)
568                  (translate-character                       (r3 //= 96)
569                   utf-translation-table-for-decode r0 r1)                       (r1 = (r7 + 32))
570                         (r1 += ((r3 + 32) << 7))
571                         (translate-character
572                          utf-translation-table-for-decode r0 r1)))
573                  (write-multibyte-character r0 r1)                  (write-multibyte-character r0 r1)
574                  (read r0)                  (read r0)
575                  (repeat)))                  (repeat)))
# Line 874  Also compose particular scripts if `utf- Line 955  Also compose particular scripts if `utf-
955              hash-table ch)              hash-table ch)
956          (set-buffer-multibyte t)          (set-buffer-multibyte t)
957          (when utf-translate-cjk-mode          (when utf-translate-cjk-mode
958            (if (not utf-translate-cjk-lang-env)            (unless utf-translate-cjk-lang-env
959                ;; Check these characters:              ;; Check these characters in utf-translate-cjk-range.
960                ;;   "U+2e80-U+33ff", "U+ff00-U+ffef"              ;; We may have to translate them to CJK charsets.
961                ;; We may have to translate them to CJK charsets.              (skip-chars-forward
962                (let ((range2 "$,29@(B-$,2G$,3r`(B-$,3u/(B"))               (concat range utf-translate-cjk-unicode-range-string))
963                  (skip-chars-forward (concat range range2))              (unless (eobp)
964                  (unless (eobp)                (utf-translate-cjk-load-tables)
965                    (utf-translate-cjk-load-tables)                (setq range
966                    (setq range (concat range range2)))                      (concat range utf-translate-cjk-unicode-range-string)))
967            (setq hash-table (get 'utf-subst-table-for-decode              (setq hash-table (get 'utf-subst-table-for-decode
968                                  'translation-hash-table)))))                                    'translation-hash-table))))
969          (while (and (skip-chars-forward range)          (while (and (skip-chars-forward range)
970                      (not (eobp)))                      (not (eobp)))
971            (setq ch (following-char))            (setq ch (following-char))

Legend:
Removed from v.1.13.2.8  
changed lines
  Added in v.1.13.2.9

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