comparison lisp/mule/mule-charset.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 1f50e6fe4f3f
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 ;;; mule-charset.el --- Charset functions for Mule. 1 ;;; mule-charset.el --- Charset functions for Mule.
2
2 ;; Copyright (C) 1992 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
3 ;; Copyright (C) 1995 Amdahl Corporation. 4 ;; Copyright (C) 1995 Amdahl Corporation.
4 ;; Copyright (C) 1996 Sun Microsystems. 5 ;; Copyright (C) 1996 Sun Microsystems.
6
7 ;; Author: Unknown
8 ;; Keywords: i18n, mule, internal
5 9
6 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
7 11
8 ;; XEmacs is free software; you can redistribute it and/or modify it 12 ;; XEmacs is free software; you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by 13 ;; under the terms of the GNU General Public License as published by
18 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
19 ;; along with XEmacs; see the file COPYING. If not, write to the 23 ;; along with XEmacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
22 26
23 27 ;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9.
24 ;;;; Composite character support 28
25 29 ;;; Commentary:
26 (defun compose-region (start end &optional buffer) 30
27 "Compose characters in the current region into one composite character. 31 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
28 From a Lisp program, pass two arguments, START to END. 32 ;; and they never will be. -sb [1999-05-26]
29 The composite character replaces the composed characters. 33
30 BUFFER defaults to the current buffer if omitted." 34 ;;; Code:
31 (interactive "r")
32 (let ((ch (make-composite-char (buffer-substring start end buffer))))
33 (delete-region start end buffer)
34 (insert-char ch nil nil buffer)))
35
36 (defun decompose-region (start end &optional buffer)
37 "Decompose any composite characters in the current region.
38 From a Lisp program, pass two arguments, START to END.
39 This converts each composite character into one or more characters,
40 the individual characters out of which the composite character was formed.
41 Non-composite characters are left as-is. BUFFER defaults to the current
42 buffer if omitted."
43 (interactive "r")
44 (save-excursion
45 (set-buffer buffer)
46 (save-restriction
47 (narrow-to-region start end)
48 (goto-char (point-min))
49 (let ((compcharset (get-charset 'composite)))
50 (while (< (point) (point-max))
51 (let ((ch (char-after (point))))
52 (if (eq compcharset (char-charset ch))
53 (progn
54 (delete-char 1)
55 (insert (composite-char-string ch))))))))))
56
57 35
58 ;;;; Classifying text according to charsets 36 ;;;; Classifying text according to charsets
59 37
60 (defun charsets-in-region (start end &optional buffer) 38 (defun charsets-in-region (start end &optional buffer)
61 "Return a list of the charsets in the region between START and END. 39 "Return a list of the charsets in the region between START and END.
95 list)) 73 list))
96 74
97 75
98 ;;;; Charset accessors 76 ;;;; Charset accessors
99 77
100 (defun charset-graphic (charset) 78 (defun charset-iso-graphic-plane (charset)
101 "Return the `graphic' property of CHARSET. 79 "Return the `graphic' property of CHARSET.
102 See `make-charset'." 80 See `make-charset'."
103 (charset-property charset 'graphic)) 81 (charset-property charset 'graphic))
104 82
105 (defun charset-final (charset) 83 (defun charset-iso-final-char (charset)
106 "Return the final byte of the ISO 2022 escape sequence designating CHARSET." 84 "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
107 (charset-property charset 'final)) 85 (charset-property charset 'final))
108 86
109 (defun charset-chars (charset) 87 (defun charset-chars (charset)
110 "Return the number of characters per dimension of CHARSET." 88 "Return the number of characters per dimension of CHARSET."
111 (charset-property charset 'chars)) 89 (charset-property charset 'chars))
112 90
113 (defun charset-columns (charset) 91 (defun charset-width (charset)
114 "Return the number of display columns per character of CHARSET. 92 "Return the number of display columns per character of CHARSET.
115 This only applies to TTY mode (under X, the actual display width can 93 This only applies to TTY mode (under X, the actual display width can
116 be automatically determined)." 94 be automatically determined)."
117 (charset-property charset 'columns)) 95 (charset-property charset 'columns))
118 96
97 ;; #### FSFmacs returns 0
119 (defun charset-direction (charset) 98 (defun charset-direction (charset)
120 "Return the display direction (`l2r' or `r2l') of CHARSET." 99 "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
121 (charset-property charset 'direction)) 100 Only left-to-right is currently implemented."
122 101 (if (eq (charset-property charset 'direction) 'l2r)
102 0
103 1))
104
105 ;; Not in Emacs/Mule
123 (defun charset-registry (charset) 106 (defun charset-registry (charset)
124 "Return the registry of CHARSET. 107 "Return the registry of CHARSET.
125 This is a regular expression matching the registry field of fonts 108 This is a regular expression matching the registry field of fonts
126 that can display the characters in CHARSET." 109 that can display the characters in CHARSET."
127 (charset-property charset 'registry)) 110 (charset-property charset 'registry))
129 (defun charset-ccl-program (charset) 112 (defun charset-ccl-program (charset)
130 "Return the CCL program of CHARSET. 113 "Return the CCL program of CHARSET.
131 See `make-charset'." 114 See `make-charset'."
132 (charset-property charset 'ccl-program)) 115 (charset-property charset 'ccl-program))
133 116
134 (defun charset-leading-byte (charset) 117 (defun charset-bytes (charset)
135 "Return the leading byte of CHARSET. 118 "Useless in XEmacs, returns 1."
136 See `make-charset'." 119 1)
137 (charset-property charset 'leading-byte)) 120
121 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
122 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
123 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
124 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
138 125
139 ;;;; Define setf methods for all settable Charset properties 126 ;;;; Define setf methods for all settable Charset properties
140 127
141 (defsetf charset-registry set-charset-registry) 128 (defsetf charset-registry set-charset-registry)
142 (defsetf charset-ccl-program set-charset-ccl-program) 129 (defsetf charset-ccl-program set-charset-ccl-program)
130
131 ;;; FSF compatibility functions
132 (defun charset-after (&optional pos)
133 "Return charset of a character in current buffer at position POS.
134 If POS is nil, it defauls to the current point.
135 If POS is out of range, the value is nil."
136 (when (null pos)
137 (setq pos (point)))
138 (check-argument-type 'integerp pos)
139 (unless (or (< pos (point-min))
140 (> pos (point-max)))
141 (char-charset (char-after pos))))
142
143 ;; Yuck!
144 ;; We're not going to support this.
145 ;(defun charset-info (charset)
146 ; "Return a vector of information of CHARSET.
147 ;The elements of the vector are:
148 ; CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
149 ; LEADING-CODE-BASE, LEADING-CODE-EXT,
150 ; ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
151 ; REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
152 ; PLIST,
153 ;where
154 ;CHARSET-ID (integer) is the identification number of the charset.
155 ;BYTES (integer) is the length of multi-byte form of a character in
156 ; the charset: one of 1, 2, 3, and 4.
157 ;DIMENSION (integer) is the number of bytes to represent a character of
158 ;the charset: 1 or 2.
159 ;CHARS (integer) is the number of characters in a dimension: 94 or 96.
160 ;WIDTH (integer) is the number of columns a character in the charset
161 ; occupies on the screen: one of 0, 1, and 2.
162 ;DIRECTION (integer) is the rendering direction of characters in the
163 ; charset when rendering. If 0, render from left to right, else
164 ; render from right to left.
165 ;LEADING-CODE-BASE (integer) is the base leading-code for the
166 ; charset.
167 ;LEADING-CODE-EXT (integer) is the extended leading-code for the
168 ; charset. All charsets of less than 0xA0 has the value 0.
169 ;ISO-FINAL-CHAR (character) is the final character of the
170 ; corresponding ISO 2022 charset.
171 ;ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
172 ; while encoding to variants of ISO 2022 coding system, one of the
173 ; following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
174 ;REVERSE-CHARSET (integer) is the charset which differs only in
175 ; LEFT-TO-RIGHT value from the charset. If there's no such a
176 ; charset, the value is -1.
177 ;SHORT-NAME (string) is the short name to refer to the charset.
178 ;LONG-NAME (string) is the long name to refer to the charset
179 ;DESCRIPTION (string) is the description string of the charset.
180 ;PLIST (property list) may contain any type of information a user
181 ; want to put and get by functions `put-charset-property' and
182 ; `get-charset-property' respectively."
183 ; (vector
184 ; (charset-id charset)
185 ; 1
186 ; (charset-dimension charset)
187 ; (charset-chars charset)
188 ; (charset-width charset)
189 ; (charset-direction charset)
190 ; nil ;; (charset-leading-code-base (charset))
191 ; nil ;; (charset-leading-code-ext (charset))
192 ; (charset-iso-final-char charset)
193 ; (charset-iso-graphic-plane charset)
194 ; -1
195 ; (charset-short-name charset)
196 ; (charset-long-name charset)
197 ; (charset-description charset)
198 ; (charset-plist charset)))
199
200 ;(make-compatible 'charset-info "Don't use this if you can help it.")
201
202 (defun define-charset (charset-id charset property-vector)
203 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
204 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
205 treated as a private charset.
206 INFO-VECTOR is a vector of the format:
207 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
208 SHORT-NAME LONG-NAME DESCRIPTION]
209 The meanings of each elements is as follows:
210 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
211 CHARS (integer) is the number of characters in a dimension: 94 or 96.
212 WIDTH (integer) is the number of columns a character in the charset
213 occupies on the screen: one of 0, 1, and 2.
214
215 DIRECTION (integer) is the rendering direction of characters in the
216 charset when rendering. If 0, render from left to right, else
217 render from right to left.
218
219 ISO-FINAL-CHAR (character) is the final character of the
220 corresponding ISO 2022 charset.
221
222 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
223 while encoding to variants of ISO 2022 coding system, one of the
224 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
225
226
227 SHORT-NAME (string) is the short name to refer to the charset.
228
229 LONG-NAME (string) is the long name to refer to the charset.
230
231 DESCRIPTION (string) is the description string of the charset."
232 (make-charset charset (aref property-vector 8)
233 (list
234 'short-name (aref property-vector 6)
235 'long-name (aref property-vector 7)
236 'dimension (aref property-vector 0)
237 'columns (aref property-vector 2)
238 'chars (aref property-vector 1)
239 'final (aref property-vector 4)
240 'graphic (aref property-vector 5)
241 'direction (aref property-vector 3))))
242
243 (make-compatible 'define-charset "")
244
245 ;;; Charset property
246
247 (defalias 'get-charset-property 'get)
248 (defalias 'put-charset-property 'put)
249 (defalias 'charset-plist 'object-plist)
250 (defalias 'set-charset-plist 'setplist)
251
252 ;;; mule-charset.el ends here