From 5b0fcea03ad0e406895366cf9f4a3bca1be6b258 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 24 May 2000 08:29:22 +0000 Subject: [PATCH] Sync with `t-gnus-6_14'. --- ChangeLog | 4 +++ lisp/nnshimbun.el | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+) diff --git a/ChangeLog b/ChangeLog index f296173..f600cdd 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2000-05-24 TSUCHIYA Masatoshi + + * lisp/nnshimbun.el: Add `Wired News' support. + 2000-05-24 Katsumi Yamaoka * 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 + "" + (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 "" 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\n" nil t) + (setq start (point)) + (search-forward "\n\n" nil t)) + (delete-region (point-min) start) + (forward-line -2) + (delete-region (point) (point-max)) + (when (search-backward "
[日本語" nil t) + (delete-region (point) (point-max))) + (goto-char (point-min)) + (while (search-forward "
" 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. -- 1.7.10.4