X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnultimate.el;h=945b24988d749318b5efe63ad71483bc00ce72d4;hb=6ce1ca7f3be9ad05a04a9138526bd596599b758d;hp=ff30cc9d6370d4e9c3d8f2274db7147cb99d6220;hpb=290ead2ee6d1de1c28175a1a9875a5f2fc9941e9;p=gnus diff --git a/lisp/nnultimate.el b/lisp/nnultimate.el index ff30cc9d6..945b24988 100644 --- a/lisp/nnultimate.el +++ b/lisp/nnultimate.el @@ -1,15 +1,17 @@ ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -17,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -36,17 +36,10 @@ (require 'gnus) (require 'nnmail) (require 'mm-util) +(require 'mm-url) (require 'nnweb) -(eval-when-compile - (ignore-errors - (require 'w3) - (require 'url) - (require 'w3-forms))) -;; Report failure to find w3 at load time if appropriate. -(eval '(progn - (require 'w3) - (require 'url) - (require 'w3-forms))) +(require 'parse-time) +(autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnultimate) @@ -62,6 +55,8 @@ (defvoo nnultimate-groups nil) (defvoo nnultimate-headers nil) (defvoo nnultimate-articles nil) +(defvar nnultimate-table-regexp + "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") ;;; Interface functions @@ -80,15 +75,20 @@ (old-total (or (nth 6 entry) 1)) (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") (furls (list (concat nnultimate-address (format furl sid)))) + (nnultimate-table-regexp + "postings.*editpost\\|forumdisplay\\|getbio") headers article subject score from date lines parent point contents tinfo fetchers map elem a href garticles topic old-max - inc datel table string current-page total-contents pages - farticles forum-contents parse furl-fetched) + inc datel table current-page total-contents pages + farticles forum-contents parse furl-fetched mmap farticle) (setq map mapping) (while (and (setq article (car articles)) map) + ;; Skip past the articles in the map until we reach the + ;; article we're looking for. (while (and map - (> article (caar map))) + (or (> article (caar map)) + (< (cadar map) (caar map)))) (pop map)) (when (setq mmap (car map)) (setq farticle -1) @@ -114,7 +114,7 @@ (set-buffer nntp-server-buffer) (erase-buffer)) (setq nnultimate-articles nil) - (with-temp-buffer + (mm-with-unibyte-buffer (dolist (elem fetchers) (setq pages 1 current-page 1 @@ -124,30 +124,36 @@ (setq subject (nth 2 (assq (car elem) topics))) (setq href (nth 3 (assq (car elem) topics))) (if (= current-page 1) - (nnweb-insert href) + (mm-url-insert href) (string-match "\\.html$" href) - (nnweb-insert (concat (substring href 0 (match-beginning 0)) + (mm-url-insert (concat (substring href 0 (match-beginning 0)) "-" (number-to-string current-page) (match-string 0 href)))) (goto-char (point-min)) - (setq contents (w3-parse-buffer (current-buffer))) + (setq contents + (ignore-errors (w3-parse-buffer (current-buffer)))) (setq table (nnultimate-find-forum-table contents)) - (setq string (mapconcat 'identity (nnweb-text table) "")) - (when (string-match "topic is \\([0-9]\\) pages" string) - (setq pages (string-to-number (match-string 1 string))) - (setcdr table nil) - (setq table (nnultimate-find-forum-table contents))) + (goto-char (point-min)) + (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t) + (setq pages (string-to-number (match-string 1)))) (setq contents (cdr (nth 2 (car (nth 2 table))))) (setq total-contents (nconc total-contents contents)) (incf current-page)) - ;;(setq total-contents (nreverse total-contents)) - (dolist (art (cdr elem)) - (if (not (nth (1- (cdr art)) total-contents)) - ();(debug) - (push (list (car art) - (nth (1- (cdr art)) total-contents) - subject) - nnultimate-articles))))) + (when t + (let ((i 0)) + (dolist (co total-contents) + (push (list (or (nnultimate-topic-article-to-article + group (car elem) (incf i)) + 1) + co subject) + nnultimate-articles)))) + (when nil + (dolist (art (cdr elem)) + (when (nth (1- (cdr art)) total-contents) + (push (list (car art) + (nth (1- (cdr art)) total-contents) + subject) + nnultimate-articles)))))) (setq nnultimate-articles (sort nnultimate-articles 'car-less-than-car)) ;; Now we have all the articles, conveniently in an alist @@ -165,17 +171,26 @@ (setq date (substring (car datel) (match-end 0)) datel nil)) (pop datel)) - (setq date (delete "" (split-string date "[- \n\t\r    ]"))) - (if (or (member "AM" date) - (member "PM" date)) - (setq date (format "%s %s %s %s" - (car (rassq (string-to-number (nth 0 date)) - parse-time-months)) - (nth 1 date) (nth 2 date) (nth 3 date))) - (setq date (format "%s %s %s %s" - (car (rassq (string-to-number (nth 1 date)) - parse-time-months)) - (nth 0 date) (nth 2 date) (nth 3 date)))) + (when date + (setq date (delete "" (split-string date "[-, \n\t\r    ]"))) + (setq date + (if (or (member "AM" date) + (member "PM" date)) + (format + "%s %s %s %s" + (nth 1 date) + (if (and (>= (length (nth 0 date)) 3) + (assoc (downcase + (substring (nth 0 date) 0 3)) + parse-time-months)) + (substring (nth 0 date) 0 3) + (car (rassq (string-to-number (nth 0 date)) + parse-time-months))) + (nth 2 date) (nth 3 date)) + (format "%s %s %s %s" + (car (rassq (string-to-number (nth 1 date)) + parse-time-months)) + (nth 0 date) (nth 2 date) (nth 3 date))))) (push (cons article @@ -183,8 +198,8 @@ article subject from (or date "") (concat "<" (number-to-string sid) "%" - (number-to-string article) - "@ultimate>") + (number-to-string article) + "@ultimate." server ">") "" 0 (/ (length (mapconcat 'identity @@ -197,17 +212,25 @@ (setq nnultimate-headers (sort headers 'car-less-than-car)) (save-excursion (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (header nnultimate-headers) - (nnheader-insert-nov (cdr header))))) - (setcar (nthcdr 6 entry) (nth 1 entry)) - (nnultimate-write-groups) + (mm-with-unibyte-current-buffer + (erase-buffer) + (dolist (header nnultimate-headers) + (nnheader-insert-nov (cdr header)))))) 'nov))) +(defun nnultimate-topic-article-to-article (group topic article) + (catch 'found + (dolist (elem (nth 5 (assoc group nnultimate-groups))) + (when (and (= topic (nth 2 elem)) + (>= article (nth 3 elem)) + (< article (+ (- (nth 1 elem) (nth 0 elem)) 1 + (nth 3 elem)))) + (throw 'found + (+ (nth 0 elem) (- article (nth 3 elem)))))))) + (deffoo nnultimate-request-group (group &optional server dont-check) (nnultimate-possibly-change-server nil server) - (when (or (not dont-check) - (not nnultimate-groups)) + (when (not nnultimate-groups) (nnultimate-request-list)) (unless dont-check (nnultimate-create-mapping group)) @@ -221,6 +244,10 @@ "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) (prin1-to-string group)))))) +(deffoo nnultimate-request-close () + (setq nnultimate-groups-alist nil + nnultimate-groups nil)) + (deffoo nnultimate-request-article (article &optional group server buffer) (nnultimate-possibly-change-server group server) (let ((contents (cdr (assq article nnultimate-articles)))) @@ -233,14 +260,18 @@ (goto-char (point-min)) (insert "Content-Type: text/html\nMIME-Version: 1.0\n") (let ((header (cdr (assq article nnultimate-headers)))) - (nnheader-insert-header header)) + (mm-with-unibyte-current-buffer + (nnheader-insert-header header))) (nnheader-report 'nnultimate "Fetched article %s" article) (cons group article))))) (deffoo nnultimate-request-list (&optional server) (nnultimate-possibly-change-server nil server) - (with-temp-buffer - (nnweb-insert (concat nnultimate-address "Ultimate.cgi")) + (mm-with-unibyte-buffer + (mm-url-insert + (if (string-match "/$" nnultimate-address) + (concat nnultimate-address "Ultimate.cgi") + nnultimate-address)) (let ((contents (nth 2 (car (nth 2 (nnultimate-find-forum-table (w3-parse-buffer (current-buffer))))))) @@ -263,7 +294,7 @@ (setq forum (string-to-number (match-string 1 href))) (if (setq elem (assoc group nnultimate-groups)) (setcar (cdr elem) articles) - (push (list group articles forum description nil nil nil) + (push (list group articles forum description nil nil nil nil) nnultimate-groups)))))) (nnultimate-write-groups) (nnultimate-generate-active) @@ -278,6 +309,12 @@ ;;; Internal functions +(defun nnultimate-prune-days (group time) + "Compute the number of days to fetch info for." + (let ((old-time (nth 7 (assoc group nnultimate-groups)))) + (if (null old-time) + 1000 + (- (time-to-days time) (time-to-days old-time))))) (defun nnultimate-create-mapping (group) (let* ((entry (assoc group nnultimate-groups)) @@ -285,24 +322,28 @@ (topics (nth 4 entry)) (mapping (nth 5 entry)) (old-total (or (nth 6 entry) 1)) - (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") + (current-time (current-time)) + (furl + (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune=" + (number-to-string + (nnultimate-prune-days group current-time)))) (furls (list (concat nnultimate-address (format furl sid)))) contents forum-contents furl-fetched a subject href - garticles topic tinfo old-max inc) - (with-temp-buffer + garticles topic tinfo old-max inc parse) + (mm-with-unibyte-buffer (while furls (erase-buffer) - (nnweb-insert (pop furls)) + (mm-url-insert (pop furls)) (goto-char (point-min)) (setq parse (w3-parse-buffer (current-buffer))) (setq contents (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table parse)))))) (setq forum-contents (nconc contents forum-contents)) - (when (and (not mapping) - (not furl-fetched)) + (unless furl-fetched (setq furl-fetched t) - ;; On the first mapping, we fetch all the forum URLs. + ;; On the first time through this loop, we find all the + ;; forum URLs. (dolist (a (nnweb-parse-find-all 'a parse)) (let ((href (cdr (assq 'href (nth 1 a))))) (when (and href @@ -318,7 +359,7 @@ ;; the group is entered, there's 2 new articles in topic one ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 ;; in topic one and 10 will be the 2 in topic three. - (dolist (row (reverse forum-contents)) + (dolist (row (nreverse forum-contents)) (setq row (nth 2 row)) (when (setq a (nnweb-parse-find 'a row)) (setq subject (car (last (nnweb-text a))) @@ -331,25 +372,28 @@ (setq art (1+ (string-to-number (car artlist))))) (pop artlist)) (setq garticles art)) - (string-match "/\\([0-9]+\\).html" href) - (setq topic (string-to-number (match-string 1 href))) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject href) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total))))) + (when garticles + (string-match "/\\([0-9]+\\).html" href) + (setq topic (string-to-number (match-string 1 href))) + (if (setq tinfo (assq topic topics)) + (progn + (setq old-max (cadr tinfo)) + (setcar (cdr tinfo) garticles)) + (setq old-max 0) + (push (list topic garticles subject href) topics) + (setcar (nthcdr 4 entry) topics)) + (when (not (= old-max garticles)) + (setq inc (- garticles old-max)) + (setq mapping (nconc mapping + (list + (list + old-total (1- (incf old-total inc)) + topic (1+ old-max))))) + (incf old-max inc) + (setcar (nthcdr 5 entry) mapping) + (setcar (nthcdr 6 entry) old-total)))))) + (setcar (nthcdr 7 entry) current-time) + (setcar (nthcdr 1 entry) (1- old-total)) (nnultimate-write-groups) mapping)) @@ -358,10 +402,10 @@ (when (and server (not (nnultimate-server-opened server))) (nnultimate-open-server server)) -; (unless nnultimate-groups-alist + (unless nnultimate-groups-alist (nnultimate-read-groups) - (setq nnultimate-groups (cdr (assoc nnultimate-address - nnultimate-groups-alist)))) + (setq nnultimate-groups (cdr (assoc nnultimate-address + nnultimate-groups-alist))))) (deffoo nnultimate-open-server (server &optional defs connectionless) (nnheader-init-server-buffer) @@ -375,7 +419,7 @@ (setq nnultimate-groups-alist nil) (let ((file (expand-file-name "groups" nnultimate-directory))) (when (file-exists-p file) - (with-temp-buffer + (mm-with-unibyte-buffer (insert-file-contents file) (goto-char (point-min)) (setq nnultimate-groups-alist (read (current-buffer))))))) @@ -388,7 +432,7 @@ nnultimate-groups-alist) (with-temp-file (expand-file-name "groups" nnultimate-directory) (prin1 nnultimate-groups-alist (current-buffer)))) - + (defun nnultimate-init (server) "Initialize buffers and such." (unless (file-exists-p nnultimate-directory) @@ -423,11 +467,14 @@ (nth 2 parse)))) (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) case-fold-search) - (when (and href (string-match - "postings\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio" - href)) + (when (and href (string-match nnultimate-table-regexp href)) t)))) (provide 'nnultimate) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + +;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8 ;;; nnultimate.el ends here