/[emacs]/emacs/lisp/international/fontset.el
ViewVC logotype

Diff of /emacs/lisp/international/fontset.el

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

revision 1.53 by eliz, Tue Dec 25 16:29:20 2001 UTC revision 1.53.4.1 by miles, Fri Apr 4 06:20:22 2003 UTC
# Line 40  Line 40 
40  ;; character `*' is embedded in `CHARSET_ENCODING' field.  The  ;; character `*' is embedded in `CHARSET_ENCODING' field.  The
41  ;; REGISTRY for ASCII characters are predefined as "ISO8859-1".  ;; REGISTRY for ASCII characters are predefined as "ISO8859-1".
42    
43  (let ((l  (defun setup-default-fontset ()
44         ;; Eval this at compile-time, since fontset.el is always loaded    "Setup the default fontset."
45         ;; when run under X and this would always load ind-util.el as well.    (dolist (elt
46         (eval-when-compile             `((latin-iso8859-1 . (nil . "ISO8859-1"))
47           `((latin-iso8859-1 . (nil . "ISO8859-1"))               (latin-iso8859-2 . (nil . "ISO8859-2"))
48             (latin-iso8859-2 . (nil . "ISO8859-2"))               (latin-iso8859-3 . (nil . "ISO8859-3"))
49             (latin-iso8859-3 . (nil . "ISO8859-3"))               (latin-iso8859-4 . (nil . "ISO8859-4"))
50             (latin-iso8859-4 . (nil . "ISO8859-4"))               (thai-tis620 . ("*" . "TIS620"))
51             (thai-tis620 . ("*" . "TIS620"))               (greek-iso8859-7 . ("*" . "ISO8859-7"))
52             (greek-iso8859-7 . ("*" . "ISO8859-7"))               (arabic-iso8859-6 . ("*" . "ISO8859-6"))
53             (arabic-iso8859-6 . ("*" . "ISO8859-6"))               (hebrew-iso8859-8 . ("*" . "ISO8859-8"))
54             (hebrew-iso8859-8 . ("*" . "ISO8859-8"))               (katakana-jisx0201 . ("*" . "JISX0201"))
55             (katakana-jisx0201 . ("*" . "JISX0201"))               (latin-jisx0201 . (nil . "JISX0201"))
56             (latin-jisx0201 . (nil . "JISX0201"))               (cyrillic-iso8859-5 . ("*" . "ISO8859-5"))
57             (cyrillic-iso8859-5 . ("*" . "ISO8859-5"))               (latin-iso8859-9 . (nil . "ISO8859-9"))
58             (latin-iso8859-9 . (nil . "ISO8859-9"))               (japanese-jisx0208-1978 . ("*" . "JISX0208.1978"))
59             (japanese-jisx0208-1978 . ("*" . "JISX0208.1978"))               (chinese-gb2312 . ("*" . "GB2312.1980"))
60             (chinese-gb2312 . ("*" . "GB2312.1980"))               (japanese-jisx0208 . ("*" . "JISX0208.1990"))
61             (japanese-jisx0208 . ("*" . "JISX0208.1990"))               (korean-ksc5601 . ("*" . "KSC5601.1989"))
62             (korean-ksc5601 . ("*" . "KSC5601.1989"))               (japanese-jisx0212 . ("*" . "JISX0212"))
63             (japanese-jisx0212 . ("*" . "JISX0212"))               (chinese-cns11643-1 . ("*" . "CNS11643.1992-1"))
64             (chinese-cns11643-1 . ("*" . "CNS11643.1992-1"))               (chinese-cns11643-2 . ("*" . "CNS11643.1992-2"))
65             (chinese-cns11643-2 . ("*" . "CNS11643.1992-2"))               (chinese-cns11643-3 . ("*" . "CNS11643.1992-3"))
66             (chinese-cns11643-3 . ("*" . "CNS11643.1992-3"))               (chinese-cns11643-4 . ("*" . "CNS11643.1992-4"))
67             (chinese-cns11643-4 . ("*" . "CNS11643.1992-4"))               (chinese-cns11643-5 . ("*" . "CNS11643.1992-5"))
68             (chinese-cns11643-5 . ("*" . "CNS11643.1992-5"))               (chinese-cns11643-6 . ("*" . "CNS11643.1992-6"))
69             (chinese-cns11643-6 . ("*" . "CNS11643.1992-6"))               (chinese-cns11643-7 . ("*" . "CNS11643.1992-7"))
70             (chinese-cns11643-7 . ("*" . "CNS11643.1992-7"))               (chinese-big5-1 . ("*" . "Big5"))
71             (chinese-big5-1 . ("*" . "Big5"))               (chinese-big5-2 . ("*" . "Big5"))
72             (chinese-big5-2 . ("*" . "Big5"))               (chinese-sisheng . (nil . "sisheng_cwnn"))
73             (chinese-sisheng . (nil . "sisheng_cwnn"))               (vietnamese-viscii-lower . (nil . "VISCII1.1"))
74             (vietnamese-viscii-lower . (nil . "VISCII1.1"))               (vietnamese-viscii-upper . (nil . "VISCII1.1"))
75             (vietnamese-viscii-upper . (nil . "VISCII1.1"))               (arabic-digit . ("*" . "MuleArabic-0"))
76             (arabic-digit . ("*" . "MuleArabic-0"))               (arabic-1-column . ("*" . "MuleArabic-1"))
77             (arabic-1-column . ("*" . "MuleArabic-1"))               (arabic-2-column . ("*" . "MuleArabic-2"))
78             (arabic-2-column . ("*" . "MuleArabic-2"))               (ipa . (nil . "MuleIPA"))
79             (ipa . (nil . "MuleIPA"))               (ethiopic . ("*" . "Ethiopic-Unicode"))
80             (ethiopic . ("*" . "Ethiopic-Unicode"))               (ascii-right-to-left . (nil . "ISO8859-1"))
81             (ascii-right-to-left . (nil . "ISO8859-1"))               (indian-is13194 . ("*" . "IS13194-Devanagari"))
82             (indian-is13194 . ("*" . "IS13194-Devanagari"))               (indian-2-column . ("*" . "MuleIndian-2"))
83             (indian-2-column . ("*" . "MuleIndian-2"))               (lao . ("*" . "MuleLao-1"))
84             (lao . ("*" . "MuleLao-1"))               (tibetan . ("proportional" . "MuleTibetan-2"))
85             (tibetan . ("proportional" . "MuleTibetan-2"))               (tibetan-1-column . ("*" . "MuleTibetan-1"))
86             (tibetan-1-column . ("*" . "MuleTibetan-1"))               (latin-iso8859-14 . (nil . "ISO8859-14"))
87             (latin-iso8859-14 . (nil . "ISO8859-14"))               (latin-iso8859-15 . (nil . "ISO8859-15"))
88             (latin-iso8859-15 . (nil . "ISO8859-15"))               (mule-unicode-0100-24ff . (nil . "ISO10646-1"))
89             (mule-unicode-0100-24ff . (nil . "ISO10646-1"))               (mule-unicode-2500-33ff . (nil . "ISO10646-1"))
90             (mule-unicode-2500-33ff . (nil . "ISO10646-1"))               (mule-unicode-e000-ffff . (nil . "ISO10646-1"))
91             (mule-unicode-e000-ffff . (nil . "ISO10646-1"))               (japanese-jisx0213-1 . ("*" . "JISX0213.2000-1"))
92             (japanese-jisx0213-1 . ("*" . "JISX0213.2000-1"))               (japanese-jisx0213-2 . ("*" . "JISX0213.2000-2"))
93             (japanese-jisx0213-2 . ("*" . "JISX0213.2000-2"))               ;; unicode
94             ;; unicode               ((,(decode-char 'ucs #x0900) . ,(decode-char 'ucs #x097F))
95             ((,(decode-char 'ucs #x0900)                . ("*" . "ISO10646.indian-1"))
96               . ,(decode-char 'ucs #x097F)) . ("*" . "ISO10646.indian-1"))               ;; Indian CDAC
97             ;; indian               (,(indian-font-char-range 'cdac:dv-ttsurekh)
98             (indian-glyph . ("*" . "Devanagari-CDAC"))                . ("*" . "Devanagari-CDAC"))
99             ((,(indian-glyph-char 0 'devanagari)               (,(indian-font-char-range 'cdac:sd-ttsurekh)
100               . ,(indian-glyph-char 255 'devanagari)) . ("*" . "Devanagari-CDAC"))                . ("*" . "Sanskrit-CDAC"))
101             ((,(indian-glyph-char 0 'sanskrit)               (,(indian-font-char-range 'cdac:bn-ttdurga)
102               . ,(indian-glyph-char 255 'sanskrit)) . ("*" . "Sanskrit-CDAC"))                . ("*" . "Bengali-CDAC"))
103             ((,(indian-glyph-char 0 'bengali)               (,(indian-font-char-range 'cdac:as-ttdurga)
104               . ,(indian-glyph-char 255 'bengali)) . ("*" . "Bengali-CDAC"))                . ("*" . "Assamese-CDAC"))
105             ((,(indian-glyph-char 0 'assamese)               (,(indian-font-char-range 'cdac:pn-ttamar)
106               . ,(indian-glyph-char 255 'assamese)) . ("*" . "Assamese-CDAC"))                . ("*" . "Punjabi-CDAC"))
107             ((,(indian-glyph-char 0 'punjabi)               (,(indian-font-char-range 'cdac:gj-ttavantika)
108               . ,(indian-glyph-char 255 'punjabi)) . ("*" . "Punjabi-CDAC"))                . ("*" . "Gujarati-CDAC"))
109             ((,(indian-glyph-char 0 'gujarati)               (,(indian-font-char-range 'cdac:or-ttsarala)
110               . ,(indian-glyph-char 255 'gujarati)) . ("*" . "Gujarati-CDAC"))                . ("*" . "Oriya-CDAC"))
111             ((,(indian-glyph-char 0 'oriya)               (,(indian-font-char-range 'cdac:tm-ttvalluvar)
112               . ,(indian-glyph-char 255 'oriya)) . ("*" . "Oriya-CDAC"))                . ("*" . "Tamil-CDAC"))
113             ((,(indian-glyph-char 0 'tamil)               (,(indian-font-char-range 'cdac:tl-tthemalatha)
114               . ,(indian-glyph-char 255 'tamil)) . ("*" . "Tamil-CDAC"))                . ("*" . "Telugu-CDAC"))
115             ((,(indian-glyph-char 0 'telugu)               (,(indian-font-char-range 'cdac:kn-ttuma)
116               . ,(indian-glyph-char 255 'telugu)) . ("*" . "Telugu-CDAC"))                . ("*" . "Kannada-CDAC"))
117             ((,(indian-glyph-char 0 'kannada)               (,(indian-font-char-range 'cdac:ml-ttkarthika)
118               . ,(indian-glyph-char 255 'kannada)) . ("*" . "Kannada-CDAC"))                . ("*" . "Malayalam-CDAC"))
119             ((,(indian-glyph-char 0 'malayalam)               ;; Indian AKRUTI
120               . ,(indian-glyph-char 255 'malayalam)) . ("*" . "Malayalam-CDAC"))               (,(indian-font-char-range 'akruti:dev)
121             )))                . ("*" . "dev-AKRUTHI"))
122        charset font-spec arg)               (,(indian-font-char-range 'akruti:bng)
123    (while l                . ("*" . "bng-AKRUTHI"))
124      (setq charset (car (car l)) font-spec (cdr (car l)) l (cdr l))               (,(indian-font-char-range 'akruti:pnj)
125      (if (symbolp charset)                . ("*" . "png-AKRUTHI"))
126          (setq arg (make-char charset))               (,(indian-font-char-range 'akruti:guj)
127        (setq arg charset))                . ("*" . "guj-AKRUTHI"))
128      (set-fontset-font "fontset-default" arg font-spec)))               (,(indian-font-char-range 'akruti:ori)
129                  . ("*" . "ori-AKRUTHI"))
130                 (,(indian-font-char-range 'akruti:tml)
131                  . ("*" . "tml-AKRUTHI"))
132                 (,(indian-font-char-range 'akruti:tlg)
133                  . ("*" . "tlg-AKRUTHI"))
134                 (,(indian-font-char-range 'akruti:knd)
135                  . ("*" . "kng-AKRUTHI"))
136                 (,(indian-font-char-range 'akruti:mal)
137                  . ("*" . "mal-AKRUTHI"))
138                 ))
139        (set-fontset-font "fontset-default" (car elt) (cdr elt))))
140    
141  ;; Set arguments in `font-encoding-alist' (which see).  ;; Set arguments in `font-encoding-alist' (which see).
142  (defun set-font-encoding (pattern charset encoding)  (defun set-font-encoding (pattern charset encoding)
# Line 139  Line 150 
150              (cons (list pattern (cons charset encoding)) font-encoding-alist)))              (cons (list pattern (cons charset encoding)) font-encoding-alist)))
151      ))      ))
152    
153  (set-font-encoding "ISO8859-1" 'ascii 0)  ;; Allow display of arbitrary characters with an iso-10646-encoded
154  (set-font-encoding "JISX0201" 'latin-jisx0201 0)  ;; (`Unicode') font.
155    (define-translation-table 'ucs-mule-to-mule-unicode
156      ucs-mule-to-mule-unicode)
157    (define-translation-hash-table 'ucs-mule-cjk-to-unicode
158      ucs-mule-cjk-to-unicode)
159    
160  (define-ccl-program ccl-encode-unicode-font  (define-ccl-program ccl-encode-unicode-font
161    `(0    `(0
162      (if (r0 == ,(charset-id 'ascii))      ;; r0: charset-id
163          ((r2 = r1)      ;; r1: 1st position code
164           (r1 = 0))      ;; r2: 2nd position code (if r0 is 2D charset)
165        (if (r0 == ,(charset-id 'latin-iso8859-1))      ((if (r0 == ,(charset-id 'ascii))
166            ((r2 = (r1 + 128))           ((r2 = r1)
167             (r1 = 0))            (r1 = 0))
168          (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))         ;; At first, try to get a Unicode code point directly.
169              ((r1 *= 96)         ((if (r2 >= 0)
170               (r1 += r2)              ;; This is a 2D charset.
171               (r1 += ,(- #x100 (* 32 96) 32))              (r1 = ((r1 << 7) | r2)))
172               (r1 >8= 0)          (lookup-character ucs-mule-cjk-to-unicode r0 r1)
173               (r2 = r7))          (if r7
174            (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))              ;; We got it!
175                ((r1 *= 96)              ((r1 = (r0 >> 8))
176                 (r1 += r2)               (r2 = (r0 & #xFF)))
177                 (r1 += ,(- #x2500 (* 32 96) 32))            ;; Look for a translation for non-ASCII chars.
178                 (r1 >8= 0)            ((translate-character ucs-mule-to-mule-unicode r0 r1)
179                 (r2 = r7))             (if (r0 == ,(charset-id 'latin-iso8859-1))
180              (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))                 ((r2 = (r1 + 128))
181                  ((r1 *= 96)                  (r1 = 0))
182                   (r1 += r2)               ((r2 = (r1 & #x7F))
183                   (r1 += ,(- #xe000 (* 32 96) 32))                (r1 >>= 7)
184                   (r1 >8= 0)                (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
185                   (r2 = r7)))))))))                    ((r1 *= 96)
186                       (r1 += r2)
187                       (r1 += ,(- #x100 (* 32 96) 32))
188                       (r1 >8= 0)
189                       (r2 = r7))
190                    (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
191                        ((r1 *= 96)
192                         (r1 += r2)
193                         (r1 += ,(- #x2500 (* 32 96) 32))
194                         (r1 >8= 0)
195                         (r2 = r7))
196                      (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
197                          ((r1 *= 96)
198                           (r1 += r2)
199                           (r1 += ,(- #xe000 (* 32 96) 32))
200                           (r1 >8= 0)
201                           (r2 = r7))
202                        ;; No way, use the glyph for U+FFFD.
203                        ((r1 = #xFF)
204                         (r2 = #xFD)))))))))))))
205      "Encode characters for display with iso10646 font.
206    Translate through the translation-hash-table named
207    `ucs-mule-cjk-to-unicode' and the translation-table named
208    `ucs-mule-to-mule-unicode' initially.")
209    
210    ;; Use the above CCL encoder for Unicode fonts.  Please note that the
211    ;; regexp is not simply "ISO10646-1" because there exists, for
212    ;; instance, the following Devanagari Unicode fonts:
213    ;;      -misc-fixed-medium-r-normal--24-240-72-72-c-120-iso10646.indian-1
214    ;;      -sibal-devanagari-medium-r-normal--24-240-75-75-P--iso10646-dev
215  (setq font-ccl-encoder-alist  (setq font-ccl-encoder-alist
216        (cons '("ISO10646-1" . ccl-encode-unicode-font)        (cons '("ISO10646.*-*" . ccl-encode-unicode-font)
217              font-ccl-encoder-alist))              font-ccl-encoder-alist))
218    
219  ;; Setting for suppressing XLoadQueryFont on big fonts.  ;; Setting for suppressing XLoadQueryFont on big fonts.
# Line 403  variable `x-font-name-charset-alist'), a Line 446  variable `x-font-name-charset-alist'), a
446                  (or (assq charset fontlist)                  (or (assq charset fontlist)
447                      (setq fontlist                      (setq fontlist
448                            (cons (cons charset ascii-font-spec) fontlist))))))))                            (cons (cons charset ascii-font-spec) fontlist))))))))
449        
450      fontlist))      fontlist))
451    
452  (defun fontset-name-p (fontset)  (defun fontset-name-p (fontset)
# Line 459  with \"fontset\" in `<CHARSET_REGISTRY> Line 502  with \"fontset\" in `<CHARSET_REGISTRY>
502              name))              name))
503        fontset)))        fontset)))
504    
505  ;;;###autoload  
506  (defun create-fontset-from-fontset-spec (fontset-spec  (defun create-fontset-from-fontset-spec (fontset-spec
507                                           &optional style-variant noerror)                                           &optional style-variant noerror)
508    "Create a fontset from fontset specification string FONTSET-SPEC.    "Create a fontset from fontset specification string FONTSET-SPEC.
# Line 481  It returns a name of the created fontset Line 524  It returns a name of the created fontset
524          (name (match-string 0 fontset-spec))          (name (match-string 0 fontset-spec))
525          xlfd-fields charset fontlist ascii-font)          xlfd-fields charset fontlist ascii-font)
526      (if (query-fontset name)      (if (query-fontset name)
527          (or noerror          (or noerror
528              (error "Fontset \"%s\" already exists" name))              (error "Fontset \"%s\" already exists" name))
529        (setq xlfd-fields (x-decompose-font-name name))        (setq xlfd-fields (x-decompose-font-name name))
530        (or xlfd-fields        (or xlfd-fields

Legend:
Removed from v.1.53  
changed lines
  Added in v.1.53.4.1

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