;;; nnslashdot.el --- interfacing with Slashdot
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
"http://slashdot.org/article.pl?sid=%s&mode=nocomment"
"Where nnslashdot will fetch the article from.")
+(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml"
+ "Where nnslashdot will fetch the stories from.")
+
(defvoo nnslashdot-threshold -1
"The article threshold.")
(nnslashdot-possibly-change-server group server)
(condition-case why
(unless gnus-nov-is-evil
- (if nnslashdot-threaded
- (nnslashdot-threaded-retrieve-headers articles group)
- (nnslashdot-sane-retrieve-headers articles group)))
+ (if nnslashdot-threaded
+ (nnslashdot-threaded-retrieve-headers articles group)
+ (nnslashdot-sane-retrieve-headers articles group)))
(search-failed (nnslashdot-lose why))))
-
+
(deffoo nnslashdot-threaded-retrieve-headers (articles group)
(let ((last (car (last articles)))
(did nil)
(nnweb-insert (format nnslashdot-article-url
(nnslashdot-sid-strip sid)) t)
(goto-char (point-min))
- (search-forward "Posted by ")
- (when (looking-at "<a[^>]+>\\([^<]+\\)")
+ (re-search-forward "Posted by[ \t\r\n]+")
+ (when (looking-at "<a[^>]+>[ \t\r\n]*\\([^<\r\n]+\\)")
(setq from (nnweb-decode-entities-string (match-string 1))))
(search-forward " on ")
(setq date (nnslashdot-date-to-date
(buffer-substring (point) (1- (search-forward "<")))))
- (forward-line 2)
- (setq lines (count-lines
- (point)
- (re-search-forward
- "A href=\"\\(http://slashdot.org\\)?/article" nil t)))
+ (setq lines (/ (- (point)
+ (progn (forward-line 1) (point)))
+ 60))
(push
(cons
1
score (match-string 5))
(when (string-match "^Re: *" subject)
(setq subject (concat "Re: " (substring subject (match-end 0)))))
- (setq subject (nnweb-decode-entities-string subject))
+ (setq subject (nnweb-decode-entities-string subject))
(forward-line 1)
(if (looking-at
"by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
- (setq from (concat (nnweb-decode-entities-string (match-string 1))
- " <" (match-string 2) ">"))
- (looking-at "by \\(.+\\) on ")
- (setq from (nnweb-decode-entities-string (match-string 1))))
- (goto-char (- (match-end 0) 5))
+ (progn
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (nnweb-decode-entities-string (match-string 1))
+ " <" (match-string 2) ">")))
+ (setq from "")
+ (when (looking-at "by \\(.+\\) on ")
+ (goto-char (- (match-end 0) 5))
+ (setq from (nnweb-decode-entities-string (match-string 1)))))
(search-forward " on ")
(setq date
(nnslashdot-date-to-date
(concat subject " (" score ")")
from date
(concat "<" (nnslashdot-sid-strip sid) "%"
- (number-to-string (1+ article))
+ (number-to-string (1+ article))
"@slashdot>")
(if parent
(concat "<" (nnslashdot-sid-strip sid) "%"
(nnweb-insert (format nnslashdot-article-url
(nnslashdot-sid-strip sid)) t)
(goto-char (point-min))
- (search-forward "Posted by ")
- (when (looking-at "<a[^>]+>\\([^<]+\\)")
+ (re-search-forward "Posted by[ \t\r\n]+")
+ (when (looking-at "<a[^>]+>[ \t\n\r]*\\([^<\r\n]+\\)")
(setq from (nnweb-decode-entities-string (match-string 1))))
(search-forward " on ")
(setq date (nnslashdot-date-to-date
(forward-line 2)
(setq lines (count-lines (point)
(re-search-forward
- "A href=\"\\(http://slashdot.org\\)?/article")))
+ "< <A href=\"\\(http://slashdot.org\\)?/article")))
(push
(cons
1
score (match-string 5))
(when (string-match "^Re: *" subject)
(setq subject (concat "Re: " (substring subject (match-end 0)))))
- (setq subject (nnweb-decode-entities-string subject))
+ (setq subject (nnweb-decode-entities-string subject))
(forward-line 1)
(if (looking-at
"by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
- (setq from (concat (nnweb-decode-entities-string (match-string 1))
- " <" (match-string 2) ">"))
- (looking-at "by \\(.+\\) on ")
- (setq from (nnweb-decode-entities-string (match-string 1))))
- (goto-char (- (match-end 0) 5))
+ (progn
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (nnweb-decode-entities-string (match-string 1))
+ " <" (match-string 2) ">")))
+ (setq from "")
+ (when (looking-at "by \\(.+\\) on ")
+ (goto-char (- (match-end 0) 5))
+ (setq from (nnweb-decode-entities-string (match-string 1)))))
(search-forward " on ")
(setq date
(nnslashdot-date-to-date
(1+ article) (concat subject " (" score ")")
from date
(concat "<" (nnslashdot-sid-strip sid) "%"
- (number-to-string (1+ article))
+ (number-to-string (1+ article))
"@slashdot>")
(if parent
(concat "<" (nnslashdot-sid-strip sid) "%"
(when (numberp article)
(if (= article 1)
(progn
- (re-search-forward "Posted by *<[^>]+>[^>]*<[^>]+> *on ")
+ (re-search-forward
+ "Posted by[ \t\r\n]+<[^>]+>[ \t\r\n]*[^>]*[ \t\r\n]*<[^>]+> *[ \t\r\n]*on ")
(search-forward "<BR>")
(setq contents
(buffer-substring
(point)
(progn
(re-search-forward
- "<p>.*A href=\"\\(http://slashdot.org\\)?/article")
+ "< [ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article")
(match-beginning 0)))))
(search-forward (format "<a name=\"%d\">" (1- article)))
(setq contents
(let ((number 0)
sid elem description articles gname)
(condition-case why
- ;; First we do the Ultramode to get info on all the latest groups.
- (progn
+ ;; First we do the Ultramode to get info on all the latest groups.
+ (progn
(mm-with-unibyte-buffer
- (nnweb-insert "http://slashdot.org/slashdot.xml" t)
+ (nnweb-insert nnslashdot-backslash-url t)
(goto-char (point-min))
(while (search-forward "<story>" nil t)
(narrow-to-region (point) (search-forward "</story>"))
(nnweb-decode-entities-string (match-string 1)))
(re-search-forward "<url>\\([^<]+\\)</url>")
(setq sid (match-string 1))
- (string-match "/\\([0-9/]+\\)\\(.shtml\\|$\\)" sid)
- (setq sid (concat "00/" (match-string 1 sid)))
+ (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid)
+ (setq sid (match-string 1 sid))
(re-search-forward "<comments>\\([^<]+\\)</comments>")
(setq articles (string-to-number (match-string 1)))
(setq gname (concat description " (" sid ")"))
(if (setq elem (assoc gname nnslashdot-groups))
(setcar (cdr elem) articles)
- (push (list gname articles sid) nnslashdot-groups))
+ (push (list gname articles sid (current-time))
+ nnslashdot-groups))
(goto-char (point-max))
(widen)))
;; Then do the older groups.
(setq gname (concat description " (" sid ")"))
(if (setq elem (assoc gname nnslashdot-groups))
(setcar (cdr elem) articles)
- (push (list gname articles sid) nnslashdot-groups)))))
+ (push (list gname articles sid (current-time))
+ nnslashdot-groups)))))
(incf number 30)))
(search-failed (nnslashdot-lose why)))
(nnslashdot-write-groups)
(nnslashdot-generate-active)
t))
-
+
(deffoo nnslashdot-request-newgroups (date &optional server)
(nnslashdot-possibly-change-server nil server)
(nnslashdot-generate-active)
nnslashdot-groups))
(nnslashdot-write-groups))
+(deffoo nnslashdot-request-close ()
+ (setq nnslashdot-headers nil
+ nnslashdot-groups nil))
+
+(deffoo nnslashdot-request-expire-articles
+ (articles group &optional server force)
+ (nnslashdot-possibly-change-server group server)
+ (let ((item (assoc group nnslashdot-groups)))
+ (when item
+ (if (fourth item)
+ (when (and (>= (length articles) (cadr item)) ;; All are expirable.
+ (nnmail-expired-article-p
+ group
+ (fourth item)
+ force))
+ (setq nnslashdot-groups (delq item nnslashdot-groups))
+ (nnslashdot-write-groups)
+ (setq articles nil)) ;; all expired.
+ (setcdr (cddr item) (list (current-time)))
+ (nnslashdot-write-groups))))
+ articles)
+
(nnoo-define-skeleton nnslashdot)
;;; Internal functions
(defun nnslashdot-write-groups ()
(with-temp-file (expand-file-name "groups" nnslashdot-directory)
- (prin1 nnslashdot-groups (current-buffer))))
-
+ (gnus-prin1 nnslashdot-groups)))
+
(defun nnslashdot-init (server)
"Initialize buffers and such."
(unless (file-exists-p nnslashdot-directory)
(setq nnslashdot-buffer
(save-excursion
(nnheader-set-temp-buffer
- (format " *nnslashdot %s*" server))))))
+ (format " *nnslashdot %s*" server))))
+ (push nnslashdot-buffer gnus-buffers)))
(defun nnslashdot-date-to-date (sdate)
(condition-case err
(defun nnslashdot-lose (why)
(error "Slashdot HTML has changed; please get a new version of nnslashdot"))
-;(defun nnslashdot-sid-strip (sid)
-; (if (string-match "^00/" sid)
-; (substring sid (match-end 0))
-; sid))
-
(defalias 'nnslashdot-sid-strip 'identity)
(provide 'nnslashdot)
projects / gnus / blobdiff