/[emacs]/emacs/lisp/language/china-util.el
ViewVC logotype

Diff of /emacs/lisp/language/china-util.el

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

revision 1.21 by wl, Tue Dec 18 17:52:17 2001 UTC revision 1.22 by monnier, Sun May 18 21:02:22 2003 UTC
# Line 1  Line 1 
1  ;;; china-util.el --- utilities for Chinese  -*- coding: iso-2022-7bit -*-  ;;; china-util.el --- utilities for Chinese  -*- coding: iso-2022-7bit -*-
2    
3  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.  ;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
4  ;; Licensed to the Free Software Foundation.  ;; Licensed to the Free Software Foundation.
5  ;; Copyright (C) 1995, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1995, 2001 Free Software Foundation, Inc.
6    
# Line 64  Line 64 
64    "Flag to tell if we should care line continuation convention of Hz.")    "Flag to tell if we should care line continuation convention of Hz.")
65    
66  (defconst hz-set-msb-table  (defconst hz-set-msb-table
67    (let ((str (make-string 127 0))    (eval-when-compile
68          (i 0))      (let ((chars nil)
69      (while (< i 33)            (i 0))
70        (aset str i i)        (while (< i 33)
71        (setq i (1+ i)))          (push i chars)
72      (while (< i 127)          (setq i (1+ i)))
73        (aset str i (+ i 128))        (while (< i 127)
74        (setq i (1+ i)))          (push (+ i 128) chars)
75      str))          (setq i (1+ i)))
76          (apply 'string (nreverse chars)))))
77    
78  ;;;###autoload  ;;;###autoload
79  (defun decode-hz-region (beg end)  (defun decode-hz-region (beg end)
# Line 171  Return the length of resulting text." Line 172  Return the length of resulting text."
172  ;; Many kudos to Himi!  The used code has been adapted from his  ;; Many kudos to Himi!  The used code has been adapted from his
173  ;; mule-ucs package.  ;; mule-ucs package.
174    
175    (eval-when-compile
176  (defun big5-to-flat-code (num)  (defun big5-to-flat-code (num)
177    "Convert NUM in Big 5 encoding to a `flat code'.    "Convert NUM in Big 5 encoding to a `flat code'.
178  0xA140 will be mapped to position 0, 0xA141 to position 1, etc.  0xA140 will be mapped to position 0, 0xA141 to position 1, etc.
# Line 226  mapped will be represented with the byte Line 228  mapped will be represented with the byte
228    
229  The return value is the filled translation table."  The return value is the filled translation table."
230    
231    (let (chartable    (let ((chartable (make-char-table 'translation-table #xFF))
         elem  
         result  
232          char          char
233          big5          big5
234          i          i
235          end          end
236          codepoint          codepoint
237          charset)          charset)
238      (setq chartable (make-char-table 'translation-table #xFF))      (dolist (elem alist)
239      (while alist        (setq char (car elem)
240        (setq elem (car alist)              big5 (cdr elem))
             char (car elem)  
             big5 (cdr elem)  
             alist (cdr alist))  
241        (cond ((and (consp char)        (cond ((and (consp char)
242                    (consp big5))                    (consp big5))
243                 (setq i (big5-to-flat-code (car big5))               (setq i (big5-to-flat-code (car big5))
244                       end (big5-to-flat-code (cdr big5))                     end (big5-to-flat-code (cdr big5))
245                       codepoint (euc-to-flat-code (cdr char))                     codepoint (euc-to-flat-code (cdr char))
246                       charset (car char))                     charset (car char))
247                 (while (>= end i)               (while (>= end i)
248                   (aset chartable                 (aset chartable
249                         (decode-big5-char (flat-code-to-big5 i))                       (decode-big5-char (flat-code-to-big5 i))
250                         (apply (function make-char)                       (apply (function make-char)
251                                charset                              charset
252                                (flat-code-to-euc codepoint)))                              (flat-code-to-euc codepoint)))
253                   (setq i (1+ i)                 (setq i (1+ i)
254                         codepoint (1+ codepoint)))                       codepoint (1+ codepoint))))
             )  
255              ((and (char-valid-p char)              ((and (char-valid-p char)
256                    (numberp big5))                    (numberp big5))
257                 (setq i (decode-big5-char big5))               (setq i (decode-big5-char big5))
258                 (aset chartable i char)               (aset chartable i char))
             )  
259              (t              (t
260               (error "Unknown slot type: %S" elem)               (error "Unknown slot type: %S" elem))))
             )  
       )  
     )  
261      ;; the return value      ;; the return value
262      chartable      chartable)))
   )  
 )  
263    
264  ;; All non-CNS encodings are commented out.  ;; All non-CNS encodings are commented out.
265    
266  (define-translation-table 'big5-to-cns  (define-translation-table 'big5-to-cns
267      (eval-when-compile
268    (expand-euc-big5-alist    (expand-euc-big5-alist
269     '(     '(
270       ;; Symbols       ;; Symbols
# Line 420  The return value is the filled translati Line 411  The return value is the filled translati
411       (?$(I=~(B . #xF9DB)       (?$(I=~(B . #xF9DB)
412       (?$(IK\(B . #xF9DC)       (?$(IK\(B . #xF9DC)
413      )      )
414    )    ))
415  )  )
416    
417  ;;  ;;

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

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