Mercurial > hg > xemacs-beta
diff lisp/unicode.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 | 15d36164ebd7 |
| children | 6812571bfcb9 |
line wrap: on
line diff
--- a/lisp/unicode.el Thu Jan 17 11:55:11 2008 +0100 +++ b/lisp/unicode.el Mon Jan 21 22:51:21 2008 +0100 @@ -611,6 +611,71 @@ (translate-region start finish table)) begin end buffer)) +(defvar unicode-query-coding-skip-chars-arg nil ;; Set in general-late.el + "Used by `unicode-query-coding-region' to skip chars with known mappings.") + +(defun unicode-query-coding-region (begin end coding-system + &optional buffer errorp highlightp) + "The `query-coding-region' implementation for Unicode coding systems." + (check-argument-type #'coding-system-p + (setq coding-system (find-coding-system coding-system))) + (check-argument-type #'integer-or-marker-p begin) + (check-argument-type #'integer-or-marker-p end) + (let* ((skip-chars-arg unicode-query-coding-skip-chars-arg) + (ranges (make-range-table)) + (looking-at-arg (concat "[" skip-chars-arg "]")) + fail-range-start fail-range-end previous-fail char-after + failed extent) + (save-excursion + (goto-char begin buffer) + (skip-chars-forward skip-chars-arg end buffer) + (while (< (point buffer) end) + (message + "fail-range-start is %S, previous-fail %S, point is %S, end is %S" + fail-range-start previous-fail (point buffer) end) + (setq char-after (char-after (point buffer) buffer) + fail-range-start (point buffer)) + (while (and + (< (point buffer) end) + (not (looking-at looking-at-arg)) + (= -1 (char-to-unicode char-after))) + (forward-char 1 buffer) + (message "what?!?") + (setq char-after (char-after (point buffer) buffer) + failed t)) + (if (= fail-range-start (point buffer)) + ;; The character can actually be encoded by the coding + ;; system; check the characters past it. + (forward-char 1 buffer) + ;; Can't be encoded; note this. + (when errorp + (error 'text-conversion-error + (format "Cannot encode %s using coding system" + (buffer-substring fail-range-start (point buffer) + buffer)) + (coding-system-name coding-system))) + (put-range-table fail-range-start + ;; If char-after is non-nil, we're not at + ;; the end of the buffer. + (setq fail-range-end (if char-after + (point buffer) + (point-max buffer))) + t ranges) + (when highlightp + (setq extent (make-extent fail-range-start fail-range-end buffer)) + (set-extent-priority extent (+ mouse-highlight-priority 2)) + (set-extent-face extent 'query-coding-warning-face))) + (skip-chars-forward skip-chars-arg end buffer)) + (if failed + (values nil ranges) + (values t nil))))) + +(loop + for coding-system in (coding-system-list) + do (when (eq 'unicode (coding-system-type coding-system)) + (coding-system-put coding-system 'query-coding-function + #'unicode-query-coding-region))) + (unless (featurep 'mule) ;; We do this in such a roundabout way--instead of having the above defun ;; and defvar calls inside a (when (featurep 'mule) ...) form--to have