Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-charset.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children 8e84bee8ddd0
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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
23
24 ;;;; Composite character support
25
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)))
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
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
100 (defun charset-graphic (charset)
101 "Return the `graphic' property of CHARSET.
102 See `make-charset'."
103 (charset-property charset 'graphic))
104
105 (defun charset-final (charset)
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
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))
118
119 (defun charset-direction (charset)
120 "Return the display direction (`l2r' or `r2l') of CHARSET."
121 (charset-property charset 'direction))
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
134 ;;;; Define setf methods for all settable Charset properties
135
136 (defsetf charset-registry set-charset-registry)
137 (defsetf charset-ccl-program set-charset-ccl-program)