|
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.
|
|
777
|
6 ;; Copyright (C) 2002 Ben Wing.
|
|
428
|
7
|
|
|
8 ;; Author: Unknown
|
|
|
9 ;; Keywords: i18n, mule, internal
|
|
|
10
|
|
|
11 ;; This file is part of XEmacs.
|
|
|
12
|
|
|
13 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
14 ;; under the terms of the GNU General Public License as published by
|
|
|
15 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
18 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
21 ;; General Public License for more details.
|
|
|
22
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;; Boston, MA 02111-1307, USA.
|
|
|
27
|
|
|
28 ;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9.
|
|
|
29
|
|
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
|
|
|
33 ;; and they never will be. -sb [1999-05-26]
|
|
|
34
|
|
|
35 ;;; Code:
|
|
|
36
|
|
|
37 ;;;; Classifying text according to charsets
|
|
|
38
|
|
|
39 (defun charsets-in-region (start end &optional buffer)
|
|
|
40 "Return a list of the charsets in the region between START and END.
|
|
|
41 BUFFER defaults to the current buffer if omitted."
|
|
|
42 (let (list)
|
|
|
43 (save-excursion
|
|
|
44 (if buffer
|
|
|
45 (set-buffer buffer))
|
|
|
46 (save-restriction
|
|
|
47 (narrow-to-region start end)
|
|
|
48 (goto-char (point-min))
|
|
|
49 (while (not (eobp))
|
|
|
50 (let* (prev-charset
|
|
|
51 (ch (char-after (point)))
|
|
|
52 (charset (char-charset ch)))
|
|
|
53 (if (not (eq prev-charset charset))
|
|
|
54 (progn
|
|
|
55 (setq prev-charset charset)
|
|
|
56 (or (memq charset list)
|
|
|
57 (setq list (cons charset list))))))
|
|
|
58 (forward-char))))
|
|
|
59 list))
|
|
|
60
|
|
|
61 (defun charsets-in-string (string)
|
|
|
62 "Return a list of the charsets in STRING."
|
|
|
63 (let ((i 0)
|
|
|
64 (len (length string))
|
|
|
65 prev-charset charset list)
|
|
|
66 (while (< i len)
|
|
|
67 (setq charset (char-charset (aref string i)))
|
|
|
68 (if (not (eq prev-charset charset))
|
|
|
69 (progn
|
|
|
70 (setq prev-charset charset)
|
|
|
71 (or (memq charset list)
|
|
|
72 (setq list (cons charset list)))))
|
|
|
73 (setq i (1+ i)))
|
|
|
74 list))
|
|
|
75
|
|
771
|
76 (defalias 'find-charset-string 'charsets-in-string)
|
|
|
77 (defalias 'find-charset-region 'charsets-in-region)
|
|
428
|
78
|
|
|
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!
|
|
771
|
147 ;; We're not going to support these.
|
|
|
148 ;(defun charset-info (charset) [incredibly broken function with random vectors]
|
|
|
149 ;(defun define-charset (...) [incredibly broken function with random vectors]
|
|
428
|
150
|
|
|
151 ;;; Charset property
|
|
|
152
|
|
|
153 (defalias 'get-charset-property 'get)
|
|
|
154 (defalias 'put-charset-property 'put)
|
|
|
155 (defalias 'charset-plist 'object-plist)
|
|
|
156 (defalias 'set-charset-plist 'setplist)
|
|
|
157
|
|
771
|
158
|
|
442
|
159 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
|
|
777
|
160 ;; SPACE and NEWLINE are already set.
|
|
442
|
161 (let ((l '(katakana-jisx0201
|
|
|
162 japanese-jisx0208 japanese-jisx0212
|
|
|
163 chinese-gb2312 chinese-big5-1 chinese-big5-2)))
|
|
|
164 (while l
|
|
|
165 (put-char-table (car l) t auto-fill-chars)
|
|
|
166 (setq l (cdr l))))
|
|
|
167
|
|
428
|
168 ;;; mule-charset.el ends here
|
