Mercurial > emacs
annotate lisp/gnus/nnultimate.el @ 76095:85a1c1106f69
(fancy-splash-screens): Make cursor-type buffer-local in splash
screen.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Fri, 23 Feb 2007 16:26:28 +0000 |
parents | e3694f1cb928 |
children | 24202b793a08 95d0cdf160ea |
rev | line source |
---|---|
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1 ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
2 |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, |
75347 | 4 ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
31717 | 5 |
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
7 ;; Keywords: news | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
31717 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; Note: You need to have `url' and `w3' installed for this | |
29 ;; backend to work. | |
30 | |
31 ;;; Code: | |
32 | |
33 (eval-when-compile (require 'cl)) | |
34 | |
35 (require 'nnoo) | |
36 (require 'message) | |
37 (require 'gnus-util) | |
38 (require 'gnus) | |
39 (require 'nnmail) | |
40 (require 'mm-util) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
41 (require 'mm-url) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
42 (require 'nnweb) |
61304
a1964e18a9ba
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-234
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
43 (require 'parse-time) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
44 (autoload 'w3-parse-buffer "w3-parse") |
31717 | 45 |
46 (nnoo-declare nnultimate) | |
47 | |
48 (defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/") | |
49 "Where nnultimate will save its files.") | |
50 | |
51 (defvoo nnultimate-address "" | |
52 "The address of the Ultimate bulletin board.") | |
53 | |
54 ;;; Internal variables | |
55 | |
56 (defvar nnultimate-groups-alist nil) | |
57 (defvoo nnultimate-groups nil) | |
58 (defvoo nnultimate-headers nil) | |
59 (defvoo nnultimate-articles nil) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
60 (defvar nnultimate-table-regexp |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
61 "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") |
31717 | 62 |
63 ;;; Interface functions | |
64 | |
65 (nnoo-define-basics nnultimate) | |
66 | |
67 (deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old) | |
68 (nnultimate-possibly-change-server group server) | |
69 (unless gnus-nov-is-evil | |
70 (let* ((last (car (last articles))) | |
71 (did nil) | |
72 (start 1) | |
73 (entry (assoc group nnultimate-groups)) | |
74 (sid (nth 2 entry)) | |
75 (topics (nth 4 entry)) | |
76 (mapping (nth 5 entry)) | |
77 (old-total (or (nth 6 entry) 1)) | |
78 (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") | |
79 (furls (list (concat nnultimate-address (format furl sid)))) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
80 (nnultimate-table-regexp |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
81 "postings.*editpost\\|forumdisplay\\|getbio") |
31717 | 82 headers article subject score from date lines parent point |
83 contents tinfo fetchers map elem a href garticles topic old-max | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
84 inc datel table current-page total-contents pages |
31717 | 85 farticles forum-contents parse furl-fetched mmap farticle) |
86 (setq map mapping) | |
87 (while (and (setq article (car articles)) | |
88 map) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
89 ;; Skip past the articles in the map until we reach the |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
90 ;; article we're looking for. |
31717 | 91 (while (and map |
92 (or (> article (caar map)) | |
93 (< (cadar map) (caar map)))) | |
94 (pop map)) | |
95 (when (setq mmap (car map)) | |
96 (setq farticle -1) | |
97 (while (and article | |
98 (<= article (nth 1 mmap))) | |
99 ;; Do we already have a fetcher for this topic? | |
100 (if (setq elem (assq (nth 2 mmap) fetchers)) | |
101 ;; Yes, so we just add the spec to the end. | |
102 (nconc elem (list (cons article | |
103 (+ (nth 3 mmap) (incf farticle))))) | |
104 ;; No, so we add a new one. | |
105 (push (list (nth 2 mmap) | |
106 (cons article | |
107 (+ (nth 3 mmap) (incf farticle)))) | |
108 fetchers)) | |
109 (pop articles) | |
110 (setq article (car articles))))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
111 ;; Now we have the mapping from/to Gnus/nnultimate article numbers, |
31717 | 112 ;; so we start fetching the topics that we need to satisfy the |
113 ;; request. | |
114 (if (not fetchers) | |
115 (save-excursion | |
116 (set-buffer nntp-server-buffer) | |
117 (erase-buffer)) | |
118 (setq nnultimate-articles nil) | |
119 (mm-with-unibyte-buffer | |
120 (dolist (elem fetchers) | |
121 (setq pages 1 | |
122 current-page 1 | |
123 total-contents nil) | |
124 (while (<= current-page pages) | |
125 (erase-buffer) | |
126 (setq subject (nth 2 (assq (car elem) topics))) | |
127 (setq href (nth 3 (assq (car elem) topics))) | |
128 (if (= current-page 1) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
129 (mm-url-insert href) |
31717 | 130 (string-match "\\.html$" href) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
131 (mm-url-insert (concat (substring href 0 (match-beginning 0)) |
31717 | 132 "-" (number-to-string current-page) |
133 (match-string 0 href)))) | |
134 (goto-char (point-min)) | |
135 (setq contents | |
136 (ignore-errors (w3-parse-buffer (current-buffer)))) | |
137 (setq table (nnultimate-find-forum-table contents)) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
138 (goto-char (point-min)) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
139 (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
140 (setq pages (string-to-number (match-string 1)))) |
31717 | 141 (setq contents (cdr (nth 2 (car (nth 2 table))))) |
142 (setq total-contents (nconc total-contents contents)) | |
143 (incf current-page)) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
144 (when t |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
145 (let ((i 0)) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
146 (dolist (co total-contents) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
147 (push (list (or (nnultimate-topic-article-to-article |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
148 group (car elem) (incf i)) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
149 1) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
150 co subject) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
151 nnultimate-articles)))) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
152 (when nil |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
153 (dolist (art (cdr elem)) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
154 (when (nth (1- (cdr art)) total-contents) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
155 (push (list (car art) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
156 (nth (1- (cdr art)) total-contents) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
157 subject) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
158 nnultimate-articles)))))) |
31717 | 159 (setq nnultimate-articles |
160 (sort nnultimate-articles 'car-less-than-car)) | |
161 ;; Now we have all the articles, conveniently in an alist | |
162 ;; where the key is the Gnus article number. | |
163 (dolist (articlef nnultimate-articles) | |
164 (setq article (nth 0 articlef) | |
165 contents (nth 1 articlef) | |
166 subject (nth 2 articlef)) | |
167 (setq from (mapconcat 'identity | |
168 (nnweb-text (car (nth 2 contents))) | |
169 " ") | |
170 datel (nnweb-text (nth 2 (car (cdr (nth 2 contents)))))) | |
171 (while datel | |
172 (when (string-match "Posted" (car datel)) | |
173 (setq date (substring (car datel) (match-end 0)) | |
174 datel nil)) | |
175 (pop datel)) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
176 (when date |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
177 (setq date (delete "" (split-string date "[-, \n\t\r ]"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
178 (setq date |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
179 (if (or (member "AM" date) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
180 (member "PM" date)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
181 (format |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
182 "%s %s %s %s" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
183 (nth 1 date) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
184 (if (and (>= (length (nth 0 date)) 3) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
185 (assoc (downcase |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
186 (substring (nth 0 date) 0 3)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
187 parse-time-months)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
188 (substring (nth 0 date) 0 3) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
189 (car (rassq (string-to-number (nth 0 date)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
190 parse-time-months))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
191 (nth 2 date) (nth 3 date)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
192 (format "%s %s %s %s" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
193 (car (rassq (string-to-number (nth 1 date)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
194 parse-time-months)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
195 (nth 0 date) (nth 2 date) (nth 3 date))))) |
31717 | 196 (push |
197 (cons | |
198 article | |
199 (make-full-mail-header | |
200 article subject | |
201 from (or date "") | |
202 (concat "<" (number-to-string sid) "%" | |
203 (number-to-string article) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
204 "@ultimate." server ">") |
31717 | 205 "" 0 |
206 (/ (length (mapconcat | |
207 'identity | |
208 (nnweb-text | |
209 (cdr (nth 2 (nth 1 (nth 2 contents))))) | |
210 "")) | |
211 70) | |
212 nil nil)) | |
213 headers)) | |
214 (setq nnultimate-headers (sort headers 'car-less-than-car)) | |
215 (save-excursion | |
216 (set-buffer nntp-server-buffer) | |
217 (mm-with-unibyte-current-buffer | |
218 (erase-buffer) | |
219 (dolist (header nnultimate-headers) | |
220 (nnheader-insert-nov (cdr header)))))) | |
221 'nov))) | |
222 | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
223 (defun nnultimate-topic-article-to-article (group topic article) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
224 (catch 'found |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
225 (dolist (elem (nth 5 (assoc group nnultimate-groups))) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
226 (when (and (= topic (nth 2 elem)) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
227 (>= article (nth 3 elem)) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
228 (< article (+ (- (nth 1 elem) (nth 0 elem)) 1 |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
229 (nth 3 elem)))) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
230 (throw 'found |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
231 (+ (nth 0 elem) (- article (nth 3 elem)))))))) |
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
232 |
31717 | 233 (deffoo nnultimate-request-group (group &optional server dont-check) |
234 (nnultimate-possibly-change-server nil server) | |
235 (when (not nnultimate-groups) | |
236 (nnultimate-request-list)) | |
237 (unless dont-check | |
238 (nnultimate-create-mapping group)) | |
239 (let ((elem (assoc group nnultimate-groups))) | |
240 (cond | |
241 ((not elem) | |
242 (nnheader-report 'nnultimate "Group does not exist")) | |
243 (t | |
244 (nnheader-report 'nnultimate "Opened group %s" group) | |
245 (nnheader-insert | |
246 "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) | |
247 (prin1-to-string group)))))) | |
248 | |
249 (deffoo nnultimate-request-close () | |
250 (setq nnultimate-groups-alist nil | |
251 nnultimate-groups nil)) | |
252 | |
253 (deffoo nnultimate-request-article (article &optional group server buffer) | |
254 (nnultimate-possibly-change-server group server) | |
255 (let ((contents (cdr (assq article nnultimate-articles)))) | |
256 (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents)))))) | |
257 (when contents | |
258 (save-excursion | |
259 (set-buffer (or buffer nntp-server-buffer)) | |
260 (erase-buffer) | |
261 (nnweb-insert-html (cons 'p (cons nil (list contents)))) | |
262 (goto-char (point-min)) | |
263 (insert "Content-Type: text/html\nMIME-Version: 1.0\n") | |
264 (let ((header (cdr (assq article nnultimate-headers)))) | |
265 (mm-with-unibyte-current-buffer | |
266 (nnheader-insert-header header))) | |
267 (nnheader-report 'nnultimate "Fetched article %s" article) | |
268 (cons group article))))) | |
269 | |
270 (deffoo nnultimate-request-list (&optional server) | |
271 (nnultimate-possibly-change-server nil server) | |
272 (mm-with-unibyte-buffer | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
273 (mm-url-insert |
31717 | 274 (if (string-match "/$" nnultimate-address) |
275 (concat nnultimate-address "Ultimate.cgi") | |
276 nnultimate-address)) | |
277 (let ((contents (nth 2 (car (nth 2 | |
278 (nnultimate-find-forum-table | |
279 (w3-parse-buffer (current-buffer))))))) | |
280 sid elem description articles a href group forum | |
281 a1 a2) | |
282 (dolist (row contents) | |
283 (setq row (nth 2 row)) | |
284 (when (setq a (nnweb-parse-find 'a row)) | |
285 (setq group (car (last (nnweb-text a))) | |
286 href (cdr (assq 'href (nth 1 a)))) | |
287 (setq description (car (last (nnweb-text (nth 1 row))))) | |
288 (setq a1 (car (last (nnweb-text (nth 2 row))))) | |
289 (setq a2 (car (last (nnweb-text (nth 3 row))))) | |
290 (when (string-match "^[0-9]+$" a1) | |
291 (setq articles (string-to-number a1))) | |
292 (when (and a2 (string-match "^[0-9]+$" a2)) | |
293 (setq articles (max articles (string-to-number a2)))) | |
294 (when href | |
295 (string-match "number=\\([0-9]+\\)" href) | |
296 (setq forum (string-to-number (match-string 1 href))) | |
297 (if (setq elem (assoc group nnultimate-groups)) | |
298 (setcar (cdr elem) articles) | |
299 (push (list group articles forum description nil nil nil nil) | |
300 nnultimate-groups)))))) | |
301 (nnultimate-write-groups) | |
302 (nnultimate-generate-active) | |
303 t)) | |
304 | |
305 (deffoo nnultimate-request-newgroups (date &optional server) | |
306 (nnultimate-possibly-change-server nil server) | |
307 (nnultimate-generate-active) | |
308 t) | |
309 | |
310 (nnoo-define-skeleton nnultimate) | |
311 | |
312 ;;; Internal functions | |
313 | |
314 (defun nnultimate-prune-days (group time) | |
315 "Compute the number of days to fetch info for." | |
316 (let ((old-time (nth 7 (assoc group nnultimate-groups)))) | |
317 (if (null old-time) | |
318 1000 | |
319 (- (time-to-days time) (time-to-days old-time))))) | |
320 | |
321 (defun nnultimate-create-mapping (group) | |
322 (let* ((entry (assoc group nnultimate-groups)) | |
323 (sid (nth 2 entry)) | |
324 (topics (nth 4 entry)) | |
325 (mapping (nth 5 entry)) | |
326 (old-total (or (nth 6 entry) 1)) | |
327 (current-time (current-time)) | |
328 (furl | |
329 (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune=" | |
330 (number-to-string | |
331 (nnultimate-prune-days group current-time)))) | |
332 (furls (list (concat nnultimate-address (format furl sid)))) | |
333 contents forum-contents furl-fetched a subject href | |
334 garticles topic tinfo old-max inc parse) | |
335 (mm-with-unibyte-buffer | |
336 (while furls | |
337 (erase-buffer) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
338 (mm-url-insert (pop furls)) |
31717 | 339 (goto-char (point-min)) |
340 (setq parse (w3-parse-buffer (current-buffer))) | |
341 (setq contents | |
342 (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table | |
343 parse)))))) | |
344 (setq forum-contents (nconc contents forum-contents)) | |
345 (unless furl-fetched | |
346 (setq furl-fetched t) | |
347 ;; On the first time through this loop, we find all the | |
348 ;; forum URLs. | |
349 (dolist (a (nnweb-parse-find-all 'a parse)) | |
350 (let ((href (cdr (assq 'href (nth 1 a))))) | |
351 (when (and href | |
352 (string-match "forumdisplay.*startpoint" href)) | |
353 (push href furls)))) | |
354 (setq furls (nreverse furls)))) | |
355 ;; The main idea here is to map Gnus article numbers to | |
356 ;; nnultimate article numbers. Say there are three topics in | |
357 ;; this forum, the first with 4 articles, the seconds with 2, | |
358 ;; and the third with 1. Then this will translate into 7 Gnus | |
359 ;; article numbers, where 1-4 comes from the first topic, 5-6 | |
360 ;; from the second and 7 from the third. Now, then next time | |
361 ;; the group is entered, there's 2 new articles in topic one | |
362 ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 | |
363 ;; in topic one and 10 will be the 2 in topic three. | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
364 (dolist (row (nreverse forum-contents)) |
31717 | 365 (setq row (nth 2 row)) |
366 (when (setq a (nnweb-parse-find 'a row)) | |
367 (setq subject (car (last (nnweb-text a))) | |
368 href (cdr (assq 'href (nth 1 a)))) | |
369 (let ((artlist (nreverse (nnweb-text row))) | |
370 art) | |
371 (while (and (not art) | |
372 artlist) | |
373 (when (string-match "^[0-9]+$" (car artlist)) | |
374 (setq art (1+ (string-to-number (car artlist))))) | |
375 (pop artlist)) | |
376 (setq garticles art)) | |
377 (when garticles | |
378 (string-match "/\\([0-9]+\\).html" href) | |
379 (setq topic (string-to-number (match-string 1 href))) | |
380 (if (setq tinfo (assq topic topics)) | |
381 (progn | |
382 (setq old-max (cadr tinfo)) | |
383 (setcar (cdr tinfo) garticles)) | |
384 (setq old-max 0) | |
385 (push (list topic garticles subject href) topics) | |
386 (setcar (nthcdr 4 entry) topics)) | |
387 (when (not (= old-max garticles)) | |
388 (setq inc (- garticles old-max)) | |
389 (setq mapping (nconc mapping | |
390 (list | |
391 (list | |
392 old-total (1- (incf old-total inc)) | |
393 topic (1+ old-max))))) | |
394 (incf old-max inc) | |
395 (setcar (nthcdr 5 entry) mapping) | |
396 (setcar (nthcdr 6 entry) old-total)))))) | |
397 (setcar (nthcdr 7 entry) current-time) | |
398 (setcar (nthcdr 1 entry) (1- old-total)) | |
399 (nnultimate-write-groups) | |
400 mapping)) | |
401 | |
402 (defun nnultimate-possibly-change-server (&optional group server) | |
403 (nnultimate-init server) | |
404 (when (and server | |
405 (not (nnultimate-server-opened server))) | |
406 (nnultimate-open-server server)) | |
407 (unless nnultimate-groups-alist | |
408 (nnultimate-read-groups) | |
409 (setq nnultimate-groups (cdr (assoc nnultimate-address | |
410 nnultimate-groups-alist))))) | |
411 | |
412 (deffoo nnultimate-open-server (server &optional defs connectionless) | |
413 (nnheader-init-server-buffer) | |
414 (if (nnultimate-server-opened server) | |
415 t | |
416 (unless (assq 'nnultimate-address defs) | |
417 (setq defs (append defs (list (list 'nnultimate-address server))))) | |
418 (nnoo-change-server 'nnultimate server defs))) | |
419 | |
420 (defun nnultimate-read-groups () | |
421 (setq nnultimate-groups-alist nil) | |
422 (let ((file (expand-file-name "groups" nnultimate-directory))) | |
423 (when (file-exists-p file) | |
424 (mm-with-unibyte-buffer | |
425 (insert-file-contents file) | |
426 (goto-char (point-min)) | |
427 (setq nnultimate-groups-alist (read (current-buffer))))))) | |
428 | |
429 (defun nnultimate-write-groups () | |
430 (setq nnultimate-groups-alist | |
431 (delq (assoc nnultimate-address nnultimate-groups-alist) | |
432 nnultimate-groups-alist)) | |
433 (push (cons nnultimate-address nnultimate-groups) | |
434 nnultimate-groups-alist) | |
435 (with-temp-file (expand-file-name "groups" nnultimate-directory) | |
436 (prin1 nnultimate-groups-alist (current-buffer)))) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
437 |
31717 | 438 (defun nnultimate-init (server) |
439 "Initialize buffers and such." | |
440 (unless (file-exists-p nnultimate-directory) | |
441 (gnus-make-directory nnultimate-directory))) | |
442 | |
443 (defun nnultimate-generate-active () | |
444 (save-excursion | |
445 (set-buffer nntp-server-buffer) | |
446 (erase-buffer) | |
447 (dolist (elem nnultimate-groups) | |
448 (insert (prin1-to-string (car elem)) | |
449 " " (number-to-string (cadr elem)) " 1 y\n")))) | |
450 | |
451 (defun nnultimate-find-forum-table (contents) | |
452 (catch 'found | |
453 (nnultimate-find-forum-table-1 contents))) | |
454 | |
455 (defun nnultimate-find-forum-table-1 (contents) | |
456 (dolist (element contents) | |
457 (unless (stringp element) | |
458 (when (and (eq (car element) 'table) | |
459 (nnultimate-forum-table-p element)) | |
460 (throw 'found element)) | |
461 (when (nth 2 element) | |
462 (nnultimate-find-forum-table-1 (nth 2 element)))))) | |
463 | |
464 (defun nnultimate-forum-table-p (parse) | |
465 (when (not (apply 'gnus-or | |
466 (mapcar | |
467 (lambda (p) | |
468 (nnweb-parse-find 'table p)) | |
469 (nth 2 parse)))) | |
470 (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) | |
471 case-fold-search) | |
40542
93f6c74a2f60
* mm-util.el, nnultimate.el, nnweb.el, nnslashdot.el: Sync with
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33374
diff
changeset
|
472 (when (and href (string-match nnultimate-table-regexp href)) |
31717 | 473 t)))) |
474 | |
475 (provide 'nnultimate) | |
476 | |
477 ;; Local Variables: | |
478 ;; coding: iso-8859-1 | |
479 ;; End: | |
480 | |
52401 | 481 ;;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8 |
31717 | 482 ;;; nnultimate.el ends here |