-(eval-and-compile
- (if (fboundp 'eword-encode-string)
- ;; For Semi-Gnus.
- (defun nnshimbun-mime-encode-string (string)
- (mapconcat
- #'identity
- (split-string (eword-encode-string (nnweb-decode-entities-string string)) "\n")
- ""))
- ;; For pure Gnus.
- (defun nnshimbun-mime-encode-string (string)
- (mapconcat
- #'identity
- (split-string
- (with-temp-buffer
- (insert (nnweb-decode-entities-string string))
- (rfc2047-encode-region (point-min) (point-max))
- (buffer-substring (point-min) (point-max)))
- "\n")
- ""))))
-
-(defun nnshimbun-lapse-seconds (time)
- (let ((now (current-time)))
- (+ (* (- (car now) (car time)) 65536)
- (- (nth 1 now) (nth 1 time)))))
-
-(defun nnshimbun-make-date-string (year month day &optional time)
- (format "%02d %s %04d %s +0900"
- day
- (aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun"
- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
- month)
- (cond ((< year 69)
- (+ year 2000))
- ((< year 100)
- (+ year 1900))
- ((< year 1000) ; possible 3-digit years.
- (+ year 1900))
- (t year))
- (or time "00:00")))
-
-(if (fboundp 'regexp-opt)
- (defalias 'nnshimbun-regexp-opt 'regexp-opt)
- (defun nnshimbun-regexp-opt (strings &optional paren)
- "Return a regexp to match a string in STRINGS.
-Each string should be unique in STRINGS and should not contain any regexps,
-quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
-is enclosed by at least one regexp grouping construct."
- (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" "")))
- (concat open-paren (mapconcat 'regexp-quote strings "\\|") close-paren))))
-
-
-;; Fast fill-region function
-
-(defvar nnshimbun-fill-column (min 80 (- (frame-width) 4)))
-
-(defconst nnshimbun-kinsoku-bol-list
- (funcall
- (if (fboundp 'string-to-char-list)
- 'string-to-char-list
- 'string-to-list) "\
-!)-_~}]:;',.?\e$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?!@!A\e(B\
-\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"))
-
-(defconst nnshimbun-kinsoku-eol-list
- (funcall
- (if (fboundp 'string-to-char-list)
- 'string-to-char-list
- 'string-to-list)
- "({[`\e$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!x\e(B"))
-
-(defun nnshimbun-fill-line ()
- (forward-line 0)
- (let ((top (point)) chr)
- (while (if (>= (move-to-column nnshimbun-fill-column)
- nnshimbun-fill-column)
- (not (progn
- (if (memq (preceding-char) nnshimbun-kinsoku-eol-list)
- (progn
- (backward-char)
- (while (memq (preceding-char) nnshimbun-kinsoku-eol-list)
- (backward-char))
- (insert "\n"))
- (while (memq (setq chr (following-char)) nnshimbun-kinsoku-bol-list)
- (forward-char))
- (if (looking-at "\\s-+")
- (or (eolp) (delete-region (point) (match-end 0)))
- (or (> (char-width chr) 1)
- (re-search-backward "\\<" top t)
- (end-of-line)))
- (or (eolp) (insert "\n"))))))
- (setq top (point))))
- (forward-line 1)
- (not (eobp)))
-
-(defsubst nnshimbun-shallow-rendering ()
- (goto-char (point-min))
- (while (search-forward "<p>" nil t)
- (insert "\n\n"))
- (goto-char (point-min))
- (while (search-forward "<br>" nil t)
- (insert "\n"))
- (nnweb-remove-markup)
- (nnweb-decode-entities)
- (goto-char (point-min))
- (while (nnshimbun-fill-line))
- (goto-char (point-min))
- (when (skip-chars-forward "\n")
- (delete-region (point-min) (point)))
- (while (search-forward "\n\n" nil t)
- (let ((p (point)))
- (when (skip-chars-forward "\n")
- (delete-region p (point)))))
- (goto-char (point-max))
- (when (skip-chars-backward "\n")
- (delete-region (point) (point-max)))
- (insert "\n"))
-
-(defun nnshimbun-make-text-or-html-contents (header &optional x-face)
- (let ((case-fold-search t) (html t) (start))
- (when (and (re-search-forward nnshimbun-contents-start nil t)
- (setq start (point))
- (re-search-forward nnshimbun-contents-end nil t))
- (delete-region (match-beginning 0) (point-max))
- (delete-region (point-min) start)
- (nnshimbun-shallow-rendering)
- (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")
- (when x-face
- (insert x-face)
- (unless (bolp)
- (insert "\n")))
- (insert "\n")
- (encode-coding-string (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP"))))
-
-(defun nnshimbun-make-html-contents (header &optional x-face)
- (let (start)
- (when (and (re-search-forward nnshimbun-contents-start nil t)
- (setq start (point))
- (re-search-forward nnshimbun-contents-end nil t))
- (delete-region (match-beginning 0) (point-max))
- (delete-region (point-min) start))
- (goto-char (point-min))
- (nnshimbun-insert-header header)
- (insert "Content-Type: text/html; charset=ISO-2022-JP\n"
- "MIME-Version: 1.0\n")
- (when x-face
- (insert x-face)
- (unless (bolp)
- (insert "\n")))
- (insert "\n")
- (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 "\n<!--X-" nil t)
- (replace-match "\n"))
- (goto-char (point-min))
- (while (search-forward " -->\n" nil t)
- (replace-match "\n"))
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (let (buf refs)
- (while (not (eobp))
- (cond
- ((looking-at "<!--")
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Subject: +")
- (push (cons 'subject (nnheader-header-value)) buf)
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "From: +")
- (push (cons 'from (nnheader-header-value)) buf)
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Date: +")
- (push (cons 'date (nnheader-header-value)) buf)
- (delete-region (point) (progn (forward-line 1) (point))))
- ((looking-at "Message-Id: +")
- (push (cons 'id (concat "<" (nnheader-header-value) ">")) buf)
- (delete-region (point) (progn (forward-line 1) (point))))
- ((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))))
- (insert "MIME-Version: 1.0\n")
- (if refs (push (cons 'references (mapconcat 'identity refs " ")) buf))
- (nnshimbun-nov-fix-header nnshimbun-current-group header buf)
- (goto-char (point-min))
- (nnshimbun-insert-header header))
- (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")))
-
-(defun nnshimbun-make-fml-contents (header &rest args)
- (require 'mml)
- (catch 'stop
- (if (search-forward "<SPAN CLASS=mailheaders>" nil t)
- (delete-region (point-min) (point))
- (throw 'stop nil))
- (if (search-forward "</PRE>")
- (progn
- (beginning-of-line)
- (delete-region (point) (point-max)))
- (throw 'stop nil))
- (if (search-backward "</SPAN>")
- (progn
- (beginning-of-line)
- (kill-line))
- (throw 'stop nil))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (nnweb-decode-entities)
- (goto-char (point-min))
- (let (buf field value start value-beg end)
- (while (and (setq start (point))
- (re-search-forward "<SPAN CLASS=\\(.*\\)>\\(.*\\)</SPAN>:"
- nil t)
- (setq field (match-string 2))
- (re-search-forward
- (concat "<SPAN CLASS=" (match-string 1) "-value>") nil t)
- (setq value-beg (point))
- (search-forward "</SPAN>" nil t)
- (setq end (point)))
- (setq value (buffer-substring value-beg
- (progn (search-backward "</SPAN>")
- (point))))
- (delete-region start end)
- (cond ((string= field "Date")
- (push (cons 'date value) buf))
- ((string= field "From")
- (push (cons 'from value) buf))
- ((string= field "Subject")
- (push (cons 'subject value) buf))
- ((string= field "Message-Id")
- (push (cons 'id value) buf))
- ((string= field "References")
- (push (cons 'references value) buf))
- (t
- (insert (concat field ": " value "\n")))))
- (nnshimbun-nov-fix-header nnshimbun-current-group header buf)
- (goto-char (point-min))
- (nnshimbun-insert-header header))
- (goto-char (point-max)))
- ;; Processing body.
- (save-restriction
- (narrow-to-region (point) (point-max))
- (nnweb-remove-markup)
- (nnweb-decode-entities)))
- (encode-coding-string (buffer-string)
- (mime-charset-to-coding-system "ISO-2022-JP")))
-
-;;; www.asahi.com
-
-(defun nnshimbun-asahi-get-headers ()
- (when (search-forward "\n<!-- Start of past -->\n" nil t)
- (delete-region (point-min) (point))
- (when (search-forward "\n<!-- End of past -->\n" nil t)
- (forward-line -1)
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (let (headers)
- (while (re-search-forward
- "^\e$B"#\e(B<a href=\"\\(\\([0-9][0-9][0-9][0-9]\\)/past/\\([A-z]*[0-9]*\\)\\.html\\)\"> *"
- nil t)
- (let ((id (format "<%s%s%%%s>"
- (match-string 2)
- (match-string 3)
- nnshimbun-current-group))
- (url (match-string 1)))
- (push (make-full-mail-header
- 0
- (nnshimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "<br>" nil t) (point)))
- "\\(<[^>]+>\\|\r\\)")
- ""))
- nnshimbun-from-address
- "" id "" 0 0 (concat nnshimbun-url url))
- headers)))
- (setq headers (nreverse headers))
- (let ((i 0))
- (while (and (nth i headers)
- (re-search-forward
- "^\\[\\([0-9][0-9]\\)/\\([0-9][0-9]\\) \\([0-9][0-9]:[0-9][0-9]\\)\\]"
- nil t))
- (let ((month (string-to-number (match-string 1)))
- (date (decode-time (current-time))))
- (mail-header-set-date
- (nth i headers)
- (nnshimbun-make-date-string
- (if (and (eq 12 month) (eq 1 (nth 4 date)))
- (1- (nth 5 date))
- (nth 5 date))
- month
- (string-to-number (match-string 2))
- (match-string 3))))
- (setq i (1+ i))))
- (nreverse headers)))))
-
-
-
-;;; www.sponichi.co.jp
-
-(defun nnshimbun-sponichi-get-headers ()
- (when (search-forward "\e$B%K%e!<%9%$%s%G%C%/%9\e(B" nil t)
- (delete-region (point-min) (point))
- (when (search-forward "\e$B%"%I%?%0\e(B" nil t)
- (forward-line 2)
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (let ((case-fold-search t) headers)
- (while (re-search-forward
- "^<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\\)\">"
- nil t)
- (let ((url (match-string 1))
- (id (format "<%s%s%s%s%%%s>"
- (match-string 3)
- (match-string 4)
- (match-string 5)
- (match-string 6)
- nnshimbun-current-group))
- (date (nnshimbun-make-date-string
- (string-to-number (match-string 3))
- (string-to-number (match-string 4))
- (string-to-number (match-string 5)))))
- (push (make-full-mail-header
- 0
- (nnshimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "<br>" nil t) (point)))
- "<[^>]+>")
- ""))
- nnshimbun-from-address
- date id "" 0 0 (concat nnshimbun-url url))
- headers)))
- headers))))
-
-
-
-;;; CNET Japan
-
-(defun nnshimbun-cnet-get-headers ()
- (let ((case-fold-search t) headers)
- (while (search-forward "\n<!--*****\e$B8+=P$7\e(B*****-->\n" nil t)
- (let ((subject (buffer-substring (point) (gnus-point-at-eol)))
- (point (point)))
- (forward-line -2)
- (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\\)\">")
- (let ((url (match-string 1))
- (id (format "<%s%s%%%s>"
- (match-string 2)
- (match-string 3)
- nnshimbun-current-group))
- (date (nnshimbun-make-date-string
- (string-to-number (match-string 2))
- (string-to-number (match-string 4))
- (string-to-number (match-string 5)))))
- (push (make-full-mail-header
- 0
- (nnshimbun-mime-encode-string subject)
- nnshimbun-from-address
- date id "" 0 0 (concat nnshimbun-url url))
- headers)))
- (goto-char point)))
- headers))
-
-
-
-;;; Wired
-
-(defun nnshimbun-wired-get-all-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)
- (nnshimbun-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)))
- "<[^>]+>")
- ""))
- nnshimbun-from-address
- date id "" 0 0 url))
- (x (assoc group group-header-alist)))
- (setcdr x (cons header (cdr x))))))
- group-header-alist)))
-
-
-
-;;; www.yomiuri.co.jp
-
-(defun nnshimbun-yomiuri-get-all-headers ()
- (save-excursion
- (set-buffer nnshimbun-buffer)
- (erase-buffer)
- (nnshimbun-retrieve-url (eval nnshimbun-index-url) t)
- (let ((case-fold-search t)
- (group-header-alist (mapcar (lambda (g) (cons g nil)) nnshimbun-groups)))
- (dolist (group nnshimbun-groups)
- (let (start)
- (goto-char (point-min))
- (when (and (search-forward (format "\n<!-- /news/%s=start -->\n" group) nil t)
- (setq start (point))
- (search-forward (format "\n<!-- /news/%s=end -->\n" group) nil t))
- (forward-line -1)
- (save-restriction
- (narrow-to-region start (point))
- (goto-char start)
- (while (re-search-forward
- "<a href=\"/\\([0-9]+\\)/\\(\\(\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)[A-z0-9]+\\)\\.htm\\)\"[^>]*>"
- nil t)
- (let ((url (concat (match-string 1) "a/" (match-string 2)))
- (id (format "<%s%s%%%s>"
- (match-string 1)
- (match-string 3)
- group))
- (year (string-to-number (match-string 4)))
- (month (string-to-number (match-string 5)))
- (day (string-to-number (match-string 6)))
- (subject (mapconcat
- 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "<br>" nil t) (point)))
- "<[^>]+>")
- ""))
- date x)
- (when (string-match "^\e$B"!\e(B" subject)
- (setq subject (substring subject (match-end 0))))
- (if (string-match "(\\([0-9][0-9]:[0-9][0-9]\\))$" subject)
- (setq date (nnshimbun-make-date-string
- year month day (match-string 1 subject))
- subject (substring subject 0 (match-beginning 0)))
- (setq date (nnshimbun-make-date-string year month day)))
- (setcdr (setq x (assoc group group-header-alist))
- (cons (make-full-mail-header
- 0
- (nnshimbun-mime-encode-string subject)
- nnshimbun-from-address
- date id "" 0 0 (concat nnshimbun-url url))
- (cdr x)))))))))
- group-header-alist)))
-
-
-
-;;; Zdnet Japan
-
-(defun nnshimbun-zdnet-get-headers ()
- (let ((case-fold-search t) headers)
- (goto-char (point-min))
- (let (start)
- (while (and (search-forward "<!--" nil t)
- (setq start (- (point) 4))
- (search-forward "-->" nil t))
- (delete-region start (point))))
- (goto-char (point-min))
- (while (re-search-forward
- "<a href=\"\\(/news/\\)?\\(\\([0-9][0-9]\\)\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([^\\.]+\\).html\\)\"><font size=\"4\"><strong>"
- nil t)
- (let ((year (+ 2000 (string-to-number (match-string 3))))
- (month (string-to-number (match-string 4)))
- (day (string-to-number (match-string 5)))
- (id (format "<%s%s%s%s%%%s>"
- (match-string 3)
- (match-string 4)
- (match-string 5)
- (match-string 6)
- nnshimbun-current-group))
- (url (match-string 2)))
- (push (make-full-mail-header
- 0
- (nnshimbun-mime-encode-string
- (mapconcat 'identity
- (split-string
- (buffer-substring
- (match-end 0)
- (progn (search-forward "</a>" nil t) (point)))
- "<[^>]+>")
- ""))
- nnshimbun-from-address
- (nnshimbun-make-date-string year month day)
- id "" 0 0 (concat nnshimbun-url url))
- 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=\"/" 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))
-
-;;; MLs on www.jp.netbsd.org
-
-(defun nnshimbun-netbsd-get-headers ()
- (let ((case-fold-search t) headers months)
- (goto-char (point-min))
- (while (re-search-forward "<A HREF=\"\\([0-9]+\\)/\\(threads.html\\)?\">" nil t)
- (push (match-string 1) months))
- (setq months (nreverse months))
- (catch 'exit
- (dolist (month months)
- (erase-buffer)
- (nnshimbun-retrieve-url
- (format "%s%s/%s/maillist.html" nnshimbun-url nnshimbun-current-group month)
- t)
- (let (id url subject)
- (while (re-search-forward
- "<A[^>]*HREF=\"\\(msg\\([0-9]+\\)\\.html\\)\">\\([^<]+\\)</A>"
- nil t)
- (setq url (format "%s%s/%s/%s"
- nnshimbun-url
- nnshimbun-current-group
- month
- (match-string 1))
- id (format "<%s%05d%%%s>"
- month
- (string-to-number (match-string 2))
- nnshimbun-current-group)
- subject (match-string 3))
- (if (nnshimbun-search-id nnshimbun-current-group id)
- (throw 'exit headers)
- (push (make-full-mail-header
- 0
- (nnshimbun-mime-encode-string subject)
- (if (looking-at "</STRONG> *<EM>\\([^<]+\\)<")
- (nnshimbun-mime-encode-string (match-string 1))
- "")
- "" id "" 0 0 url)
- headers)))))
- headers)))
-
-;;; MLs using fml
-(defun nnshimbun-fml-get-headers ()
- (let (headers auxs aux)
- (catch 'stop
- (while (re-search-forward "<a href=\"\\([0-9]+\\(\\.week\\|\\.month\\)?\\)/index.html\">" nil t)
- (setq auxs (append auxs (list (match-string 1)))))
- (while auxs
- (erase-buffer)
- (nnshimbun-retrieve-url
- (concat nnshimbun-url (setq aux (car auxs)) "/"))
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (let (id url date subject from)
- (goto-char (point-min))
- (while (re-search-forward
- "<LI><A HREF=\"\\([0-9]+\\.html\\)\">Article .*</A> <DIV><SPAN CLASS=article>Article <SPAN CLASS=article-value>\\([0-9]+\\)</SPAN></SPAN> at <SPAN CLASS=Date-value>\\([^<]*\\)</SPAN> <SPAN CLASS=Subject>Subject: <SPAN CLASS=Subject-value>\\([^<]*\\)</SPAN></SPAN></DIV><DIV><SPAN CLASS=From>From: <SPAN CLASS=From-value>\\([^<]*\\)</SPAN></SPAN></DIV>"
- nil t)
- (setq url (concat nnshimbun-url aux "/" (match-string 1))
- id (format "<%s%05d%%%s>"
- aux
- (string-to-number (match-string 2))
- nnshimbun-current-group)
- date (match-string 3)
- subject (match-string 4)
- from (match-string 5))
- (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)
- from date id "" 0 0 url)
- headers))
-; (message "%s" id)))
- (setq auxs (cdr auxs))))
- headers))