2001-05-05 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
authorShengHuo ZHU <zsh@cs.rochester.edu>
Sun, 6 May 2001 05:07:27 +0000 (05:07 +0000)
committerShengHuo ZHU <zsh@cs.rochester.edu>
Sun, 6 May 2001 05:07:27 +0000 (05:07 +0000)
* nnslashdot.el (nnslashdot-request-expire-articles): Fix.

* nnrss.el (nnrss-open-server): Read server data when it is called.
(nnrss-request-expire-articles): Fix.

lisp/ChangeLog
lisp/nnrss.el
lisp/nnslashdot.el

index 7ea0ed8..ac86967 100644 (file)
@@ -1,3 +1,10 @@
+2001-05-05 15:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnslashdot.el (nnslashdot-request-expire-articles): Fix.
+
+       * nnrss.el (nnrss-open-server): Read server data when it is called.
+       (nnrss-request-expire-articles): Fix.
+
 2001-05-05 09:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
        * message.el (message-do-send-housekeeping): mail-abbrevs may
index 048e8c5..a174995 100644 (file)
@@ -33,6 +33,7 @@
 (require 'mm-util)
 (require 'gnus-util)
 (require 'time-date)
+(require 'rfc2231)
 (eval-when-compile
   (ignore-errors
     (require 'xml)
   t)
 
 (deffoo nnrss-open-server (server &optional defs connectionless)
+  (nnrss-read-server-data server)
   (nnoo-change-server 'nnrss server defs)
   t)
 
 (deffoo nnrss-request-expire-articles
     (articles group &optional server force)
   (nnrss-possibly-change-group group server)
-  (let (e days expirable)
+  (let (e days not-expirable changed)
     (dolist (art articles)
-      (when (setq e (assq art nnrss-group-data))
-      (if (nnmail-expired-article-p
-          group
-          (if (listp (setq days (nth 1 e))) days 
-            (days-to-time (- days (time-to-days '(0 0)))))
-          force)
-         (push art expirable)
-         (setq nnrss-group-data (delq e nnrss-group-data)))))
-    (if expirable
+      (if (and (setq e (assq art nnrss-group-data))
+              (nnmail-expired-article-p
+               group
+               (if (listp (setq days (nth 1 e))) days 
+                 (days-to-time (- days (time-to-days '(0 0)))))
+               force))
+         (setq nnrss-group-data (delq e nnrss-group-data)
+               changed t)
+       (push art not-expirable)))
+    (if changed
        (nnrss-save-group-data group server))
-    expirable))
+    not-expirable))
 
 (deffoo nnrss-request-delete-group (group &optional force server)
   (nnrss-possibly-change-group group server)
                                   (not (equal server ""))
                                   "-")
                        server ".el")) nnrss-directory)))
-    (delete-file file))
+    (ignore-errors
+      (delete-file file)))
   t)
 
 (deffoo nnrss-request-list-newsgroups (&optional server)
 (defun nnrss-possibly-change-group (&optional group server)
   (when (and server
             (not (nnrss-server-opened server)))
-    (nnrss-read-server-data server)
     (nnrss-open-server server))
   (when (and group (not (equal group nnrss-group)))
     (nnrss-read-group-data group server)
     (setq nnrss-group group)))
 
+(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
+
 (defun nnrss-generate-active ()
+  (if (y-or-n-p "Fetch extra categories?")
+      (dolist (func nnrss-extra-categories)
+       (funcall func)))
   (save-excursion
     (set-buffer nntp-server-buffer)
     (erase-buffer)
       (with-temp-buffer
        (let ((coding-system-for-read 'binary))
          (insert-file-contents file))
+       (emacs-lisp-mode)
        (goto-char (point-min))
        (eval-buffer)))))
 
       (with-temp-buffer
        (let ((coding-system-for-read 'binary))
          (insert-file-contents file))
+       (emacs-lisp-mode)
        (goto-char (point-min))
        (eval-buffer))
       (dolist (e nnrss-group-data)
@@ -483,17 +493,45 @@ It is useful when `(setq nnrss-use-local t)'."
   (insert "#!/bin/sh\n")
   (insert "WGET=wget\n")
   (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
-  (dolist (elem nnrss-group-alist)
+  (dolist (elem nnrss-server-data)
+    (let ((url (or (nth 2 elem)
+                  (second (assoc (car elem) nnrss-group-alist)))))
     (insert "$WGET -q -O \"$RSSDIR\"/'" 
            (nnrss-translate-file-chars (concat (car elem) ".xml"))
-           "' '"
-           (second elem) "'\n")))
+           "' '" url "'\n"))))
 
 (defun nnrss-translate-file-chars (name)
   (let ((nnheader-file-name-translation-alist
         (append nnheader-file-name-translation-alist '((?' . ?_)))))
     (nnheader-translate-file-chars name)))
 
+(defvar nnrss-moreover-url 
+  "http://w.moreover.com/categories/category_list_rss.html"
+  "The url of moreover.com categories.")
+
+(defun nnrss-snarf-moreover-categories ()
+  "Snarf RSS links from moreover.com."
+  (interactive)
+  (let (category name url changed)
+    (with-temp-buffer
+      (nnrss-insert nnrss-moreover-url)
+      (goto-char (point-min))
+      (while (re-search-forward 
+             "<A NAME=\"\\([^\"]+\\)\">\\|<A HREF=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
+       (if (match-string 1)
+           (setq category (match-string 1))
+         (setq url (match-string 2)
+               name (nnweb-decode-entities-string
+                     (rfc2231-decode-encoded-string 
+                      (match-string 3))))
+         (if category
+             (setq name (concat category "." name)))
+         (unless (assoc name nnrss-server-data)
+           (setq changed t)
+           (push (list name 0 url) nnrss-server-data)))))
+    (if changed
+       (nnrss-save-server-data ""))))
+
 (provide 'nnrss)
 
 ;;; nnrss.el ends here
index d761d04..8d95721 100644 (file)
 (deffoo nnslashdot-request-expire-articles
     (articles group &optional server force)
   (nnslashdot-possibly-change-server group server)
-  (let ((item (assoc group nnslashdot-groups)) expirable)
+  (let ((item (assoc group nnslashdot-groups)))
     (when item
       (if (fourth item)
          (when (and (>= (length articles) (cadr item)) ;; All are expirable.
                      force))
            (setq nnslashdot-groups (delq item nnslashdot-groups))
            (nnslashdot-write-groups)
-           (setq expirable articles))
+           (setq articles nil)) ;; all expired.
        (setcdr (cddr item) (list (current-time)))
-       (nnslashdot-write-groups)))
-    expirable))
+       (nnslashdot-write-groups))))
+  articles)
 
 (nnoo-define-skeleton nnslashdot)