1 ;;; -*- mode: Emacs-Lisp; coding: junet-unix -*-
3 ;;; Author: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
8 ;; This file is a part of Semi-Gnus.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; if not, you can either send email to this
22 ;; program's maintainer or write to: The Free Software Foundation,
23 ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
27 ;; Gnus backend to read newspapers on WEB.
32 (gnus-declare-backend "nnshimbun" 'address)
34 (eval-when-compile (require 'cl))
43 ;; Report failure to find w3 at load time if appropriate.
44 (eval '(require 'nnweb))
47 (nnoo-declare nnshimbun)
49 (defvar nnshimbun-default-type 'asahi)
51 (defvar nnshimbun-type-definition
54 (url . "http://spin.asahi.com/")
55 (groups "national" "business" "politics" "international" "sports" "personal" "feneral")
56 (coding-system . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
57 (generate-nov . nnshimbun-asahi-generate-nov-database)
58 (make-contents . nnshimbun-asahi-make-contents))
60 (address . "sponichi")
61 (url . "http://www.sponichi.co.jp/")
62 (groups "baseball" "soccer" "usa" "others" "society" "entertainment" "horseracing")
63 (coding-system . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
64 (generate-nov . nnshimbun-sponichi-generate-nov-database)
65 (make-contents . nnshimbun-sponichi-make-contents))
68 (url . "http://cnet.sphere.ne.jp/")
70 (coding-system . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
71 (generate-nov . nnshimbun-cnet-generate-nov-database)
72 (make-contents . nnshimbun-cnet-make-contents))
75 (url . "http://www.hotwired.co.jp/")
76 (groups "business" "culture" "technology")
77 (coding-system . ,(if (boundp 'MULE) '*euc-japan* 'euc-jp))
78 (generate-nov . nnshimbun-wired-generate-nov-database)
79 (make-contents . nnshimbun-wired-make-contents))
82 (defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/")
83 "Where nnshimbun will save its files.")
85 (defvoo nnshimbun-nov-is-evil nil
86 "*Non-nil means that nnshimbun will never retrieve NOV headers.")
88 (defvoo nnshimbun-nov-file-name ".overview")
90 ;; set by nnshimbun-possibly-change-server
91 (defvoo nnshimbun-current-directory nil)
92 (defvoo nnshimbun-current-group nil)
94 ;; set by nnoo-change-server
95 (defvoo nnshimbun-address nil)
96 (defvoo nnshimbun-type nil)
98 ;; set by nnshimbun-possibly-change-server
99 (defvoo nnshimbun-server-directory nil)
100 (defvoo nnshimbun-buffer nil)
102 ;; set by nnshimbun-open-server
103 (defvoo nnshimbun-url nil)
104 (defvoo nnshimbun-coding-system nil)
105 (defvoo nnshimbun-groups nil)
106 (defvoo nnshimbun-generate-nov nil)
107 (defvoo nnshimbun-make-contents nil)
109 (defvoo nnshimbun-status-string "")
110 (defvoo nnshimbun-nov-buffer-alist nil)
111 (defvoo nnshimbun-nov-buffer-file-name nil)
113 (defvoo nnshimbun-keep-backlog 300)
114 (defvoo nnshimbun-backlog-articles nil)
115 (defvoo nnshimbun-backlog-hashtb nil)
120 (defmacro nnshimbun-backlog (&rest form)
121 `(let ((gnus-keep-backlog nnshimbun-keep-backlog)
122 (gnus-backlog-buffer (format " *nnshimbun backlog %s*" nnshimbun-address))
123 (gnus-backlog-articles nnshimbun-backlog-articles)
124 (gnus-backlog-hashtb nnshimbun-backlog-hashtb))
127 (setq nnshimbun-backlog-articles gnus-backlog-articles
128 nnshimbun-backlog-hashtb gnus-backlog-hashtb))))
129 (put 'nnshimbun-backlog 'lisp-indent-function 0)
130 (put 'nnshimbun-backlog 'edebug-form-spec '(form body))
134 ;;; Interface Functions
135 (nnoo-define-basics nnshimbun)
137 (deffoo nnshimbun-open-server (server &optional defs)
138 (let* ((type (or (car (cdr (assq 'nnshimbun-type defs)))
139 (if (not (equal server "")) (intern server))
140 nnshimbun-default-type))
141 (defaults (cdr (assq type nnshimbun-type-definition))))
143 (nnheader-report 'nnshimbun "Unknown server type: %s" type)
144 (unless (assq 'nnshimbun-type defs)
145 (setq defs (append defs (list (list 'nnshimbun-type type)))))
146 (unless (assq 'nnshimbun-address defs)
147 (setq defs (append defs (list (list 'nnshimbun-address
148 (if (equal server "")
151 (nnoo-change-server 'nnshimbun server defs)
152 ;; Set default vaules for defined server.
153 (dolist (default defaults)
154 (let ((symbol (intern (concat "nnshimbun-" (symbol-name (car default))))))
155 (unless (assq symbol defs)
156 (set symbol (cdr default)))))
157 (nnshimbun-possibly-change-server nil server)
158 (when (not (file-exists-p nnshimbun-directory))
159 (ignore-errors (make-directory nnshimbun-directory t)))
161 ((not (file-exists-p nnshimbun-directory))
162 (nnshimbun-close-server)
163 (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-directory))
164 ((not (file-directory-p (file-truename nnshimbun-directory)))
165 (nnshimbun-close-server)
166 (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-directory))
168 (when (not (file-exists-p nnshimbun-server-directory))
169 (ignore-errors (make-directory nnshimbun-server-directory t)))
171 ((not (file-exists-p nnshimbun-server-directory))
172 (nnshimbun-close-server)
173 (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-server-directory))
174 ((not (file-directory-p (file-truename nnshimbun-server-directory)))
175 (nnshimbun-close-server)
176 (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-server-directory))
178 (nnheader-report 'nnshimbun "Opened server %s using directory %s"
179 server nnshimbun-server-directory)
182 (deffoo nnshimbun-close-server (&optional server)
183 (when (and (nnshimbun-server-opened server)
184 (gnus-buffer-live-p nnshimbun-buffer))
186 (set-buffer nnshimbun-buffer)
187 (kill-buffer nnshimbun-buffer)))
189 (gnus-backlog-shutdown))
191 (nnoo-close-server 'nnshimbun server)
194 (defun nnshimbun-retrieve-url (url &optional no-cache)
195 "Rertrieve URL contents and insert to current buffer."
196 (let ((coding-system-for-read 'binary)
197 (coding-system-for-write 'binary))
198 (set-buffer-multibyte nil)
199 ;; Following code is imported from `url-insert-file-contents'.
201 (let ((old-asynch (default-value 'url-be-asynchronous))
202 (old-caching (default-value 'url-automatic-caching))
203 (old-mode (default-value 'url-standalone-mode)))
206 (setq-default url-be-asynchronous nil)
208 (setq-default url-automatic-caching nil)
209 (setq-default url-standalone-mode nil))
210 (let ((buf (current-buffer))
211 (url-working-buffer (cdr (url-retrieve url no-cache))))
212 (set-buffer url-working-buffer)
215 (insert-buffer url-working-buffer)
217 (set-buffer url-working-buffer)
218 (set-buffer-modified-p nil))
219 (kill-buffer url-working-buffer)))
220 (setq-default url-be-asynchronous old-asynch)
221 (setq-default url-automatic-caching old-caching)
222 (setq-default url-standalone-mode old-mode))))
223 ;; Modify buffer coding system.
224 (decode-coding-region (point-min) (point-max) nnshimbun-coding-system)
225 (set-buffer-multibyte t)))
227 (deffoo nnshimbun-request-article (article &optional group server to-buffer)
228 (when (nnshimbun-possibly-change-server group server)
229 (if (stringp article)
230 (setq article (nnshimbun-search-id group article)))
231 (if (integerp article)
232 (if (nnshimbun-backlog
233 (gnus-backlog-request-article group article
234 (or to-buffer nntp-server-buffer)))
236 (let (header contents)
237 (when (setq header (save-excursion
238 (set-buffer (nnshimbun-open-nov group))
239 (and (nnheader-find-nov-line article)
240 (nnheader-parse-nov))))
241 (let ((xref (substring (mail-header-xref header) 6)))
243 (set-buffer nnshimbun-buffer)
245 (nnshimbun-retrieve-url xref)
246 (nnheader-message 6 "nnshimbun: Make contents...")
247 (setq contents (funcall nnshimbun-make-contents header))
248 (nnheader-message 6 "nnshimbun: Make contents...done"))))
251 (set-buffer (or to-buffer nntp-server-buffer))
255 (gnus-backlog-enter-article group article (current-buffer)))
256 (nnheader-report 'nnshimbun "Article %s retrieved" (mail-header-id header))
257 (cons group (mail-header-number header))))))
258 (nnheader-report 'nnml "Couldn't retrieve article: %s" (prin1-to-string article))
261 (deffoo nnshimbun-request-group (group &optional server dont-check)
262 (let ((pathname-coding-system 'binary))
264 ((not (nnshimbun-possibly-change-server group server))
265 (nnheader-report 'nnshimbun "Invalid group (no such directory)"))
266 ((not (file-exists-p nnshimbun-current-directory))
267 (nnheader-report 'nnshimbun "Directory %s does not exist"
268 nnshimbun-current-directory))
269 ((not (file-directory-p nnshimbun-current-directory))
270 (nnheader-report 'nnshimbun "%s is not a directory" nnshimbun-current-directory))
272 (nnheader-report 'nnshimbun "Group %s selected" group)
277 (set-buffer (nnshimbun-open-nov group))
278 (goto-char (point-min))
279 (setq beg (ignore-errors (read (current-buffer))))
280 (goto-char (point-max))
282 (setq end (ignore-errors (read (current-buffer)))
283 lines (count-lines (point-min) (point-max))))
284 (nnheader-report 'nnshimbunw "Selected group %s" group)
285 (nnheader-insert "211 %d %d %d %s\n"
286 lines (or beg 0) (or end 0) group))))))
288 (deffoo nnshimbun-request-scan (&optional group server)
289 (nnshimbun-possibly-change-server group server)
290 (nnshimbun-generate-nov-database group))
292 (deffoo nnshimbun-close-group (group &optional server)
295 (deffoo nnshimbun-request-list (&optional server)
297 (set-buffer nntp-server-buffer)
299 (dolist (group nnshimbun-groups)
300 (when (nnshimbun-possibly-change-server group server)
303 (set-buffer (nnshimbun-open-nov group))
304 (goto-char (point-min))
305 (setq beg (ignore-errors (read (current-buffer))))
306 (goto-char (point-max))
308 (setq end (ignore-errors (read (current-buffer)))))
309 (insert (format "%s %d %d n\n" group (or end 0) (or beg 0)))))))
313 (if (fboundp 'mime-entity-fetch-field)
315 (defun nnshimbun-insert-header (header)
316 (insert "Subject: " (or (mime-entity-fetch-field header 'Subject) "(none)") "\n"
317 "From: " (or (mime-entity-fetch-field header 'From) "(nobody)") "\n"
318 "Date: " (or (mail-header-date header) "") "\n"
319 "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
320 "References: " (or (mail-header-references header) "") "\n"
322 (princ (or (mail-header-lines header) 0) (current-buffer))
325 (defun nnshimbun-insert-header (header)
326 (nnheader-insert-header header)
329 (deffoo nnshimbun-retrieve-headers (articles &optional group server fetch-old)
330 (when (nnshimbun-possibly-change-server group server)
331 (if (nnshimbun-retrieve-headers-with-nov articles fetch-old)
334 (set-buffer nntp-server-buffer)
337 (dolist (art articles)
339 (setq art (nnshimbun-search-id group art)))
343 (set-buffer (nnshimbun-open-nov group))
344 (and (nnheader-find-nov-line art)
345 (nnheader-parse-nov))))
346 (insert (format "220 %d Article retrieved.\n" art))
347 (nnshimbun-insert-header header)
349 (delete-region (point) (point-max))))))
352 (defun nnshimbun-retrieve-headers-with-nov (articles &optional fetch-old)
353 (if (or gnus-nov-is-evil nnshimbun-nov-is-evil)
355 (let ((nov (expand-file-name nnshimbun-nov-file-name nnshimbun-current-directory)))
356 (when (file-exists-p nov)
358 (set-buffer nntp-server-buffer)
360 (nnheader-insert-file-contents nov)
362 (not (numberp fetch-old)))
363 t ; Don't remove anything.
364 (nnheader-nov-delete-outside-range
365 (if fetch-old (max 1 (- (car articles) fetch-old))
367 (car (last articles)))
372 ;;; Nov Database Operations
374 (defun nnshimbun-generate-nov-database (group)
375 (prog1 (funcall nnshimbun-generate-nov group)
377 (set-buffer (nnshimbun-open-nov group))
378 (when (buffer-modified-p)
379 (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name
382 (defun nnshimbun-search-id (group id)
384 (set-buffer (nnshimbun-open-nov group))
385 (goto-char (point-min))
387 (while (and (not found)
388 (search-forward id nil t)) ; We find the ID.
389 ;; And the id is in the fourth field.
390 (if (not (and (search-backward "\t" nil t 4)
391 (not (search-backward "\t" (gnus-point-at-bol) t))))
395 ;; We return the article number.
396 (setq number (ignore-errors (read (current-buffer))))))
399 (defun nnshimbun-open-nov (group)
400 (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist))))
401 (if (buffer-live-p buffer)
403 (setq buffer (gnus-get-buffer-create
404 (format " *nnshimbun overview %s %s*"
405 nnshimbun-address group)))
408 (set (make-local-variable 'nnshimbun-nov-buffer-file-name)
410 nnshimbun-nov-file-name
411 (nnmail-group-pathname group nnshimbun-server-directory)))
413 (when (file-exists-p nnshimbun-nov-buffer-file-name)
414 (nnheader-insert-file-contents nnshimbun-nov-buffer-file-name))
415 (set-buffer-modified-p nil))
416 (push (cons group buffer) nnshimbun-nov-buffer-alist)
419 (defun nnshimbun-save-nov ()
421 (while nnshimbun-nov-buffer-alist
422 (when (buffer-name (cdar nnshimbun-nov-buffer-alist))
423 (set-buffer (cdar nnshimbun-nov-buffer-alist))
424 (when (buffer-modified-p)
425 (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name
427 (set-buffer-modified-p nil)
428 (kill-buffer (current-buffer)))
429 (setq nnshimbun-nov-buffer-alist (cdr nnshimbun-nov-buffer-alist)))))
433 ;;; Server Initialize
434 (defun nnshimbun-possibly-change-server (group &optional server)
436 (unless (nnshimbun-server-opened server)
437 (nnshimbun-open-server server)))
438 (setq nnshimbun-server-directory
439 (nnheader-concat nnshimbun-directory (concat nnshimbun-address "/")))
440 (unless (gnus-buffer-live-p nnshimbun-buffer)
441 (setq nnshimbun-buffer
443 (nnheader-set-temp-buffer
444 (format " *nnshimbun %s %s*" nnshimbun-type server)))))
447 (let ((pathname (nnmail-group-pathname group nnshimbun-server-directory))
448 (pathname-coding-system 'binary))
449 (when (not (equal pathname nnshimbun-current-directory))
450 (setq nnshimbun-current-directory pathname
451 nnshimbun-current-group group))
452 (when (not (file-exists-p nnshimbun-current-directory))
453 (ignore-errors (make-directory nnshimbun-current-directory t)))
455 ((not (file-exists-p nnshimbun-current-directory))
456 (nnheader-report 'nnshimbun "Couldn't create directory: %s" nnshimbun-current-directory))
457 ((not (file-directory-p (file-truename nnshimbun-current-directory)))
458 (nnheader-report 'nnshimbun "Not a directory: %s" nnshimbun-current-directory))
466 (if (fboundp 'eword-encode-string)
468 (defun nnshimbun-mime-encode-string (string)
471 (split-string (eword-encode-string (nnweb-decode-entities-string string)) "\n")
474 (defun nnshimbun-mime-encode-string (string)
479 (insert (nnweb-decode-entities-string string))
480 (rfc2047-encode-region (point-min) (point-max))
481 (buffer-substring (point-min) (point-max)))
485 (defun nnshimbun-lapse-seconds (time)
486 (let ((now (current-time)))
487 (+ (* (- (car now) (car time)) 65536)
488 (- (nth 1 now) (nth 1 time)))))
490 (defun nnshimbun-make-date-string (year month day &optional time)
491 (format "%02d %s %04d %s +0900"
493 (aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun"
494 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
500 ;; Fast fill-region function
502 (defvar nnshimbun-fill-column (min 80 (- (frame-width) 4)))
504 (defconst nnshimbun-kinsoku-bol-list
506 (if (fboundp 'string-to-char-list)
509 !)-_~}]:;',.?
\e$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?!@!A
\e(B\
510 \e$B!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n$!$#$%$'$)$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v
\e(B"))
512 (defconst nnshimbun-kinsoku-eol-list
514 (if (fboundp 'string-to-char-list)
517 "({[`
\e$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!x
\e(B"))
519 (defun nnshimbun-fill-line ()
521 (let ((top (point)) chr)
522 (while (if (>= (move-to-column fill-column) fill-column)
524 (if (memq (preceding-char) nnshimbun-kinsoku-eol-list)
527 (while (memq (preceding-char) nnshimbun-kinsoku-eol-list)
530 (while (memq (setq chr (following-char)) nnshimbun-kinsoku-bol-list)
532 (if (looking-at "\\s-+")
533 (or (eolp) (delete-region (point) (match-end 0)))
534 (or (> (char-width chr) 1)
535 (re-search-backward "\\<" top t)
537 (or (eolp) (insert "\n"))))))
546 (defun nnshimbun-asahi-get-headers (group)
548 (set-buffer nnshimbun-buffer)
550 (nnshimbun-retrieve-url (format "%sp%s.html" nnshimbun-url group) t)
551 (goto-char (point-min))
552 (when (search-forward "\n<!-- Start of past -->\n" nil t)
553 (delete-region (point-min) (point))
554 (when (search-forward "\n<!-- End of past -->\n" nil t)
556 (delete-region (point) (point-max))
557 (goto-char (point-min))
559 (while (re-search-forward
560 "^
\e$B"#
\e(B<a href=\"\\(\\([0-9][0-9][0-9][0-9]\\)/past/\\([A-z]*[0-9]*\\)\\.html\\)\"> *"
562 (let ((id (format "<%s%s%%%s>" (match-string 2) (match-string 3) group))
563 (url (match-string 1)))
564 (push (make-full-mail-header
566 (nnshimbun-mime-encode-string
571 (progn (search-forward "<br>" nil t) (point)))
574 "webmaster@www.asahi.com"
575 "" id "" 0 0 (concat nnshimbun-url url))
577 (setq headers (nreverse headers))
579 (while (and (nth i headers)
581 "^\\[\\([0-9][0-9]\\)/\\([0-9][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\)\\]"
583 (let ((month (string-to-number (match-string 1)))
584 (date (decode-time (current-time))))
585 (mail-header-set-date
587 (nnshimbun-make-date-string
588 (if (and (eq 12 month) (eq 1 (nth 4 date)))
592 (string-to-number (match-string 2))
595 (nreverse headers))))))
597 (defun nnshimbun-asahi-generate-nov-database (group)
599 (set-buffer (nnshimbun-open-nov group))
601 (goto-char (point-max))
603 (setq i (or (ignore-errors (read (current-buffer))) 0))
604 (goto-char (point-max))
605 (dolist (header (nnshimbun-asahi-get-headers group))
606 (unless (nnshimbun-search-id group (mail-header-id header))
607 (mail-header-set-number header (setq i (1+ i)))
608 (nnheader-insert-nov header))))))
610 (defun nnshimbun-asahi-make-contents (header)
611 (goto-char (point-min))
612 (let (start (html t))
613 (when (and (search-forward "\n<!-- Start of kiji -->\n" nil t)
615 (search-forward "\n<!-- End of kiji -->\n" nil t))
616 (delete-region (point-min) start)
618 (delete-region (point) (point-max))
619 (goto-char (point-min))
620 (while (search-forward "<p>" nil t)
622 (nnweb-remove-markup)
623 (nnweb-decode-entities)
624 (goto-char (point-min))
626 ;(fill-region (point) (gnus-point-at-eol))
627 (nnshimbun-fill-line)
630 (goto-char (point-min))
631 (nnshimbun-insert-header header)
632 (insert "Content-Type: " (if html "text/html" "text/plain")
633 "; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
634 (encode-coding-string (buffer-string)
635 (mime-charset-to-coding-system "ISO-2022-JP"))))
639 ;;; www.sponichi.co.jp
641 (defun nnshimbun-sponichi-get-headers (group)
643 (set-buffer nnshimbun-buffer)
645 (nnshimbun-retrieve-url (format "%s%s/index.html" nnshimbun-url group))
646 (goto-char (point-min))
647 (when (search-forward "
\e$B%K%e!<%9%$%s%G%C%/%9
\e(B" nil t)
648 (delete-region (point-min) (point))
649 (when (search-forward "
\e$B%"%I%?%0
\e(B" nil t)
651 (delete-region (point) (point-max))
652 (goto-char (point-min))
654 (while (re-search-forward
655 "^<a href=\"/\\(\\([A-z]*\\)/kiji/\\([0-9][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)\\.html\\)\">"
657 (let ((url (match-string 1))
658 (id (format "<%s%s%s%s%%%s>"
664 (date (nnshimbun-make-date-string
665 (string-to-number (match-string 3))
666 (string-to-number (match-string 4))
667 (string-to-number (match-string 5)))))
668 (push (make-full-mail-header
670 (nnshimbun-mime-encode-string
675 (progn (search-forward "<br>" nil t) (point)))
678 "webmaster@www.sponichi.co.jp"
679 date id "" 0 0 (concat nnshimbun-url url))
683 (defun nnshimbun-sponichi-generate-nov-database (group)
685 (set-buffer (nnshimbun-open-nov group))
687 (goto-char (point-max))
689 (setq i (or (ignore-errors (read (current-buffer))) 0))
690 (goto-char (point-max))
691 (dolist (header (nnshimbun-sponichi-get-headers group))
692 (unless (nnshimbun-search-id group (mail-header-id header))
693 (mail-header-set-number header (setq i (1+ i)))
694 (nnheader-insert-nov header))))))
696 (defun nnshimbun-sponichi-make-contents (header)
697 (goto-char (point-min))
698 (let (start (html t))
699 (when (and (search-forward "\n<span class=\"text\">
\e$B!!
\e(B" nil t)
701 (search-forward "\n" nil t))
702 (delete-region (point-min) start)
704 (delete-region (point) (point-max))
705 (goto-char (point-min))
706 (while (search-forward "<p>" nil t)
708 (nnweb-remove-markup)
709 (nnweb-decode-entities)
710 (goto-char (point-min))
712 ;(fill-region (point) (gnus-point-at-eol))
713 (nnshimbun-fill-line)
716 (goto-char (point-min))
717 (nnshimbun-insert-header header)
718 (insert "Content-Type: " (if html "text/html" "text/plain")
719 "; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
720 (encode-coding-string (buffer-string)
721 (mime-charset-to-coding-system "ISO-2022-JP"))))
727 (defun nnshimbun-cnet-get-headers (group)
729 (set-buffer nnshimbun-buffer)
731 (nnshimbun-retrieve-url (format "%s/News/Oneweek/" nnshimbun-url) t)
732 (goto-char (point-min))
734 (while (search-forward "\n<!--*****
\e$B8+=P$7
\e(B*****-->\n" nil t)
735 (let ((subject (buffer-substring (point) (gnus-point-at-eol)))
738 (when (looking-at "<a href=\"/\\(News/\\([0-9][0-9][0-9][0-9]\\)/Item/\\([0-9][0-9]\\([0-9][0-9]\\)\\([0-9][0-9]\\)-[0-9]+\\).html\\)\">")
739 (let ((url (match-string 1))
740 (id (format "<%s%s%%%s>" (match-string 2) (match-string 3) group))
741 (date (nnshimbun-make-date-string
742 (string-to-number (match-string 2))
743 (string-to-number (match-string 4))
744 (string-to-number (match-string 5)))))
745 (push (make-full-mail-header
747 (nnshimbun-mime-encode-string subject)
749 date id "" 0 0 (concat nnshimbun-url url))
754 (defun nnshimbun-cnet-generate-nov-database (group)
756 (set-buffer (nnshimbun-open-nov group))
758 (goto-char (point-max))
760 (setq i (or (ignore-errors (read (current-buffer))) 0))
761 (goto-char (point-max))
762 (dolist (header (nnshimbun-cnet-get-headers group))
763 (unless (nnshimbun-search-id group (mail-header-id header))
764 (mail-header-set-number header (setq i (1+ i)))
765 (nnheader-insert-nov header))))))
767 (defun nnshimbun-cnet-make-contents (header)
768 (goto-char (point-min))
770 (when (and (search-forward "\n<!--KIJI-->\n" nil t)
772 (search-forward "\n<!--/KIJI-->\n" nil t))
773 (delete-region (point-min) start)
775 (delete-region (point) (point-max)))
776 (goto-char (point-min))
777 (nnshimbun-insert-header header)
778 (insert "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
779 (encode-coding-string (buffer-string)
780 (mime-charset-to-coding-system "ISO-2022-JP"))))
786 (defun nnshimbun-wired-get-headers ()
788 (set-buffer nnshimbun-buffer)
789 (let ((group-header-alist (mapcar (lambda (g) (cons g nil)) nnshimbun-groups))
792 "<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>"
793 (regexp-quote nnshimbun-url)
794 (regexp-opt nnshimbun-groups))))
795 (dolist (xover (list (concat nnshimbun-url "news/news/index.html")
796 (concat nnshimbun-url "news/news/last_seven.html")))
798 (nnshimbun-retrieve-url xover t)
799 (goto-char (point-min))
800 (while (re-search-forward regexp nil t)
801 (let* ((url (concat nnshimbun-url (match-string 2)))
802 (group (downcase (match-string 3)))
803 (id (format "<%s%%%s>" (match-string 4) group))
804 (date (nnshimbun-make-date-string
805 (string-to-number (match-string 5))
806 (string-to-number (match-string 6))
807 (string-to-number (match-string 7))))
808 (header (make-full-mail-header
810 (nnshimbun-mime-encode-string
815 (progn (search-forward "</b>" nil t) (point)))
818 "webmaster@www.hotwired.co.jp"
820 (x (assoc group group-header-alist)))
821 (setcdr x (cons header (cdr x))))))
822 group-header-alist)))
824 (defvar nnshimbun-wired-last-check nil)
825 (defvar nnshimbun-wired-check-interval 300)
827 (defun nnshimbun-wired-generate-nov-database (&rest args)
828 (unless (and nnshimbun-wired-last-check
829 (< (nnshimbun-lapse-seconds nnshimbun-wired-last-check)
830 nnshimbun-wired-check-interval))
832 (dolist (list (nnshimbun-wired-get-headers))
833 (let ((group (car list)))
834 (nnshimbun-possibly-change-server group)
836 (set-buffer (nnshimbun-open-nov group))
838 (goto-char (point-max))
840 (setq i (or (ignore-errors (read (current-buffer))) 0))
841 (goto-char (point-max))
842 (dolist (header (cdr list))
843 (unless (nnshimbun-search-id group (mail-header-id header))
844 (mail-header-set-number header (setq i (1+ i)))
845 (nnheader-insert-nov header)))))))
847 (setq nnshimbun-wired-last-check (current-time)))))
849 (defun nnshimbun-wired-make-contents (header)
850 (goto-char (point-min))
851 (let (start (html t))
852 (when (and (search-forward "\n<!-- START_OF_BODY -->\n" nil t)
854 (search-forward "\n<!-- END_OF_BODY -->\n" nil t))
855 (delete-region (point-min) start)
857 (delete-region (point) (point-max))
858 (when (search-backward "<DIV ALIGN=\"RIGHT\">[
\e$BF|K\8l
\e(B" nil t)
859 (delete-region (point) (point-max)))
860 (goto-char (point-min))
861 (while (search-forward "<br>" nil t)
863 (nnweb-remove-markup)
864 (nnweb-decode-entities)
865 (goto-char (point-min))
866 (when (skip-chars-forward "\n")
867 (delete-region (point-min) (point)))
869 (nnshimbun-fill-line))
871 (goto-char (point-min))
872 (nnshimbun-insert-header header)
873 (insert "Content-Type: " (if html "text/html" "text/plain")
874 "; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
875 (encode-coding-string (buffer-string)
876 (mime-charset-to-coding-system "ISO-2022-JP"))))
881 ;;; nnshimbun.el ends here.