(default-coded-charset-priority-list): Add `=>big5-cdp@iwds-1',
[chise/xemacs-chise.git.1] / lisp / mule / mule-charset.el
1 ;;; mule-charset.el --- Charset functions for Mule.
2
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Amdahl Corporation.
5 ;; Copyright (C) 1996 Sun Microsystems.
6 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
7 ;;   2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018
8 ;;   MORIOKA Tomohiko
9
10 ;; Author: Unknown
11 ;; Keywords: i18n, mule, internal
12
13 ;; This file is part of XEmacs.
14
15 ;; XEmacs is free software; you can redistribute it and/or modify it
16 ;; under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; any later version.
19
20 ;; XEmacs is distributed in the hope that it will be useful, but
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23 ;; General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with XEmacs; see the file COPYING.  If not, write to the 
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
29
30 ;;; Synched up with: Not synched.  API at source level synched with FSF 20.3.9.
31
32 ;;; Commentary:
33
34 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
35 ;; and they never will be.  -sb [1999-05-26]
36
37 ;;; Code:
38 \f
39 ;;;; Classifying text according to charsets
40
41 (defun charsets-in-region (start end &optional buffer)
42   "Return a list of the charsets in the region between START and END.
43 BUFFER defaults to the current buffer if omitted."
44   (let (list)
45     (save-excursion
46       (if buffer
47           (set-buffer buffer))
48       (save-restriction
49         (narrow-to-region start end)
50         (goto-char (point-min))
51         (while (not (eobp))
52           (let* (prev-charset
53                  (ch (char-after (point)))
54                  (charset (char-charset ch)))
55             (if (not (eq prev-charset charset))
56                 (progn
57                   (setq prev-charset charset)
58                   (or (memq charset list)
59                       (setq list (cons charset list))))))
60           (forward-char))))
61     list))
62
63 (defun charsets-in-string (string)
64   "Return a list of the charsets in STRING."
65   (let ((i 0)
66         (len (length string))
67         prev-charset charset list)
68     (while (< i len)
69       (setq charset (char-charset (aref string i)))
70       (if (not (eq prev-charset charset))
71           (progn
72             (setq prev-charset charset)
73             (or (memq charset list)
74                 (setq list (cons charset list)))))
75       (setq i (1+ i)))
76     list))
77
78 \f
79 ;;;; Charset accessors
80
81 (defun charset-iso-graphic-plane (charset)
82   "Return the `graphic' property of CHARSET.
83 See `make-charset'."
84   (charset-property charset 'graphic))
85
86 (defun charset-iso-final-char (charset)
87   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
88   (charset-property charset 'final))
89
90 (defun charset-chars (charset)
91   "Return the number of characters per dimension of CHARSET."
92   (charset-property charset 'chars))
93
94 (defun charset-width (charset)
95   "Return the number of display columns per character of CHARSET.
96 This only applies to TTY mode (under X, the actual display width can
97 be automatically determined)."
98   (charset-property charset 'columns))
99
100 ;; #### FSFmacs returns 0
101 (defun charset-direction (charset)
102   "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
103 Only left-to-right is currently implemented."
104   (if (eq (charset-property charset 'direction) 'l2r)
105       0
106     1))
107
108 ;; Not in Emacs/Mule
109 (defun charset-registry (charset)
110   "Return the registry of CHARSET.
111 This is a regular expression matching the registry field of fonts
112 that can display the characters in CHARSET."
113   (charset-property charset 'registry))
114
115 (defun charset-ccl-program (charset)
116   "Return the CCL program of CHARSET.
117 See `make-charset'."
118   (charset-property charset 'ccl-program))
119
120 (defun charset-bytes (charset)
121   "Useless in XEmacs, returns 1."
122    1)
123
124 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
125 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
126 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
127 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
128
129 ;;;; Define setf methods for all settable Charset properties
130
131 (defsetf charset-registry    set-charset-registry)
132 (defsetf charset-ccl-program set-charset-ccl-program)
133
134 ;;; FSF compatibility functions
135 (defun charset-after (&optional pos)
136   "Return charset of a character in current buffer at position POS.
137 If POS is nil, it defauls to the current point.
138 If POS is out of range, the value is nil."
139   (when (null pos)
140     (setq pos (point)))
141   (check-argument-type 'integerp pos)
142   (unless (or (< pos (point-min))
143               (> pos (point-max)))
144     (char-charset (char-after pos))))
145
146 ;; Yuck!
147 ;; We're not going to support this.
148 ;(defun charset-info (charset)
149 ;  "Return a vector of information of CHARSET.
150 ;The elements of the vector are:
151 ;        CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
152 ;        LEADING-CODE-BASE, LEADING-CODE-EXT,
153 ;        ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
154 ;        REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
155 ;        PLIST,
156 ;where
157 ;CHARSET-ID (integer) is the identification number of the charset.
158 ;BYTES (integer) is the length of multi-byte form of a character in
159 ;  the charset: one of 1, 2, 3, and 4.
160 ;DIMENSION (integer) is the number of bytes to represent a character of
161 ;the charset: 1 or 2.
162 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
163 ;WIDTH (integer) is the number of columns a character in the charset
164 ;  occupies on the screen: one of 0, 1, and 2.
165 ;DIRECTION (integer) is the rendering direction of characters in the
166 ;  charset when rendering.  If 0, render from left to right, else
167 ;  render from right to left.
168 ;LEADING-CODE-BASE (integer) is the base leading-code for the
169 ;  charset.
170 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
171 ;  charset.  All charsets of less than 0xA0 has the value 0.
172 ;ISO-FINAL-CHAR (character) is the final character of the
173 ;  corresponding ISO 2022 charset.
174 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
175 ;  while encoding to variants of ISO 2022 coding system, one of the
176 ;  following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
177 ;REVERSE-CHARSET (integer) is the charset which differs only in
178 ;  LEFT-TO-RIGHT value from the charset.  If there's no such a
179 ;  charset, the value is -1.
180 ;SHORT-NAME (string) is the short name to refer to the charset.
181 ;LONG-NAME (string) is the long name to refer to the charset
182 ;DESCRIPTION (string) is the description string of the charset.
183 ;PLIST (property list) may contain any type of information a user
184 ;  want to put and get by functions `put-charset-property' and
185 ;  `get-charset-property' respectively."
186 ;  (vector
187 ;   (charset-id charset)
188 ;   1
189 ;   (charset-dimension charset)
190 ;   (charset-chars charset)
191 ;   (charset-width charset)
192 ;   (charset-direction charset)
193 ;   nil ;; (charset-leading-code-base (charset))
194 ;   nil ;; (charset-leading-code-ext (charset))
195 ;   (charset-iso-final-char charset)
196 ;   (charset-iso-graphic-plane charset)
197 ;   -1
198 ;   (charset-short-name charset)
199 ;   (charset-long-name charset)
200 ;   (charset-description charset)
201 ;   (charset-plist charset)))
202
203 ;(make-compatible 'charset-info "Don't use this if you can help it.")
204
205 (defun define-charset (charset-id charset property-vector)
206   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
207 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
208  treated as a private charset.
209 INFO-VECTOR is a vector of the format:
210    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
211     SHORT-NAME LONG-NAME DESCRIPTION]
212 The meanings of each elements is as follows:
213 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
214 CHARS (integer) is the number of characters in a dimension: 94 or 96.
215 WIDTH (integer) is the number of columns a character in the charset
216 occupies on the screen: one of 0, 1, and 2.
217
218 DIRECTION (integer) is the rendering direction of characters in the
219 charset when rendering.  If 0, render from left to right, else
220 render from right to left.
221
222 ISO-FINAL-CHAR (character) is the final character of the
223 corresponding ISO 2022 charset.
224
225 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
226 while encoding to variants of ISO 2022 coding system, one of the
227 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
228
229
230 SHORT-NAME (string) is the short name to refer to the charset.
231
232 LONG-NAME (string) is the long name to refer to the charset.
233
234 DESCRIPTION (string) is the description string of the charset."
235   (make-charset charset (aref property-vector 8)
236                 (list
237                  'short-name (aref property-vector 6)
238                  'long-name (aref property-vector 7)
239                  'dimension (aref property-vector 0)
240                  'columns (aref property-vector 2)
241                  'chars (aref property-vector 1)
242                  'final (aref property-vector 4)
243                  'graphic (aref property-vector 5)
244                  'direction (aref property-vector 3))))
245
246 (make-compatible 'define-charset "")
247
248 ;;; Charset property
249
250 (defalias 'get-charset-property 'get)
251 (defalias 'put-charset-property 'put)
252 (defalias 'charset-plist 'object-plist)
253 (defalias 'set-charset-plist 'setplist)
254
255 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
256 ;; SPACE and NEWLIE are already set.
257 ;; (let ((l '(katakana-jisx0201
258 ;;            japanese-jisx0208 japanese-jisx0212
259 ;;            chinese-gb2312 chinese-big5-1 chinese-big5-2)))
260 ;;   (while l
261 ;;     (put-char-table (car l) t auto-fill-chars)
262 ;;     (setq l (cdr l))))
263
264
265 ;;; @ Coded character set
266 ;;;
267
268 (when (featurep 'utf-2000)
269   (setq default-coded-charset-priority-list
270         '(ascii
271           control-1
272           latin-iso8859-1
273           latin-iso8859-2
274           latin-iso8859-3
275           latin-iso8859-4
276           latin-iso8859-9
277           latin-jisx0201
278           cyrillic-iso8859-5
279           greek-iso8859-7
280           thai-tis620
281           =jis-x0208
282           =ucs-radicals
283           =ucs-radicals@unicode
284           ;; =ucs-bmp-cjk@JP
285           =ucs-bmp-cjk@JP/hanazono
286           =mj-0
287           =mj-1
288           =ucs-bmp-cjk@gb
289           =jis-x0208@1983
290           chinese-gb2312
291           =jis-x0208-1990
292           japanese-jisx0208-1978
293           =jis-x0212
294           chinese-cns11643-1
295           chinese-cns11643-2
296           chinese-cns11643-3
297           chinese-cns11643-4
298           chinese-cns11643-5
299           chinese-cns11643-6
300           chinese-cns11643-7
301           =adobe-japan1-0
302           =adobe-japan1-1
303           =adobe-japan1-2
304           =adobe-japan1-3
305           =adobe-japan1-4
306           =adobe-japan1-5
307           =adobe-japan1-6
308           =big5-cdp
309           =hanyo-denshi/ja
310           =hanyo-denshi/jb
311           =hanyo-denshi/jc
312           =hanyo-denshi/jd
313           =hanyo-denshi/ft
314           =hanyo-denshi/ia
315           =hanyo-denshi/ib
316           =hanyo-denshi/hg
317           =hanyo-denshi/ip
318           =hanyo-denshi/jt
319           =hanyo-denshi/ks/mf
320           =hanyo-denshi/tk/mf-01
321           =gt-pj-2
322           =gt-pj-3
323           =gt-pj-4
324           =gt-pj-5
325           =gt-pj-6
326           =gt-pj-7
327           =gt-pj-8
328           =gt-pj-9
329           =gt-pj-10
330           =gt-pj-11
331           =gt-pj-k1
332           =gt-pj-k2
333           chinese-big5-eten-a
334           chinese-big5-eten-b
335           chinese-big5
336           =jis-x0213-1-2000
337           =jis-x0213-2-2000
338           ;; chinese-gb12345
339           =gt-pj-1
340           =ucs-bmp-cjk
341           =ucs-sip-ext-b
342           =ruimoku-v6
343           =zinbun-oracle
344           =hanziku-1
345           =hanziku-2
346           =hanziku-3
347           =hanziku-4
348           =hanziku-5
349           =hanziku-6
350           =hanziku-7
351           =hanziku-8
352           =hanziku-9
353           =hanziku-10
354           =hanziku-11
355           =hanziku-12
356           =ucs-sip-ext-b@iso
357           =ucs-sip@iso
358           ideograph-daikanwa-2
359           ideograph-daikanwa
360           korean-ksc5601
361           katakana-jisx0201
362           hebrew-iso8859-8
363           latin-viscii
364           latin-viscii-lower
365           latin-viscii-upper
366           ipa
367           lao
368           ethiopic-ucs
369           ethiopic
370           arabic-digit
371           arabic-1-column
372           arabic-2-column
373           arabic-iso8859-6
374           chinese-big5-1
375           chinese-big5-2
376           ;; =zihai-17xx
377           =ucs-bmp-var-001
378           =ucs-sip-var-001
379           =ucs-bmp-var-002
380           =ucs-sip-var-002
381           =ucs-bmp-var-003
382           =ucs-sip-var-003
383           =ucs-bmp-var-004
384           =ucs-sip-var-004
385           =ucs-bmp-var-005
386           =ucs-bmp-var-006
387           =ucs-sip-var-006
388           =ucs-bmp-var-008
389           =ucs-bmp-var-010
390           =ucs-bmp-itaiji-001
391           =ucs-sip-itaiji-001
392           =ucs-bmp-itaiji-002
393           =ucs-sip-itaiji-002
394           =ucs-bmp-itaiji-003
395           =ucs-sip-itaiji-003
396           =ucs-bmp-itaiji-004
397           =ucs-sip-itaiji-004
398           =ucs-bmp-itaiji-005
399           =ucs-sip-itaiji-005
400           =ucs-bmp-itaiji-006
401           =ucs-sip-itaiji-006
402           =ucs-bmp-itaiji-007
403           =ucs-sip-itaiji-007
404           =ucs-bmp-itaiji-008
405           =ucs-bmp-itaiji-009
406           =ucs-bmp-itaiji-010
407           =ucs-bmp-itaiji-011
408           =ucs-sip-itaiji-011
409           =ucs-bmp-itaiji-012
410           =ucs-bmp-itaiji-084
411           =big5-cdp-itaiji-001
412           =big5-cdp-itaiji-002
413           =big5-cdp-itaiji-003
414           =big5-cdp-var-001
415           =big5-cdp-var-002
416           =big5-cdp-var-003
417           =big5-cdp-var-004
418           =big5-cdp-var-005
419           =ucs-bmp-cjk-compat
420           =ucs-bmp-cjk-compat@unicode
421           =ucs-sip@JP/hanazono
422           =cbeta
423           =jef-china3
424           chinese-isoir165
425           ==jis-x0208@1990
426           ==ucs-radicals@unicode
427           ==ucs-bmp-cjk@JP/hanazono
428           ==mj-0
429           ==mj-1
430           ==ucs-bmp-cjk@gb
431           ==ucs-sip-ext-b@iso
432           ==ucs-sip@JP/hanazono
433           ==ucs-bmp-itaiji-001
434           ==ucs-sip-itaiji-001
435           ==ucs-bmp-itaiji-002
436           ==ucs-sip-itaiji-002
437           ==ucs-bmp-itaiji-003
438           ==ucs-sip-itaiji-003
439           ==ucs-bmp-itaiji-005
440           ==ucs-bmp-itaiji-006
441           ==ucs-bmp-var-002
442           ==ucs-sip-var-002
443           ==hanyo-denshi/ja
444           ==hanyo-denshi/jb
445           ==hanyo-denshi/jc
446           ==hanyo-denshi/jd
447           ==hanyo-denshi/ft
448           ==hanyo-denshi/ia
449           ==hanyo-denshi/ib
450           ==hanyo-denshi/hg
451           ==hanyo-denshi/ip
452           ==hanyo-denshi/jt
453           ==adobe-japan1-6
454           ==big5-cdp
455           ==big5-cdp-itaiji-001
456           ==cns11643-1
457           ==cns11643-2
458           ==cns11643-3
459           ==cns11643-4
460           ==cns11643-5
461           ==cns11643-6
462           ==cns11643-7
463           ==ucs-sip@iso
464           ==jis-x0208@1983
465           ==jis-x0208@1978
466           ==jis-x0213-1@2000
467           ==jis-x0213-2
468           ==jis-x0212
469           ==ks-x1001
470           ==ruimoku-v6
471           ==gt-pj-k1
472           ==gt-pj-k2
473           ==hanyo-denshi/tk/mf-01
474           ==daikanwa
475           ==cbeta
476           ==jef-china3
477           ==ucs-bmp-cjk-compat@JP
478           ==ucs-bmp-cjk-compat@gb
479           ===mj-0
480           ===mj-1
481           ===jis-x0208
482           ===jis-x0208@1990
483           ===big5-cdp
484           ===ucs-bmp-cjk@gb
485           ===adobe-japan1-6
486           ===cns11643-1
487           ===cns11643-2
488           ===cns11643-3
489           ===cns11643-4
490           ===cns11643-5
491           ===cns11643-6
492           ===cns11643-7
493           ;; ===hanyo-denshi/ja
494           ===hanyo-denshi/jb
495           ===hanyo-denshi/jc
496           ===hanyo-denshi/jd
497           ===hanyo-denshi/ft
498           ===hanyo-denshi/ia
499           ===hanyo-denshi/ib
500           ===hanyo-denshi/hg
501           ===hanyo-denshi/ip
502           ===hanyo-denshi/jt
503           ===jis-x0213-1
504           ===jis-x0213-1@2004
505           ===jis-x0213-2
506           ===jis-x0208@1983
507           ===jis-x0208@1978
508           ===jis-x0212
509           ===ks-x1001
510           ===daikanwa
511           ===ucs-sip-ext-b@iso
512           ===ucs-sip@iso
513           ===ruimoku-v6
514           ===hng-jou ; 01
515           ===hng-keg ; 02
516           ===hng-dng ; 03
517           ===hng-mam ; 05
518           ===hng-drt ; 06
519           ===hng-kgk ; 07
520           ===hng-myz ; 08
521           ===hng-kda ; 09
522           ===hng-khi ; 10
523           ===hng-khm ; 11
524           ===hng-hok ; 13
525           ===hng-kyd ; 14
526           ===hng-sok ; 15
527           ===hng-yhk ; 16
528           ===hng-kak ; 17
529           ===hng-kar ; 18
530           ===hng-kae ; 19
531           ===hng-sys ; 22
532           ===hng-tsu ; 24
533           ===hng-tzj ; 25
534           ===hng-hos ; 26
535           ===hng-nak ; 28
536           ===hng-jhk ; 29
537           ===hng-hod ; 30
538           ===hng-gok ; 31
539           ===hng-ink ; 33
540           ===hng-nto ; 34
541           ===hng-nkm ; 36
542           ===hng-k24 ; 37
543           ===hng-nkk ; 39
544           ===hng-kcc ; 41
545           ===hng-kcj ; 42
546           ===hng-kbk ; 43
547           ===hng-sik ; 44
548           ===hng-skk ; 46
549           ===hng-kyu ; 47
550           ===hng-ksk ; 48
551           ===hng-wan ; 49
552           ===hng-okd ; 50
553           ===hng-wad ; 54
554           ===hng-kmi ; 55
555           ===hng-zkd ; 56
556           ===hng-doh ; 57
557           ===hng-jyu ; 58
558           ===hng-tzs ; 60
559           ===hng-kss ; 64
560           ===hng-kyo ; 66
561           ===hng-smk ; 74
562           ===cbeta
563           ===jef-china3
564           ===ucs-bmp-cjk-compat@unicode
565           ;; ucs-sip
566           =>>big5-cdp
567           =>>jis-x0208
568           =>>jis-x0208@1990
569           =>>jis-x0213-1
570           =>>jis-x0213-1@2004
571           =>>jis-x0213-2
572           =>jis-x0208
573           =>jis-x0213-1
574           =>mj-0
575           =>big5-cdp
576           =>ruimoku-v6
577           =>big5-cdp@iwds-1
578           =>big5-cdp@component
579           =>big5-cdp@cognate
580           =>big5-cdp-itaiji-001
581           =>ucs-bmp-itaiji-001
582           =>ucs-sip-itaiji-001
583           =>ucs-bmp-itaiji-002
584           =>ucs-sip-itaiji-002
585           =>ucs-bmp-itaiji-003
586           =>ucs-sip-itaiji-003
587           =>ucs-bmp-itaiji-004
588           =>ucs-sip-itaiji-004
589           =>ucs-bmp-itaiji-005
590           =>ucs-sip-itaiji-005
591           =>ucs-bmp-itaiji-006
592           =>ucs-bmp-itaiji-007
593           =>ucs-sip-itaiji-007
594           =>ucs-bmp-itaiji-009
595           =>ucs-bmp-itaiji-001@iwds-1
596           =>ucs-sip-itaiji-001@iwds-1
597           =>daikanwa
598           ucs-bmp
599           ==>ucs-bmp-cjk@bucs
600           =>ucs-bmp-cjk@unicode
601           =>ucs-bmp-cjk@cognate
602           =>ucs-bmp-cjk@component
603           =>ucs-sip@cognate
604           =>ucs-sip@component
605           =>ucs-bmp-cjk@iwds-1
606           =>ucs-sip@iwds-1
607           =+>ucs-bmp-cjk@unicode
608           =+>ucs-bmp-cjk-compat@jis
609           =+>jis-x0213-2
610           =+>jis-x0213-1@2004
611           ;; =>>ucs@unicode
612           =adobe-japan1-base
613           =>jis-x0208@1997
614           =>>hanyo-denshi/ft
615           =>>hanyo-denshi/ia
616           =>>hanyo-denshi/jt
617           =>>adobe-japan1-6
618           =>>cns11643-1
619           =>>cns11643-2
620           =>>cns11643-3
621           =>>cns11643-4
622           =>>cns11643-6
623           =>>cbeta
624           =>>gt
625           =>cns11643-1
626           =>cns11643-7
627           =>cbeta
628           =>zinbun-oracle
629           =+>adobe-japan1-6
630           =+>ucs-bmp-var-003
631           =+>jis-x0208@1978
632           =+>big5-cdp
633           )))
634
635 ;;; mule-charset.el ends here