2001-06-13 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / nnslashdot.el

diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el
index 3762927..8d95721 100644 (file)
--- a/lisp/nnslashdot.el
+++ b/lisp/nnslashdot.el
@@ -1,5 +1,5 @@
 ;;; 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
@@ -57,6 +57,9 @@
     "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.")
 
@@ -155,7 +158,7 @@
                 "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
                (progn
                  (goto-char (- (match-end 0) 5))
-                 (setq from (concat 
+                 (setq from (concat
                              (nnweb-decode-entities-string (match-string 1))
                              " <" (match-string 2) ">")))
              (setq from "")
@@ -183,7 +186,7 @@
               (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) "%"
@@ -257,7 +260,7 @@
               "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
              (progn
                (goto-char (- (match-end 0) 5))
-               (setq from (concat 
+               (setq from (concat
                            (nnweb-decode-entities-string (match-string 1))
                            " <" (match-string 2) ">")))
            (setq from "")
@@ -284,7 +287,7 @@
             (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) "%"
@@ -385,9 +388,9 @@
        sid elem description articles gname)
     (condition-case why
         ;; First we do the Ultramode to get info on all the latest groups.
-       (progn 
+       (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>"))
@@ -397,14 +400,15 @@
                    (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.
@@ -425,13 +429,14 @@
                  (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)
@@ -496,6 +501,24 @@
   (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
@@ -519,7 +542,7 @@
 (defun nnslashdot-write-groups ()
   (with-temp-file (expand-file-name "groups" nnslashdot-directory)
     (prin1 nnslashdot-groups (current-buffer))))
-    
+
 (defun nnslashdot-init (server)
   "Initialize buffers and such."
   (unless (file-exists-p nnslashdot-directory)