X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fnnslashdot.el;h=8d9572167e21689f92d712ae1618c21e1a317e7a;hb=6ddf4efe9c1528cc39fb33ffd455351316cc3d1f;hp=376292773505453963c145ca17a053aa8e13115e;hpb=c76d62c3c345a91830dd538955507cfff655114e;p=gnus

diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el
index 376292773..8d9572167 100644
--- 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)