(contents-start . "\n<!-- honbun start -->\n")
(contents-end . "\n<!-- honbun end -->\n"))
("zdnet"
- (url . "http://zdseek.pub.softbank.co.jp/news/")
+ (url . "http://www.zdnet.co.jp/news/")
(groups "comp")
(coding-system . ,(if (boundp 'MULE) '*sjis* 'shift_jis))
(generate-nov . nnshimbun-generate-nov-for-each-group)
(index-url . nnshimbun-url)
(from-address . "zdnn@softbank.co.jp")
(make-contents . nnshimbun-make-html-contents)
- (contents-start . "<!--BODY-->")
- (contents-end . "<!--BODYEND-->"))
+ (contents-start . "\\(<!--BODY-->\\|<!--DATE-->\\)")
+ (contents-end . "\\(<!--BODYEND-->\\|<!--BYLINEEND-->\\)"))
("mew"
(url . "http://www.mew.org/archive/")
(groups ,@(mapcar #'car nnshimbun-mew-groups))
(get-headers . nnshimbun-xemacs-get-headers)
(index-url . (nnshimbun-xemacs-concat-url nil))
(make-contents . nnshimbun-make-mhonarc-contents))
+ ("netbsd"
+ (url . "http://www.jp.netbsd.org/ja/JP/ml/")
+ (groups "announce-ja" "junk-ja" "tech-misc-ja" "tech-pkg-ja"
+ "port-arm32-ja" "port-hpcmips-ja" "port-mac68k-ja"
+ "port-mips-ja" "port-powerpc-ja" "hpcmips-changes-ja"
+ "members-ja" "admin-ja" "www-changes-ja")
+ (coding-system . ,(if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-jp))
+ (generate-nov . nnshimbun-generate-nov-for-each-group)
+ (get-headers . nnshimbun-netbsd-get-headers)
+ (index-url . (format "%s%s/index.html" nnshimbun-url nnshimbun-current-group))
+ (make-contents . nnshimbun-make-mhonarc-contents))
))
(defvar nnshimbun-x-face-alist
(nnheader-report 'nnml "Couldn't retrieve article: %s" (prin1-to-string article))
nil)))
+(defsubst nnshimbun-header-xref (x)
+ (if (and (setq x (mail-header-xref x))
+ (string-match "^Xref: " x))
+ (substring x 6)
+ x))
+
(defun nnshimbun-request-article-1 (article &optional group server to-buffer)
(if (nnshimbun-backlog
(gnus-backlog-request-article
(set-buffer (nnshimbun-open-nov group))
(and (nnheader-find-nov-line article)
(nnheader-parse-nov))))
- (let* ((xref (substring (mail-header-xref header) 6))
+ (let* ((xref (nnshimbun-header-xref header))
(x-faces (cdr (or (assoc (or server
(nnoo-current-server 'nnshimbun))
nnshimbun-x-face-alist)
(insert "Subject: " (or (mime-entity-fetch-field header 'Subject) "(none)") "\n"
"From: " (or (mime-entity-fetch-field header 'From) "(nobody)") "\n"
"Date: " (or (mail-header-date header) "") "\n"
- "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
- "References: " (or (mail-header-references header) "") "\n"
- "Lines: ")
- (princ (or (mail-header-lines header) 0) (current-buffer))
- (insert "\n")
- (if (mail-header-xref header)
- (insert (mail-header-xref header) "\n")))
+ "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n")
+ (let ((refs (mail-header-references header)))
+ (and refs
+ (string< "" refs)
+ (insert "References: " refs "\n")))
+ (insert "Lines: " (number-to-string (or (mail-header-lines header) 0)) "\n"
+ "Xref: " (nnshimbun-header-xref header) "\n"))
;; For pure Gnus.
(defun nnshimbun-insert-header (header)
(nnheader-insert-header header)
(delete-char -1)
- (if (mail-header-xref header)
- (insert (mail-header-xref header) "\n")))))
+ (insert "Xref: " (nnshimbun-header-xref header) "\n"))))
(deffoo nnshimbun-retrieve-headers (articles &optional group server fetch-old)
(when (nnshimbun-possibly-change-group group server)
(setq found t)))
(unless found
(goto-char (point-min))
- (when (search-forward (concat "X-Nnshimbun-Original-Id: " id) nil t)
+ (when (search-forward (concat "X-Nnshimbun-Id: " id) nil t)
(forward-line 0)
(setq found t)))
(if found
(when (nnheader-find-nov-line (mail-header-number header))
(dolist (arg args)
(if (eq (car arg) 'id)
- (let ((extra (mail-header-extra header)) x)
- (when (setq x (assq 'X-Nnshimbun-Original-Id extra))
- (setq extra (delq x extra)))
- (mail-header-set-extra
- header
- (cons (cons 'X-Nnshimbun-Original-Id (cdr arg)) extra)))
+ (let ((extra (mail-header-extra header)))
+ (unless (assq 'X-Nnshimbun-Id extra)
+ (mail-header-set-extra
+ header
+ (cons (cons 'X-Nnshimbun-Id (mail-header-id header))
+ extra)))
+ (mail-header-set-id header (cdr arg)))
(let ((func (intern (concat "mail-header-set-" (symbol-name (car arg))))))
(if (cdr arg) (eval (list func header (cdr arg)))))))
- (let ((xref (mail-header-xref header)))
- (when (string-match "^Xref: " xref)
- (mail-header-set-xref header (substring xref 6))))
+ (mail-header-set-xref header (nnshimbun-header-xref header))
(delete-region (point) (progn (forward-line 1) (point)))
(nnheader-insert-nov header))))
(defun nnshimbun-make-text-or-html-contents (header &optional x-face)
(let ((case-fold-search t) (html t) (start))
- (when (and (search-forward nnshimbun-contents-start nil t)
+ (when (and (re-search-forward nnshimbun-contents-start nil t)
(setq start (point))
- (search-forward nnshimbun-contents-end nil t))
+ (re-search-forward nnshimbun-contents-end nil t))
+ (delete-region (match-beginning 0) (point-max))
(delete-region (point-min) start)
- (delete-region (- (point) (length nnshimbun-contents-end)) (point-max))
(nnshimbun-shallow-rendering)
(setq html nil))
(goto-char (point-min))
(defun nnshimbun-make-html-contents (header &optional x-face)
(let (start)
- (when (and (search-forward nnshimbun-contents-start nil t)
+ (when (and (re-search-forward nnshimbun-contents-start nil t)
(setq start (point))
- (search-forward nnshimbun-contents-end nil t))
- (delete-region (point-min) start)
- (delete-region (- (point) (length nnshimbun-contents-end)) (point-max)))
+ (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"
(narrow-to-region (point-min) (point))
(nnweb-decode-entities)
(goto-char (point-min))
- (while (search-forward "<!--X-" nil t)
- (replace-match ""))
+ (while (search-forward "\n<!--X-" nil t)
+ (replace-match "\n"))
(goto-char (point-min))
- (while (search-forward " -->" nil t)
- (replace-match ""))
+ (while (search-forward " -->\n" nil t)
+ (replace-match "\n"))
(goto-char (point-min))
- (let (refs id)
+ (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 "Message-Id: ")
- (setq id (concat "<" (nnheader-header-value) ">"))
- (forward-line 1))
- ((looking-at "Reference: ")
+ ((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: ")
(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))))
+ (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
(delete-region start (point))))
(goto-char (point-min))
(while (re-search-forward
- "<a href=\"\\(\\([0-9][0-9]\\)\\([0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([^\\.]+\\).html\\)\"><font size=\"4\"><strong>"
+ "<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 2))))
- (month (string-to-number (match-string 3)))
- (day (string-to-number (match-string 4)))
+ (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 2)
(match-string 3)
(match-string 4)
(match-string 5)
+ (match-string 6)
nnshimbun-current-group))
- (url (match-string 1)))
+ (url (match-string 2)))
(push (make-full-mail-header
0
(nnshimbun-mime-encode-string
headers)))
(nreverse headers)))
+
+
;;; MLs on www.mew.org
(defmacro nnshimbun-mew-concat-url (url)
(forward-line -2)))))
headers)))))
+
+
;;; MLs on www.xemacs.org
(defmacro nnshimbun-xemacs-concat-url (url)
(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)))
(provide 'nnshimbun)
;;; nnshimbun.el ends here.
projects / elisp / gnus.git- / blobdiff