From: tsuchiya <tsuchiya>
Date: Wed, 24 May 2000 08:14:31 +0000 (+0000)
Subject: * lisp/nnshimbun.el: Add `Wired News' support.
X-Git-Tag: t-gnus-6_14_4-03~16
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=883149d0c42a34fa2c7f4b962d73a8ba70846034;p=elisp%2Fgnus.git-

* lisp/nnshimbun.el: Add `Wired News' support.
---

diff --git a/ChangeLog b/ChangeLog
index 46b2a60..d078cf2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2000-05-24  TSUCHIYA Masatoshi  <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+	* lisp/nnshimbun.el: Add `Wired News' support.
+
 2000-05-24  Katsumi Yamaoka <yamaoka@jpl.org>
 
 	* lisp/gnus-group.el (gnus-group-make-shimbun-group): Complete
diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el
index 051692f..684adc3 100644
--- a/lisp/nnshimbun.el
+++ b/lisp/nnshimbun.el
@@ -70,6 +70,13 @@
      (coding-system . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
      (generate-nov  . nnshimbun-cnet-generate-nov-database)
      (make-contents . nnshimbun-cnet-make-contents))
+    (wired
+     (address . "wired")
+     (url . "http://www.hotwired.co.jp/")
+     (groups "business" "culture" "technology")
+     (coding-system . ,(if (boundp 'MULE) '*euc-japan* 'euc-jp))
+     (generate-nov  . nnshimbun-wired-generate-nov-database)
+     (make-contents . nnshimbun-wired-make-contents))
     ))
 
 (defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/")
@@ -774,5 +781,101 @@
 
 
 
+;;; Wired
+
+(defun nnshimbun-wired-get-headers ()
+  (save-excursion
+    (set-buffer nnshimbun-buffer)
+    (let ((group-header-alist (mapcar (lambda (g) (cons g nil)) nnshimbun-groups))
+	  (case-fold-search t)
+	  (regexp (format
+		   "<a href=\"\\(%s\\|/\\)\\(news/news/\\(%s\\)/story/\\(\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)[0-9]+\\)\\.html\\)\"><b>"
+		   (regexp-quote nnshimbun-url)
+		   (regexp-opt nnshimbun-groups))))
+      (dolist (xover (list (concat nnshimbun-url "news/news/index.html")
+			   (concat nnshimbun-url "news/news/last_seven.html")))
+	(erase-buffer)
+	(nnshimbun-retrieve-url xover t)
+	(goto-char (point-min))
+	(while (re-search-forward regexp nil t)
+	  (let* ((url   (concat nnshimbun-url (match-string 2)))
+		 (group (downcase (match-string 3)))
+		 (id    (format "<%s%%%s>" (match-string 4) group))
+		 (date  (nnshimbun-make-date-string
+			 (string-to-number (match-string 5))
+			 (string-to-number (match-string 6))
+			 (string-to-number (match-string 7))))
+		 (header (make-full-mail-header
+			  0
+			  (nnshimbun-mime-encode-string
+			   (mapconcat 'identity
+				      (split-string
+				       (buffer-substring
+					(match-end 0)
+					(progn (search-forward "</b>" nil t) (point)))
+				       "<[^>]+>")
+				      ""))
+			  "webmaster@www.hotwired.co.jp"
+			  date id "" 0 0 url))
+		 (x (assoc group group-header-alist)))
+	    (setcdr x (cons header (cdr x))))))
+      group-header-alist)))
+
+(defvar nnshimbun-wired-last-check nil)
+(defvar nnshimbun-wired-check-interval 300)
+
+(defun nnshimbun-wired-generate-nov-database (&rest args)
+  (unless (and nnshimbun-wired-last-check
+	       (< (nnshimbun-lapse-seconds nnshimbun-wired-last-check)
+		  nnshimbun-wired-check-interval))
+    (save-excursion
+      (dolist (list (nnshimbun-wired-get-headers))
+	(let ((group (car list)))
+	  (nnshimbun-possibly-change-server group)
+	  (when (cdr list)
+	    (set-buffer (nnshimbun-open-nov group))
+	    (let (i)
+	      (goto-char (point-max))
+	      (forward-line -1)
+	      (setq i (or (ignore-errors (read (current-buffer))) 0))
+	      (goto-char (point-max))
+	      (dolist (header (cdr list))
+		(unless (nnshimbun-search-id group (mail-header-id header))
+		  (mail-header-set-number header (setq i (1+ i)))
+		  (nnheader-insert-nov header)))))))
+      (nnshimbun-save-nov)
+      (setq nnshimbun-wired-last-check (current-time)))))
+
+(defun nnshimbun-wired-make-contents (header)
+  (goto-char (point-min))
+  (let (start (html t))
+    (when (and (search-forward "\n<!-- START_OF_BODY -->\n" nil t)
+	       (setq start (point))
+	       (search-forward "\n<!-- END_OF_BODY -->\n" nil t))
+      (delete-region (point-min) start)
+      (forward-line -2)
+      (delete-region (point) (point-max))
+      (when (search-backward "<DIV ALIGN=\"RIGHT\">[日本語" nil t)
+	(delete-region (point) (point-max)))
+      (goto-char (point-min))
+      (while (search-forward "<br>" nil t)
+	(insert "\n"))
+      (nnweb-remove-markup)
+      (nnweb-decode-entities)
+      (goto-char (point-min))
+      (when (skip-chars-forward "\n")
+	(delete-region (point-min) (point)))
+      (while (not (eobp))
+	(nnshimbun-fill-line))
+      (setq html nil))
+    (goto-char (point-min))
+    (nnshimbun-insert-header header)
+    (insert "Content-Type: " (if html "text/html" "text/plain")
+	    "; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
+    (encode-coding-string (buffer-string)
+			  (mime-charset-to-coding-system "ISO-2022-JP"))))
+
+
+
 (provide 'nnshimbun)
 ;;; nnshimbun.el ends here.