|
502
|
1 ;;; mule-charset.el --- Charset functions for Mule. -*- coding: iso-2022-7bit; -*-
|
|
428
|
2
|
|
|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Amdahl Corporation.
|
|
|
5 ;; Copyright (C) 1996 Sun Microsystems.
|
|
|
6
|
|
|
7 ;; Author: Unknown
|
|
|
8 ;; Keywords: i18n, mule, internal
|
|
|
9
|
|
|
10 ;; This file is part of XEmacs.
|
|
|
11
|
|
|
12 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
13 ;; under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
20 ;; General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
|
26
|
|
|
27 ;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9.
|
|
|
28
|
|
|
29 ;;; Commentary:
|
|
|
30
|
|
|
31 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
|
|
|
32 ;; and they never will be. -sb [1999-05-26]
|
|
|
33
|
|
|
34 ;;; Code:
|
|
|
35
|
|
|
36 ;;;; Classifying text according to charsets
|
|
|
37
|
|
|
38 (defun charsets-in-region (start end &optional buffer)
|
|
|
39 "Return a list of the charsets in the region between START and END.
|
|
|
40 BUFFER defaults to the current buffer if omitted."
|
|
|
41 (let (list)
|
|
|
42 (save-excursion
|
|
|
43 (if buffer
|
|
|
44 (set-buffer buffer))
|
|
|
45 (save-restriction
|
|
|
46 (narrow-to-region start end)
|
|
|
47 (goto-char (point-min))
|
|
|
48 (while (not (eobp))
|
|
|
49 (let* (prev-charset
|
|
|
50 (ch (char-after (point)))
|
|
|
51 (charset (char-charset ch)))
|
|
|
52 (if (not (eq prev-charset charset))
|
|
|
53 (progn
|
|
|
54 (setq prev-charset charset)
|
|
|
55 (or (memq charset list)
|
|
|
56 (setq list (cons charset list))))))
|
|
|
57 (forward-char))))
|
|
|
58 list))
|
|
|
59
|
|
|
60 (defun charsets-in-string (string)
|
|
|
61 "Return a list of the charsets in STRING."
|
|
|
62 (let ((i 0)
|
|
|
63 (len (length string))
|
|
|
64 prev-charset charset list)
|
|
|
65 (while (< i len)
|
|
|
66 (setq charset (char-charset (aref string i)))
|
|
|
67 (if (not (eq prev-charset charset))
|
|
|
68 (progn
|
|
|
69 (setq prev-charset charset)
|
|
|
70 (or (memq charset list)
|
|
|
71 (setq list (cons charset list)))))
|
|
|
72 (setq i (1+ i)))
|
|
|
73 list))
|
|
|
74
|
|
771
|
75 (defalias 'find-charset-string 'charsets-in-string)
|
|
|
76 (defalias 'find-charset-region 'charsets-in-region)
|
|
428
|
77
|
|
|
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!
|
|
771
|
146 ;; We're not going to support these.
|
|
|
147 ;(defun charset-info (charset) [incredibly broken function with random vectors]
|
|
|
148 ;(defun define-charset (...) [incredibly broken function with random vectors]
|
|
428
|
149
|
|
|
150 ;;; Charset property
|
|
|
151
|
|
|
152 (defalias 'get-charset-property 'get)
|
|
|
153 (defalias 'put-charset-property 'put)
|
|
|
154 (defalias 'charset-plist 'object-plist)
|
|
|
155 (defalias 'set-charset-plist 'setplist)
|
|
|
156
|
|
771
|
157
|
|
|
158 (defun char-width (character)
|
|
|
159 "Return number of columns a CHARACTER occupies when displayed."
|
|
|
160 (charset-width (char-charset character)))
|
|
|
161
|
|
|
162 ;; The following several functions are useful in GNU Emacs 20 because
|
|
|
163 ;; of the multibyte "characters" the internal representation of which
|
|
|
164 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
|
|
|
165 ;; We provide them for compatibility reasons solely.
|
|
|
166
|
|
|
167 (define-obsolete-function-alias 'sref 'aref)
|
|
|
168 (defun char-bytes (character)
|
|
|
169 "Return number of bytes a CHARACTER occupies in a string or buffer.
|
|
|
170 It always returns 1 in XEmacs, and in recent FSF Emacs versions."
|
|
|
171 1)
|
|
|
172 (make-obsolete 'char-bytes "This function always returns 1")
|
|
|
173
|
|
|
174 (defun string-to-sequence (string type)
|
|
|
175 "Convert STRING to a sequence of TYPE which contains characters in STRING.
|
|
|
176 TYPE should be `list' or `vector'.
|
|
|
177 Multibyte characters are concerned."
|
|
|
178 (ecase type
|
|
|
179 (list
|
|
|
180 (mapcar #'identity string))
|
|
|
181 (vector
|
|
|
182 (mapvector #'identity string))))
|
|
|
183
|
|
|
184 (defun string-to-list (string)
|
|
|
185 "Return a list of characters in STRING."
|
|
|
186 (mapcar #'identity string))
|
|
|
187
|
|
|
188 (defun string-to-vector (string)
|
|
|
189 "Return a vector of characters in STRING."
|
|
|
190 (mapvector #'identity string))
|
|
|
191
|
|
|
192 (defun store-substring (string idx obj)
|
|
|
193 "Embed OBJ (string or character) at index IDX of STRING."
|
|
|
194 (let* ((str (cond ((stringp obj) obj)
|
|
|
195 ((characterp obj) (char-to-string obj))
|
|
|
196 (t (error
|
|
|
197 "Invalid argument (should be string or character): %s"
|
|
|
198 obj))))
|
|
|
199 (string-len (length string))
|
|
|
200 (len (length str))
|
|
|
201 (i 0))
|
|
|
202 (while (and (< i len) (< idx string-len))
|
|
|
203 (aset string idx (aref str i))
|
|
|
204 (setq idx (1+ idx) i (1+ i)))
|
|
|
205 string))
|
|
|
206
|
|
|
207
|
|
442
|
208 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
|
|
|
209 ;; SPACE and NEWLIE are already set.
|
|
|
210 (let ((l '(katakana-jisx0201
|
|
|
211 japanese-jisx0208 japanese-jisx0212
|
|
|
212 chinese-gb2312 chinese-big5-1 chinese-big5-2)))
|
|
|
213 (while l
|
|
|
214 (put-char-table (car l) t auto-fill-chars)
|
|
|
215 (setq l (cdr l))))
|
|
|
216
|
|
428
|
217 ;;; mule-charset.el ends here
|
