1 |
;;; nnslashdot.el --- interfacing with Slashdot |
;;; nnslashdot.el --- interfacing with Slashdot |
2 |
;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 |
;; Keywords: news |
;; Keywords: news |
23 |
|
|
24 |
;;; Commentary: |
;;; Commentary: |
25 |
|
|
|
;; Note: You need to have `url' and `w3' installed for this |
|
|
;; backend to work. |
|
|
|
|
26 |
;;; Code: |
;;; Code: |
27 |
|
|
28 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
33 |
(require 'gnus) |
(require 'gnus) |
34 |
(require 'nnmail) |
(require 'nnmail) |
35 |
(require 'mm-util) |
(require 'mm-util) |
36 |
(eval-when-compile |
(require 'mm-url) |
|
(ignore-errors |
|
|
(require 'nnweb))) |
|
|
;; Report failure to find w3 at load time if appropriate. |
|
|
(eval '(require 'nnweb)) |
|
37 |
|
|
38 |
(nnoo-declare nnslashdot) |
(nnoo-declare nnslashdot) |
39 |
|
|
53 |
(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" |
(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" |
54 |
"Where nnslashdot will fetch the stories from.") |
"Where nnslashdot will fetch the stories from.") |
55 |
|
|
56 |
|
(defvoo nnslashdot-use-front-page nil |
57 |
|
"Use the front page in addition to the backslash page.") |
58 |
|
|
59 |
(defvoo nnslashdot-threshold -1 |
(defvoo nnslashdot-threshold -1 |
60 |
"The article threshold.") |
"The article threshold.") |
61 |
|
|
101 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
102 |
(erase-buffer) |
(erase-buffer) |
103 |
(when (= start 1) |
(when (= start 1) |
104 |
(nnweb-insert (format nnslashdot-article-url |
(mm-url-insert (format nnslashdot-article-url sid) t) |
|
(nnslashdot-sid-strip sid)) t) |
|
105 |
(goto-char (point-min)) |
(goto-char (point-min)) |
106 |
|
(if (eobp) |
107 |
|
(error "Couldn't open connection to slashdot")) |
108 |
(re-search-forward "Posted by[ \t\r\n]+") |
(re-search-forward "Posted by[ \t\r\n]+") |
109 |
(when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") |
(when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") |
110 |
(setq from (nnweb-decode-entities-string (match-string 2)))) |
(setq from (mm-url-decode-entities-string (match-string 2)))) |
111 |
(search-forward "on ") |
(search-forward "on ") |
112 |
(setq date (nnslashdot-date-to-date |
(setq date (nnslashdot-date-to-date |
113 |
(buffer-substring (point) (1- (search-forward "<"))))) |
(buffer-substring (point) (1- (search-forward "<"))))) |
119 |
1 |
1 |
120 |
(make-full-mail-header |
(make-full-mail-header |
121 |
1 group from date |
1 group from date |
122 |
(concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") |
(concat "<" sid "%1@slashdot>") |
123 |
"" 0 lines nil nil)) |
"" 0 lines nil nil)) |
124 |
headers) |
headers) |
125 |
(setq start (if nnslashdot-threaded 2 (pop articles)))) |
(setq start (if nnslashdot-threaded 2 (pop articles)))) |
126 |
(while (and start (<= start last)) |
(while (and start (<= start last)) |
127 |
(setq point (goto-char (point-max))) |
(setq point (goto-char (point-max))) |
128 |
(nnweb-insert |
(mm-url-insert |
129 |
(format nnslashdot-comments-url |
(format nnslashdot-comments-url sid |
|
(nnslashdot-sid-strip sid) |
|
130 |
nnslashdot-threshold 0 (- start 2)) |
nnslashdot-threshold 0 (- start 2)) |
131 |
t) |
t) |
132 |
(when (and nnslashdot-threaded first-comments) |
(when (and nnslashdot-threaded first-comments) |
150 |
(setq changed t)) |
(setq changed t)) |
151 |
(when (string-match "^Re: *" subject) |
(when (string-match "^Re: *" subject) |
152 |
(setq subject (concat "Re: " (substring subject (match-end 0))))) |
(setq subject (concat "Re: " (substring subject (match-end 0))))) |
153 |
(setq subject (nnweb-decode-entities-string subject)) |
(setq subject (mm-url-decode-entities-string subject)) |
154 |
(search-forward "<BR>") |
(search-forward "<BR>") |
155 |
(if (looking-at |
(cond |
156 |
"by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))") |
((looking-at |
157 |
(progn |
"by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))") |
158 |
(goto-char (- (match-end 0) 5)) |
(goto-char (- (match-end 0) 5)) |
159 |
(setq from (concat |
(setq from (concat |
160 |
(nnweb-decode-entities-string (match-string 1)) |
(mm-url-decode-entities-string (match-string 1)) |
161 |
" <" (match-string 3) ">"))) |
" <" (match-string 3) ">"))) |
162 |
(setq from "") |
((looking-at "by[ \t\n]+<a[^>]+>\\([^<(]+\\) (\\([0-9]+\\))</a>") |
163 |
(when (looking-at "by \\([^<>]*\\) on ") |
(goto-char (- (match-end 0) 5)) |
164 |
(goto-char (- (match-end 0) 5)) |
(setq from (concat |
165 |
(setq from (nnweb-decode-entities-string (match-string 1))))) |
(mm-url-decode-entities-string (match-string 1)) |
166 |
(search-forward " on ") |
" <" (match-string 2) ">"))) |
167 |
|
((looking-at "by \\([^<>]*\\)[\t\n\r ]+on ") |
168 |
|
(goto-char (- (match-end 0) 5)) |
169 |
|
(setq from (mm-url-decode-entities-string (match-string 1)))) |
170 |
|
(t |
171 |
|
(setq from ""))) |
172 |
|
(search-forward "on ") |
173 |
(setq date |
(setq date |
174 |
(nnslashdot-date-to-date |
(nnslashdot-date-to-date |
175 |
(buffer-substring (point) (progn (skip-chars-forward "^()<>\n\r") (point))))) |
(buffer-substring (point) (progn (skip-chars-forward "^()<>\n\r") (point))))) |
189 |
article |
article |
190 |
(concat subject " (" score ")") |
(concat subject " (" score ")") |
191 |
from date |
from date |
192 |
(concat "<" (nnslashdot-sid-strip sid) "%" cid "@slashdot>") |
(concat "<" sid "%" cid "@slashdot>") |
193 |
(if parent |
(if parent |
194 |
(concat "<" (nnslashdot-sid-strip sid) "%" |
(concat "<" sid "%" parent "@slashdot>") |
|
parent "@slashdot>") |
|
195 |
"") |
"") |
196 |
0 lines nil nil)) |
0 lines nil nil)) |
197 |
headers) |
headers) |
261 |
(point) |
(point) |
262 |
(progn |
(progn |
263 |
(re-search-forward |
(re-search-forward |
264 |
"< [ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article") |
"<IFRAME\\|<SCRIPT LANGUAGE=\"JAVASCRIPT\">\\|<!-- no ad 6 -->\\|< [ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article") |
265 |
(match-beginning 0))))) |
(match-beginning 0))))) |
266 |
(setq cid (cdr (assq article |
(setq cid (cdr (assq article |
267 |
(nth 4 (assoc group nnslashdot-groups))))) |
(nth 4 (assoc group nnslashdot-groups))))) |
301 |
(deffoo nnslashdot-request-list (&optional server) |
(deffoo nnslashdot-request-list (&optional server) |
302 |
(nnslashdot-possibly-change-server nil server) |
(nnslashdot-possibly-change-server nil server) |
303 |
(let ((number 0) |
(let ((number 0) |
304 |
|
(first nnslashdot-use-front-page) |
305 |
sid elem description articles gname) |
sid elem description articles gname) |
306 |
(condition-case why |
(condition-case why |
307 |
;; First we do the Ultramode to get info on all the latest groups. |
;; First we do the Ultramode to get info on all the latest groups. |
308 |
(progn |
(progn |
309 |
(mm-with-unibyte-buffer |
(mm-with-unibyte-buffer |
310 |
(nnweb-insert nnslashdot-backslash-url t) |
(mm-url-insert nnslashdot-backslash-url t) |
311 |
(goto-char (point-min)) |
(goto-char (point-min)) |
312 |
|
(if (eobp) |
313 |
|
(error "Couldn't open connection to slashdot")) |
314 |
(while (search-forward "<story>" nil t) |
(while (search-forward "<story>" nil t) |
315 |
(narrow-to-region (point) (search-forward "</story>")) |
(narrow-to-region (point) (search-forward "</story>")) |
316 |
(goto-char (point-min)) |
(goto-char (point-min)) |
317 |
(re-search-forward "<title>\\([^<]+\\)</title>") |
(re-search-forward "<title>\\([^<]+\\)</title>") |
318 |
(setq description |
(setq description |
319 |
(nnweb-decode-entities-string (match-string 1))) |
(mm-url-decode-entities-string (match-string 1))) |
320 |
(re-search-forward "<url>\\([^<]+\\)</url>") |
(re-search-forward "<url>\\([^<]+\\)</url>") |
321 |
(setq sid (match-string 1)) |
(setq sid (match-string 1)) |
322 |
(string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) |
(string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) |
331 |
(goto-char (point-max)) |
(goto-char (point-max)) |
332 |
(widen))) |
(widen))) |
333 |
;; Then do the older groups. |
;; Then do the older groups. |
334 |
(while (> (- nnslashdot-group-number number) 0) |
(while (or first |
335 |
|
(> (- nnslashdot-group-number number) 0)) |
336 |
|
(setq first nil) |
337 |
(mm-with-unibyte-buffer |
(mm-with-unibyte-buffer |
338 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
339 |
(nnweb-insert (format nnslashdot-active-url number) t) |
(mm-url-insert (format nnslashdot-active-url number) t) |
340 |
(goto-char (point-min)) |
(goto-char (point-min)) |
341 |
(while (re-search-forward |
(while (re-search-forward |
342 |
"article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" |
"article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)</a>" |
343 |
nil t) |
nil t) |
344 |
(setq sid (match-string 1) |
(setq sid (match-string 1) |
345 |
description |
description |
346 |
(nnweb-decode-entities-string (match-string 2))) |
(mm-url-decode-entities-string (match-string 2))) |
347 |
(forward-line 1) |
(forward-line 1) |
348 |
(when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t) |
(when (re-search-forward "with \\([0-9]+\\) comment" nil t) |
349 |
(setq articles (string-to-number (match-string 1)))) |
(setq articles (1+ (string-to-number (match-string 1))))) |
350 |
(setq gname (concat description " (" sid ")")) |
(setq gname (concat description " (" sid ")")) |
351 |
(if (setq elem (assoc gname nnslashdot-groups)) |
(if (setq elem (assoc gname nnslashdot-groups)) |
352 |
(setcar (cdr elem) articles) |
(setcar (cdr elem) articles) |
365 |
|
|
366 |
(deffoo nnslashdot-request-post (&optional server) |
(deffoo nnslashdot-request-post (&optional server) |
367 |
(nnslashdot-possibly-change-server nil server) |
(nnslashdot-possibly-change-server nil server) |
368 |
(let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) |
(let ((sid (message-fetch-field "newsgroups")) |
369 |
(subject (message-fetch-field "subject")) |
(subject (message-fetch-field "subject")) |
370 |
(references (car (last (split-string |
(references (car (last (split-string |
371 |
(message-fetch-field "references"))))) |
(message-fetch-field "references"))))) |
400 |
(message-goto-body) |
(message-goto-body) |
401 |
(setq body (buffer-substring (point) (point-max))) |
(setq body (buffer-substring (point) (point-max))) |
402 |
(erase-buffer) |
(erase-buffer) |
403 |
(nnweb-fetch-form |
(mm-url-fetch-form |
404 |
"http://slashdot.org/comments.pl" |
"http://slashdot.org/comments.pl" |
405 |
`(("sid" . ,sid) |
`(("sid" . ,sid) |
406 |
("pid" . ,pid) |
("pid" . ,pid) |
505 |
(set-buffer nntp-server-buffer) |
(set-buffer nntp-server-buffer) |
506 |
(erase-buffer) |
(erase-buffer) |
507 |
(dolist (elem nnslashdot-groups) |
(dolist (elem nnslashdot-groups) |
508 |
(insert (prin1-to-string (car elem)) |
(when (numberp (cadr elem)) |
509 |
" " (number-to-string (cadr elem)) " 1 y\n")))) |
(insert (prin1-to-string (car elem)) |
510 |
|
" " (number-to-string (cadr elem)) " 1 y\n"))))) |
511 |
|
|
512 |
(defun nnslashdot-lose (why) |
(defun nnslashdot-lose (why) |
513 |
(error "Slashdot HTML has changed; please get a new version of nnslashdot")) |
(error "Slashdot HTML has changed; please get a new version of nnslashdot")) |
514 |
|
|
|
(defalias 'nnslashdot-sid-strip 'identity) |
|
|
|
|
515 |
(provide 'nnslashdot) |
(provide 'nnslashdot) |
516 |
|
|
517 |
;;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3 |
;;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3 |