Mercurial > hg > xemacs-beta
annotate lisp/coding.el @ 4549:68d1ca56cffa
First part of interactive checks that coding systems encode regions.
2008-01-21 Aidan Kehoe <kehoea@parhasard.net>
* coding.el (decode-coding-string):
(encode-coding-string): Accept GNU's NOCOPY argument for
these. Todo; write compiler macros to use it.
(query-coding-warning-face): New face, to show unencodable
characters.
(default-query-coding-region-safe-charset-skip-chars-map):
New variable, a cache used by #'default-query-coding-region.
(default-query-coding-region): Default implementation of
#'query-coding-region, using the safe-charsets and safe-chars
coding systemproperties.
(query-coding-region): New function; can a given coding system
encode a given region?
(query-coding-string): New function; can a given coding system
encode a given string?
(unencodable-char-position): Function API taken from GNU; return
the first unencodable position given a string and coding system.
(encode-coding-char): Function API taken from GNU; return CHAR
encoded using CODING-SYSTEM, or nil if CODING-SYSTEM would trash
CHAR.
((unless (featurep 'mule)): Override the default
query-coding-region implementation on non-Mule.
* mule/mule-coding.el (make-8-bit-generate-helper): Eliminate a
duplicate comment.
(make-8-bit-choose-category): Simplify implementation.
(8-bit-fixed-query-coding-region): Implementation of
#'query-coding-region for coding systems created with
#'make-8-bit-coding-system.
(make-8-bit-coding-system): Initialise the #'query-coding-region
implementation for these character sets.
(make-8-bit-coding-system): Ditto for the compiler macro version
of this function.
* unicode.el (unicode-query-coding-skip-chars-arg): New variable,
used by unicode-query-coding-region, initialised in
mule/general-late.el.
(unicode-query-coding-region): New function, the
#'query-coding-region implementation for Unicode coding systems.
Initialise the query-coding-function property for the Unicode
coding systems to #'unicode-query-coding-region.
* mule/mule-charset.el (charset-skip-chars-string): New
function. Return a #'skip-chars-forward argument that skips all
characters in CHARSET.
(map-charset-chars): Function synced from GNU, modified to work
with XEmacs. Map FUNC across the int value charset ranges of
CHARSET.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 21 Jan 2008 22:51:21 +0100 |
| parents | dd9c1d5f5319 |
| children | 6812571bfcb9 |
| 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 | |
| 771 | 8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing. |
| 428 | 9 |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
| 12 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 13 ;; under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 20 ;; General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 440 | 23 ;; along with XEmacs; see the file COPYING. If not, write to the |
| 428 | 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 25 ;; Boston, MA 02111-1307, USA. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;;; split off of mule.el. | |
| 30 | |
| 31 ;;; Code: | |
| 32 | |
| 502 | 33 (globally-declare-fboundp |
| 34 '(coding-system-lock-shift | |
| 35 coding-system-seven coding-system-charset charset-dimension)) | |
| 36 | |
| 428 | 37 (defalias 'check-coding-system 'get-coding-system) |
| 38 | |
| 39 (defun modify-coding-system-alist (target-type regexp coding-system) | |
| 40 "Modify one of look up tables for finding a coding system on I/O operation. | |
| 41 There are three of such tables, `file-coding-system-alist', | |
| 42 `process-coding-system-alist', and `network-coding-system-alist'. | |
| 43 | |
| 44 TARGET-TYPE specifies which of them to modify. | |
| 45 If it is `file', it affects `file-coding-system-alist' (which see). | |
| 46 If it is `process', it affects `process-coding-system-alist' (which see). | |
| 599 | 47 If it is `network', it affects `network-coding-system-alist' (which see). |
| 428 | 48 |
| 49 REGEXP is a regular expression matching a target of I/O operation. | |
| 50 The target is a file name if TARGET-TYPE is `file', a program name if | |
| 51 TARGET-TYPE is `process', or a network service name or a port number | |
| 52 to connect to if TARGET-TYPE is `network'. | |
| 53 | |
| 54 CODING-SYSTEM is a coding system to perform code conversion on the I/O | |
| 55 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems | |
| 56 for decoding and encoding respectively, | |
| 57 or a function symbol which, when called, returns such a cons cell." | |
| 58 (or (memq target-type '(file process network)) | |
| 59 (error "Invalid target type: %s" target-type)) | |
| 60 (or (stringp regexp) | |
| 61 (and (eq target-type 'network) (integerp regexp)) | |
| 62 (error "Invalid regular expression: %s" regexp)) | |
| 63 (if (symbolp coding-system) | |
| 64 (if (not (fboundp coding-system)) | |
| 65 (progn | |
| 66 (check-coding-system coding-system) | |
| 67 (setq coding-system (cons coding-system coding-system)))) | |
| 68 (check-coding-system (car coding-system)) | |
| 69 (check-coding-system (cdr coding-system))) | |
| 70 (cond ((eq target-type 'file) | |
| 71 (let ((slot (assoc regexp file-coding-system-alist))) | |
| 72 (if slot | |
| 73 (setcdr slot coding-system) | |
| 74 (setq file-coding-system-alist | |
| 75 (cons (cons regexp coding-system) | |
| 76 file-coding-system-alist))))) | |
| 77 ((eq target-type 'process) | |
| 78 (let ((slot (assoc regexp process-coding-system-alist))) | |
| 79 (if slot | |
| 80 (setcdr slot coding-system) | |
| 81 (setq process-coding-system-alist | |
| 82 (cons (cons regexp coding-system) | |
| 83 process-coding-system-alist))))) | |
| 84 (t | |
| 85 (let ((slot (assoc regexp network-coding-system-alist))) | |
| 86 (if slot | |
| 87 (setcdr slot coding-system) | |
| 88 (setq network-coding-system-alist | |
| 89 (cons (cons regexp coding-system) | |
| 90 network-coding-system-alist))))))) | |
| 91 | |
| 92 (defsubst keyboard-coding-system () | |
| 93 "Return coding-system of what is sent from terminal keyboard." | |
| 94 keyboard-coding-system) | |
| 95 | |
| 96 (defun set-keyboard-coding-system (coding-system) | |
| 97 "Set the coding system used for TTY keyboard input. Currently broken." | |
| 98 (interactive "zkeyboard-coding-system: ") | |
| 99 (get-coding-system coding-system) ; correctness check | |
| 100 (setq keyboard-coding-system coding-system) | |
| 442 | 101 (if (eq (device-type) 'tty) |
| 502 | 102 (declare-fboundp (set-console-tty-input-coding-system |
| 103 (device-console) keyboard-coding-system))) | |
| 428 | 104 (redraw-modeline t)) |
| 105 | |
| 106 (defsubst terminal-coding-system () | |
| 107 "Return coding-system of your terminal." | |
| 108 terminal-coding-system) | |
| 109 | |
| 110 (defun set-terminal-coding-system (coding-system) | |
| 111 "Set the coding system used for TTY display output. Currently broken." | |
| 112 (interactive "zterminal-coding-system: ") | |
| 113 (get-coding-system coding-system) ; correctness check | |
| 114 (setq terminal-coding-system coding-system) | |
| 115 ; #### should this affect all current tty consoles ? | |
| 116 (if (eq (device-type) 'tty) | |
| 502 | 117 (declare-fboundp (set-console-tty-output-coding-system |
| 118 (device-console) terminal-coding-system))) | |
| 428 | 119 (redraw-modeline t)) |
| 120 | |
| 121 (defun what-coding-system (start end &optional arg) | |
| 122 "Show the encoding of text in the region. | |
| 123 This function is meant to be called interactively; | |
| 124 from a Lisp program, use `detect-coding-region' instead." | |
| 125 (interactive "r\nP") | |
| 126 (princ (detect-coding-region start end))) | |
| 127 | |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
128 (defun decode-coding-string (str coding-system &optional nocopy) |
| 428 | 129 "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
|
130 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
|
131 successful conversion. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
132 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
|
133 allowed." |
| 428 | 134 (with-string-as-buffer-contents |
| 135 str (decode-coding-region (point-min) (point-max) coding-system))) | |
| 136 | |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
137 (defun encode-coding-string (str coding-system &optional nocopy) |
| 428 | 138 "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
|
139 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
|
140 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
|
141 if does not differ from the encoded string. " |
| 428 | 142 (with-string-as-buffer-contents |
| 143 str (encode-coding-region (point-min) (point-max) coding-system))) | |
| 144 | |
| 145 | |
| 146 ;;;; Coding system accessors | |
| 147 | |
| 148 (defun coding-system-mnemonic (coding-system) | |
| 149 "Return the 'mnemonic property of CODING-SYSTEM." | |
| 150 (coding-system-property coding-system 'mnemonic)) | |
| 151 | |
| 771 | 152 (defun coding-system-documentation (coding-system) |
| 153 "Return the 'documentation property of CODING-SYSTEM." | |
| 154 (coding-system-property coding-system 'documentation)) | |
| 155 | |
| 156 (define-obsolete-function-alias 'coding-system-doc-string | |
| 157 'coding-system-description) | |
| 428 | 158 |
| 159 (defun coding-system-eol-type (coding-system) | |
| 160 "Return the 'eol-type property of CODING-SYSTEM." | |
| 161 (coding-system-property coding-system 'eol-type)) | |
| 162 | |
| 163 (defun coding-system-eol-lf (coding-system) | |
| 164 "Return the 'eol-lf property of CODING-SYSTEM." | |
| 165 (coding-system-property coding-system 'eol-lf)) | |
| 166 | |
| 167 (defun coding-system-eol-crlf (coding-system) | |
| 168 "Return the 'eol-crlf property of CODING-SYSTEM." | |
| 169 (coding-system-property coding-system 'eol-crlf)) | |
| 170 | |
| 171 (defun coding-system-eol-cr (coding-system) | |
| 172 "Return the 'eol-cr property of CODING-SYSTEM." | |
| 173 (coding-system-property coding-system 'eol-cr)) | |
| 174 | |
| 175 (defun coding-system-post-read-conversion (coding-system) | |
| 176 "Return the 'post-read-conversion property of CODING-SYSTEM." | |
| 177 (coding-system-property coding-system 'post-read-conversion)) | |
| 178 | |
| 179 (defun coding-system-pre-write-conversion (coding-system) | |
| 180 "Return the 'pre-write-conversion property of CODING-SYSTEM." | |
| 181 (coding-system-property coding-system 'pre-write-conversion)) | |
| 182 | |
| 502 | 183 ;;; #### bleagh!!!!!!! |
| 184 | |
| 185 (defun coding-system-get (coding-system prop) | |
| 186 "Extract a value from CODING-SYSTEM's property list for property PROP." | |
| 187 (or (plist-get | |
| 188 (get (coding-system-name coding-system) 'coding-system-property) | |
| 189 prop) | |
| 190 (condition-case nil | |
| 191 (coding-system-property coding-system prop) | |
| 192 (error nil)))) | |
| 193 | |
| 194 (defun coding-system-put (coding-system prop value) | |
| 195 "Change value in CODING-SYSTEM's property list PROP to VALUE." | |
| 196 (put (coding-system-name coding-system) | |
| 197 'coding-system-property | |
| 198 (plist-put (get (coding-system-name coding-system) | |
| 199 'coding-system-property) | |
| 200 prop value))) | |
| 201 | |
| 202 (defun coding-system-category (coding-system) | |
| 203 "Return the coding category of CODING-SYSTEM." | |
| 204 (or (coding-system-get coding-system 'category) | |
| 771 | 205 (case (coding-system-type coding-system) |
| 206 (no-conversion 'no-conversion) | |
| 207 (shift-jis 'shift-jis) | |
| 3767 | 208 (unicode (case (coding-system-property coding-system 'unicode-type) |
| 985 | 209 (utf-8 (let ((bom (coding-system-property coding-system |
| 210 'need-bom))) | |
| 211 (cond (bom 'utf-8-bom) | |
| 212 ((not bom) 'utf-8)))) | |
| 771 | 213 (ucs-4 'ucs-4) |
| 214 (utf-16 (let ((bom (coding-system-property coding-system | |
| 215 'need-bom)) | |
| 216 (le (coding-system-property coding-system | |
| 217 'little-endian))) | |
| 218 (cond ((and bom le) 'utf-16-little-endian-bom) | |
| 219 ((and bom (not le) 'utf-16-bom)) | |
| 220 ((and (not bom) le) 'utf-16-little-endian) | |
| 221 ((and (not bom) (not le) 'utf-16))))))) | |
| 222 (big5 'big5) | |
| 223 (iso2022 (cond ((coding-system-lock-shift coding-system) | |
| 224 'iso-lock-shift) | |
| 225 ((coding-system-seven coding-system) | |
| 226 'iso-7) | |
| 227 (t | |
| 228 (let ((dim 0) | |
| 229 ccs | |
| 230 (i 0)) | |
| 231 (while (< i 4) | |
| 232 (setq ccs (declare-fboundp | |
| 233 (coding-system-iso2022-charset | |
| 234 coding-system i))) | |
| 235 (if (and ccs | |
| 236 (> (charset-dimension ccs) dim)) | |
| 237 (setq dim (charset-dimension ccs)) | |
| 238 ) | |
| 239 (setq i (1+ i))) | |
| 240 (cond ((= dim 1) 'iso-8-1) | |
| 241 ((= dim 2) 'iso-8-2) | |
| 242 (t 'iso-8-designate)))))) | |
| 243 ))) | |
| 502 | 244 |
| 428 | 245 |
| 440 | 246 ;;; Make certain variables equivalent to coding-system aliases |
| 247 (defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers) | |
| 248 (define-coding-system-alias 'file-name (or (car args) 'binary))) | |
| 249 | |
| 250 (dontusethis-set-symbol-value-handler | |
| 251 'file-name-coding-system | |
| 252 'set-value | |
| 253 'dontusethis-set-value-file-name-coding-system-handler) | |
| 254 | |
| 255 (defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers) | |
| 256 (define-coding-system-alias 'terminal (or (car args) 'binary))) | |
| 257 | |
| 258 (dontusethis-set-symbol-value-handler | |
| 259 'terminal-coding-system | |
| 260 'set-value | |
| 261 'dontusethis-set-value-terminal-coding-system-handler) | |
| 262 | |
| 263 (defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers) | |
| 264 (define-coding-system-alias 'keyboard (or (car args) 'binary))) | |
| 265 | |
| 266 (dontusethis-set-symbol-value-handler | |
| 267 'keyboard-coding-system | |
| 268 'set-value | |
| 269 'dontusethis-set-value-keyboard-coding-system-handler) | |
| 270 | |
| 271 (when (not (featurep 'mule)) | |
| 771 | 272 (define-coding-system-alias 'escape-quoted 'binary) |
| 440 | 273 ;; these are so that gnus and friends work when not mule |
| 4227 | 274 (define-coding-system-alias 'iso-8859-1 'raw-text) |
| 4222 | 275 ;; We're misrepresenting ourselves to the gnus code by saying we support |
| 276 ;; both. | |
| 4227 | 277 ; (define-coding-system-alias 'iso-8859-2 'raw-text) |
| 278 (define-coding-system-alias 'ctext 'raw-text)) | |
| 440 | 279 |
| 428 | 280 (make-compatible-variable 'enable-multibyte-characters "Unimplemented") |
| 281 | |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
282 ;; 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
|
283 (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
|
284 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
285 (defvar default-query-coding-region-safe-charset-skip-chars-map |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
286 #s(hash-table test equal data ()) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
287 "A map from list of charsets to `skip-chars-forward' arguments for them.") |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
288 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
289 (defun default-query-coding-region (begin end coding-system |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
290 &optional buffer errorp highlightp) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
291 "The default `query-coding-region' implementation. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
292 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
293 Uses the `safe-charsets' and `safe-chars' coding system properties. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
294 The former is a list of XEmacs character sets that can be safely |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
295 encoded by CODING-SYSTEM; the latter a char table describing, in |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
296 addition, characters that can be safely encoded by CODING-SYSTEM." |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
297 (check-argument-type #'coding-system-p |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
298 (setq coding-system (find-coding-system coding-system))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
299 (check-argument-type #'integer-or-marker-p begin) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
300 (check-argument-type #'integer-or-marker-p end) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
301 (let* ((safe-charsets |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
302 (coding-system-get coding-system 'safe-charsets)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
303 (safe-chars (coding-system-get coding-system 'safe-chars)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
304 (skip-chars-arg |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
305 (gethash safe-charsets |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
306 default-query-coding-region-safe-charset-skip-chars-map)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
307 (ranges (make-range-table)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
308 fail-range-start fail-range-end previous-fail char-after |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
309 looking-at-arg failed extent) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
310 (unless skip-chars-arg |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
311 (setq skip-chars-arg |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
312 (puthash safe-charsets |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
313 (mapconcat #'charset-skip-chars-string |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
314 safe-charsets "") |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
315 default-query-coding-region-safe-charset-skip-chars-map))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
316 (if (and (zerop (length skip-chars-arg)) (null safe-chars)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
317 (progn |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
318 ;; Uh-oh, nothing known about this coding system. Fail. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
319 (when errorp |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
320 (error 'text-conversion-error |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
321 "Coding system doesn't say what it can encode" |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
322 (coding-system-name coding-system))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
323 (put-range-table begin end t ranges) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
324 (when highlightp |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
325 (setq extent (make-extent begin end buffer)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
326 (set-extent-priority extent (+ mouse-highlight-priority 2)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
327 (set-extent-face extent 'query-coding-warning-face)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
328 (values nil ranges)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
329 (setq looking-at-arg (if (equal "" skip-chars-arg) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
330 ;; Regexp that will never match. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
331 #r".\{0,0\}" |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
332 (concat "[" skip-chars-arg "]"))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
333 (save-excursion |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
334 (goto-char begin buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
335 (skip-chars-forward skip-chars-arg end buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
336 (while (< (point buffer) end) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
337 (message |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
338 "fail-range-start is %S, previous-fail %S, point is %S, end is %S" |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
339 fail-range-start previous-fail (point buffer) end) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
340 (setq char-after (char-after (point buffer) buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
341 fail-range-start (point buffer)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
342 (while (and |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
343 (< (point buffer) end) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
344 (not (looking-at looking-at-arg)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
345 (or (not safe-chars) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
346 (not (get-char-table char-after safe-chars)))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
347 (forward-char 1 buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
348 (setq char-after (char-after (point buffer) buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
349 failed t)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
350 (if (= fail-range-start (point buffer)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
351 ;; The character can actually be encoded by the coding |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
352 ;; system; check the characters past it. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
353 (forward-char 1 buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
354 ;; Can't be encoded; note this. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
355 (when errorp |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
356 (error 'text-conversion-error |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
357 (format "Cannot encode %s using coding system" |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
358 (buffer-substring fail-range-start (point buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
359 buffer)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
360 (coding-system-name coding-system))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
361 (put-range-table fail-range-start |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
362 ;; If char-after is non-nil, we're not at |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
363 ;; the end of the buffer. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
364 (setq fail-range-end (if char-after |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
365 (point buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
366 (point-max buffer))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
367 t ranges) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
368 (when highlightp |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
369 (setq extent (make-extent fail-range-start fail-range-end buffer)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
370 (set-extent-priority extent (+ mouse-highlight-priority 2)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
371 (set-extent-face extent 'query-coding-warning-face))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
372 (skip-chars-forward skip-chars-arg end buffer)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
373 (if failed |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
374 (values nil ranges) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
375 (values t nil)))))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
376 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
377 (defsubst query-coding-region (start end coding-system &optional buffer |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
378 errorp highlight) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
379 "Work out whether CODING-SYSTEM can losslessly encode a region. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
380 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
381 START and END are the beginning and end of the region to check. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
382 CODING-SYSTEM is the coding system to try. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
383 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
384 Optional argument BUFFER is the buffer to check, and defaults to the current |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
385 buffer. Optional argument ERRORP says to signal a `text-conversion-error' |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
386 if some character in the region cannot be encoded, and defaults to nil. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
387 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
388 Optional argument HIGHLIGHT says to display unencodable characters in the |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
389 region using `query-coding-warning-face'. It defaults to nil. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
390 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
391 This function returns a list; the intention is that callers use use |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
392 `multiple-value-bind' or the related CL multiple value functions to deal |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
393 with it. The first element is `t' if the string can be encoded using |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
394 CODING-SYSTEM, or `nil' if not. The second element is `nil' if the string |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
395 can be encoded using CODING-SYSTEM; otherwise, it is a range table |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
396 describing the positions of the unencodable characters. See |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
397 `make-range-table'." |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
398 (funcall (or (coding-system-get coding-system 'query-coding-function) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
399 #'default-query-coding-region) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
400 start end coding-system buffer errorp highlight)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
401 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
402 (defun query-coding-string (string coding-system &optional errorp highlight) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
403 "Work out whether CODING-SYSTEM can losslessly encode STRING. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
404 CODING-SYSTEM is the coding system to check. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
405 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
406 Optional argument ERRORP says to signal a `text-conversion-error' if some |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
407 character in the region cannot be encoded, and defaults to nil. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
408 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
409 Optional argument HIGHLIGHT says to display unencodable characters in the |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
410 region using `query-coding-warning-face'. It defaults to nil. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
411 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
412 This function returns a list; the intention is that callers use use |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
413 `multiple-value-bind' or the related CL multiple value functions to deal |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
414 with it. The first element is `t' if the string can be encoded using |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
415 CODING-SYSTEM, or `nil' if not. The second element is `nil' if the string |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
416 can be encoded using CODING-SYSTEM; otherwise, it is a range table |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
417 describing the positions of the unencodable characters. See |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
418 `make-range-table'." |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
419 (with-temp-buffer |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
420 (insert string) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
421 (query-coding-region (point-min) (point-max) coding-system (current-buffer) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
422 ;; ### Will highlight work here? |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
423 errorp highlight))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
424 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
425 (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
|
426 &optional count string) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
427 "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
|
428 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
|
429 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
|
430 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
431 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
|
432 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
|
433 list of positions. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
434 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
435 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
|
436 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
|
437 in the string." |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
438 (flet ((thunk () |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
439 (multiple-value-bind (result ranges) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
440 (query-coding-region start end coding-system) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
441 (if result |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
442 ;; If query-coding-region thinks the entire region is |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
443 ;; encodable, result will be t, and the thunk should |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
444 ;; return nil, because there are no unencodable |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
445 ;; positions in the region. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
446 nil |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
447 (if count |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
448 (block counted |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
449 (map-range-table |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
450 #'(lambda (begin end value) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
451 (while (and (<= begin end) (<= begin count)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
452 (push begin result) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
453 (incf begin)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
454 (if (> begin count) (return-from counted))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
455 ranges)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
456 (map-range-table |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
457 #'(lambda (begin end value) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
458 (while (<= begin end) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
459 (push begin result) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
460 (incf begin))) ranges)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
461 result)))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
462 (if string |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
463 (with-temp-buffer (insert string) (thunk)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
464 (thunk)))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
465 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
466 (defun encode-coding-char (char coding-system) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
467 "Encode CHAR by CODING-SYSTEM and return the resulting string. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
468 If CODING-SYSTEM can't safely encode CHAR, return nil." |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
469 (check-argument-type #'characterp char) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
470 (multiple-value-bind (succeededp) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
471 (query-coding-string char coding-system) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
472 (when succeededp |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
473 (encode-coding-string char coding-system)))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
474 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
475 (unless (featurep 'mule) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
476 ;; If we're under non-Mule, every XEmacs character can be encoded |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
477 ;; with every XEmacs coding system. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
478 (fset #'default-query-coding-region |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
479 #'(lambda (&rest ignored) (values t nil))) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
480 (unintern 'default-query-coding-region-safe-charset-skip-chars-map)) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
481 |
| 728 | 482 ;;; coding.el ends here |