From: tsuchiya <tsuchiya>
Date: Wed, 6 Dec 2000 02:56:23 +0000 (+0000)
Subject: * lisp/nnshimbun.el (nnshimbun-retrieve-url): coding detection is improved.
X-Git-Tag: t-gnus-6_14_5-09~2
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=edd05480a2b2a1671e3685e365c325fc0daa0487;p=elisp%2Fgnus.git-

* lisp/nnshimbun.el (nnshimbun-retrieve-url): coding detection is improved.
(nnshimbun-meta-content-type-charset-regexp): New constant.
(nnshimbun-meta-charset-content-type-regexp): Ditto.
---

diff --git a/ChangeLog b/ChangeLog
index 4a25124..003316d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2000-12-06  TSUCHIYA Masatoshi  <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+	* lisp/nnshimbun.el (nnshimbun-retrieve-url): coding detection is
+	improved.
+	(nnshimbun-meta-content-type-charset-regexp): New constant.
+	(nnshimbun-meta-charset-content-type-regexp): Ditto.
+
 2000-12-01  Katsumi Yamaoka <yamaoka@jpl.org>
 
 	* lisp/lpath.el: Attempt to add another FLIM path to `load-path' if
diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el
index d30091e..6a1a719 100644
--- a/lisp/nnshimbun.el
+++ b/lisp/nnshimbun.el
@@ -38,11 +38,10 @@
 (require 'nnmail)
 (require 'nnoo)
 (require 'gnus-bcklg)
-(eval-when-compile
-  (ignore-errors
-    (require 'nnweb)))
+(eval-when-compile (ignore-errors (require 'nnweb)))
 ;; Report failure to find w3 at load time if appropriate.
 (eval '(require 'nnweb))
+(require 'mcharset)
 
 
 (nnoo-declare nnshimbun)
@@ -213,6 +212,22 @@
 (defvoo nnshimbun-backlog-articles nil)
 (defvoo nnshimbun-backlog-hashtb nil)
 
+(defconst nnshimbun-meta-content-type-charset-regexp
+  (eval-when-compile
+    (concat "<meta[ \t]+http-equiv=\"?Content-type\"?[ \t]+content=\"\\([^;]+\\)"
+	    ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
+	    ">"))
+  "Regexp used in parsing `<META HTTP-EQUIV=\"Content-Type\" content=\"...;charset=...\">
+for a charset indication")
+
+(defconst nnshimbun-meta-charset-content-type-regexp
+  (eval-when-compile
+    (concat "<meta[ \t]+content=\"\\([^;]+\\)"
+	    ";[ \t]*charset=\"?\\([^\"]+\\)\"?"
+	    "[ \t]+http-equiv=\"?Content-type\"?>"))
+  "Regexp used in parsing `<META content=\"...;charset=...\" HTTP-EQUIV=\"Content-Type\">
+for a charset indication")
+
 
 
 ;;; backlog
@@ -282,36 +297,67 @@
 
 (defun nnshimbun-retrieve-url (url &optional no-cache)
   "Rertrieve URL contents and insert to current buffer."
-  (let ((coding-system-for-read 'binary)
-	(coding-system-for-write 'binary))
-    (set-buffer-multibyte nil)
-    ;; Following code is imported from `url-insert-file-contents'.
-    (save-excursion
-      (let ((old-asynch (default-value 'url-be-asynchronous))
-	    (old-caching (default-value 'url-automatic-caching))
-	    (old-mode (default-value 'url-standalone-mode)))
-	(unwind-protect
-	    (progn
-	      (setq-default url-be-asynchronous nil)
-	      (when no-cache
-		(setq-default url-automatic-caching nil)
-		(setq-default url-standalone-mode nil))
-	      (let ((buf (current-buffer))
-		    (url-working-buffer (cdr (url-retrieve url no-cache))))
-		(set-buffer url-working-buffer)
-		(url-uncompress)
-		(set-buffer buf)
-		(insert-buffer url-working-buffer)
-		(save-excursion
-		  (set-buffer url-working-buffer)
-		  (set-buffer-modified-p nil))
-		(kill-buffer url-working-buffer)))
-	  (setq-default url-be-asynchronous old-asynch)
-	  (setq-default url-automatic-caching old-caching)
-	  (setq-default url-standalone-mode old-mode))))
-    ;; Modify buffer coding system.
-    (decode-coding-region (point-min) (point-max) nnshimbun-coding-system)
-    (set-buffer-multibyte t)))
+  (let ((buf (current-buffer))
+	(url-working-buffer url-working-buffer))
+    (let ((old-asynch (default-value 'url-be-asynchronous))
+	  (old-caching (default-value 'url-automatic-caching))
+	  (old-mode (default-value 'url-standalone-mode)))
+      (setq-default url-be-asynchronous nil)
+      (when no-cache
+	(setq-default url-automatic-caching nil)
+	(setq-default url-standalone-mode nil))
+      (unwind-protect
+	  (let ((coding-system-for-read 'binary)
+		(coding-system-for-write 'binary)
+		(input-coding-system 'binary)
+		(output-coding-system 'binary)
+		(default-enable-multibyte-characters nil))
+	    (set-buffer
+	     (setq url-working-buffer
+		   (cdr (url-retrieve url no-cache))))
+	    (url-uncompress))
+	(setq-default url-be-asynchronous old-asynch)
+	(setq-default url-automatic-caching old-caching)
+	(setq-default url-standalone-mode old-mode)))
+    (let ((charset
+	   (or url-current-mime-charset
+	       (let ((case-fold-search t))
+		 (goto-char (point-min))
+		 (if (or (re-search-forward nnshimbun-meta-content-type-charset-regexp nil t)
+			 (re-search-forward nnshimbun-meta-charset-content-type-regexp nil t))
+		     (buffer-substring-no-properties (match-beginning 2) (match-end 2)))))))
+      (decode-coding-region
+       (point-min) (point-max)
+       (if charset
+	   (let ((mime-charset-coding-system-alist
+		  (append '((euc-jp . euc-japan)
+			    (shift-jis . shift_jis)
+			    (shift_jis . shift_jis)
+			    (sjis . shift_jis)
+			    (x-euc-jp . euc-japan)
+			    (x-shift-jis . shift_jis)
+			    (x-shift_jis . shift_jis)
+			    (x-sjis . shift_jis))
+			  mime-charset-coding-system-alist)))
+	     (mime-charset-to-coding-system charset))
+	 (let ((default (condition-case nil
+			    (coding-system-category nnshimbun-coding-system)
+			  (error nil)))
+	       (candidate (detect-coding-region (point-min) (point-max))))
+	   (unless (listp candidate)
+	     (setq candidate (list candidate)))
+	   (catch 'coding
+	     (dolist (coding candidate)
+	       (if (eq default (coding-system-category coding))
+		   (throw 'coding coding)))
+	     (if (eq (coding-system-category 'binary)
+		     (coding-system-category (car candidate)))
+		 nnshimbun-coding-system
+	       (car candidate)))))))
+    (set-buffer-multibyte t)
+    (set-buffer buf)
+    (insert-buffer url-working-buffer)
+    (kill-buffer url-working-buffer)))
 
 (deffoo nnshimbun-request-article (article &optional group server to-buffer)
   (when (nnshimbun-possibly-change-group group server)