Synch with `t-gnus-6_14'.

diff --git a/ChangeLog b/ChangeLog
index 38a431d..6859e0f 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2000-12-06  Katsumi Yamaoka <yamaoka@jpl.org>
+
+       * lisp/nnshimbun.el (TopLevel): Defalias `coding-system-category'
+       to `get-code-mnemonic' for Mule.
+       (TopLevel): Make codesys `euc-japan' and `shift_jis' for Mule.
+       (nnshimbun-type-definition): Use `static-if' to determine codesys.
+       (TopLevel): Require `static'.
+
+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-03  Tetsuo Tsukamoto  <czkmt@remus.dti.ne.jp>
 
        * texi/gnus-ja.texi: Fixes for the last modification.

diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el
index d30091e..1e92a5d 100644 (file)
--- a/lisp/nnshimbun.el
+++ b/lisp/nnshimbun.el
@@ -33,16 +33,16 @@
 (gnus-declare-backend "nnshimbun" 'address)
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
 
 (require 'nnheader)
 (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)
@@ -61,7 +61,7 @@
   `(("asahi"
      (url . "http://spin.asahi.com/")
      (groups "national" "business" "politics" "international" "sports" "personal" "feneral")
-     (coding-system  . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
+     (coding-system  . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis))
      (generate-nov   . nnshimbun-generate-nov-for-each-group)
      (get-headers    . nnshimbun-asahi-get-headers)
      (index-url      . (format "%sp%s.html" nnshimbun-url nnshimbun-current-group))
@@ -72,7 +72,7 @@
     ("sponichi"
      (url . "http://www.sponichi.co.jp/")
      (groups "baseball" "soccer" "usa" "others" "society" "entertainment" "horseracing")
-     (coding-system  . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
+     (coding-system  . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis))
      (generate-nov   . nnshimbun-generate-nov-for-each-group)
      (get-headers    . nnshimbun-sponichi-get-headers)
      (index-url      . (format "%s%s/index.html" nnshimbun-url nnshimbun-current-group))
@@ -83,7 +83,7 @@
     ("cnet"
      (url . "http://cnet.sphere.ne.jp/")
      (groups "comp")
-     (coding-system  . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
+     (coding-system  . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis))
      (generate-nov   . nnshimbun-generate-nov-for-each-group)
      (get-headers    . nnshimbun-cnet-get-headers)
      (index-url      . (format "%s/News/Oneweek/" nnshimbun-url))
@@ -94,7 +94,7 @@
     ("wired"
      (url . "http://www.hotwired.co.jp/")
      (groups "business" "culture" "technology")
-     (coding-system  . ,(if (boundp 'MULE) '*euc-japan* 'euc-jp))
+     (coding-system  . ,(static-if (boundp 'MULE) '*euc-japan* 'euc-jp))
      (generate-nov   . nnshimbun-generate-nov-for-all-groups)
      (get-headers    . nnshimbun-wired-get-all-headers)
      (index-url)
@@ -105,7 +105,7 @@
     ("yomiuri"
      (url . "http://www.yomiuri.co.jp/")
      (groups "shakai" "sports" "seiji" "keizai" "kokusai" "fuho")
-     (coding-system  . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
+     (coding-system  . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis))
      (generate-nov   . nnshimbun-generate-nov-for-all-groups)
      (get-headers    . nnshimbun-yomiuri-get-all-headers)
      (index-url      . (concat nnshimbun-url "main.htm"))
@@ -116,7 +116,7 @@
     ("zdnet"
      (url . "http://www.zdnet.co.jp/news/")
      (groups "comp")
-     (coding-system  . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
+     (coding-system  . ,(static-if (boundp 'MULE) '*sjis* 'shift_jis))
      (generate-nov   . nnshimbun-generate-nov-for-each-group)
      (get-headers    . nnshimbun-zdnet-get-headers)
      (index-url      . nnshimbun-url)
@@ -127,7 +127,7 @@
     ("mew"
      (url . "http://www.mew.org/archive/")
      (groups ,@(mapcar #'car nnshimbun-mew-groups))
-     (coding-system . ,(if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp))
+     (coding-system . ,(static-if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp))
      (generate-nov  . nnshimbun-generate-nov-for-each-group)
      (get-headers   . nnshimbun-mew-get-headers)
      (index-url     . (nnshimbun-mew-concat-url "index.html"))
@@ -137,7 +137,7 @@
      (groups "xemacs-announce" "xemacs-beta-ja" "xemacs-beta"
             "xemacs-build-reports" "xemacs-cvs" "xemacs-mule"
             "xemacs-nt" "xemacs-patches" "xemacs-users-ja" "xemacs")
-     (coding-system . ,(if (boundp 'MULE) '*euc-japan* 'euc-jp))
+     (coding-system . ,(static-if (boundp 'MULE) '*euc-japan* 'euc-jp))
      (generate-nov  . nnshimbun-generate-nov-for-each-group)
      (get-headers   . nnshimbun-xemacs-get-headers)
      (index-url     . (nnshimbun-xemacs-concat-url nil))
@@ -148,7 +148,7 @@
             "port-arm32-ja" "port-hpcmips-ja" "port-mac68k-ja"
             "port-mips-ja" "port-powerpc-ja" "hpcmips-changes-ja"
             "members-ja" "admin-ja" "www-changes-ja")
-     (coding-system  . ,(if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp))
+     (coding-system  . ,(static-if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp))
      (generate-nov   . nnshimbun-generate-nov-for-each-group)
      (get-headers    . nnshimbun-netbsd-get-headers)
      (index-url      . (format "%s%s/index.html" nnshimbun-url nnshimbun-current-group))
@@ -213,6 +213,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
@@ -280,38 +296,80 @@
   (nnoo-close-server 'nnshimbun server)
   t)
 
+(static-when (boundp 'MULE)
+  (unless (coding-system-p 'euc-japan)
+    (copy-coding-system '*euc-japan* 'euc-japan))
+  (unless (coding-system-p 'shift_jis)
+    (copy-coding-system '*sjis* 'shift_jis))
+  (eval-and-compile
+    (defalias-maybe 'coding-system-category 'get-code-mnemonic)))
+
 (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)