annotate lisp/mule/mule-charset.el @ 147:e186c2b7192d xemacs-20-2

Added tag r20-2p1 for changeset 2af401a6ecca
author cvs
date Mon, 13 Aug 2007 09:34:48 +0200
parents 131b0175ea99
children 8e84bee8ddd0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
1 ;;; mule-charset.el --- Charset functions for Mule.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
2 ;; Copyright (C) 1992 Free Software Foundation, Inc.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
3 ;; Copyright (C) 1995 Amdahl Corporation.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
4 ;; Copyright (C) 1996 Sun Microsystems.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
5
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
6 ;; This file is part of XEmacs.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
7
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
8 ;; XEmacs is free software; you can redistribute it and/or modify it
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
9 ;; under the terms of the GNU General Public License as published by
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
10 ;; the Free Software Foundation; either version 2, or (at your option)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
11 ;; any later version.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
12
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
13 ;; XEmacs is distributed in the hope that it will be useful, but
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
16 ;; General Public License for more details.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
17
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
18 ;; You should have received a copy of the GNU General Public License
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
19 ;; along with XEmacs; see the file COPYING. If not, write to the
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
21 ;; Boston, MA 02111-1307, USA.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
22
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
23
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
24 ;;;; Composite character support
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
25
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
26 (defun compose-region (start end &optional buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
27 "Compose characters in the current region into one composite character.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
28 From a Lisp program, pass two arguments, START to END.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
29 The composite character replaces the composed characters.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
30 BUFFER defaults to the current buffer if omitted."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
31 (interactive "r")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
32 (let ((ch (make-composite-char (buffer-substring start end buffer))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
33 (delete-region start end buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
34 (insert-char ch nil nil buffer)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
35
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
36 (defun decompose-region (start end &optional buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
37 "Decompose any composite characters in the current region.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
38 From a Lisp program, pass two arguments, START to END.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
39 This converts each composite character into one or more characters,
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
40 the individual characters out of which the composite character was formed.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
41 Non-composite characters are left as-is. BUFFER defaults to the current
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
42 buffer if omitted."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
43 (interactive "r")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
44 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
45 (set-buffer buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
46 (save-restriction
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
47 (narrow-to-region start end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
48 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
49 (let ((compcharset (get-charset 'composite)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
50 (while (< (point) (point-max))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
51 (let ((ch (char-after (point))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
52 (if (eq compcharset (char-charset ch))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
53 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
54 (delete-char 1)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
55 (insert (composite-char-string ch))))))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
56
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
57
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
58 ;;;; Classifying text according to charsets
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
59
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
60 (defun charsets-in-region (start end &optional buffer)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
61 "Return a list of the charsets in the region between START and END.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
62 BUFFER defaults to the current buffer if omitted."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
63 (let (list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
64 (save-excursion
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
65 (if buffer
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
66 (set-buffer buffer))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
67 (save-restriction
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
68 (narrow-to-region start end)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
69 (goto-char (point-min))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
70 (while (not (eobp))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
71 (let* (prev-charset
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
72 (ch (char-after (point)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
73 (charset (char-charset ch)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
74 (if (not (eq prev-charset charset))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
75 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
76 (setq prev-charset charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
77 (or (memq charset list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
78 (setq list (cons charset list))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
79 (forward-char))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
80 list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
81
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
82 (defun charsets-in-string (string)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
83 "Return a list of the charsets in STRING."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
84 (let ((i 0)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
85 (len (length string))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
86 prev-charset charset list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
87 (while (< i len)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
88 (setq charset (char-charset (aref string i)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
89 (if (not (eq prev-charset charset))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
90 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
91 (setq prev-charset charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
92 (or (memq charset list)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
93 (setq list (cons charset list)))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
94 (setq i (1+ i)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
95 list))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
96
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
97
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
98 ;;;; Charset accessors
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
99
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
100 (defun charset-graphic (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
101 "Return the `graphic' property of CHARSET.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
102 See `make-charset'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
103 (charset-property charset 'graphic))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
104
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
105 (defun charset-final (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
106 "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
107 (charset-property charset 'final))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
108
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
109 (defun charset-chars (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
110 "Return the number of characters per dimension of CHARSET."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
111 (charset-property charset 'chars))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
112
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
113 (defun charset-columns (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
114 "Return the number of display columns per character of CHARSET.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
115 This only applies to TTY mode (under X, the actual display width can
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
116 be automatically determined)."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
117 (charset-property charset 'columns))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
118
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
119 (defun charset-direction (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
120 "Return the display direction (`l2r' or `r2l') of CHARSET."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
121 (charset-property charset 'direction))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
122
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
123 (defun charset-registry (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
124 "Return the registry of CHARSET.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
125 This is a regular expression matching the registry field of fonts
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
126 that can display the characters in CHARSET."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
127 (charset-property charset 'registry))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
128
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
129 (defun charset-ccl-program (charset)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
130 "Return the CCL program of CHARSET.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
131 See `make-charset'."
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
132 (charset-property charset 'ccl-program))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
133
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
134 ;;;; Define setf methods for all settable Charset properties
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
135
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
136 (defsetf charset-registry set-charset-registry)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents:
diff changeset
137 (defsetf charset-ccl-program set-charset-ccl-program)