diff lisp/international/mule.el @ 90428:a8190f7e546e

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 285-296) - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: admin/FOR-RELEASE: Update refcard section. * gnus--rel--5.10 (patch 102-104) - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-64

--- a/lisp/international/mule.el	Wed Jun 07 11:41:58 2006 +0000
+++ b/lisp/international/mule.el	Wed Jun 07 18:05:10 2006 +0000
@@ -356,9 +356,9 @@
 			 ))
 	(let (kill-buffer-hook kill-buffer-query-functions)
 	  (kill-buffer buffer)))
-      (let ((hook (assoc file after-load-alist)))
-	(when hook
-	  (mapcar (function eval) (cdr hook))))
+      (unless purify-flag
+ 	(do-after-load-evaluation fullname))
+      
       (unless (or nomessage noninteractive)
 	(if source
 	    (message "Loading %s (source)...done" file)
@@ -1649,6 +1649,9 @@
 	(setq alist (cdr alist))))
     coding-system))
 
+(put 'enable-character-translation 'permanent-local t)
+(put 'enable-character-translation 'safe-local-variable	'booleanp)
+
 (defun find-auto-coding (filename size)
   "Find a coding system for a file FILENAME of which SIZE bytes follow point.
 These bytes should include at least the first 1k of the file
@@ -1686,17 +1689,21 @@
 	     (head-end (+ head-start (min size 1024)))
 	     (tail-start (+ head-start (max (- size 3072) 0)))
 	     (tail-end (+ head-start size))
-	     coding-system head-found tail-found pos)
+	     coding-system head-found tail-found pos char-trans)
 	;; Try a short cut by searching for the string "coding:"
 	;; and for "unibyte:" at the head and tail of SIZE bytes.
 	(setq head-found (or (search-forward "coding:" head-end t)
-			     (search-forward "unibyte:" head-end t)))
+			     (search-forward "unibyte:" head-end t)
+			     (search-forward "enable-character-translation:" 
+					     head-end t)))
 	(if (and head-found (> head-found tail-start))
 	    ;; Head and tail are overlapped.
 	    (setq tail-found head-found)
 	  (goto-char tail-start)
 	  (setq tail-found (or (search-forward "coding:" tail-end t)
-			       (search-forward "unibyte:" tail-end t))))
+			       (search-forward "unibyte:" tail-end t)
+			       (search-forward "enable-character-translation:"
+					       tail-end t))))
 
 	;; At first check the head.
 	(when head-found
@@ -1714,12 +1721,16 @@
 		       (re-search-forward
 			"\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)"
 			head-end t))
-	      (setq coding-system (intern (match-string 2))))))
+	      (setq coding-system (intern (match-string 2))))
+	    (when (re-search-forward
+		   "\\(.*;\\)?[ \t]*enable-character-translation:[ \t]*\\([^ ;]+\\)"
+		   head-end t)
+	      (setq char-trans (match-string 2)))))
 
 	;; If no coding: tag in the head, check the tail.
 	;; Here we must pay attention to the case that the end-of-line
 	;; is just "\r" and we can't use "^" nor "$" in regexp.
-	(when (and tail-found (not coding-system))
+	(when (and tail-found (or (not coding-system) (not char-trans)))
 	  (goto-char tail-start)
 	  (re-search-forward "[\r\n]\^L" nil t)
 	  (if (re-search-forward
@@ -1742,6 +1753,11 @@
 		       "[\r\n]" prefix
 		       "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
 		       suffix "[\r\n]"))
+		     (re-char-trans
+		      (concat
+		       "[\r\n]" prefix
+		       "[ \t]*enable-character-translation[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
+		       suffix "[\r\n]"))
 		     (re-end
 		      (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix
 			      "[\r\n]?"))
@@ -1755,7 +1771,21 @@
 		  (setq coding-system 'raw-text))
 		(when (and (not coding-system)
 			   (re-search-forward re-coding tail-end t))
-		  (setq coding-system (intern (match-string 1)))))))
+		  (setq coding-system (intern (match-string 1))))
+		(when (and (not char-trans)
+			   (re-search-forward re-char-trans tail-end t))
+		  (setq char-trans (match-string 1))))))
+	(if coding-system
+	    ;; If the coding-system name ends with "!", remove it and
+	    ;; set char-trans to "nil".
+	    (let ((name (symbol-name coding-system)))
+	      (if (= (aref name (1- (length name))) ?!)
+		  (setq coding-system (intern (substring name 0 -1))
+			char-trans "nil"))))
+	(when (and char-trans
+		   (not (setq char-trans (intern char-trans))))
+	  (make-local-variable 'enable-character-translation)
+	  (setq enable-character-translation nil))
 	(if coding-system
 	    (cons coding-system :coding)))
       ;; Finally, try all the `auto-coding-functions'.
@@ -1962,7 +1992,8 @@
 	(or coding
 	    (setq coding (car (find-operation-coding-system
 			       'insert-file-contents
-			       filename visit beg end replace))))
+			       (cons filename (current-buffer))
+			       visit beg end replace))))
 	(if (coding-system-p coding)
 	    (or enable-multibyte-characters
 		(setq coding
@@ -2246,18 +2277,19 @@
   "If the buffer has an HTML meta tag, use it to determine encoding.
 This function is intended to be added to `auto-coding-functions'."
   (setq size (min (+ (point) size)
-		  ;; Only search forward 10 lines
 		  (save-excursion
-		    (forward-line 10)
+		    ;; Limit the search by the end of the HTML header.
+		    (or (search-forward "</head>" size t)
+			;; In case of no header, search only 10 lines.
+			(forward-line 10))
 		    (point))))
-  (when (and (search-forward "<html" size t)
-	     (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t))
-      (let* ((match (match-string 1))
-	     (sym (intern (downcase match))))
-	(if (coding-system-p sym)
-	    sym
-	  (message "Warning: unknown coding system \"%s\"" match)
-	  nil))))
+  (when (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t)
+    (let* ((match (match-string 1))
+	   (sym (intern (downcase match))))
+      (if (coding-system-p sym)
+	  sym
+	(message "Warning: unknown coding system \"%s\"" match)
+	nil))))
 
 ;;;
 (provide 'mule)