|
392
|
1 ;;; mule-charset.el --- Charset functions for Mule.
|
|
|
2 ;; Copyright (C) 1992 Free Software Foundation, Inc.
|
|
|
3 ;; Copyright (C) 1995 Amdahl Corporation.
|
|
|
4 ;; Copyright (C) 1996 Sun Microsystems.
|
|
|
5
|
|
|
6 ;; This file is part of XEmacs.
|
|
|
7
|
|
|
8 ;; 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
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
16 ;; General Public License for more details.
|
|
|
17
|
|
|
18 ;; 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
|
|
|
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
21 ;; Boston, MA 02111-1307, USA.
|
|
|
22
|
|
412
|
23
|
|
|
24 ;;;; Composite character support
|
|
392
|
25
|
|
412
|
26 (defun compose-region (start end &optional buffer)
|
|
|
27 "Compose characters in the current region into one composite character.
|
|
|
28 From a Lisp program, pass two arguments, START to END.
|
|
|
29 The composite character replaces the composed characters.
|
|
|
30 BUFFER defaults to the current buffer if omitted."
|
|
|
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)))
|
|
392
|
35
|
|
412
|
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))))))))))
|
|
392
|
56
|
|
|
57
|
|
|
58 ;;;; Classifying text according to charsets
|
|
|
59
|
|
|
60 (defun charsets-in-region (start end &optional buffer)
|
|
|
61 "Return a list of the charsets in the region between START and END.
|
|
|
62 BUFFER defaults to the current buffer if omitted."
|
|
|
63 (let (list)
|
|
|
64 (save-excursion
|
|
|
65 (if buffer
|
|
|
66 (set-buffer buffer))
|
|
|
67 (save-restriction
|
|
|
68 (narrow-to-region start end)
|
|
|
69 (goto-char (point-min))
|
|
|
70 (while (not (eobp))
|
|
|
71 (let* (prev-charset
|
|
|
72 (ch (char-after (point)))
|
|
|
73 (charset (char-charset ch)))
|
|
|
74 (if (not (eq prev-charset charset))
|
|
|
75 (progn
|
|
|
76 (setq prev-charset charset)
|
|
|
77 (or (memq charset list)
|
|
|
78 (setq list (cons charset list))))))
|
|
|
79 (forward-char))))
|
|
|
80 list))
|
|
|
81
|
|
|
82 (defun charsets-in-string (string)
|
|
|
83 "Return a list of the charsets in STRING."
|
|
|
84 (let ((i 0)
|
|
|
85 (len (length string))
|
|
|
86 prev-charset charset list)
|
|
|
87 (while (< i len)
|
|
|
88 (setq charset (char-charset (aref string i)))
|
|
|
89 (if (not (eq prev-charset charset))
|
|
|
90 (progn
|
|
|
91 (setq prev-charset charset)
|
|
|
92 (or (memq charset list)
|
|
|
93 (setq list (cons charset list)))))
|
|
|
94 (setq i (1+ i)))
|
|
|
95 list))
|
|
|
96
|
|
|
97
|
|
|
98 ;;;; Charset accessors
|
|
|
99
|
|
398
|
100 (defun charset-iso-graphic-plane (charset)
|
|
392
|
101 "Return the `graphic' property of CHARSET.
|
|
|
102 See `make-charset'."
|
|
|
103 (charset-property charset 'graphic))
|
|
|
104
|
|
398
|
105 (defun charset-iso-final-char (charset)
|
|
392
|
106 "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
|
|
|
107 (charset-property charset 'final))
|
|
|
108
|
|
|
109 (defun charset-chars (charset)
|
|
|
110 "Return the number of characters per dimension of CHARSET."
|
|
|
111 (charset-property charset 'chars))
|
|
|
112
|
|
398
|
113 (defun charset-width (charset)
|
|
392
|
114 "Return the number of display columns per character of CHARSET.
|
|
|
115 This only applies to TTY mode (under X, the actual display width can
|
|
|
116 be automatically determined)."
|
|
|
117 (charset-property charset 'columns))
|
|
|
118
|
|
|
119 (defun charset-direction (charset)
|
|
412
|
120 "Return the display direction (`l2r' or `r2l') of CHARSET."
|
|
|
121 (charset-property charset 'direction))
|
|
392
|
122
|
|
|
123 (defun charset-registry (charset)
|
|
|
124 "Return the registry of CHARSET.
|
|
|
125 This is a regular expression matching the registry field of fonts
|
|
|
126 that can display the characters in CHARSET."
|
|
|
127 (charset-property charset 'registry))
|
|
|
128
|
|
|
129 (defun charset-ccl-program (charset)
|
|
|
130 "Return the CCL program of CHARSET.
|
|
|
131 See `make-charset'."
|
|
|
132 (charset-property charset 'ccl-program))
|
|
|
133
|
|
398
|
134 (defun charset-bytes (charset)
|
|
|
135 "Useless in XEmacs, returns 1."
|
|
|
136 1)
|
|
|
137
|
|
|
138 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
|
|
|
139 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
|
|
|
140 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
|
|
|
141 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
|
|
392
|
142
|
|
|
143 ;;;; Define setf methods for all settable Charset properties
|
|
|
144
|
|
|
145 (defsetf charset-registry set-charset-registry)
|
|
|
146 (defsetf charset-ccl-program set-charset-ccl-program)
|
