changeset 4551:6812571bfcb9

Fix some bugs.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 13 Mar 2008 10:21:01 +0100
parents 1217f19ce196
children 9c1cfceab252
files lisp/coding.el lisp/mule/mule-coding.el lisp/unicode.el
diffstat 3 files changed, 37 insertions(+), 13 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/coding.el	Mon Jan 21 22:54:43 2008 +0100
+++ b/lisp/coding.el	Thu Mar 13 10:21:01 2008 +0100
@@ -299,8 +299,13 @@
   (check-argument-type #'integer-or-marker-p begin)
   (check-argument-type #'integer-or-marker-p end)
   (let* ((safe-charsets
-          (coding-system-get coding-system 'safe-charsets))
-         (safe-chars (coding-system-get coding-system 'safe-chars))
+          (or (coding-system-get coding-system 'safe-charsets)
+	      (coding-system-get (coding-system-base coding-system)
+				 'safe-charsets)))
+         (safe-chars
+	  (or (coding-system-get coding-system 'safe-chars)
+	      (coding-system-get (coding-system-base coding-system)
+				 'safe-chars)))
          (skip-chars-arg
           (gethash safe-charsets
                    default-query-coding-region-safe-charset-skip-chars-map))
@@ -313,6 +318,11 @@
 		     (mapconcat #'charset-skip-chars-string
 				safe-charsets "")
 		     default-query-coding-region-safe-charset-skip-chars-map)))
+    (when highlightp
+      (map-extents #'(lambda (extent ignored-arg)
+		       (when (eq 'query-coding-warning-face
+				 (extent-face extent))
+			 (delete-extent extent))) buffer begin end))
     (if (and (zerop (length skip-chars-arg)) (null safe-chars))
 	(progn
 	    ;; Uh-oh, nothing known about this coding system. Fail. 
--- a/lisp/mule/mule-coding.el	Mon Jan 21 22:54:43 2008 +0100
+++ b/lisp/mule/mule-coding.el	Thu Mar 13 10:21:01 2008 +0100
@@ -553,15 +553,24 @@
   (check-argument-type #'integer-or-marker-p begin)
   (check-argument-type #'integer-or-marker-p end)
   (let ((from-unicode
-         (coding-system-get coding-system '8-bit-fixed-query-from-unicode))
+         (or (coding-system-get coding-system '8-bit-fixed-query-from-unicode)
+	     (coding-system-get (coding-system-base coding-system)
+				'8-bit-fixed-query-from-unicode)))
         (skip-chars-arg
-         (coding-system-get coding-system '8-bit-fixed-query-skip-chars))
+         (or (coding-system-get coding-system '8-bit-fixed-query-skip-chars)
+	     (coding-system-get (coding-system-base coding-system)
+				'8-bit-fixed-query-skip-chars)))
 	(ranges (make-range-table))
         char-after fail-range-start fail-range-end previous-fail extent
 	failed)
     (check-type from-unicode hash-table)
     (check-type skip-chars-arg string)
     (save-excursion
+      (when highlightp
+	(map-extents #'(lambda (extent ignored-arg)
+			 (when (eq 'query-coding-warning-face
+				   (extent-face extent))
+			   (delete-extent extent))) buffer begin end))
       (goto-char begin buffer)
       (skip-chars-forward skip-chars-arg end buffer)
       (while (< (point buffer) end)
@@ -588,7 +597,7 @@
 	  (when errorp 
 	    (error 'text-conversion-error
 		   (format "Cannot encode %s using coding system"
-			   (buffer-substring fail-range-start (point buffeR)
+			   (buffer-substring fail-range-start (point buffer)
 					     buffer))
 		   (coding-system-name coding-system)))
 	  (put-range-table fail-range-start
@@ -603,8 +612,8 @@
 	    (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))
-	(message "about to give the result, ranges %S" ranges))
+	  (skip-chars-forward skip-chars-arg end buffer)))
+      (message "about to give the result, ranges %S" ranges)
       (if failed 
 	  (values nil ranges)
 	(values t nil)))))
--- a/lisp/unicode.el	Mon Jan 21 22:54:43 2008 +0100
+++ b/lisp/unicode.el	Thu Mar 13 10:21:01 2008 +0100
@@ -624,15 +624,20 @@
   (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)
+         fail-range-start fail-range-end previous-fail char-after failed
+	 extent)
     (save-excursion
+      (when highlightp
+	(map-extents #'(lambda (extent ignored-arg)
+			 (when (eq 'query-coding-warning-face
+				   (extent-face extent))
+			   (delete-extent extent))) buffer begin end))
       (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)
+;        (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
@@ -646,7 +651,7 @@
         (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)
+	    (forward-char 1 buffer)
           ;; Can't be encoded; note this.
           (when errorp 
             (error 'text-conversion-error