Mercurial > emacs

comparison lisp/gnus/nnultimate.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 93f6c74a2f60
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -*- coding: iso-latin-1 -*- 1 ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
2 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. 2
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
3 5
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; Keywords: news 7 ;; Keywords: news
6 8
7 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
18 20
19 ;; You should have received a copy of the GNU General Public License 21 ;; 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 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
23 25
24 ;;; Commentary: 26 ;;; Commentary:
25 27
26 ;; Note: You need to have `url' and `w3' installed for this 28 ;; Note: You need to have `url' and `w3' installed for this
27 ;; backend to work. 29 ;; backend to work.
34 (require 'message) 36 (require 'message)
35 (require 'gnus-util) 37 (require 'gnus-util)
36 (require 'gnus) 38 (require 'gnus)
37 (require 'nnmail) 39 (require 'nnmail)
38 (require 'mm-util) 40 (require 'mm-util)
39 (eval-when-compile 41 (require 'mm-url)
40 (ignore-errors 42 (require 'nnweb)
41 (require 'nnweb))) 43 (require 'parse-time)
42 ;; Report failure to find w3 at load time if appropriate. 44 (autoload 'w3-parse-buffer "w3-parse")
43 (eval '(require 'nnweb))
44 45
45 (nnoo-declare nnultimate) 46 (nnoo-declare nnultimate)
46 47
47 (defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/") 48 (defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
48 "Where nnultimate will save its files.") 49 "Where nnultimate will save its files.")
105 (cons article 106 (cons article
106 (+ (nth 3 mmap) (incf farticle)))) 107 (+ (nth 3 mmap) (incf farticle))))
107 fetchers)) 108 fetchers))
108 (pop articles) 109 (pop articles)
109 (setq article (car articles))))) 110 (setq article (car articles)))))
110 ;; Now we have the mapping from/to Gnus/nnultimate article numbers, 111 ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
111 ;; so we start fetching the topics that we need to satisfy the 112 ;; so we start fetching the topics that we need to satisfy the
112 ;; request. 113 ;; request.
113 (if (not fetchers) 114 (if (not fetchers)
114 (save-excursion 115 (save-excursion
115 (set-buffer nntp-server-buffer) 116 (set-buffer nntp-server-buffer)
123 (while (<= current-page pages) 124 (while (<= current-page pages)
124 (erase-buffer) 125 (erase-buffer)
125 (setq subject (nth 2 (assq (car elem) topics))) 126 (setq subject (nth 2 (assq (car elem) topics)))
126 (setq href (nth 3 (assq (car elem) topics))) 127 (setq href (nth 3 (assq (car elem) topics)))
127 (if (= current-page 1) 128 (if (= current-page 1)
128 (nnweb-insert href) 129 (mm-url-insert href)
129 (string-match "\\.html$" href) 130 (string-match "\\.html$" href)
130 (nnweb-insert (concat (substring href 0 (match-beginning 0)) 131 (mm-url-insert (concat (substring href 0 (match-beginning 0))
131 "-" (number-to-string current-page) 132 "-" (number-to-string current-page)
132 (match-string 0 href)))) 133 (match-string 0 href))))
133 (goto-char (point-min)) 134 (goto-char (point-min))
134 (setq contents 135 (setq contents
135 (ignore-errors (w3-parse-buffer (current-buffer)))) 136 (ignore-errors (w3-parse-buffer (current-buffer))))
171 (when (string-match "Posted" (car datel)) 172 (when (string-match "Posted" (car datel))
172 (setq date (substring (car datel) (match-end 0)) 173 (setq date (substring (car datel) (match-end 0))
173 datel nil)) 174 datel nil))
174 (pop datel)) 175 (pop datel))
175 (when date 176 (when date
176 (setq date (delete "" (split-string 177 (setq date (delete "" (split-string date "[-, \n\t\r    ]")))
177 date "[-, \n\t\r    ]"))) 178 (setq date
178 (if (or (member "AM" date) 179 (if (or (member "AM" date)
179 (member "PM" date)) 180 (member "PM" date))
180 (setq date (format 181 (format
181 "%s %s %s %s" 182 "%s %s %s %s"
182 (nth 1 date) 183 (nth 1 date)
183 (if (and (>= (length (nth 0 date)) 3) 184 (if (and (>= (length (nth 0 date)) 3)
184 (assoc (downcase 185 (assoc (downcase
185 (substring (nth 0 date) 0 3)) 186 (substring (nth 0 date) 0 3))
186 parse-time-months)) 187 parse-time-months))
187 (substring (nth 0 date) 0 3) 188 (substring (nth 0 date) 0 3)
188 (car (rassq (string-to-number (nth 0 date)) 189 (car (rassq (string-to-number (nth 0 date))
189 parse-time-months))) 190 parse-time-months)))
190 (nth 2 date) (nth 3 date))) 191 (nth 2 date) (nth 3 date))
191 (setq date (format "%s %s %s %s" 192 (format "%s %s %s %s"
192 (car (rassq (string-to-number (nth 1 date)) 193 (car (rassq (string-to-number (nth 1 date))
193 parse-time-months)) 194 parse-time-months))
194 (nth 0 date) (nth 2 date) (nth 3 date))))) 195 (nth 0 date) (nth 2 date) (nth 3 date)))))
195 (push 196 (push
196 (cons 197 (cons
197 article 198 article
198 (make-full-mail-header 199 (make-full-mail-header
199 article subject 200 article subject
267 (cons group article))))) 268 (cons group article)))))
268 269
269 (deffoo nnultimate-request-list (&optional server) 270 (deffoo nnultimate-request-list (&optional server)
270 (nnultimate-possibly-change-server nil server) 271 (nnultimate-possibly-change-server nil server)
271 (mm-with-unibyte-buffer 272 (mm-with-unibyte-buffer
272 (nnweb-insert 273 (mm-url-insert
273 (if (string-match "/$" nnultimate-address) 274 (if (string-match "/$" nnultimate-address)
274 (concat nnultimate-address "Ultimate.cgi") 275 (concat nnultimate-address "Ultimate.cgi")
275 nnultimate-address)) 276 nnultimate-address))
276 (let ((contents (nth 2 (car (nth 2 277 (let ((contents (nth 2 (car (nth 2
277 (nnultimate-find-forum-table 278 (nnultimate-find-forum-table
332 contents forum-contents furl-fetched a subject href 333 contents forum-contents furl-fetched a subject href
333 garticles topic tinfo old-max inc parse) 334 garticles topic tinfo old-max inc parse)
334 (mm-with-unibyte-buffer 335 (mm-with-unibyte-buffer
335 (while furls 336 (while furls
336 (erase-buffer) 337 (erase-buffer)
337 (nnweb-insert (pop furls)) 338 (mm-url-insert (pop furls))
338 (goto-char (point-min)) 339 (goto-char (point-min))
339 (setq parse (w3-parse-buffer (current-buffer))) 340 (setq parse (w3-parse-buffer (current-buffer)))
340 (setq contents 341 (setq contents
341 (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table 342 (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table
342 parse)))))) 343 parse))))))
475 476
476 ;; Local Variables: 477 ;; Local Variables:
477 ;; coding: iso-8859-1 478 ;; coding: iso-8859-1
478 ;; End: 479 ;; End:
479 480
481 ;;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8
480 ;;; nnultimate.el ends here 482 ;;; nnultimate.el ends here