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