(default-coded-charset-priority-list): Add `=ucs-bmp-itaiji-012'.
[chise/xemacs-chise.git-] / 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-bmp-itaiji-007
402           =ucs-sip-itaiji-007
403           =ucs-bmp-itaiji-008
404           =ucs-bmp-itaiji-009
405           =ucs-bmp-itaiji-010
406           =ucs-bmp-itaiji-011
407           =ucs-sip-itaiji-011
408           =ucs-bmp-itaiji-012
409           =ucs-bmp-itaiji-084
410           =big5-cdp-itaiji-001
411           =big5-cdp-itaiji-002
412           =big5-cdp-itaiji-003
413           =big5-cdp-var-001
414           =big5-cdp-var-002
415           =big5-cdp-var-003
416           =big5-cdp-var-004
417           =big5-cdp-var-005
418           =cbeta
419           =jef-china3
420           chinese-isoir165
421           =ucs-bmp-cjk-compat
422           =ucs-bmp-cjk-compat@unicode
423           =ucs-sip@JP/hanazono
424           ==jis-x0208@1990
425           ==ucs-radicals@unicode
426           ==ucs-bmp-cjk@JP/hanazono
427           ==mj-0
428           ==mj-1
429           ==ucs-bmp-cjk@gb
430           ==ucs-sip-ext-b@iso
431           ==ucs-sip@JP/hanazono
432           ==ucs-sip-itaiji-001
433           ==ucs-bmp-itaiji-002
434           ==ucs-sip-itaiji-002
435           ==ucs-bmp-itaiji-003
436           ==ucs-sip-itaiji-003
437           ==ucs-bmp-itaiji-005
438           ==ucs-bmp-var-002
439           ==ucs-sip-var-002
440           ==hanyo-denshi/ja
441           ==hanyo-denshi/jb
442           ==hanyo-denshi/jc
443           ==hanyo-denshi/jd
444           ==hanyo-denshi/ft
445           ==hanyo-denshi/ia
446           ==hanyo-denshi/ib
447           ==hanyo-denshi/hg
448           ==hanyo-denshi/ip
449           ==hanyo-denshi/jt
450           ==adobe-japan1-6
451           ==big5-cdp
452           ==big5-cdp-itaiji-001
453           ==cns11643-1
454           ==cns11643-2
455           ==cns11643-3
456           ==cns11643-4
457           ==cns11643-5
458           ==cns11643-6
459           ==cns11643-7
460           ==ucs-sip@iso
461           ==jis-x0208@1983
462           ==jis-x0208@1978
463           ==jis-x0213-1@2000
464           ==jis-x0213-2
465           ==jis-x0212
466           ==ks-x1001
467           ==ruimoku-v6
468           ==gt-pj-k1
469           ==gt-pj-k2
470           ==hanyo-denshi/tk/mf-01
471           ==daikanwa
472           ==cbeta
473           ==jef-china3
474           ==ucs-bmp-cjk-compat@JP
475           ==ucs-bmp-cjk-compat@gb
476           ===mj-0
477           ===mj-1
478           ===jis-x0208
479           ===jis-x0208@1990
480           ===big5-cdp
481           ===ucs-bmp-cjk@gb
482           ===adobe-japan1-6
483           ===cns11643-1
484           ===cns11643-2
485           ===cns11643-3
486           ===cns11643-4
487           ===cns11643-5
488           ===cns11643-6
489           ===cns11643-7
490           ;; ===hanyo-denshi/ja
491           ===hanyo-denshi/jb
492           ===hanyo-denshi/jc
493           ===hanyo-denshi/jd
494           ===hanyo-denshi/ft
495           ===hanyo-denshi/ia
496           ===hanyo-denshi/ib
497           ===hanyo-denshi/hg
498           ===hanyo-denshi/ip
499           ===hanyo-denshi/jt
500           ===jis-x0213-1
501           ===jis-x0213-1@2004
502           ===jis-x0213-2
503           ===jis-x0208@1983
504           ===jis-x0208@1978
505           ===jis-x0212
506           ===ks-x1001
507           ===daikanwa
508           ===ucs-sip-ext-b@iso
509           ===ucs-sip@iso
510           ===ruimoku-v6
511           ===hng-jou ; 01
512           ===hng-keg ; 02
513           ===hng-dng ; 03
514           ===hng-mam ; 05
515           ===hng-drt ; 06
516           ===hng-kgk ; 07
517           ===hng-myz ; 08
518           ===hng-kda ; 09
519           ===hng-khi ; 10
520           ===hng-khm ; 11
521           ===hng-hok ; 13
522           ===hng-kyd ; 14
523           ===hng-sok ; 15
524           ===hng-yhk ; 16
525           ===hng-kak ; 17
526           ===hng-kar ; 18
527           ===hng-kae ; 19
528           ===hng-sys ; 22
529           ===hng-tsu ; 24
530           ===hng-tzj ; 25
531           ===hng-hos ; 26
532           ===hng-nak ; 28
533           ===hng-jhk ; 29
534           ===hng-hod ; 30
535           ===hng-gok ; 31
536           ===hng-ink ; 33
537           ===hng-nto ; 34
538           ===hng-nkm ; 36
539           ===hng-k24 ; 37
540           ===hng-nkk ; 39
541           ===hng-kcc ; 41
542           ===hng-kcj ; 42
543           ===hng-kbk ; 43
544           ===hng-sik ; 44
545           ===hng-skk ; 46
546           ===hng-kyu ; 47
547           ===hng-ksk ; 48
548           ===hng-wan ; 49
549           ===hng-okd ; 50
550           ===hng-wad ; 54
551           ===hng-kmi ; 55
552           ===hng-zkd ; 56
553           ===hng-doh ; 57
554           ===hng-jyu ; 58
555           ===hng-tzs ; 60
556           ===hng-kss ; 64
557           ===hng-kyo ; 66
558           ===hng-smk ; 74
559           ===cbeta
560           ===jef-china3
561           ===ucs-bmp-cjk-compat@unicode
562           ;; ucs-sip
563           =>>big5-cdp
564           =>>jis-x0208
565           =>>jis-x0208@1990
566           =>>jis-x0213-1
567           =>>jis-x0213-1@2004
568           =>>jis-x0213-2
569           =>jis-x0208
570           =>jis-x0213-1
571           =>mj-0
572           =>big5-cdp
573           =>ruimoku-v6
574           =>big5-cdp-itaiji-001
575           =>ucs-bmp-itaiji-001
576           =>ucs-sip-itaiji-001
577           =>ucs-bmp-itaiji-002
578           =>ucs-sip-itaiji-002
579           =>ucs-bmp-itaiji-003
580           =>ucs-bmp-itaiji-004
581           =>ucs-sip-itaiji-004
582           =>ucs-bmp-itaiji-005
583           =>ucs-sip-itaiji-005
584           =>ucs-bmp-itaiji-006
585           =>ucs-bmp-itaiji-007
586           =>ucs-sip-itaiji-007
587           =>ucs-bmp-itaiji-009
588           =>daikanwa
589           ucs-bmp
590           ==>ucs-bmp-cjk@bucs
591           =>ucs-bmp-cjk@unicode
592           =>ucs-bmp-cjk@cognate
593           =>ucs-bmp-cjk@component
594           =>ucs-sip@cognate
595           =>ucs-sip@component
596           =>ucs-bmp-cjk@iwds-1
597           =>ucs-sip@iwds-1
598           =+>ucs-bmp-cjk@unicode
599           =+>ucs-bmp-cjk-compat@jis
600           =+>jis-x0213-2
601           =+>jis-x0213-1@2004
602           ;; =>>ucs@unicode
603           =adobe-japan1-base
604           =>jis-x0208@1997
605           =>>hanyo-denshi/ft
606           =>>hanyo-denshi/ia
607           =>>hanyo-denshi/jt
608           =>>adobe-japan1-6
609           =>>cns11643-1
610           =>>cns11643-2
611           =>>cns11643-3
612           =>>cns11643-4
613           =>>cns11643-6
614           =>>cbeta
615           =>>gt
616           =>cns11643-1
617           =>cns11643-7
618           =>cbeta
619           =+>adobe-japan1-6
620           =+>ucs-bmp-var-003
621           =+>jis-x0208@1978
622           )))
623
624 ;;; mule-charset.el ends here