X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnslashdot.el;h=b122cd71a84968098efc75de3167444d6a4d41da;hb=f9e54240fc63f1ead8962e2afbc9b75e53994cd5;hp=23dae0d56e7e7b2b83a24d07b44886ff9bd8d341;hpb=027a90912122f2cb3e36d82310f32962e3ce2f71;p=elisp%2Fgnus.git- diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 23dae0d..b122cd7 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -29,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'nnoo) (require 'message) @@ -57,6 +58,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.") @@ -90,7 +94,7 @@ (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) @@ -104,7 +108,8 @@ (let ((case-fold-search t)) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url sid) t) + (nnweb-insert (format nnslashdot-article-url + (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (search-forward "Posted by ") (when (looking-at "]+>\\([^<]+\\)") @@ -112,23 +117,24 @@ (search-forward " on ") (setq date (nnslashdot-date-to-date (buffer-substring (point) (1- (search-forward "<"))))) - (forward-line 2) - (setq lines (count-lines - (point) - (search-forward - "A href=http://slashdot.org/article" nil t))) + (setq lines (/ (- (point) + (progn (forward-line 1) (point))) + 60)) (push (cons 1 (make-full-mail-header - 1 group from date (concat "<" sid "%1@slashdot>") + 1 group from date + (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") "" 0 lines nil nil)) headers)) (while (and (setq start (pop startats)) (< start last)) (setq point (goto-char (point-max))) (nnweb-insert - (format nnslashdot-comments-url sid nnslashdot-threshold 0 start) + (format nnslashdot-comments-url + (nnslashdot-sid-strip sid) + nnslashdot-threshold 0 start) t) (when first-comments (setq first-comments nil) @@ -151,11 +157,15 @@ (forward-line 1) (if (looking-at "by ]+>\\([^<]+\\)[ \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 @@ -163,7 +173,7 @@ (setq lines (/ (abs (- (search-forward ""))) 70)) - (forward-line 2) + (forward-line 4) (setq parent (if (looking-at ".*cid=\\([0-9]+\\)") (match-string 1) @@ -176,11 +186,11 @@ (1+ article) (concat subject " (" score ")") from date - (concat "<" sid "%" - (number-to-string (1+ article)) + (concat "<" (nnslashdot-sid-strip sid) "%" + (number-to-string (1+ article)) "@slashdot>") (if parent - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ (string-to-number parent))) "@slashdot>") "") @@ -190,8 +200,9 @@ (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header)))) + (mm-with-unibyte-current-buffer + (dolist (header nnslashdot-headers) + (nnheader-insert-nov (cdr header))))) 'nov)) (deffoo nnslashdot-sane-retrieve-headers (articles group) @@ -204,7 +215,8 @@ (set-buffer nnslashdot-buffer) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url sid) t) + (nnweb-insert (format nnslashdot-article-url + (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (search-forward "Posted by ") (when (looking-at "]+>\\([^<]+\\)") @@ -214,13 +226,14 @@ (buffer-substring (point) (1- (search-forward "<"))))) (forward-line 2) (setq lines (count-lines (point) - (search-forward - "A href=http://slashdot.org/article"))) + (re-search-forward + "A href=\"\\(http://slashdot.org\\)?/article"))) (push (cons 1 (make-full-mail-header - 1 group from date (concat "<" sid "%1@slashdot>") + 1 group from date (concat "<" (nnslashdot-sid-strip sid) + "%1@slashdot>") "" 0 lines nil nil)) headers)) (while (or (not article) @@ -230,7 +243,8 @@ (setq start (1+ article))) (setq point (goto-char (point-max))) (nnweb-insert - (format nnslashdot-comments-url sid nnslashdot-threshold 4 start) + (format nnslashdot-comments-url (nnslashdot-sid-strip sid) + nnslashdot-threshold 4 start) t) (goto-char point) (while (re-search-forward @@ -245,11 +259,15 @@ (forward-line 1) (if (looking-at "by ]+>\\([^<]+\\)[ \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 @@ -269,11 +287,11 @@ (make-full-mail-header (1+ article) (concat subject " (" score ")") from date - (concat "<" sid "%" - (number-to-string (1+ article)) + (concat "<" (nnslashdot-sid-strip sid) "%" + (number-to-string (1+ article)) "@slashdot>") (if parent - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ (string-to-number parent))) "@slashdot>") "") @@ -284,8 +302,9 @@ (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header)))) + (mm-with-unibyte-current-buffer + (dolist (header nnslashdot-headers) + (nnheader-insert-nov (cdr header))))) 'nov)) (deffoo nnslashdot-request-group (group &optional server dont-check) @@ -329,7 +348,7 @@ (point) (progn (re-search-forward - "

.*A href=http://slashdot\\.org/article") + "

.*A href=\"\\(http://slashdot.org\\)?/article") (match-beginning 0))))) (search-forward (format "" (1- article))) (setq contents @@ -342,17 +361,18 @@ (save-excursion (set-buffer (or buffer nntp-server-buffer)) (erase-buffer) - (insert contents) - (goto-char (point-min)) - (while (re-search-forward "\\(
\r?\\)+" nil t) - (replace-match "

" t t)) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) - "\n") - (let ((header (cdr (assq article nnslashdot-headers)))) - (nnheader-insert-header header)) - (nnheader-report 'nnslashdot "Fetched article %s" article) + (mm-with-unibyte-current-buffer + (insert contents) + (goto-char (point-min)) + (while (re-search-forward "\\(
\r?\\)+" nil t) + (replace-match "

" t t)) + (goto-char (point-min)) + (insert "Content-Type: text/html\nMIME-Version: 1.0\n") + (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) + "\n") + (let ((header (cdr (assq article nnslashdot-headers)))) + (nnheader-insert-header header)) + (nnheader-report 'nnslashdot "Fetched article %s" article)) (cons group article))))) (deffoo nnslashdot-close-server (&optional server) @@ -369,25 +389,27 @@ 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 "" nil t) (narrow-to-region (point) (search-forward "")) (goto-char (point-min)) (re-search-forward "\\([^<]+\\)") - (setq description (nnweb-decode-entities-string (match-string 1))) + (setq description + (nnweb-decode-entities-string (match-string 1))) (re-search-forward "\\([^<]+\\)") (setq sid (match-string 1)) - (string-match "/\\([0-9/]+\\).shtml" sid) + (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) (setq sid (match-string 1 sid)) (re-search-forward "\\([^<]+\\)") (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. @@ -397,22 +419,25 @@ (nnweb-insert (format nnslashdot-active-url number) t) (goto-char (point-min)) (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" nil t) + "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" + nil t) (setq sid (match-string 1) - description (nnweb-decode-entities-string (match-string 2))) + description + (nnweb-decode-entities-string (match-string 2))) (forward-line 1) (when (re-search-forward "\\([0-9]+\\)" nil t) (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))))) (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) @@ -420,7 +445,7 @@ (deffoo nnslashdot-request-post (&optional server) (nnslashdot-possibly-change-server nil server) - (let ((sid (message-fetch-field "newsgroups")) + (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) (subject (message-fetch-field "subject")) (references (car (last (split-string (message-fetch-field "references"))))) @@ -473,6 +498,28 @@ 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 @@ -496,7 +543,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) @@ -529,6 +576,13 @@ (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) ;;; nnslashdot.el ends here