;;; nnslashdot.el --- interfacing with Slashdot
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Commentary:
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
;;; Code:
(eval-when-compile (require 'cl))
(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml"
"Where nnslashdot will fetch the stories from.")
+(defvoo nnslashdot-use-front-page nil
+ "Use the front page in addition to the backslash page.")
+
(defvoo nnslashdot-threshold -1
"The article threshold.")
(entry (assoc group nnslashdot-groups))
(sid (nth 2 entry))
(first-comments t)
- headers article subject score from date lines parent point cid
+ headers article subject score from date lines parent point cid
s startats changed)
(save-excursion
(set-buffer nnslashdot-buffer)
(let ((case-fold-search t))
(erase-buffer)
(when (= start 1)
- (mm-url-insert (format nnslashdot-article-url
- (nnslashdot-sid-strip sid)) t)
+ (mm-url-insert (format nnslashdot-article-url sid) t)
(goto-char (point-min))
+ (if (eobp)
+ (error "Couldn't open connection to slashdot"))
(re-search-forward "Posted by[ \t\r\n]+")
(when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)")
(setq from (mm-url-decode-entities-string (match-string 2))))
1
(make-full-mail-header
1 group from date
- (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>")
+ (concat "<" sid "%1@slashdot>")
"" 0 lines nil nil))
headers)
(setq start (if nnslashdot-threaded 2 (pop articles))))
(while (and start (<= start last))
(setq point (goto-char (point-max)))
(mm-url-insert
- (format nnslashdot-comments-url
- (nnslashdot-sid-strip sid)
+ (format nnslashdot-comments-url sid
nnslashdot-threshold 0 (- start 2))
t)
(when (and nnslashdot-threaded first-comments)
(setq subject (concat "Re: " (substring subject (match-end 0)))))
(setq subject (mm-url-decode-entities-string subject))
(search-forward "<BR>")
- (if (looking-at
- "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
- (progn
- (goto-char (- (match-end 0) 5))
- (setq from (concat
- (mm-url-decode-entities-string (match-string 1))
- " <" (match-string 3) ">")))
- (setq from "")
- (when (looking-at "by \\([^<>]*\\) on ")
- (goto-char (- (match-end 0) 5))
- (setq from (mm-url-decode-entities-string (match-string 1)))))
- (search-forward " on ")
+ (cond
+ ((looking-at
+ "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 3) ">")))
+ ((looking-at "by[ \t\n]+<a[^>]+>\\([^<(]+\\) (\\([0-9]+\\))</a>")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 2) ">")))
+ ((looking-at "by \\([^<>]*\\)[\t\n\r ]+on ")
+ (goto-char (- (match-end 0) 5))
+ (setq from (mm-url-decode-entities-string (match-string 1))))
+ (t
+ (setq from "")))
+ (search-forward "on ")
(setq date
(nnslashdot-date-to-date
(buffer-substring (point) (progn (skip-chars-forward "^()<>\n\r") (point)))))
article
(concat subject " (" score ")")
from date
- (concat "<" (nnslashdot-sid-strip sid) "%" cid "@slashdot>")
+ (concat "<" sid "%" cid "@slashdot>")
(if parent
- (concat "<" (nnslashdot-sid-strip sid) "%"
- parent "@slashdot>")
+ (concat "<" sid "%" parent "@slashdot>")
"")
0 lines nil nil))
headers)
(while (and articles (<= (car articles) article))
(pop articles))
(setq article (1+ article)))
- (if nnslashdot-threaded
+ (if nnslashdot-threaded
(progn
(setq start (pop startats))
(if start (setq start (+ start 2))))
(when (numberp article)
(if (= article 1)
(progn
- (re-search-forward
+ (re-search-forward
"Posted by")
(search-forward "<BR>")
(setq contents
(point)
(progn
(re-search-forward
- "< [ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article")
+ "<IFRAME\\|<SCRIPT LANGUAGE=\"JAVASCRIPT\">\\|<!-- no ad 6 -->\\|< [ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article")
(match-beginning 0)))))
- (setq cid (cdr (assq article
+ (setq cid (cdr (assq article
(nth 4 (assoc group nnslashdot-groups)))))
(search-forward (format "<a name=\"%s\">" cid))
(setq contents
(deffoo nnslashdot-request-list (&optional server)
(nnslashdot-possibly-change-server nil server)
(let ((number 0)
+ (first nnslashdot-use-front-page)
sid elem description articles gname)
(condition-case why
;; First we do the Ultramode to get info on all the latest groups.
(mm-with-unibyte-buffer
(mm-url-insert nnslashdot-backslash-url t)
(goto-char (point-min))
+ (if (eobp)
+ (error "Couldn't open connection to slashdot"))
(while (search-forward "<story>" nil t)
(narrow-to-region (point) (search-forward "</story>"))
(goto-char (point-min))
(goto-char (point-max))
(widen)))
;; Then do the older groups.
- (while (> (- nnslashdot-group-number number) 0)
+ (while (or first
+ (> (- nnslashdot-group-number number) 0))
+ (setq first nil)
(mm-with-unibyte-buffer
(let ((case-fold-search t))
(mm-url-insert (format nnslashdot-active-url number) t)
(goto-char (point-min))
(while (re-search-forward
- "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>"
+ "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)</a>"
nil t)
(setq sid (match-string 1)
description
(mm-url-decode-entities-string (match-string 2)))
(forward-line 1)
- (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t)
- (setq articles (string-to-number (match-string 1))))
+ (when (re-search-forward "with \\([0-9]+\\) comment" nil t)
+ (setq articles (1+ (string-to-number (match-string 1)))))
(setq gname (concat description " (" sid ")"))
(if (setq elem (assoc gname nnslashdot-groups))
(setcar (cdr elem) articles)
(deffoo nnslashdot-request-post (&optional server)
(nnslashdot-possibly-change-server nil server)
- (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups")))
+ (let ((sid (message-fetch-field "newsgroups"))
(subject (message-fetch-field "subject"))
(references (car (last (split-string
(message-fetch-field "references")))))
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (elem nnslashdot-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
+ (when (numberp (cadr elem))
+ (insert (prin1-to-string (car elem))
+ " " (number-to-string (cadr elem)) " 1 y\n")))))
(defun nnslashdot-lose (why)
(error "Slashdot HTML has changed; please get a new version of nnslashdot"))
-(defalias 'nnslashdot-sid-strip 'identity)
-
(provide 'nnslashdot)
;;; nnslashdot.el ends here
projects / elisp / gnus.git- / blobdiff