Mercurial > hg > xemacs-beta
annotate lisp/coding.el @ 5556:a142ad1a9140
Use dlsym() in preference to NSLookupSymbolInModule() on Darwin, if available.
ChangeLog addition:
2011-08-24 Aidan Kehoe <kehoea@parhasard.net>
* configure.ac:
On OS X, if dlopen() is available in dlfcn.h, use it in preference
to dyld; the latter API is deprecated.
Move DLSYM_NEEDS_UNDERSCORE together with HAVE_DLYD, it's not
needed if the dlsym() and dlopen() APIs are being used.
Define REALPATH_CORRECTS_CASE, DEFAULT_FILE_SYSTEM_IGNORE_CASE in
this file, don't define them in terms of HAVE_DYLD in
src/config.h.in.
* configure: Regenerate.
src/ChangeLog addition:
2011-08-24 Aidan Kehoe <kehoea@parhasard.net>
* config.h.in:
Move REALPATH_CORRECTS_CASE, DEFAULT_FILE_SYSTEM_IGNORE_CASE to
../configure.ac rather than implementing them in terms of
HAVE_DYLD here.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 24 Aug 2011 23:41:29 +0100 |
parents | 4dee0387b9de |
children |
rev | line source |
---|---|
428 | 1 ;;; coding.el --- Coding-system functions for XEmacs. |
2 | |
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
4 ;; Licensed to the Free Software Foundation. | |
5 ;; Copyright (C) 1995 Amdahl Corporation. | |
6 ;; Copyright (C) 1995 Sun Microsystems. | |
7 ;; Copyright (C) 1997 MORIOKA Tomohiko | |
5081
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing. |
428 | 9 |
10 ;; This file is part of XEmacs. | |
11 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
15 ;; option) any later version. |
428 | 16 |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
20 ;; for more details. |
428 | 21 |
22 ;; You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5083
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
428 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;;; split off of mule.el. | |
28 | |
29 ;;; Code: | |
30 | |
502 | 31 (globally-declare-fboundp |
32 '(coding-system-lock-shift | |
33 coding-system-seven coding-system-charset charset-dimension)) | |
34 | |
428 | 35 (defalias 'check-coding-system 'get-coding-system) |
36 | |
37 (defun modify-coding-system-alist (target-type regexp coding-system) | |
38 "Modify one of look up tables for finding a coding system on I/O operation. | |
39 There are three of such tables, `file-coding-system-alist', | |
40 `process-coding-system-alist', and `network-coding-system-alist'. | |
41 | |
42 TARGET-TYPE specifies which of them to modify. | |
43 If it is `file', it affects `file-coding-system-alist' (which see). | |
44 If it is `process', it affects `process-coding-system-alist' (which see). | |
599 | 45 If it is `network', it affects `network-coding-system-alist' (which see). |
428 | 46 |
47 REGEXP is a regular expression matching a target of I/O operation. | |
48 The target is a file name if TARGET-TYPE is `file', a program name if | |
49 TARGET-TYPE is `process', or a network service name or a port number | |
50 to connect to if TARGET-TYPE is `network'. | |
51 | |
52 CODING-SYSTEM is a coding system to perform code conversion on the I/O | |
53 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems | |
54 for decoding and encoding respectively, | |
55 or a function symbol which, when called, returns such a cons cell." | |
56 (or (memq target-type '(file process network)) | |
57 (error "Invalid target type: %s" target-type)) | |
58 (or (stringp regexp) | |
59 (and (eq target-type 'network) (integerp regexp)) | |
60 (error "Invalid regular expression: %s" regexp)) | |
61 (if (symbolp coding-system) | |
62 (if (not (fboundp coding-system)) | |
63 (progn | |
64 (check-coding-system coding-system) | |
65 (setq coding-system (cons coding-system coding-system)))) | |
66 (check-coding-system (car coding-system)) | |
67 (check-coding-system (cdr coding-system))) | |
68 (cond ((eq target-type 'file) | |
69 (let ((slot (assoc regexp file-coding-system-alist))) | |
70 (if slot | |
71 (setcdr slot coding-system) | |
72 (setq file-coding-system-alist | |
73 (cons (cons regexp coding-system) | |
74 file-coding-system-alist))))) | |
75 ((eq target-type 'process) | |
76 (let ((slot (assoc regexp process-coding-system-alist))) | |
77 (if slot | |
78 (setcdr slot coding-system) | |
79 (setq process-coding-system-alist | |
80 (cons (cons regexp coding-system) | |
81 process-coding-system-alist))))) | |
82 (t | |
83 (let ((slot (assoc regexp network-coding-system-alist))) | |
84 (if slot | |
85 (setcdr slot coding-system) | |
86 (setq network-coding-system-alist | |
87 (cons (cons regexp coding-system) | |
88 network-coding-system-alist))))))) | |
89 | |
90 (defsubst keyboard-coding-system () | |
91 "Return coding-system of what is sent from terminal keyboard." | |
92 keyboard-coding-system) | |
93 | |
94 (defun set-keyboard-coding-system (coding-system) | |
95 "Set the coding system used for TTY keyboard input. Currently broken." | |
96 (interactive "zkeyboard-coding-system: ") | |
97 (get-coding-system coding-system) ; correctness check | |
98 (setq keyboard-coding-system coding-system) | |
442 | 99 (if (eq (device-type) 'tty) |
502 | 100 (declare-fboundp (set-console-tty-input-coding-system |
101 (device-console) keyboard-coding-system))) | |
428 | 102 (redraw-modeline t)) |
103 | |
104 (defsubst terminal-coding-system () | |
105 "Return coding-system of your terminal." | |
106 terminal-coding-system) | |
107 | |
108 (defun set-terminal-coding-system (coding-system) | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
109 "Set the coding system used for TTY display output." |
428 | 110 (interactive "zterminal-coding-system: ") |
111 (get-coding-system coding-system) ; correctness check | |
112 (setq terminal-coding-system coding-system) | |
113 ; #### should this affect all current tty consoles ? | |
114 (if (eq (device-type) 'tty) | |
502 | 115 (declare-fboundp (set-console-tty-output-coding-system |
116 (device-console) terminal-coding-system))) | |
428 | 117 (redraw-modeline t)) |
118 | |
119 (defun what-coding-system (start end &optional arg) | |
120 "Show the encoding of text in the region. | |
121 This function is meant to be called interactively; | |
122 from a Lisp program, use `detect-coding-region' instead." | |
123 (interactive "r\nP") | |
124 (princ (detect-coding-region start end))) | |
125 | |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
126 (defun decode-coding-string (str coding-system &optional nocopy) |
428 | 127 "Decode the string STR which is encoded in CODING-SYSTEM. |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
128 Normally does not modify STR. Returns the decoded string on |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
129 successful conversion. |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
130 Optional argument NOCOPY says that modifying STR and returning it is |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
131 allowed." |
428 | 132 (with-string-as-buffer-contents |
133 str (decode-coding-region (point-min) (point-max) coding-system))) | |
134 | |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
135 (defun encode-coding-string (str coding-system &optional nocopy) |
428 | 136 "Encode the string STR using CODING-SYSTEM. |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
137 Does not modify STR. Returns the encoded string on successful conversion. |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
138 Optional argument NOCOPY says that the original string may be returned |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
139 if does not differ from the encoded string. " |
428 | 140 (with-string-as-buffer-contents |
141 str (encode-coding-region (point-min) (point-max) coding-system))) | |
142 | |
143 | |
144 ;;;; Coding system accessors | |
145 | |
146 (defun coding-system-mnemonic (coding-system) | |
147 "Return the 'mnemonic property of CODING-SYSTEM." | |
148 (coding-system-property coding-system 'mnemonic)) | |
149 | |
771 | 150 (defun coding-system-documentation (coding-system) |
151 "Return the 'documentation property of CODING-SYSTEM." | |
152 (coding-system-property coding-system 'documentation)) | |
153 | |
154 (define-obsolete-function-alias 'coding-system-doc-string | |
155 'coding-system-description) | |
428 | 156 |
157 (defun coding-system-eol-type (coding-system) | |
158 "Return the 'eol-type property of CODING-SYSTEM." | |
159 (coding-system-property coding-system 'eol-type)) | |
160 | |
161 (defun coding-system-eol-lf (coding-system) | |
162 "Return the 'eol-lf property of CODING-SYSTEM." | |
163 (coding-system-property coding-system 'eol-lf)) | |
164 | |
165 (defun coding-system-eol-crlf (coding-system) | |
166 "Return the 'eol-crlf property of CODING-SYSTEM." | |
167 (coding-system-property coding-system 'eol-crlf)) | |
168 | |
169 (defun coding-system-eol-cr (coding-system) | |
170 "Return the 'eol-cr property of CODING-SYSTEM." | |
171 (coding-system-property coding-system 'eol-cr)) | |
172 | |
173 (defun coding-system-post-read-conversion (coding-system) | |
174 "Return the 'post-read-conversion property of CODING-SYSTEM." | |
175 (coding-system-property coding-system 'post-read-conversion)) | |
176 | |
177 (defun coding-system-pre-write-conversion (coding-system) | |
178 "Return the 'pre-write-conversion property of CODING-SYSTEM." | |
179 (coding-system-property coding-system 'pre-write-conversion)) | |
180 | |
502 | 181 ;;; #### bleagh!!!!!!! |
182 | |
183 (defun coding-system-get (coding-system prop) | |
184 "Extract a value from CODING-SYSTEM's property list for property PROP." | |
185 (or (plist-get | |
186 (get (coding-system-name coding-system) 'coding-system-property) | |
187 prop) | |
188 (condition-case nil | |
189 (coding-system-property coding-system prop) | |
190 (error nil)))) | |
191 | |
192 (defun coding-system-put (coding-system prop value) | |
193 "Change value in CODING-SYSTEM's property list PROP to VALUE." | |
194 (put (coding-system-name coding-system) | |
195 'coding-system-property | |
196 (plist-put (get (coding-system-name coding-system) | |
197 'coding-system-property) | |
198 prop value))) | |
199 | |
200 (defun coding-system-category (coding-system) | |
201 "Return the coding category of CODING-SYSTEM." | |
202 (or (coding-system-get coding-system 'category) | |
771 | 203 (case (coding-system-type coding-system) |
204 (no-conversion 'no-conversion) | |
205 (shift-jis 'shift-jis) | |
3767 | 206 (unicode (case (coding-system-property coding-system 'unicode-type) |
985 | 207 (utf-8 (let ((bom (coding-system-property coding-system |
208 'need-bom))) | |
209 (cond (bom 'utf-8-bom) | |
210 ((not bom) 'utf-8)))) | |
771 | 211 (ucs-4 'ucs-4) |
212 (utf-16 (let ((bom (coding-system-property coding-system | |
213 'need-bom)) | |
214 (le (coding-system-property coding-system | |
215 'little-endian))) | |
216 (cond ((and bom le) 'utf-16-little-endian-bom) | |
217 ((and bom (not le) 'utf-16-bom)) | |
218 ((and (not bom) le) 'utf-16-little-endian) | |
219 ((and (not bom) (not le) 'utf-16))))))) | |
220 (big5 'big5) | |
221 (iso2022 (cond ((coding-system-lock-shift coding-system) | |
222 'iso-lock-shift) | |
223 ((coding-system-seven coding-system) | |
224 'iso-7) | |
225 (t | |
226 (let ((dim 0) | |
227 ccs | |
228 (i 0)) | |
229 (while (< i 4) | |
230 (setq ccs (declare-fboundp | |
231 (coding-system-iso2022-charset | |
232 coding-system i))) | |
233 (if (and ccs | |
234 (> (charset-dimension ccs) dim)) | |
235 (setq dim (charset-dimension ccs)) | |
236 ) | |
237 (setq i (1+ i))) | |
238 (cond ((= dim 1) 'iso-8-1) | |
239 ((= dim 2) 'iso-8-2) | |
240 (t 'iso-8-designate)))))) | |
241 ))) | |
502 | 242 |
428 | 243 |
4597
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
244 ;;; Make certain variables equivalent to coding-system aliases: |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
245 (macrolet |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
246 ((force-coding-system-equivalency (&rest details-list) |
4599
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
247 "Certain coding-system aliases should correspond to certain variables. |
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
248 |
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
5366
diff
changeset
|
249 This macro implements that correspondence. This gives us compatibility with |
4599
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
250 other Mule implementations (which don't use the coding system aliases), and |
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
251 a certain amount of freedom of implementation for XEmacs; using a variable's |
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
252 value in C for every file operation or write to a terminal in C is probably |
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
253 an improvement on the hash-table lookup(s) necessary for a coding system |
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
254 alias, though we haven't profiled this yet to see if it makes a difference." |
4597
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
255 (loop for (alias variable-symbol) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
256 in details-list |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
257 with result = (list 'progn) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
258 do |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
259 (push |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
260 `(dontusethis-set-symbol-value-handler ',variable-symbol |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
261 'set-value #'(lambda (sym args fun harg handlers) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
262 (define-coding-system-alias ',alias |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
263 (or (car args) 'binary)))) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
264 result) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
265 finally return (nreverse result)))) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
266 (force-coding-system-equivalency |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
267 (file-name file-name-coding-system) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
268 (terminal terminal-coding-system) |
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
269 (keyboard keyboard-coding-system))) |
440 | 270 |
428 | 271 (make-compatible-variable 'enable-multibyte-characters "Unimplemented") |
272 | |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
273 ;; Sure would be nice to be able to use defface here. |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
274 (copy-face 'highlight 'query-coding-warning-face) |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
275 |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
276 (defun query-coding-clear-highlights (begin end &optional buffer-or-string) |
4555
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
277 "Remove extent faces added by `query-coding-region' between BEGIN and END. |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
278 |
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
279 Optional argument BUFFER-OR-STRING is the buffer or string to use, and |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
280 defaults to the current buffer. |
4555
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
281 |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
282 The HIGHLIGHTP argument to `query-coding-region' indicates that it should |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
283 display unencodable characters using `query-coding-warning-face'. After |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
284 this function has been called, this will no longer be the case. " |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
285 (map-extents #'(lambda (extent ignored-arg) |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
286 (when (eq 'query-coding-warning-face |
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
287 (extent-face extent)) |
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
288 (delete-extent extent))) buffer-or-string begin end)) |
4555
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
289 |
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
290 (defun query-coding-string (string coding-system &optional |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
291 ignore-invalid-sequencesp errorp highlight) |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
292 "Work out whether CODING-SYSTEM can losslessly encode STRING. |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
293 CODING-SYSTEM is the coding system to check. |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
294 |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
295 IGNORE-INVALID-SEQUENCESP, an optional argument, says to treat XEmacs |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
296 characters which have an unambiguous encoded representation, despite being |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
297 undefined in what they represent, as encodable. These chiefly arise with |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
298 variable-length encodings like UTF-8 and UTF-16, where an invalid sequence |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
299 is passed through to XEmacs as a sequence of characters with a defined |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
300 correspondence to the octets on disk, but no non-error semantics; see the |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
301 `invalid-sequence-coding-system' argument to `set-language-info'. |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
302 |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
303 They can also arise with fixed-length encodings like ISO 8859-7, where |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
304 certain octets on disk have undefined values, and treating them as |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
305 corresponding to the ISO 8859-1 characters with the same numerical values |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
306 may lead to data that are not understood by other applications. |
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
307 |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
308 Optional argument ERRORP says to signal a `text-conversion-error' if some |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
309 character in the region cannot be encoded, and defaults to nil. |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
310 |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
311 Optional argument HIGHLIGHT says to display unencodable characters in the |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
312 region using `query-coding-warning-face'. It defaults to nil. |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
313 |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
314 This function can return multiple values; the intention is that callers use |
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
315 `multiple-value-bind' or the related CL multiple value functions to deal |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
316 with it. The first result is `t' if the region can be encoded using |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
317 CODING-SYSTEM, or `nil' if not. If the region cannot be encoded using |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
318 CODING-SYSTEM, the second result is a range table describing the positions |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
319 of the unencodable characters. |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
320 |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
321 Ranges that describe characters that would be ignored were |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
322 IGNORE-INVALID-SEQUENCESP non-nil map to the symbol `invalid-sequence'; |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
323 other ranges map to the symbol `unencodable'. If IGNORE-INVALID-SEQUENCESP |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
324 is non-nil, all ranges will map to the symbol `unencodable'. See |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
325 `make-range-table' for more details of range tables." |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
326 (with-temp-buffer |
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
327 (when highlight |
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
328 (query-coding-clear-highlights 0 (length string) string)) |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
329 (insert string) |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
330 (multiple-value-bind (result ranges) |
4596
4fc32a3a086e
Fix a couple of bugs, #'query-coding-region, #'query-coding-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
331 (query-coding-region (point-min) (point-max) coding-system |
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
332 (current-buffer) ignore-invalid-sequencesp |
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
333 errorp) |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
334 (unless result |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
335 (let ((original-ranges ranges) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
336 extent) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
337 (setq ranges (make-range-table)) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
338 (map-range-table |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
339 #'(lambda (begin end value) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
340 ;; Sigh, string indices are zero-based, buffer offsets are |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
341 ;; one-based. |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
342 (put-range-table (decf begin) (decf end) value ranges) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
343 (when highlight |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
344 (setq extent (make-extent begin end string)) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
345 (set-extent-priority extent (+ mouse-highlight-priority 2)) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
346 (set-extent-property extent 'duplicable t) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
347 (set-extent-face extent 'query-coding-warning-face))) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
348 original-ranges))) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
349 (if result result (values result ranges))))) |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
350 |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
351 ;; Function docstring and API are taken from GNU coding.c version 1.353, GPLv2. |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
352 (defun unencodable-char-position (start end coding-system |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
353 &optional count string) |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
354 "Return position of first un-encodable character in a region. |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
355 START and END specify the region and CODING-SYSTEM specifies the |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
356 encoding to check. Return nil if CODING-SYSTEM does encode the region. |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
357 |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
358 If optional 4th argument COUNT is non-nil, it specifies at most how |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
359 many un-encodable characters to search. In this case, the value is a |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
360 list of positions. |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
361 |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
362 If optional 5th argument STRING is non-nil, it is a string to search |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
363 for un-encodable characters. In that case, START and END are indexes |
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
364 in the string." |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
365 (let ((thunk |
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
366 #'(lambda (start end coding-system stringp count) |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
367 (multiple-value-bind (result ranges) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
368 (query-coding-region start end coding-system) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
369 (if result |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
370 nil |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
371 (block worked-it-all-out |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
372 (if count |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
373 (map-range-table |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
374 #'(lambda (begin end value) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
375 (while (and (< begin end) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
376 (< (length result) count)) |
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
377 (push (if stringp (1- begin) begin) result) |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
378 (incf begin)) |
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
5083
diff
changeset
|
379 (when (eql (length result) count) |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
380 (return-from worked-it-all-out result))) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
381 ranges) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
382 (map-range-table |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
383 #'(lambda (begin end value) |
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
384 (return-from worked-it-all-out |
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
385 (if stringp (1- begin) begin))) |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
386 ranges)) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
387 (assert (not (null count)) t |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
388 "We should never reach this point with null COUNT.") |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
389 result)))))) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
390 (check-argument-type #'integer-or-marker-p start) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
391 (check-argument-type #'integer-or-marker-p end) |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
392 (check-coding-system coding-system) |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
393 (when count (check-argument-type #'natnump count) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
394 ;; Special-case zero, sigh. |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
395 (if (zerop count) (setq count 1))) |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
396 (and string (check-argument-type #'stringp string)) |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
397 (if string |
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
398 (with-temp-buffer |
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
399 (insert string) |
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
400 (funcall thunk (1+ start) (1+ end) coding-system t count)) |
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
401 (funcall thunk start end coding-system nil count)))) |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
402 |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
403 ;; XEmacs; this is a GPLv3 function in coding.c in GNU. This is why we have |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
404 ;; both a very divergent docstring and a very divergent implementation. |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
405 (defun check-coding-systems-region (begin end coding-system-list) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
406 "Can coding systems in CODING-SYSTEM-LIST encode text in a region? |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
407 |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
408 CODING-SYSTEM-LIST must be a list of coding systems. BEGIN and END are |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
409 normally buffer positions delimiting the region. If some coding system in |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
410 CODING-SYSTEM-LIST cannot encode the entire region, the return value of this |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
411 function is an alist mapping coding system names to lists of individual |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
412 buffer positions (not ranges) that the individual coding systems cannot |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
413 encode. |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
414 |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
415 If all coding systems in CODING-SYSTEM-LIST can encode the region, |
4622
8cbca852bcd4
#'check-coding-systems-region: return nil on success, not t.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4609
diff
changeset
|
416 this function returns nil. |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
417 |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
418 If BEGIN is a string, `check-coding-systems-region' ignores END, and checks |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
419 whether the coding systems can encode BEGIN. The alist that is returned |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
420 uses zero-based string indices, not one-based buffer positions. |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
421 |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
422 This function is for GNU compatibility. See also `query-coding-region'." |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
423 (let ((thunk |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
424 #'(lambda (begin end coding-system-list stringp) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
425 (loop |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
426 for coding-system in coding-system-list |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
427 with result = nil |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
428 with intermediate = nil |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
429 with range-lambda = (if stringp |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
430 #'(lambda (begin end value) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
431 (while (< begin end) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
432 (push (1- begin) intermediate) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
433 (incf begin))) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
434 #'(lambda (begin end value) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
435 (while (< begin end) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
436 (push begin intermediate) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
437 (incf begin)))) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
438 do (setq coding-system (check-coding-system coding-system)) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
439 (multiple-value-bind (encoded ranges) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
440 (query-coding-region begin end coding-system) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
441 (unless encoded |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
442 (setq intermediate |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
443 (list (coding-system-name coding-system))) |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
444 (map-range-table range-lambda ranges) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
445 (push (nreverse intermediate) result))) |
4622
8cbca852bcd4
#'check-coding-systems-region: return nil on success, not t.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4609
diff
changeset
|
446 finally return result)))) |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
447 (if (stringp begin) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
448 (with-temp-buffer |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
449 (insert begin) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
450 (funcall thunk (point-min) (point-max) coding-system-list t)) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
451 (check-argument-type #'integer-or-marker-p begin) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
452 (check-argument-type #'integer-or-marker-p end) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
453 (funcall thunk begin end coding-system-list nil)))) |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
454 |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
455 ;; XEmacs; docstring taken from GNU, international/mule-cmds.el, revision |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
456 ;; 1.311, GPLv2. |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
457 (defun encode-coding-char (char coding-system &optional charset) |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
458 "Encode CHAR by CODING-SYSTEM and return the resulting string. |
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
459 If CODING-SYSTEM can't safely encode CHAR, return nil. |
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
460 The optional third argument CHARSET is, for the moment, ignored." |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
461 (check-argument-type #'characterp char) |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
462 (and (query-coding-string char coding-system) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
463 (encode-coding-string char coding-system))) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
464 |
5081
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
465 (if (featurep 'mule) |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
466 (progn |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
467 ;; Under Mule, we do much of the complicated coding system creation in |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
468 ;; Lisp and especially at compile time. We need some function |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
469 ;; definition for this function to be created in this file, but we can |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
470 ;; leave assigning the docstring to the autoload cookie |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
471 ;; handling later. Thankfully; that docstring is big. |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
472 (autoload 'make-coding-system "mule/make-coding-system") |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
473 |
5081
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
474 ;; (During byte-compile before dumping, make-coding-system may already |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
475 ;; have been loaded, make sure not to overwrite the correct compiler |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
476 ;; macro:) |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
477 (when (eq 'autoload (car (symbol-function 'make-coding-system))) |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
478 ;; Make sure to pick up the correct compiler macro when compiling |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
479 ;; files: |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
480 (define-compiler-macro make-coding-system (&whole form name type |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
481 &optional description props) |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
482 (load (second (symbol-function 'make-coding-system))) |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
483 (funcall (get 'make-coding-system 'cl-compiler-macro) |
baffa6ca776a
Backed out changeset c673987f5f3d
Aidan Kehoe <kehoea@parhasard.net>
parents:
5068
diff
changeset
|
484 form name type description props)))) |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
485 |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
486 ;; Mule's not available; |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
487 (fset 'make-coding-system (symbol-function 'make-coding-system-internal)) |
5083
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
488 (define-compiler-macro make-coding-system (&whole form name type |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
489 &optional description props) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
490 (cond |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
491 ;; We shouldn't normally see these forms under non-Mule; they're all in |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
492 ;; the mule/ subdirectory. |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
493 ((equal '(quote fixed-width) type) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
494 form) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
495 ((byte-compile-constp type) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
496 `(funcall (or (and (fboundp 'make-coding-system-internal) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
497 'make-coding-system-internal) 'make-coding-system) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
498 ,@(cdr form))) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
499 (t form))) |
88f955fa5a7f
Back out revision c673987f5f3d, undump mule/make-coding-system.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5081
diff
changeset
|
500 |
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
501 (define-coding-system-alias 'escape-quoted 'binary) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
502 |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
503 ;; These are so that gnus and friends work when not mule: |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
504 (define-coding-system-alias 'iso-8859-1 'raw-text) |
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
505 (define-coding-system-alias 'ctext 'raw-text)) |
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
506 |
728 | 507 ;;; coding.el ends here |