Mercurial > emacs
annotate lisp/international/mule-util.el @ 106642:33320786e55e
*** empty log message ***
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Sat, 26 Dec 2009 15:56:43 +0000 |
parents | a9dc0e7c3f2b |
children | 1d1d5d9bd884 |
rev | line source |
---|---|
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
29354
diff
changeset
|
1 ;;; mule-util.el --- utility functions for mulitilingual environment (mule) |
17052 | 2 |
74544 | 3 ;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, |
100908 | 4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
74605
6ee41fdd69ff
Update AIST copyright years.
Kenichi Handa <handa@m17n.org>
parents:
74544
diff
changeset
|
5 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
100908 | 6 ;; 2005, 2006, 2007, 2008, 2009 |
62274 | 7 ;; National Institute of Advanced Industrial Science and Technology (AIST) |
8 ;; Registration Number H14PRO021 | |
89483 | 9 ;; Copyright (C) 2003 |
10 ;; National Institute of Advanced Industrial Science and Technology (AIST) | |
11 ;; Registration Number H13PRO009 | |
17052 | 12 |
13 ;; Keywords: mule, multilingual | |
14 | |
15 ;; This file is part of GNU Emacs. | |
16 | |
94664
889bc336b89b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91967
diff
changeset
|
17 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17052 | 18 ;; it under the terms of the GNU General Public License as published by |
94664
889bc336b89b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91967
diff
changeset
|
19 ;; the Free Software Foundation, either version 3 of the License, or |
889bc336b89b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91967
diff
changeset
|
20 ;; (at your option) any later version. |
17052 | 21 |
22 ;; GNU Emacs is distributed in the hope that it will be useful, | |
23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
25 ;; GNU General Public License for more details. | |
26 | |
27 ;; You should have received a copy of the GNU General Public License | |
94664
889bc336b89b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
91967
diff
changeset
|
28 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17052 | 29 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
29354
diff
changeset
|
30 ;;; Commentary: |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
29354
diff
changeset
|
31 |
17052 | 32 ;;; Code: |
33 | |
34 ;;; String manipulations while paying attention to multibyte | |
35 ;;; characters. | |
36 | |
37 ;;;###autoload | |
38 (defun string-to-sequence (string type) | |
39 "Convert STRING to a sequence of TYPE which contains characters in STRING. | |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
40 TYPE should be `list' or `vector'." |
28458 | 41 ;;; (let ((len (length string)) |
42 ;;; (i 0) | |
43 ;;; val) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
44 (cond ((eq type 'list) |
28458 | 45 ;; Applicable post-Emacs 20.2 and asymptotically ~10 times |
46 ;; faster than the code below: | |
47 (append string nil)) | |
48 ;;; (setq val (make-list len 0)) | |
49 ;;; (let ((l val)) | |
50 ;;; (while (< i len) | |
51 ;;; (setcar l (aref string i)) | |
52 ;;; (setq l (cdr l) i (1+ i)))))) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
53 ((eq type 'vector) |
28458 | 54 ;; As above. |
55 (vconcat string)) | |
56 ;;; (setq val (make-vector len 0)) | |
57 ;;; (while (< i len) | |
58 ;;; (aset val i (aref string i)) | |
59 ;;; (setq i (1+ i)))) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
60 (t |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
61 (error "Invalid type: %s" type))) |
28458 | 62 ;;; val) |
63 ) | |
46511
f44beb42c7c1
(string-to-sequence, truncate-string): Add autoload cookie.
Juanma Barranquero <lekktu@gmail.com>
parents:
46051
diff
changeset
|
64 |
f44beb42c7c1
(string-to-sequence, truncate-string): Add autoload cookie.
Juanma Barranquero <lekktu@gmail.com>
parents:
46051
diff
changeset
|
65 ;;;###autoload |
41232
43e756c38f4f
(string-to-sequence): Make it obsolete.
Richard M. Stallman <rms@gnu.org>
parents:
38414
diff
changeset
|
66 (make-obsolete 'string-to-sequence |
46051
990c78360ef5
(string-to-sequence): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents:
45908
diff
changeset
|
67 "use `string-to-list' or `string-to-vector'." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
58804
diff
changeset
|
68 "22.1") |
17052 | 69 |
70 ;;;###autoload | |
71 (defsubst string-to-list (string) | |
72 "Return a list of characters in STRING." | |
41232
43e756c38f4f
(string-to-sequence): Make it obsolete.
Richard M. Stallman <rms@gnu.org>
parents:
38414
diff
changeset
|
73 (append string nil)) |
17052 | 74 |
75 ;;;###autoload | |
76 (defsubst string-to-vector (string) | |
77 "Return a vector of characters in STRING." | |
41232
43e756c38f4f
(string-to-sequence): Make it obsolete.
Richard M. Stallman <rms@gnu.org>
parents:
38414
diff
changeset
|
78 (vconcat string)) |
17052 | 79 |
80 ;;;###autoload | |
81 (defun store-substring (string idx obj) | |
82 "Embed OBJ (string or character) at index IDX of STRING." | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
83 (if (integerp obj) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
84 (aset string idx obj) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
85 (let ((len1 (length obj)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
86 (len2 (length string)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
87 (i 0)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
88 (while (< i len1) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
89 (aset string (+ idx i) (aref obj i)) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
90 (setq i (1+ i))))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
91 string) |
17052 | 92 |
93 ;;;###autoload | |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
94 (defun truncate-string-to-width (str end-column |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
95 &optional start-column padding ellipsis) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
96 "Truncate string STR to end at column END-COLUMN. |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
97 The optional 3rd arg START-COLUMN, if non-nil, specifies the starting |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
98 column; that means to return the characters occupying columns |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
99 START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
100 are specified in terms of character display width in the current |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
101 buffer; see also `char-width'. |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
102 |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
103 The optional 4th arg PADDING, if non-nil, specifies a padding |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
104 character (which should have a display width of 1) to add at the end |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
105 of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
106 comes in the middle of a character in STR. PADDING is also added at |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
107 the beginning of the result if column START-COLUMN appears in the |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
108 middle of a character in STR. |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
109 |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
110 If PADDING is nil, no padding is added in these cases, so |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
111 the resulting string may be narrower than END-COLUMN. |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
112 |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
113 If ELLIPSIS is non-nil, it should be a string which will replace the |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
114 end of STR (including any padding) if it extends beyond END-COLUMN, |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
115 unless the display width of STR is equal to or less than the display |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
116 width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
117 defaults to \"...\"." |
17052 | 118 (or start-column |
119 (setq start-column 0)) | |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
120 (when (and ellipsis (not (stringp ellipsis))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
121 (setq ellipsis "...")) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
122 (let ((str-len (length str)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
123 (str-width (string-width str)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
124 (ellipsis-len (if ellipsis (length ellipsis) 0)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
125 (ellipsis-width (if ellipsis (string-width ellipsis) 0)) |
17052 | 126 (idx 0) |
127 (column 0) | |
128 (head-padding "") (tail-padding "") | |
129 ch last-column last-idx from-idx) | |
130 (condition-case nil | |
131 (while (< column start-column) | |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
132 (setq ch (aref str idx) |
17052 | 133 column (+ column (char-width ch)) |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
134 idx (1+ idx))) |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
135 (args-out-of-range (setq idx str-len))) |
17052 | 136 (if (< column start-column) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
137 (if padding (make-string end-column padding) "") |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
138 (when (and padding (> column start-column)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
139 (setq head-padding (make-string (- column start-column) padding))) |
17052 | 140 (setq from-idx idx) |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
141 (when (>= end-column column) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
142 (if (and (< end-column str-width) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
143 (> str-width ellipsis-width)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
144 (setq end-column (- end-column ellipsis-width)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
145 (setq ellipsis "")) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
146 (condition-case nil |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
147 (while (< column end-column) |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
148 (setq last-column column |
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
149 last-idx idx |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
150 ch (aref str idx) |
19916
f43513081277
(truncate-string-to-width):
Richard M. Stallman <rms@gnu.org>
parents:
19745
diff
changeset
|
151 column (+ column (char-width ch)) |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
152 idx (1+ idx))) |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
153 (args-out-of-range (setq idx str-len))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
154 (when (> column end-column) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
155 (setq column last-column |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
156 idx last-idx)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
157 (when (and padding (< column end-column)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
158 (setq tail-padding (make-string (- end-column column) padding)))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
159 (concat head-padding (substring str from-idx idx) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
160 tail-padding ellipsis)))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
161 |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
162 ;;; Test suite for truncate-string-to-width |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
163 ;; (dolist (test '((("" 0) . "") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
164 ;; (("x" 1) . "x") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
165 ;; (("xy" 1) . "x") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
166 ;; (("xy" 2 1) . "y") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
167 ;; (("xy" 0) . "") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
168 ;; (("xy" 3) . "xy") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
169 ;; (("$AVP(B" 0) . "") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
170 ;; (("$AVP(B" 1) . "") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
171 ;; (("$AVP(B" 2) . "$AVP(B") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
172 ;; (("$AVP(B" 1 nil ? ) . " ") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
173 ;; (("$AVPND(B" 3 1 ? ) . " ") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
174 ;; (("x$AVP(Bx" 2) . "x") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
175 ;; (("x$AVP(Bx" 3) . "x$AVP(B") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
176 ;; (("x$AVP(Bx" 3) . "x$AVP(B") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
177 ;; (("x$AVP(Bx" 4 1) . "$AVP(Bx") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
178 ;; (("kor$(CGQ(Be$(C1[(Ban" 8 1 ? ) . "or$(CGQ(Be$(C1[(B") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
179 ;; (("kor$(CGQ(Be$(C1[(Ban" 7 2 ? ) . "r$(CGQ(Be ") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
180 ;; (("" 0 nil nil "...") . "") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
181 ;; (("x" 3 nil nil "...") . "x") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
182 ;; (("$AVP(B" 3 nil nil "...") . "$AVP(B") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
183 ;; (("foo" 3 nil nil "...") . "foo") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
184 ;; (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure? |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
185 ;; (("foobar" 6 0 nil "...") . "foobar") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
186 ;; (("foobarbaz" 6 nil nil "...") . "foo...") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
187 ;; (("foobarbaz" 7 2 nil "...") . "ob...") |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
188 ;; (("foobarbaz" 9 3 nil "...") . "barbaz") |
89909 | 189 ;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 15 1 ? t) . " h$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo") |
190 ;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 14 1 ? t) . " h$A$s(Be$A$K(Bl$A$A(B...") | |
191 ;; (("x" 3 nil nil "$(Gemk#(B") . "x") | |
192 ;; (("$AVP(B" 2 nil nil "$(Gemk#(B") . "$AVP(B") | |
193 ;; (("$AVP(B" 1 nil ?x "$(Gemk#(B") . "x") ;; XEmacs error | |
194 ;; (("$AVPND(B" 3 nil ? "$(Gemk#(B") . "$AVP(B ") ;; XEmacs error | |
195 ;; (("foobarbaz" 4 nil nil "$(Gemk#(B") . "$(Gemk#(B") | |
196 ;; (("foobarbaz" 5 nil nil "$(Gemk#(B") . "f$(Gemk#(B") | |
197 ;; (("foobarbaz" 6 nil nil "$(Gemk#(B") . "fo$(Gemk#(B") | |
198 ;; (("foobarbaz" 8 3 nil "$(Gemk#(B") . "b$(Gemk#(B") | |
199 ;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 14 4 ?x "$AHU1>$(Gk#(B") . "xe$A$KHU1>$(Gk#(B") | |
200 ;; (("$A$3(Bh$A$s(Be$A$K(Bl$A$A(Bl$A$O(Bo" 13 4 ?x "$AHU1>$(Gk#(B") . "xex$AHU1>$(Gk#(B") | |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
201 ;; )) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
202 ;; (let (ret) |
48156
5701c670b676
(coding-system-eol-type-mnemonic): Move to mule.el.
Juanma Barranquero <lekktu@gmail.com>
parents:
46511
diff
changeset
|
203 ;; (condition-case e |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
204 ;; (setq ret (apply #'truncate-string-to-width (car test))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
205 ;; (error (setq ret e))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
206 ;; (unless (equal ret (cdr test)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
207 ;; (error "%s: expected %s, got %s" |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
208 ;; (prin1-to-string (cons 'truncate-string-to-width (car test))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
209 ;; (prin1-to-string (cdr test)) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
210 ;; (if (consp ret) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
211 ;; (format "error: %s: %s" (car ret) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
212 ;; (prin1-to-string (cdr ret))) |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
213 ;; (prin1-to-string ret)))))) |
17052 | 214 |
215 | |
216 ;;; Nested alist handler. Nested alist is alist whose elements are | |
217 ;;; also nested alist. | |
218 | |
219 ;;;###autoload | |
220 (defsubst nested-alist-p (obj) | |
23196 | 221 "Return t if OBJ is a nested alist. |
17052 | 222 |
223 Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is | |
224 any Lisp object, and BRANCHES is a list of cons cells of the form | |
45908
bb8152219329
open-paren-in-column-0 in dosctring.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45453
diff
changeset
|
225 \(KEY-ELEMENT . NESTED-ALIST). |
17052 | 226 |
227 You can use a nested alist to store any Lisp object (ENTRY) for a key | |
228 sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ | |
229 can be a string, a vector, or a list." | |
230 (and obj (listp obj) (listp (cdr obj)))) | |
231 | |
232 ;;;###autoload | |
233 (defun set-nested-alist (keyseq entry alist &optional len branches) | |
234 "Set ENTRY for KEYSEQ in a nested alist ALIST. | |
23196 | 235 Optional 4th arg LEN non-nil means the first LEN elements in KEYSEQ |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
236 are considered. |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
237 Optional 5th argument BRANCHES if non-nil is branches for a keyseq |
17052 | 238 longer than KEYSEQ. |
239 See the documentation of `nested-alist-p' for more detail." | |
240 (or (nested-alist-p alist) | |
23196 | 241 (error "Invalid argument %s" alist)) |
17052 | 242 (let ((islist (listp keyseq)) |
243 (len (or len (length keyseq))) | |
244 (i 0) | |
245 key-elt slot) | |
246 (while (< i len) | |
247 (if (null (nested-alist-p alist)) | |
248 (error "Keyseq %s is too long for this nested alist" keyseq)) | |
249 (setq key-elt (if islist (nth i keyseq) (aref keyseq i))) | |
250 (setq slot (assoc key-elt (cdr alist))) | |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
251 (unless slot |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
252 (setq slot (cons key-elt (list t))) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
253 (setcdr alist (cons slot (cdr alist)))) |
17052 | 254 (setq alist (cdr slot)) |
255 (setq i (1+ i))) | |
256 (setcar alist entry) | |
257 (if branches | |
26890
4cd9407a4683
(set-nested-alist): Set BRANCHES (if
Kenichi Handa <handa@m17n.org>
parents:
26691
diff
changeset
|
258 (setcdr (last alist) branches)))) |
17052 | 259 |
260 ;;;###autoload | |
261 (defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long) | |
262 "Look up key sequence KEYSEQ in nested alist ALIST. Return the definition. | |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
263 Optional 3rd argument LEN specifies the length of KEYSEQ. |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
264 Optional 4th argument START specifies index of the starting key. |
17052 | 265 The returned value is normally a nested alist of which |
266 car part is the entry for KEYSEQ. | |
267 If ALIST is not deep enough for KEYSEQ, return number which is | |
268 how many key elements at the front of KEYSEQ it takes | |
269 to reach a leaf in ALIST. | |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
270 Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil |
17052 | 271 even if ALIST is not deep enough." |
272 (or (nested-alist-p alist) | |
28458 | 273 (error "Invalid argument %s" alist)) |
17052 | 274 (or len |
275 (setq len (length keyseq))) | |
276 (let ((i (or start 0))) | |
277 (if (catch 'lookup-nested-alist-tag | |
278 (if (listp keyseq) | |
279 (while (< i len) | |
280 (if (setq alist (cdr (assoc (nth i keyseq) (cdr alist)))) | |
281 (setq i (1+ i)) | |
282 (throw 'lookup-nested-alist-tag t)))) | |
283 (while (< i len) | |
284 (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist)))) | |
285 (setq i (1+ i)) | |
286 (throw 'lookup-nested-alist-tag t)))) | |
287 ;; KEYSEQ is too long. | |
288 (if nil-for-too-long nil i) | |
289 alist))) | |
290 | |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
291 |
17052 | 292 ;; Coding system related functions. |
293 | |
294 ;;;###autoload | |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
295 (defun coding-system-post-read-conversion (coding-system) |
42049 | 296 "Return the value of CODING-SYSTEM's `post-read-conversion' property." |
88652
8b4e3bbe01d4
(coding-system-post-read-conversion)
Dave Love <fx@gnu.org>
parents:
42049
diff
changeset
|
297 (coding-system-get coding-system :post-read-conversion)) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
298 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
299 ;;;###autoload |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
300 (defun coding-system-pre-write-conversion (coding-system) |
42049 | 301 "Return the value of CODING-SYSTEM's `pre-write-conversion' property." |
88652
8b4e3bbe01d4
(coding-system-post-read-conversion)
Dave Love <fx@gnu.org>
parents:
42049
diff
changeset
|
302 (coding-system-get coding-system :pre-write-conversion)) |
18200
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
303 |
c913160e34a7
(set-coding-system-alist): Deleted.
Kenichi Handa <handa@m17n.org>
parents:
17092
diff
changeset
|
304 ;;;###autoload |
22126
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
305 (defun coding-system-translation-table-for-decode (coding-system) |
89483 | 306 "Return the value of CODING-SYSTEM's `decode-translation-table' property." |
88652
8b4e3bbe01d4
(coding-system-post-read-conversion)
Dave Love <fx@gnu.org>
parents:
42049
diff
changeset
|
307 (coding-system-get coding-system :decode-translation-table)) |
19455
7cf3d42a6fd7
(coding-system-unification-table):
Kenichi Handa <handa@m17n.org>
parents:
19264
diff
changeset
|
308 |
7cf3d42a6fd7
(coding-system-unification-table):
Kenichi Handa <handa@m17n.org>
parents:
19264
diff
changeset
|
309 ;;;###autoload |
22126
97cf1cae1971
Change term unification to
Kenichi Handa <handa@m17n.org>
parents:
21554
diff
changeset
|
310 (defun coding-system-translation-table-for-encode (coding-system) |
89483 | 311 "Return the value of CODING-SYSTEM's `encode-translation-table' property." |
88652
8b4e3bbe01d4
(coding-system-post-read-conversion)
Dave Love <fx@gnu.org>
parents:
42049
diff
changeset
|
312 (coding-system-get coding-system :encode-translation-table)) |
17052 | 313 |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
314 ;;;###autoload |
89483 | 315 (defmacro with-coding-priority (coding-systems &rest body) |
316 "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list. | |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
317 CODING-SYSTEMS is a list of coding systems. See `set-coding-priority'. |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
318 This affects the implicit sorting of lists of coding sysems returned by |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
319 operations such as `find-coding-systems-region'." |
89483 | 320 (let ((current (make-symbol "current"))) |
321 `(let ((,current (coding-system-priority-list))) | |
322 (apply #'set-coding-system-priority ,coding-systems) | |
323 (unwind-protect | |
324 (progn ,@body) | |
325 (apply #'set-coding-system-priority ,current))))) | |
326 (put 'with-coding-priority 'lisp-indent-function 1) | |
327 (put 'with-coding-priority 'edebug-form-spec t) | |
17052 | 328 |
18299
c6f35cac24b4
(coding-system-parent): New function.
Kenichi Handa <handa@m17n.org>
parents:
18200
diff
changeset
|
329 ;;;###autoload |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
330 (defmacro detect-coding-with-priority (from to priority-list) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
331 "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
332 PRIORITY-LIST is an alist of coding categories vs the corresponding |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
333 coding systems ordered by priority." |
88867
438e610d8d06
(detect-coding-with-priority): Fix the place of using `,' marker in
Kenichi Handa <handa@m17n.org>
parents:
88842
diff
changeset
|
334 `(with-coding-priority (mapcar #'cdr ,priority-list) |
88810 | 335 (detect-coding-region ,from ,to))) |
336 (make-obsolete 'detect-coding-with-priority | |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
337 "use `with-coding-priority' and `detect-coding-region'." "23.1") |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
338 |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
339 ;;;###autoload |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
340 (defun detect-coding-with-language-environment (from to lang-env) |
89500
e8de75a86fbc
(detect-coding-with-language-environment): Doc fix.
Dave Love <fx@gnu.org>
parents:
89483
diff
changeset
|
341 "Detect a coding system for the text between FROM and TO with LANG-ENV. |
23196 | 342 The detection takes into account the coding system priorities for the |
20730
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
343 language environment LANG-ENV." |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
344 (let ((coding-priority (get-language-info lang-env 'coding-priority))) |
42d729244a85
(find-safe-coding-system): Moved to
Kenichi Handa <handa@m17n.org>
parents:
20162
diff
changeset
|
345 (if coding-priority |
88652
8b4e3bbe01d4
(coding-system-post-read-conversion)
Dave Love <fx@gnu.org>
parents:
42049
diff
changeset
|
346 (with-coding-priority coding-priority |
8b4e3bbe01d4
(coding-system-post-read-conversion)
Dave Love <fx@gnu.org>
parents:
42049
diff
changeset
|
347 (detect-coding-region from to))))) |
20162
dc6f12ef4d47
(find-safe-coding-system): New function.
Kenichi Handa <handa@m17n.org>
parents:
20113
diff
changeset
|
348 |
95841
b4e36ff621b3
Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents:
94664
diff
changeset
|
349 (declare-function internal-char-font "fontset.c" (position &optional ch)) |
b4e36ff621b3
Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents:
94664
diff
changeset
|
350 |
52403 | 351 ;;;###autoload |
352 (defun char-displayable-p (char) | |
353 "Return non-nil if we should be able to display CHAR. | |
354 On a multi-font display, the test is only whether there is an | |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
355 appropriate font from the selected frame's fontset to display |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
356 CHAR's charset in general. Since fonts may be specified on a |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
357 per-character basis, this may not be accurate." |
91967
39b7a7b122f8
(char-displayable-p): Fix for Latin-1
Kenichi Handa <handa@m17n.org>
parents:
91327
diff
changeset
|
358 (cond ((< char 128) |
39b7a7b122f8
(char-displayable-p): Fix for Latin-1
Kenichi Handa <handa@m17n.org>
parents:
91327
diff
changeset
|
359 ;; ASCII characters are always displayable. |
52403 | 360 t) |
58804
9b0a547610a4
(char-displayable-p): Return nil for unibyte mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57443
diff
changeset
|
361 ((not enable-multibyte-characters) |
9b0a547610a4
(char-displayable-p): Return nil for unibyte mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57443
diff
changeset
|
362 ;; Maybe there's a font for it, but we can't put it in the buffer. |
9b0a547610a4
(char-displayable-p): Return nil for unibyte mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57443
diff
changeset
|
363 nil) |
52403 | 364 ((display-multi-font-p) |
365 ;; On a window system, a character is displayable if we have | |
366 ;; a font for that character in the default face of the | |
367 ;; currently selected frame. | |
55095
4d5ade635f7a
(char-displayable-p): Simplified by using internal-char-font.
Kenichi Handa <handa@m17n.org>
parents:
54638
diff
changeset
|
368 (car (internal-char-font nil char))) |
52403 | 369 (t |
91967
39b7a7b122f8
(char-displayable-p): Fix for Latin-1
Kenichi Handa <handa@m17n.org>
parents:
91327
diff
changeset
|
370 ;; On a terminal, a character is displayable if the coding |
39b7a7b122f8
(char-displayable-p): Fix for Latin-1
Kenichi Handa <handa@m17n.org>
parents:
91327
diff
changeset
|
371 ;; system for the terminal can encode it. |
39b7a7b122f8
(char-displayable-p): Fix for Latin-1
Kenichi Handa <handa@m17n.org>
parents:
91327
diff
changeset
|
372 (let ((coding (terminal-coding-system))) |
99752
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
373 (when coding |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
374 (let ((cs-list (coding-system-get coding :charset-list))) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
375 (cond |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
376 ((listp cs-list) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
377 (catch 'tag |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
378 (mapc #'(lambda (charset) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
379 (if (encode-char char charset) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
380 (throw 'tag charset))) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
381 cs-list) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
382 nil)) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
383 ((eq cs-list 'iso-2022) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
384 (catch 'tag2 |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
385 (mapc #'(lambda (charset) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
386 (if (and (plist-get (charset-plist charset) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
387 :iso-final-char) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
388 (encode-char char charset)) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
389 (throw 'tag2 charset))) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
390 charset-list) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
391 nil)) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
392 ((eq cs-list 'emacs-mule) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
393 (catch 'tag3 |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
394 (mapc #'(lambda (charset) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
395 (if (and (plist-get (charset-plist charset) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
396 :emacs-mule-id) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
397 (encode-char char charset)) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
398 (throw 'tag3 charset))) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
399 charset-list) |
25fea170fd1a
* international/mule-util.el (set-nested-alist): Doc fix. Use `when'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
400 nil))))))))) |
17052 | 401 |
28458 | 402 (provide 'mule-util) |
403 | |
45453
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
404 ;; Local Variables: |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
405 ;; coding: iso-2022-7bit |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
406 ;; End: |
05d77f58ead5
(truncate-string-to-width): New optional argument `ellipsis'. Add
Colin Walters <walters@gnu.org>
parents:
42049
diff
changeset
|
407 |
58804
9b0a547610a4
(char-displayable-p): Return nil for unibyte mode.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57443
diff
changeset
|
408 ;; arch-tag: 5bdb52b6-a3a5-4529-b7a0-37d01b0e570b |
26890
4cd9407a4683
(set-nested-alist): Set BRANCHES (if
Kenichi Handa <handa@m17n.org>
parents:
26691
diff
changeset
|
409 ;;; mule-util.el ends here |