Use `=daikanwa/+p' instead of `morohashi-daikanwa' for M-ddddd'.
[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 MORIOKA Tomohiko
8
9 ;; Author: Unknown
10 ;; Keywords: i18n, mule, internal
11
12 ;; This file is part of XEmacs.
13
14 ;; XEmacs is free software; you can redistribute it and/or modify it
15 ;; under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; XEmacs is distributed in the hope that it will be useful, but
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
22 ;; General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with XEmacs; see the file COPYING.  If not, write to the 
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
28
29 ;;; Synched up with: Not synched.  API at source level synched with FSF 20.3.9.
30
31 ;;; Commentary:
32
33 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
34 ;; and they never will be.  -sb [1999-05-26]
35
36 ;;; Code:
37 \f
38 ;;;; Classifying text according to charsets
39
40 (defun charsets-in-region (start end &optional buffer)
41   "Return a list of the charsets in the region between START and END.
42 BUFFER defaults to the current buffer if omitted."
43   (let (list)
44     (save-excursion
45       (if buffer
46           (set-buffer buffer))
47       (save-restriction
48         (narrow-to-region start end)
49         (goto-char (point-min))
50         (while (not (eobp))
51           (let* (prev-charset
52                  (ch (char-after (point)))
53                  (charset (char-charset ch)))
54             (if (not (eq prev-charset charset))
55                 (progn
56                   (setq prev-charset charset)
57                   (or (memq charset list)
58                       (setq list (cons charset list))))))
59           (forward-char))))
60     list))
61
62 (defun charsets-in-string (string)
63   "Return a list of the charsets in STRING."
64   (let ((i 0)
65         (len (length string))
66         prev-charset charset list)
67     (while (< i len)
68       (setq charset (char-charset (aref string i)))
69       (if (not (eq prev-charset charset))
70           (progn
71             (setq prev-charset charset)
72             (or (memq charset list)
73                 (setq list (cons charset list)))))
74       (setq i (1+ i)))
75     list))
76
77 \f
78 ;;;; Charset accessors
79
80 (defun charset-iso-graphic-plane (charset)
81   "Return the `graphic' property of CHARSET.
82 See `make-charset'."
83   (charset-property charset 'graphic))
84
85 (defun charset-iso-final-char (charset)
86   "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
87   (charset-property charset 'final))
88
89 (defun charset-chars (charset)
90   "Return the number of characters per dimension of CHARSET."
91   (charset-property charset 'chars))
92
93 (defun charset-width (charset)
94   "Return the number of display columns per character of CHARSET.
95 This only applies to TTY mode (under X, the actual display width can
96 be automatically determined)."
97   (charset-property charset 'columns))
98
99 ;; #### FSFmacs returns 0
100 (defun charset-direction (charset)
101   "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
102 Only left-to-right is currently implemented."
103   (if (eq (charset-property charset 'direction) 'l2r)
104       0
105     1))
106
107 ;; Not in Emacs/Mule
108 (defun charset-registry (charset)
109   "Return the registry of CHARSET.
110 This is a regular expression matching the registry field of fonts
111 that can display the characters in CHARSET."
112   (charset-property charset 'registry))
113
114 (defun charset-ccl-program (charset)
115   "Return the CCL program of CHARSET.
116 See `make-charset'."
117   (charset-property charset 'ccl-program))
118
119 (defun charset-bytes (charset)
120   "Useless in XEmacs, returns 1."
121    1)
122
123 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
124 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
125 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
126 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
127
128 ;;;; Define setf methods for all settable Charset properties
129
130 (defsetf charset-registry    set-charset-registry)
131 (defsetf charset-ccl-program set-charset-ccl-program)
132
133 ;;; FSF compatibility functions
134 (defun charset-after (&optional pos)
135   "Return charset of a character in current buffer at position POS.
136 If POS is nil, it defauls to the current point.
137 If POS is out of range, the value is nil."
138   (when (null pos)
139     (setq pos (point)))
140   (check-argument-type 'integerp pos)
141   (unless (or (< pos (point-min))
142               (> pos (point-max)))
143     (char-charset (char-after pos))))
144
145 ;; Yuck!
146 ;; We're not going to support this.
147 ;(defun charset-info (charset)
148 ;  "Return a vector of information of CHARSET.
149 ;The elements of the vector are:
150 ;        CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
151 ;        LEADING-CODE-BASE, LEADING-CODE-EXT,
152 ;        ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
153 ;        REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
154 ;        PLIST,
155 ;where
156 ;CHARSET-ID (integer) is the identification number of the charset.
157 ;BYTES (integer) is the length of multi-byte form of a character in
158 ;  the charset: one of 1, 2, 3, and 4.
159 ;DIMENSION (integer) is the number of bytes to represent a character of
160 ;the charset: 1 or 2.
161 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
162 ;WIDTH (integer) is the number of columns a character in the charset
163 ;  occupies on the screen: one of 0, 1, and 2.
164 ;DIRECTION (integer) is the rendering direction of characters in the
165 ;  charset when rendering.  If 0, render from left to right, else
166 ;  render from right to left.
167 ;LEADING-CODE-BASE (integer) is the base leading-code for the
168 ;  charset.
169 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
170 ;  charset.  All charsets of less than 0xA0 has the value 0.
171 ;ISO-FINAL-CHAR (character) is the final character of the
172 ;  corresponding ISO 2022 charset.
173 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
174 ;  while encoding to variants of ISO 2022 coding system, one of the
175 ;  following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
176 ;REVERSE-CHARSET (integer) is the charset which differs only in
177 ;  LEFT-TO-RIGHT value from the charset.  If there's no such a
178 ;  charset, the value is -1.
179 ;SHORT-NAME (string) is the short name to refer to the charset.
180 ;LONG-NAME (string) is the long name to refer to the charset
181 ;DESCRIPTION (string) is the description string of the charset.
182 ;PLIST (property list) may contain any type of information a user
183 ;  want to put and get by functions `put-charset-property' and
184 ;  `get-charset-property' respectively."
185 ;  (vector
186 ;   (charset-id charset)
187 ;   1
188 ;   (charset-dimension charset)
189 ;   (charset-chars charset)
190 ;   (charset-width charset)
191 ;   (charset-direction charset)
192 ;   nil ;; (charset-leading-code-base (charset))
193 ;   nil ;; (charset-leading-code-ext (charset))
194 ;   (charset-iso-final-char charset)
195 ;   (charset-iso-graphic-plane charset)
196 ;   -1
197 ;   (charset-short-name charset)
198 ;   (charset-long-name charset)
199 ;   (charset-description charset)
200 ;   (charset-plist charset)))
201
202 ;(make-compatible 'charset-info "Don't use this if you can help it.")
203
204 (defun define-charset (charset-id charset property-vector)
205   "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
206 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
207  treated as a private charset.
208 INFO-VECTOR is a vector of the format:
209    [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
210     SHORT-NAME LONG-NAME DESCRIPTION]
211 The meanings of each elements is as follows:
212 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
213 CHARS (integer) is the number of characters in a dimension: 94 or 96.
214 WIDTH (integer) is the number of columns a character in the charset
215 occupies on the screen: one of 0, 1, and 2.
216
217 DIRECTION (integer) is the rendering direction of characters in the
218 charset when rendering.  If 0, render from left to right, else
219 render from right to left.
220
221 ISO-FINAL-CHAR (character) is the final character of the
222 corresponding ISO 2022 charset.
223
224 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
225 while encoding to variants of ISO 2022 coding system, one of the
226 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
227
228
229 SHORT-NAME (string) is the short name to refer to the charset.
230
231 LONG-NAME (string) is the long name to refer to the charset.
232
233 DESCRIPTION (string) is the description string of the charset."
234   (make-charset charset (aref property-vector 8)
235                 (list
236                  'short-name (aref property-vector 6)
237                  'long-name (aref property-vector 7)
238                  'dimension (aref property-vector 0)
239                  'columns (aref property-vector 2)
240                  'chars (aref property-vector 1)
241                  'final (aref property-vector 4)
242                  'graphic (aref property-vector 5)
243                  'direction (aref property-vector 3))))
244
245 (make-compatible 'define-charset "")
246
247 ;;; Charset property
248
249 (defalias 'get-charset-property 'get)
250 (defalias 'put-charset-property 'put)
251 (defalias 'charset-plist 'object-plist)
252 (defalias 'set-charset-plist 'setplist)
253
254 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
255 ;; SPACE and NEWLIE are already set.
256 ;; (let ((l '(katakana-jisx0201
257 ;;            japanese-jisx0208 japanese-jisx0212
258 ;;            chinese-gb2312 chinese-big5-1 chinese-big5-2)))
259 ;;   (while l
260 ;;     (put-char-table (car l) t auto-fill-chars)
261 ;;     (setq l (cdr l))))
262
263
264 ;;; @ Coded character set
265 ;;;
266
267 (when (featurep 'utf-2000)
268   (setq default-coded-charset-priority-list
269         '(ascii
270           control-1
271           latin-iso8859-1
272           latin-iso8859-2
273           latin-iso8859-3
274           latin-iso8859-4
275           latin-iso8859-9
276           latin-jisx0201
277           cyrillic-iso8859-5
278           greek-iso8859-7
279           thai-tis620
280           =jis-x0208
281           chinese-gb2312
282           japanese-jisx0208
283           =jis-x0208-1990
284           =ucs-radicals
285           =ucs-radicals@unicode
286           =ucs-bmp-cjk@unicode
287           ;; =ucs-bmp-cjk@JP
288           =ucs-bmp-cjk@JP/hanazono
289           =ucs-bmp-cjk-compat
290           =ucs-bmp-cjk-compat@unicode
291           japanese-jisx0208-1978
292           =jis-x0212
293           =gt-pj-2
294           =gt-pj-3
295           =gt-pj-4
296           =gt-pj-5
297           =gt-pj-6
298           =gt-pj-7
299           =gt-pj-8
300           =gt-pj-9
301           =gt-pj-10
302           =gt-pj-11
303           =gt-pj-k1
304           =gt-pj-k2
305           chinese-cns11643-1
306           chinese-cns11643-2
307           chinese-cns11643-3
308           chinese-cns11643-4
309           chinese-cns11643-5
310           chinese-cns11643-6
311           chinese-cns11643-7
312           =big5-cdp
313           chinese-big5-eten-a
314           chinese-big5-eten-b
315           chinese-big5
316           =jis-x0213-1-2000
317           =jis-x0213-2-2000
318           ;; chinese-gb12345
319           =gt-pj-1
320           =ucs-bmp-cjk
321           =ucs-sip-ext-b
322           =ruimoku-v6
323           =zinbun-oracle
324           =hanziku-1
325           =hanziku-2
326           =hanziku-3
327           =hanziku-4
328           =hanziku-5
329           =hanziku-6
330           =hanziku-7
331           =hanziku-8
332           =hanziku-9
333           =hanziku-10
334           =hanziku-11
335           =hanziku-12
336           =hanyo-denshi/ja
337           =hanyo-denshi/jb
338           =hanyo-denshi/jc
339           =hanyo-denshi/jd
340           =hanyo-denshi/ft
341           =hanyo-denshi/ia
342           =hanyo-denshi/ib
343           =hanyo-denshi/hg
344           =hanyo-denshi/ip
345           =hanyo-denshi/jt
346           =hanyo-denshi/ks/mf
347           =ucs-sip-ext-b@iso
348           ideograph-daikanwa-2
349           ideograph-daikanwa
350           korean-ksc5601
351           katakana-jisx0201
352           hebrew-iso8859-8
353           latin-viscii
354           latin-viscii-lower
355           latin-viscii-upper
356           ipa
357           lao
358           ethiopic-ucs
359           ethiopic
360           arabic-digit
361           arabic-1-column
362           arabic-2-column
363           =cbeta
364           =jef-china3
365           chinese-isoir165
366           arabic-iso8859-6
367           chinese-big5-1
368           chinese-big5-2
369           ;; ucs-sip
370           =>>big5-cdp
371           =>>jis-x0208
372           =>>jis-x0213-1
373           =>>jis-x0213-1@2004
374           =>jis-x0208
375           =>jis-x0213-1
376           ucs-bmp
377           ==>ucs-bmp-cjk@bucs
378           =>ucs-bmp-cjk@unicode
379           =+>ucs-bmp-cjk@unicode
380           ;; =>>ucs@unicode
381           =adobe-japan1-6
382           =adobe-japan1-base
383           =>jis-x0208@1997
384           =>>hanyo-denshi/ft
385           =>>hanyo-denshi/jt
386           =>>gt
387           )))
388
389 ;;; mule-charset.el ends here