From: yamaoka <yamaoka>
Date: Fri, 18 Aug 2000 06:26:40 +0000 (+0000)
Subject: Contributions from Arisawa-san.
X-Git-Tag: t-gnus-6_14_5-04~6
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=58ca130e1db0e032ecb6a3bc89517a2548c64401;p=elisp%2Fgnus.git-

Contributions from Arisawa-san.
+ Add `mew' and `xemacs' support.
---

diff --git a/ChangeLog b/ChangeLog
index edf3372..9adbdc6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2000-08-18  TSUCHIYA Masatoshi  <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+            Akihiro Arisawa  <ari@atesoft.advantest.co.jp>
+
+	* nnshimbun.el: Add `mew' and `xemacs' support.
+
 2000-08-09  Katsumi Yamaoka <yamaoka@jpl.org>
 
 	* lisp/nntp.el (nntp-open-telnet): Wait for the telnet prompt
diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el
index 71a9e8d..c8af93e 100644
--- a/lisp/nnshimbun.el
+++ b/lisp/nnshimbun.el
@@ -48,6 +48,14 @@
 
 (defvar nnshimbun-check-interval 300)
 
+(defconst nnshimbun-mew-groups
+  '(("meadow-develop" "meadow-develop" nil t)
+    ("meadow-users-jp" "meadow-users-jp")
+    ("mule-win32" "mule-win32")
+    ("mew-win32" "mew-win32")
+    ("mew-dist" "mew-dist/3300" t)
+    ("mgp-users-jp" "mgp-users-jp/A" t t)))
+
 (defvar nnshimbun-type-definition
   `(("asahi"
      (url . "http://spin.asahi.com/")
@@ -115,6 +123,24 @@
      (make-contents  . nnshimbun-make-html-contents)
      (contents-start . "<!--BODY-->")
      (contents-end   . "<!--BODYEND-->"))
+    ("mew"
+     (url . "http://www.mew.org/archive/")
+     (groups ,@(mapcar #'car nnshimbun-mew-groups))
+     (coding-system . ,(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"))
+     (make-contents . nnshimbun-make-mhonarc-contents))
+    ("xemacs"
+     (url . "http://www.xemacs.org/list-archives/")
+     (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))
+     (generate-nov  . nnshimbun-generate-nov-for-each-group)
+     (get-headers   . nnshimbun-xemacs-get-headers)
+     (index-url     . (nnshimbun-xemacs-concat-url nil))
+     (make-contents . nnshimbun-make-mhonarc-contents))
     ))
 
 (defvar nnshimbun-x-face-alist
@@ -759,6 +785,71 @@ is enclosed by at least one regexp grouping construct."
     (encode-coding-string (buffer-string)
 			  (mime-charset-to-coding-system "ISO-2022-JP"))))
 
+(defun nnshimbun-make-mhonarc-contents (header &rest args)
+  (require 'mml)
+  (if (search-forward "<!--X-Head-End-->" nil t)
+      (progn
+	(forward-line 0)
+	;; Processing headers.
+	(save-restriction
+	  (narrow-to-region (point-min) (point))
+	  (nnweb-decode-entities)
+	  (goto-char (point-min))
+	  (while (search-forward "<!--X-" nil t)
+	    (replace-match ""))
+	  (goto-char (point-min))
+	  (while (search-forward " -->" nil t)
+	    (replace-match ""))
+	  (goto-char (point-min))
+	  (let (refs id)
+	    (while (not (eobp))
+	      (cond
+	       ((looking-at "<!--")
+		(delete-region (point) (progn (forward-line 1) (point))))
+	       ((looking-at "Message-Id: ")
+		(setq id (concat "<" (nnheader-header-value) ">"))
+		(forward-line 1))
+	       ((looking-at "Reference: ")
+		(push (concat "<" (nnheader-header-value) ">") refs)
+		(delete-region (point) (progn (forward-line 1) (point))))
+	       ((looking-at "Content-Type: ")
+		(unless (search-forward "charset" (gnus-point-at-eol) t)
+		  (end-of-line)
+		  (insert "; charset=ISO-2022-JP"))
+		(forward-line 1))
+	       (t (forward-line 1))))
+	    (let (buf)
+	      (dolist (ref refs)
+		(and
+		 (setq ref (nnshimbun-search-id nnshimbun-current-group ref 'nov))
+		 (push (mail-header-id ref) buf)))
+	      (setq refs buf))
+	    (insert "References: "
+		    (setq refs (mapconcat #'identity refs " "))
+		    "\nMIME-Version: 1.0\n")
+	    (nnshimbun-nov-fix-header nnshimbun-current-group
+				      header
+				      `((id . ,id)
+					(references . ,refs))))
+	  (goto-char (point-max)))
+	;; Processing body.
+	(save-restriction
+	  (narrow-to-region (point) (point-max))
+	  (delete-region
+	   (point)
+	   (progn
+	     (search-forward "\n<!--X-Body-of-Message-->\n" nil t)
+	     (point)))
+	  (when (search-forward "\n<!--X-Body-of-Message-End-->\n" nil t)
+	    (forward-line -1)
+	    (delete-region (point) (point-max)))
+	  (nnweb-remove-markup)
+	  (nnweb-decode-entities)))
+    (goto-char (point-min))
+    (nnshimbun-insert-header header)
+    (insert "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n"))
+  (encode-coding-string (buffer-string)
+			(mime-charset-to-coding-system "ISO-2022-JP")))
 
 
 ;;; www.asahi.com
@@ -1023,6 +1114,147 @@ is enclosed by at least one regexp grouping construct."
 	      headers)))
     (nreverse headers)))
 
+;;; MLs on www.mew.org
+
+(defmacro nnshimbun-mew-concat-url (url)
+  `(concat nnshimbun-url
+	   (nth 1 (assoc nnshimbun-current-group nnshimbun-mew-groups))
+	   "/"
+	   ,url))
+
+(defmacro nnshimbun-mew-reverse-order-p ()
+  `(nth 2 (assoc nnshimbun-current-group nnshimbun-mew-groups)))
+
+(defmacro nnshimbun-mew-spew-p ()
+  `(nth 3 (assoc nnshimbun-current-group nnshimbun-mew-groups)))
+
+(defsubst nnshimbun-mew-retrieve-xover (aux)
+  (erase-buffer)
+  (nnshimbun-retrieve-url
+   (nnshimbun-mew-concat-url (if (= aux 1) "index.html" (format "mail%d.html" aux)))
+   t))
+
+(defconst nnshimbun-mew-regexp "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<")
+
+(defmacro nnshimbun-mew-extract-header-values ()
+  `(progn
+     (setq url (nnshimbun-mew-concat-url (match-string 1))
+	   id (format "<%05d%%%s>"
+		      (1- (string-to-number (match-string 2)))
+		      nnshimbun-current-group)
+	   subject (match-string 3))
+     (forward-line 1)
+     (if (nnshimbun-search-id nnshimbun-current-group id)
+	 (throw 'stop headers)
+       (push (make-full-mail-header
+	      0
+	      (nnshimbun-mime-encode-string subject)
+	      (if (looking-at "<EM>\\([^<]+\\)<")
+		  (nnshimbun-mime-encode-string (match-string 1))
+		"")
+	      "" id "" 0 0 url)
+	     headers))))
+
+(eval-and-compile
+  (if (fboundp 'mime-entity-fetch-field)
+      ;; For Semi-Gnus.
+      (defmacro nnshimbun-mew-mail-header-subject (header)
+	`(mime-entity-fetch-field ,header 'Subject))
+    ;; For pure Gnus.
+    (defalias 'nnshimbun-mew-mail-header-subject 'mail-header-subject)))
+
+(defun nnshimbun-mew-get-headers ()
+  (if (nnshimbun-mew-spew-p)
+      (let ((headers (nnshimbun-mew-get-headers-1)))
+	(erase-buffer)
+	(insert-buffer-substring (nnshimbun-open-nov nnshimbun-current-group))
+	(delq nil
+	      (mapcar
+	       (lambda (header)
+		 (goto-char (point-min))
+		 (let ((subject (nnshimbun-mew-mail-header-subject header))
+		       (found))
+		   (while (and (not found)
+			       (search-forward subject nil t))
+		     (if (not (and (search-backward "\t" nil t)
+				   (not (search-backward "\t" (gnus-point-at-bol) t))))
+			 (forward-line 1)
+		       (setq found t)))
+		   (if found
+		       nil
+		     (goto-char (point-max))
+		     (nnheader-insert-nov header)
+		     header)))
+	       headers)))
+    (nnshimbun-mew-get-headers-1)))
+
+(defun nnshimbun-mew-get-headers-1 ()
+  (let (headers)
+    (when (re-search-forward
+	   "<A[^>]*HREF=\"mail\\([0-9]+\\)\\.html\">\\[?Last Page\\]?</A>" nil t)
+      (let ((limit (string-to-number (match-string 1))))
+	(catch 'stop
+	  (if (nnshimbun-mew-reverse-order-p)
+	      (let ((aux 1))
+		(while (let (id url subject)
+			 (while (re-search-forward nnshimbun-mew-regexp nil t)
+			   (nnshimbun-mew-extract-header-values))
+			 (< aux limit))
+		  (nnshimbun-mew-retrieve-xover (setq aux (1+ aux)))))
+	    (while (> limit 0)
+	      (nnshimbun-mew-retrieve-xover limit)
+	      (setq limit (1- limit))
+	      (let (id url subject)
+		(goto-char (point-max))
+		(while (re-search-backward nnshimbun-mew-regexp nil t)
+		  (nnshimbun-mew-extract-header-values)
+		  (forward-line -2)))))
+	  headers)))))
+
+;;; MLs on www.xemacs.org
+
+(defmacro nnshimbun-xemacs-concat-url (url)
+  `(concat nnshimbun-url nnshimbun-current-group "/" ,url))
+
+(defun nnshimbun-xemacs-get-headers ()
+  (let (headers auxs aux)
+    (catch 'stop
+      (while (re-search-forward
+	      (concat "<A HREF=\"/list-archives/" nnshimbun-current-group
+		      "/\\([12][0-9][0-9][0-9][0-1][0-9]\\)/\">\\[Index\\]")
+	      nil t)
+	(setq auxs (append auxs (list (match-string 1)))))
+      (while auxs
+	(erase-buffer)
+	(nnshimbun-retrieve-url
+	 (nnshimbun-xemacs-concat-url (concat (setq aux (car auxs)) "/")))
+	(let (id url subject)
+	  (goto-char (point-max))
+	  (while (re-search-backward
+		  "<A[^>]*HREF=\"\\(msg\\([0-9]+\\).html\\)\">\\([^<]+\\)<"
+		  nil t)
+	    (setq url (nnshimbun-xemacs-concat-url
+		       (concat aux "/" (match-string 1)))
+		  id (format "<%s%05d%%%s>"
+			     aux
+			     (string-to-number (match-string 2))
+			     nnshimbun-current-group)
+		  subject (match-string 3))
+	    (forward-line 1)
+	    (if (nnshimbun-search-id nnshimbun-current-group id)
+		(throw 'stop headers)
+	      (push (make-full-mail-header
+		     0
+		     (nnshimbun-mime-encode-string subject)
+		     (if (looking-at "<td><em>\\([^<]+\\)<")
+			 (match-string 1)
+		       "")
+		     "" id "" 0 0 url)
+		    headers))
+	    (message "%s" id)
+	    (forward-line -2)))
+	(setq auxs (cdr auxs))))
+    headers))
 
 
 (provide 'nnshimbun)