1 ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
2 ;; Copyright (C) 1999 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; Note: You need to have `url' and `w3' installed for this
31 (eval-when-compile (require 'cl))
45 ;; Report failure to find w3 at load time if appropriate.
51 (nnoo-declare nnultimate)
53 (defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
54 "Where nnultimate will save its files.")
56 (defvoo nnultimate-address ""
57 "The address of the Ultimate bulletin board.")
59 ;;; Internal variables
61 (defvar nnultimate-groups-alist nil)
62 (defvoo nnultimate-groups nil)
63 (defvoo nnultimate-headers nil)
64 (defvoo nnultimate-articles nil)
66 ;;; Interface functions
68 (nnoo-define-basics nnultimate)
70 (deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old)
71 (nnultimate-possibly-change-server group server)
72 (unless gnus-nov-is-evil
73 (let* ((last (car (last articles)))
76 (entry (assoc group nnultimate-groups))
78 (topics (nth 4 entry))
79 (mapping (nth 5 entry))
80 (old-total (or (nth 6 entry) 0))
81 (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
82 headers article subject score from date lines parent point
83 contents tinfo fetchers map elem a href garticles topic old-max
84 inc datel table string current-page total-contents pages
87 (nnweb-insert (concat nnultimate-address (format furl sid)))
88 (goto-char (point-min))
90 (nth 2 (car (nth 2 (nnultimate-find-forum-table
91 (w3-parse-buffer (current-buffer)))))))
92 ;; The main idea here is to map Gnus article numbers to
93 ;; nnultimate article numbers. Say there are three topics in
94 ;; this forum, the first with 4 articles, the seconds with 2,
95 ;; and the third with 1. Then this will translate into 7 Gnus
96 ;; article numbers, where 1-4 comes from the first topic, 5-6
97 ;; from the second and 7 from the third. Now, then next time
98 ;; the group is entered, there's 2 new articles in topic one and
99 ;; 1 in topic three. Then Gnus article number 8-9 be 5-6 in
100 ;; topic one and 10 will be the 2 in topic three.
101 (dolist (row (cdr contents))
102 (setq row (nth 2 row))
103 (when (setq a (nnweb-parse-find 'a row))
104 (setq subject (car (last (nnweb-text a)))
105 href (cdr (assq 'href (nth 1 a))))
106 (let ((artlist (nreverse (nnweb-text row)))
108 (while (and (not art)
110 (when (string-match "^[0-9]+$" (car artlist))
111 (setq art (1+ (string-to-number (car artlist)))))
113 (setq garticles art))
114 (string-match "/\\([0-9]+\\).html" href)
115 (setq topic (string-to-number (match-string 1 href)))
116 (if (setq tinfo (assq topic topics))
118 (setq old-max (cadr tinfo))
119 (setcar (cdr tinfo) garticles))
121 (push (list topic garticles subject href) topics)
122 (setcar (nthcdr 4 entry) topics))
123 (when (not (= old-max garticles))
124 (setq inc (- garticles old-max))
125 (setq mapping (nconc mapping
129 topic (1+ old-max)))))
131 (setcar (nthcdr 5 entry) mapping)
132 (setcar (nthcdr 6 entry) old-total))))
134 (while (and (setq article (car articles))
137 (> article (caar map)))
142 (<= article (caar map)))
143 (if (setq elem (assq (cadar map) fetchers))
144 (nconc elem (list (cons article
147 (push (list (cadar map) (cons article
151 (setq article (car (setq articles (cdr articles))))))
152 ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
153 ;; so we start fetching the topics that we need to satisfy the
157 (set-buffer nntp-server-buffer)
159 (setq nnultimate-articles nil)
161 (dolist (elem fetchers)
165 (while (<= current-page pages)
167 (setq subject (nth 2 (assq (car elem) topics)))
168 (setq href (nth 3 (assq (car elem) topics)))
169 (if (= current-page 1)
171 (string-match "\\.html$" href)
172 (nnweb-insert (concat (substring href 0 (match-beginning 0))
173 "-" (number-to-string current-page)
174 (match-string 0 href))))
175 (goto-char (point-min))
176 (setq contents (w3-parse-buffer (current-buffer)))
177 (setq table (nnultimate-find-forum-table contents))
178 (setq string (mapconcat 'identity (nnweb-text table) ""))
179 (when (string-match "topic is \\([0-9]\\) pages" string)
180 (setq pages (string-to-number (match-string 1 string)))
182 (setq table (nnultimate-find-forum-table contents)))
183 (setq contents (cdr (nth 2 (car (nth 2 table)))))
184 (setq total-contents (nconc total-contents contents))
186 ;;(setq total-contents (nreverse total-contents))
187 (dolist (art (cdr elem))
188 (if (not (nth (1- (cdr art)) total-contents))
190 (push (list (car art)
191 (nth (1- (cdr art)) total-contents)
193 nnultimate-articles)))))
194 (setq nnultimate-articles
195 (sort nnultimate-articles 'car-less-than-car))
196 ;; Now we have all the articles, conveniently in an alist
197 ;; where the key is the Gnus article number.
198 (dolist (articlef nnultimate-articles)
199 (setq article (nth 0 articlef)
200 contents (nth 1 articlef)
201 subject (nth 2 articlef))
202 (setq from (mapconcat 'identity
203 (nnweb-text (car (nth 2 contents)))
205 datel (nnweb-text (nth 2 (car (cdr (nth 2 contents))))))
207 (when (string-match "Posted" (car datel))
208 (setq date (substring (car datel) (match-end 0))
211 (setq date (delete "" (split-string date "[- \n\t\r ]")))
212 (setq date (format "%s %s %s %s"
213 (car (rassq (string-to-number (nth 1 date))
215 (nth 0 date) (nth 2 date) (nth 3 date)))
219 (make-full-mail-header
222 (concat "<" (number-to-string sid) "%"
223 (number-to-string article)
226 (/ (length (mapconcat
229 (cdr (nth 2 (nth 1 (nth 2 contents)))))
234 (setq nnultimate-headers (sort headers 'car-less-than-car))
236 (set-buffer nntp-server-buffer)
238 (dolist (header nnultimate-headers)
239 (nnheader-insert-nov (cdr header))))))
240 (setcar (nthcdr 6 entry) (nth 1 entry))
241 (nnultimate-write-groups)
244 (deffoo nnultimate-request-group (group &optional server dont-check)
245 (nnultimate-possibly-change-server nil server)
246 (when (or (not dont-check)
247 (not nnultimate-groups))
248 (nnultimate-request-list))
249 (let ((elem (assoc group nnultimate-groups)))
252 (nnheader-report 'nnultimate "Group does not exist"))
254 (nnheader-report 'nnultimate "Opened group %s" group)
256 "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
257 (prin1-to-string group))))))
259 (deffoo nnultimate-request-article (article &optional group server buffer)
260 (nnultimate-possibly-change-server group server)
261 (let ((contents (cdr (assq article nnultimate-articles))))
262 (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents))))))
265 (set-buffer (or buffer nntp-server-buffer))
267 (nnweb-insert-html (cons 'p (cons nil (list contents))))
268 (goto-char (point-min))
269 (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
270 (let ((header (cdr (assq article nnultimate-headers))))
271 (nnheader-insert-header header))
272 (nnheader-report 'nnultimate "Fetched article %s" article)
273 (cons group article)))))
275 (deffoo nnultimate-request-list (&optional server)
276 (nnultimate-possibly-change-server nil server)
278 (nnweb-insert (concat nnultimate-address "Ultimate.cgi"))
279 (let ((contents (nth 2 (car (nth 2
280 (nnultimate-find-forum-table
281 (w3-parse-buffer (current-buffer)))))))
282 sid elem description articles a href group forum
284 (dolist (row contents)
285 (setq row (nth 2 row))
286 (when (setq a (nnweb-parse-find 'a row))
287 (setq group (car (last (nnweb-text a)))
288 href (cdr (assq 'href (nth 1 a))))
289 (setq description (car (last (nnweb-text (nth 1 row)))))
290 (setq a1 (car (last (nnweb-text (nth 2 row)))))
291 (setq a2 (car (last (nnweb-text (nth 3 row)))))
292 (when (string-match "^[0-9]+$" a1)
293 (setq articles (string-to-number a1)))
294 (when (and a2 (string-match "^[0-9]+$" a2))
295 (setq articles (max articles (string-to-number a2))))
297 (string-match "number=\\([0-9]+\\)" href)
298 (setq forum (string-to-number (match-string 1 href)))
299 (if (setq elem (assoc group nnultimate-groups))
300 (setcar (cdr elem) articles)
301 (push (list group articles forum description nil nil nil)
302 nnultimate-groups))))))
303 (nnultimate-write-groups)
304 (nnultimate-generate-active)
307 (deffoo nnultimate-request-newgroups (date &optional server)
308 (nnultimate-possibly-change-server nil server)
309 (nnultimate-generate-active)
312 (nnoo-define-skeleton nnultimate)
314 ;;; Internal functions
316 (defun nnultimate-possibly-change-server (&optional group server)
317 (nnultimate-init server)
319 (not (nnultimate-server-opened server)))
320 (nnultimate-open-server server))
321 ; (unless nnultimate-groups-alist
322 (nnultimate-read-groups)
323 (setq nnultimate-groups (cdr (assoc nnultimate-address
324 nnultimate-groups-alist))))
326 (deffoo nnultimate-open-server (server &optional defs connectionless)
327 (nnheader-init-server-buffer)
328 (if (nnultimate-server-opened server)
330 (unless (assq 'nnultimate-address defs)
331 (setq defs (append defs (list (list 'nnultimate-address server)))))
332 (nnoo-change-server 'nnultimate server defs)))
334 (defun nnultimate-read-groups ()
335 (let ((file (expand-file-name "groups" nnultimate-directory)))
336 (when (file-exists-p file)
338 (insert-file-contents file)
339 (goto-char (point-min))
340 (setq nnultimate-groups-alist (read (current-buffer)))))))
342 (defun nnultimate-write-groups ()
343 (setq nnultimate-groups-alist
344 (delq (assoc nnultimate-address nnultimate-groups-alist)
345 nnultimate-groups-alist))
346 (push (cons nnultimate-address nnultimate-groups)
347 nnultimate-groups-alist)
348 (with-temp-file (expand-file-name "groups" nnultimate-directory)
349 (prin1 nnultimate-groups-alist (current-buffer))))
351 (defun nnultimate-init (server)
352 "Initialize buffers and such."
353 (unless (file-exists-p nnultimate-directory)
354 (gnus-make-directory nnultimate-directory)))
356 (defun nnultimate-date-to-date (sdate)
357 (let ((elem (split-string sdate)))
358 (concat (substring (nth 0 elem) 0 3) " "
359 (substring (nth 1 elem) 0 3) " "
360 (substring (nth 2 elem) 0 2) " "
361 (substring (nth 3 elem) 1 6) " "
362 (format-time-string "%Y") " "
365 (defun nnultimate-generate-active ()
367 (set-buffer nntp-server-buffer)
369 (dolist (elem nnultimate-groups)
370 (insert (prin1-to-string (car elem))
371 " " (number-to-string (cadr elem)) " 1 y\n"))))
373 (defun nnultimate-find-forum-table (contents)
375 (nnultimate-find-forum-table-1 contents)))
377 (defun nnultimate-find-forum-table-1 (contents)
378 (dolist (element contents)
379 (unless (stringp element)
380 (when (and (eq (car element) 'table)
381 (nnultimate-forum-table-p element))
382 (throw 'found element))
383 (when (nth 2 element)
384 (nnultimate-find-forum-table-1 (nth 2 element))))))
386 (defun nnultimate-forum-table-p (parse)
387 (when (not (apply 'gnus-or
390 (nnweb-parse-find 'table p))
392 (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
394 (when (and href (string-match "forumdisplay\\|Forum[0-9]+/HTML\\|getbio"
398 (provide 'nnultimate)
400 ;;; nnultimate.el ends here