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.
6 ;; This file is part of XEmacs.
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)
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.
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.
24 ;;;; Composite character support
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."
32 (let ((ch (make-composite-char (buffer-substring start end buffer))))
33 (delete-region start end buffer)
34 (insert-char ch nil nil buffer)))
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
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))
55 (insert (composite-char-string ch))))))))))
58 ;;;; Classifying text according to charsets
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."
68 (narrow-to-region start end)
69 (goto-char (point-min))
72 (ch (char-after (point)))
73 (charset (char-charset ch)))
74 (if (not (eq prev-charset charset))
76 (setq prev-charset charset)
77 (or (memq charset list)
78 (setq list (cons charset list))))))
82 (defun charsets-in-string (string)
83 "Return a list of the charsets in STRING."
86 prev-charset charset list)
88 (setq charset (char-charset (aref string i)))
89 (if (not (eq prev-charset charset))
91 (setq prev-charset charset)
92 (or (memq charset list)
93 (setq list (cons charset list)))))
98 ;;;; Charset accessors
100 (defun charset-graphic (charset)
101 "Return the `graphic' property of CHARSET.
103 (charset-property charset 'graphic))
105 (defun charset-final (charset)
106 "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
107 (charset-property charset 'final))
109 (defun charset-chars (charset)
110 "Return the number of characters per dimension of CHARSET."
111 (charset-property charset 'chars))
113 (defun charset-columns (charset)
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))
119 (defun charset-direction (charset)
120 "Return the display direction (`l2r' or `r2l') of CHARSET."
121 (charset-property charset 'direction))
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))
129 (defun charset-ccl-program (charset)
130 "Return the CCL program of CHARSET.
132 (charset-property charset 'ccl-program))
134 (defun charset-leading-byte (charset)
135 "Return the leading byte of CHARSET.
137 (charset-property charset 'leading-byte))
139 ;;;; Define setf methods for all settable Charset properties
141 (defsetf charset-registry set-charset-registry)
142 (defsetf charset-ccl-program set-charset-ccl-program)