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