diff options
| author | Lars Magne Ingebrigtsen | 2010-09-02 00:39:34 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-09-02 00:39:34 +0000 |
| commit | 261ff377d4488834a77324e5dced30b0168dbfbd (patch) | |
| tree | 37783760b36533d5d2bed09271549a61af21cf29 | |
| parent | f736244589204741532ab6a0f9a9ebf324d5dbde (diff) | |
| download | emacs-261ff377d4488834a77324e5dced30b0168dbfbd.tar.gz emacs-261ff377d4488834a77324e5dced30b0168dbfbd.zip | |
Remove nnlistserv, nnwfm and related code.
| -rw-r--r-- | doc/misc/gnus.texi | 3 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/nnlistserv.el | 152 | ||||
| -rw-r--r-- | lisp/gnus/nnwfm.el | 432 |
5 files changed, 7 insertions, 588 deletions
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 783a785bb70..3db39e32101 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi | |||
| @@ -29066,8 +29066,7 @@ As the variables for the other back ends, there are | |||
| 29066 | @code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil}, | 29066 | @code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil}, |
| 29067 | @code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a | 29067 | @code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a |
| 29068 | non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those | 29068 | non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those |
| 29069 | variables.@footnote{Although the back end @code{nnwfm} doesn't have | 29069 | variables. |
| 29070 | its own nn*-nov-is-evil.} | ||
| 29071 | @end table | 29070 | @end table |
| 29072 | 29071 | ||
| 29073 | 29072 | ||
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 0993d93ddbe..11ce61ce496 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * nnwfm.el: Removed. | ||
| 4 | |||
| 5 | * nnlistserv.el: Removed. | ||
| 6 | |||
| 1 | 2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> | 7 | 2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> |
| 2 | 8 | ||
| 3 | * gnus-html.el (gnus-html-image-url-blocked-p): New function. | 9 | * gnus-html.el (gnus-html-image-url-blocked-p): New function. |
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 6ce133c2fb7..2ff86bf53d9 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -1745,8 +1745,6 @@ slower." | |||
| 1745 | ("nngateway" post-mail address prompt-address physical-address) | 1745 | ("nngateway" post-mail address prompt-address physical-address) |
| 1746 | ("nnweb" none) | 1746 | ("nnweb" none) |
| 1747 | ("nnrss" none) | 1747 | ("nnrss" none) |
| 1748 | ("nnwfm" none) | ||
| 1749 | ("nnlistserv" none) | ||
| 1750 | ("nnagent" post-mail) | 1748 | ("nnagent" post-mail) |
| 1751 | ("nnimap" post-mail address prompt-address physical-address) | 1749 | ("nnimap" post-mail address prompt-address physical-address) |
| 1752 | ("nnmaildir" mail respool address) | 1750 | ("nnmaildir" mail respool address) |
diff --git a/lisp/gnus/nnlistserv.el b/lisp/gnus/nnlistserv.el deleted file mode 100644 index 3e53001cec0..00000000000 --- a/lisp/gnus/nnlistserv.el +++ /dev/null | |||
| @@ -1,152 +0,0 @@ | |||
| 1 | ;;; nnlistserv.el --- retrieving articles via web mailing list archives | ||
| 2 | |||
| 3 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | ;; Keywords: news, mail | ||
| 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 3 of the License, or | ||
| 14 | ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (eval-when-compile (require 'cl)) | ||
| 29 | |||
| 30 | (require 'nnoo) | ||
| 31 | (require 'mm-url) | ||
| 32 | (require 'nnweb) | ||
| 33 | |||
| 34 | (nnoo-declare nnlistserv | ||
| 35 | nnweb) | ||
| 36 | |||
| 37 | (defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") | ||
| 38 | "Where nnlistserv will save its files." | ||
| 39 | nnweb-directory) | ||
| 40 | |||
| 41 | (defvoo nnlistserv-name 'kk | ||
| 42 | "What search engine type is being used." | ||
| 43 | nnweb-type) | ||
| 44 | |||
| 45 | (defvoo nnlistserv-type-definition | ||
| 46 | '((kk | ||
| 47 | (article . nnlistserv-kk-wash-article) | ||
| 48 | (map . nnlistserv-kk-create-mapping) | ||
| 49 | (search . nnlistserv-kk-search) | ||
| 50 | (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") | ||
| 51 | (pages "fra160396" "fra160796" "fra061196" "fra160197" | ||
| 52 | "fra090997" "fra040797" "fra130397" "nye") | ||
| 53 | (index . "date.html") | ||
| 54 | (identifier . nnlistserv-kk-identity))) | ||
| 55 | "Type-definition alist." | ||
| 56 | nnweb-type-definition) | ||
| 57 | |||
| 58 | (defvoo nnlistserv-search nil | ||
| 59 | "Search string to feed to DejaNews." | ||
| 60 | nnweb-search) | ||
| 61 | |||
| 62 | (defvoo nnlistserv-ephemeral-p nil | ||
| 63 | "Whether this nnlistserv server is ephemeral." | ||
| 64 | nnweb-ephemeral-p) | ||
| 65 | |||
| 66 | ;;; Internal variables | ||
| 67 | |||
| 68 | ;;; Interface functions | ||
| 69 | |||
| 70 | (nnoo-define-basics nnlistserv) | ||
| 71 | |||
| 72 | (nnoo-import nnlistserv | ||
| 73 | (nnweb)) | ||
| 74 | |||
| 75 | ;;; Internal functions | ||
| 76 | |||
| 77 | ;;; | ||
| 78 | ;;; KK functions. | ||
| 79 | ;;; | ||
| 80 | |||
| 81 | (defun nnlistserv-kk-create-mapping () | ||
| 82 | "Perform the search and create a number-to-url alist." | ||
| 83 | (save-excursion | ||
| 84 | (set-buffer nnweb-buffer) | ||
| 85 | (let ((case-fold-search t) | ||
| 86 | (active (or (cadr (assoc nnweb-group nnweb-group-alist)) | ||
| 87 | (cons 1 0))) | ||
| 88 | (pages (nnweb-definition 'pages)) | ||
| 89 | map url page subject from ) | ||
| 90 | (while (setq page (pop pages)) | ||
| 91 | (erase-buffer) | ||
| 92 | (when (funcall (nnweb-definition 'search) page) | ||
| 93 | ;; Go through all the article hits on this page. | ||
| 94 | (goto-char (point-min)) | ||
| 95 | (mm-url-decode-entities) | ||
| 96 | (goto-char (point-min)) | ||
| 97 | (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t) | ||
| 98 | (setq url (match-string 1) | ||
| 99 | subject (match-string 2) | ||
| 100 | from (match-string 3)) | ||
| 101 | (setq url (concat (format (nnweb-definition 'address) page) url)) | ||
| 102 | (unless (nnweb-get-hashtb url) | ||
| 103 | (push | ||
| 104 | (list | ||
| 105 | (incf (cdr active)) | ||
| 106 | (make-full-mail-header | ||
| 107 | (cdr active) subject from "" | ||
| 108 | (concat "<" (nnweb-identifier url) "@kk>") | ||
| 109 | nil 0 0 url)) | ||
| 110 | map) | ||
| 111 | (nnweb-set-hashtb (cadar map) (car map)) | ||
| 112 | (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) | ||
| 113 | ;; Return the articles in the right order. | ||
| 114 | (setq nnweb-articles | ||
| 115 | (sort (nconc nnweb-articles map) 'car-less-than-car))))) | ||
| 116 | |||
| 117 | (defun nnlistserv-kk-wash-article () | ||
| 118 | (let ((case-fold-search t) | ||
| 119 | (headers '(sent name email subject id)) | ||
| 120 | sent name email subject id) | ||
| 121 | (mm-url-decode-entities) | ||
| 122 | (while headers | ||
| 123 | (goto-char (point-min)) | ||
| 124 | (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t) | ||
| 125 | (set (pop headers) (match-string 1))) | ||
| 126 | (goto-char (point-min)) | ||
| 127 | (search-forward "<!-- body" nil t) | ||
| 128 | (delete-region (point-min) (progn (forward-line 1) (point))) | ||
| 129 | (goto-char (point-max)) | ||
| 130 | (search-backward "<!-- body" nil t) | ||
| 131 | (delete-region (point-max) (progn (beginning-of-line) (point))) | ||
| 132 | (mm-url-remove-markup) | ||
| 133 | (goto-char (point-min)) | ||
| 134 | (insert (format "From: %s <%s>\n" name email) | ||
| 135 | (format "Subject: %s\n" subject) | ||
| 136 | (format "Message-ID: %s\n" id) | ||
| 137 | (format "Date: %s\n\n" sent)))) | ||
| 138 | |||
| 139 | (defun nnlistserv-kk-search (search) | ||
| 140 | (mm-url-insert | ||
| 141 | (concat (format (nnweb-definition 'address) search) | ||
| 142 | (nnweb-definition 'index))) | ||
| 143 | t) | ||
| 144 | |||
| 145 | (defun nnlistserv-kk-identity (url) | ||
| 146 | "Return an unique identifier based on URL." | ||
| 147 | url) | ||
| 148 | |||
| 149 | (provide 'nnlistserv) | ||
| 150 | |||
| 151 | ;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617 | ||
| 152 | ;;; nnlistserv.el ends here | ||
diff --git a/lisp/gnus/nnwfm.el b/lisp/gnus/nnwfm.el deleted file mode 100644 index fceb3ccd6ad..00000000000 --- a/lisp/gnus/nnwfm.el +++ /dev/null | |||
| @@ -1,432 +0,0 @@ | |||
| 1 | ;;; nnwfm.el --- interfacing with a web forum | ||
| 2 | |||
| 3 | ;; Copyright (C) 2000, 2002, 2003, 2004, 2005, | ||
| 4 | ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 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 3 of the License, or | ||
| 14 | ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; Note: You need to have `url' and `w3' installed for this | ||
| 27 | ;; backend to work. | ||
| 28 | |||
| 29 | ;;; Code: | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | ||
| 32 | |||
| 33 | (require 'nnoo) | ||
| 34 | (require 'message) | ||
| 35 | (require 'gnus-util) | ||
| 36 | (require 'gnus) | ||
| 37 | (require 'nnmail) | ||
| 38 | (require 'mm-util) | ||
| 39 | (require 'mm-url) | ||
| 40 | (require 'nnweb) | ||
| 41 | (autoload 'w3-parse-buffer "w3-parse") | ||
| 42 | |||
| 43 | (nnoo-declare nnwfm) | ||
| 44 | |||
| 45 | (defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/") | ||
| 46 | "Where nnwfm will save its files.") | ||
| 47 | |||
| 48 | (defvoo nnwfm-address "" | ||
| 49 | "The address of the Ultimate bulletin board.") | ||
| 50 | |||
| 51 | ;;; Internal variables | ||
| 52 | |||
| 53 | (defvar nnwfm-groups-alist nil) | ||
| 54 | (defvoo nnwfm-groups nil) | ||
| 55 | (defvoo nnwfm-headers nil) | ||
| 56 | (defvoo nnwfm-articles nil) | ||
| 57 | (defvar nnwfm-table-regexp | ||
| 58 | "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") | ||
| 59 | |||
| 60 | ;;; Interface functions | ||
| 61 | |||
| 62 | (nnoo-define-basics nnwfm) | ||
| 63 | |||
| 64 | (deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old) | ||
| 65 | (nnwfm-possibly-change-server group server) | ||
| 66 | (unless gnus-nov-is-evil | ||
| 67 | (let* ((last (car (last articles))) | ||
| 68 | (did nil) | ||
| 69 | (start 1) | ||
| 70 | (entry (assoc group nnwfm-groups)) | ||
| 71 | (sid (nth 2 entry)) | ||
| 72 | (topics (nth 4 entry)) | ||
| 73 | (mapping (nth 5 entry)) | ||
| 74 | (old-total (or (nth 6 entry) 1)) | ||
| 75 | (nnwfm-table-regexp "Thread.asp") | ||
| 76 | headers article subject score from date lines parent point | ||
| 77 | contents tinfo fetchers map elem a href garticles topic old-max | ||
| 78 | inc datel table string current-page total-contents pages | ||
| 79 | farticles forum-contents parse furl-fetched mmap farticle | ||
| 80 | thread-id tables hstuff bstuff time) | ||
| 81 | (setq map mapping) | ||
| 82 | (while (and (setq article (car articles)) | ||
| 83 | map) | ||
| 84 | (while (and map | ||
| 85 | (or (> article (caar map)) | ||
| 86 | (< (cadar map) (caar map)))) | ||
| 87 | (pop map)) | ||
| 88 | (when (setq mmap (car map)) | ||
| 89 | (setq farticle -1) | ||
| 90 | (while (and article | ||
| 91 | (<= article (nth 1 mmap))) | ||
| 92 | ;; Do we already have a fetcher for this topic? | ||
| 93 | (if (setq elem (assq (nth 2 mmap) fetchers)) | ||
| 94 | ;; Yes, so we just add the spec to the end. | ||
| 95 | (nconc elem (list (cons article | ||
| 96 | (+ (nth 3 mmap) (incf farticle))))) | ||
| 97 | ;; No, so we add a new one. | ||
| 98 | (push (list (nth 2 mmap) | ||
| 99 | (cons article | ||
| 100 | (+ (nth 3 mmap) (incf farticle)))) | ||
| 101 | fetchers)) | ||
| 102 | (pop articles) | ||
| 103 | (setq article (car articles))))) | ||
| 104 | ;; Now we have the mapping from/to Gnus/nnwfm article numbers, | ||
| 105 | ;; so we start fetching the topics that we need to satisfy the | ||
| 106 | ;; request. | ||
| 107 | (if (not fetchers) | ||
| 108 | (save-excursion | ||
| 109 | (set-buffer nntp-server-buffer) | ||
| 110 | (erase-buffer)) | ||
| 111 | (setq nnwfm-articles nil) | ||
| 112 | (mm-with-unibyte-buffer | ||
| 113 | (dolist (elem fetchers) | ||
| 114 | (erase-buffer) | ||
| 115 | (setq subject (nth 2 (assq (car elem) topics)) | ||
| 116 | thread-id (nth 0 (assq (car elem) topics))) | ||
| 117 | (mm-url-insert | ||
| 118 | (concat nnwfm-address | ||
| 119 | (format "Item.asp?GroupID=%d&ThreadID=%d" sid | ||
| 120 | thread-id))) | ||
| 121 | (goto-char (point-min)) | ||
| 122 | (setq tables (caddar | ||
| 123 | (caddar | ||
| 124 | (cdr (caddar | ||
| 125 | (caddar | ||
| 126 | (ignore-errors | ||
| 127 | (w3-parse-buffer (current-buffer))))))))) | ||
| 128 | (setq tables (cdr (caddar (memq (assq 'div tables) tables)))) | ||
| 129 | (setq contents nil) | ||
| 130 | (dolist (table tables) | ||
| 131 | (when (eq (car table) 'table) | ||
| 132 | (setq table (caddar (caddar (caddr table))) | ||
| 133 | hstuff (delete ":link" (nnweb-text (car table))) | ||
| 134 | bstuff (car (caddar (cdr table))) | ||
| 135 | from (car hstuff)) | ||
| 136 | (when (nth 2 hstuff) | ||
| 137 | (setq time (nnwfm-date-to-time (nth 2 hstuff))) | ||
| 138 | (push (list from time bstuff) contents)))) | ||
| 139 | (setq contents (nreverse contents)) | ||
| 140 | (dolist (art (cdr elem)) | ||
| 141 | (push (list (car art) | ||
| 142 | (nth (1- (cdr art)) contents) | ||
| 143 | subject) | ||
| 144 | nnwfm-articles)))) | ||
| 145 | (setq nnwfm-articles | ||
| 146 | (sort nnwfm-articles 'car-less-than-car)) | ||
| 147 | ;; Now we have all the articles, conveniently in an alist | ||
| 148 | ;; where the key is the Gnus article number. | ||
| 149 | (dolist (articlef nnwfm-articles) | ||
| 150 | (setq article (nth 0 articlef) | ||
| 151 | contents (nth 1 articlef) | ||
| 152 | subject (nth 2 articlef)) | ||
| 153 | (setq from (nth 0 contents) | ||
| 154 | date (message-make-date (nth 1 contents))) | ||
| 155 | (push | ||
| 156 | (cons | ||
| 157 | article | ||
| 158 | (make-full-mail-header | ||
| 159 | article subject | ||
| 160 | from (or date "") | ||
| 161 | (concat "<" (number-to-string sid) "%" | ||
| 162 | (number-to-string article) | ||
| 163 | "@wfm>") | ||
| 164 | "" 0 | ||
| 165 | (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) "")) | ||
| 166 | 70) | ||
| 167 | nil nil)) | ||
| 168 | headers)) | ||
| 169 | (setq nnwfm-headers (sort headers 'car-less-than-car)) | ||
| 170 | (save-excursion | ||
| 171 | (set-buffer nntp-server-buffer) | ||
| 172 | (mm-with-unibyte-current-buffer | ||
| 173 | (erase-buffer) | ||
| 174 | (dolist (header nnwfm-headers) | ||
| 175 | (nnheader-insert-nov (cdr header)))))) | ||
| 176 | 'nov))) | ||
| 177 | |||
| 178 | (deffoo nnwfm-request-group (group &optional server dont-check) | ||
| 179 | (nnwfm-possibly-change-server nil server) | ||
| 180 | (when (not nnwfm-groups) | ||
| 181 | (nnwfm-request-list)) | ||
| 182 | (unless dont-check | ||
| 183 | (nnwfm-create-mapping group)) | ||
| 184 | (let ((elem (assoc group nnwfm-groups))) | ||
| 185 | (cond | ||
| 186 | ((not elem) | ||
| 187 | (nnheader-report 'nnwfm "Group does not exist")) | ||
| 188 | (t | ||
| 189 | (nnheader-report 'nnwfm "Opened group %s" group) | ||
| 190 | (nnheader-insert | ||
| 191 | "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) | ||
| 192 | (prin1-to-string group)))))) | ||
| 193 | |||
| 194 | (deffoo nnwfm-request-close () | ||
| 195 | (setq nnwfm-groups-alist nil | ||
| 196 | nnwfm-groups nil)) | ||
| 197 | |||
| 198 | (deffoo nnwfm-request-article (article &optional group server buffer) | ||
| 199 | (nnwfm-possibly-change-server group server) | ||
| 200 | (let ((contents (cdr (assq article nnwfm-articles)))) | ||
| 201 | (when (setq contents (nth 2 (car contents))) | ||
| 202 | (save-excursion | ||
| 203 | (set-buffer (or buffer nntp-server-buffer)) | ||
| 204 | (erase-buffer) | ||
| 205 | (nnweb-insert-html contents) | ||
| 206 | (goto-char (point-min)) | ||
| 207 | (insert "Content-Type: text/html\nMIME-Version: 1.0\n") | ||
| 208 | (let ((header (cdr (assq article nnwfm-headers)))) | ||
| 209 | (mm-with-unibyte-current-buffer | ||
| 210 | (nnheader-insert-header header))) | ||
| 211 | (nnheader-report 'nnwfm "Fetched article %s" article) | ||
| 212 | (cons group article))))) | ||
| 213 | |||
| 214 | (deffoo nnwfm-request-list (&optional server) | ||
| 215 | (nnwfm-possibly-change-server nil server) | ||
| 216 | (mm-with-unibyte-buffer | ||
| 217 | (mm-url-insert | ||
| 218 | (if (string-match "/$" nnwfm-address) | ||
| 219 | (concat nnwfm-address "Group.asp") | ||
| 220 | nnwfm-address)) | ||
| 221 | (let* ((nnwfm-table-regexp "Thread.asp") | ||
| 222 | (contents (w3-parse-buffer (current-buffer))) | ||
| 223 | sid elem description articles a href group forum | ||
| 224 | a1 a2) | ||
| 225 | (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table | ||
| 226 | contents)))))) | ||
| 227 | (setq row (nth 2 row)) | ||
| 228 | (when (setq a (nnweb-parse-find 'a row)) | ||
| 229 | (setq group (car (last (nnweb-text a))) | ||
| 230 | href (cdr (assq 'href (nth 1 a)))) | ||
| 231 | (setq description (car (last (nnweb-text (nth 1 row))))) | ||
| 232 | (setq articles | ||
| 233 | (string-to-number | ||
| 234 | (gnus-replace-in-string | ||
| 235 | (car (last (nnweb-text (nth 3 row)))) "," ""))) | ||
| 236 | (when (and href | ||
| 237 | (string-match "GroupId=\\([0-9]+\\)" href)) | ||
| 238 | (setq forum (string-to-number (match-string 1 href))) | ||
| 239 | (if (setq elem (assoc group nnwfm-groups)) | ||
| 240 | (setcar (cdr elem) articles) | ||
| 241 | (push (list group articles forum description nil nil nil nil) | ||
| 242 | nnwfm-groups)))))) | ||
| 243 | (nnwfm-write-groups) | ||
| 244 | (nnwfm-generate-active) | ||
| 245 | t)) | ||
| 246 | |||
| 247 | (deffoo nnwfm-request-newgroups (date &optional server) | ||
| 248 | (nnwfm-possibly-change-server nil server) | ||
| 249 | (nnwfm-generate-active) | ||
| 250 | t) | ||
| 251 | |||
| 252 | (nnoo-define-skeleton nnwfm) | ||
| 253 | |||
| 254 | ;;; Internal functions | ||
| 255 | |||
| 256 | (defun nnwfm-new-threads-p (group time) | ||
| 257 | "See whether we want to fetch the threads for GROUP written before TIME." | ||
| 258 | (let ((old-time (nth 7 (assoc group nnwfm-groups)))) | ||
| 259 | (or (null old-time) | ||
| 260 | (time-less-p old-time time)))) | ||
| 261 | |||
| 262 | (defun nnwfm-create-mapping (group) | ||
| 263 | (let* ((entry (assoc group nnwfm-groups)) | ||
| 264 | (sid (nth 2 entry)) | ||
| 265 | (topics (nth 4 entry)) | ||
| 266 | (mapping (nth 5 entry)) | ||
| 267 | (old-total (or (nth 6 entry) 1)) | ||
| 268 | (current-time (current-time)) | ||
| 269 | (nnwfm-table-regexp "Thread.asp") | ||
| 270 | (furls (list (concat nnwfm-address | ||
| 271 | (format "Thread.asp?GroupId=%d" sid)))) | ||
| 272 | fetched-urls | ||
| 273 | contents forum-contents a subject href | ||
| 274 | garticles topic tinfo old-max inc parse elem date | ||
| 275 | url time) | ||
| 276 | (mm-with-unibyte-buffer | ||
| 277 | (while furls | ||
| 278 | (erase-buffer) | ||
| 279 | (push (car furls) fetched-urls) | ||
| 280 | (mm-url-insert (pop furls)) | ||
| 281 | (goto-char (point-min)) | ||
| 282 | (while (re-search-forward " wr(" nil t) | ||
| 283 | (forward-char -1) | ||
| 284 | (setq elem (message-tokenize-header | ||
| 285 | (gnus-replace-in-string | ||
| 286 | (buffer-substring | ||
| 287 | (1+ (point)) | ||
| 288 | (progn | ||
| 289 | (forward-sexp 1) | ||
| 290 | (1- (point)))) | ||
| 291 | "\\\\[\"\\\\]" ""))) | ||
| 292 | (push (list | ||
| 293 | (string-to-number (nth 1 elem)) | ||
| 294 | (gnus-replace-in-string (nth 2 elem) "\"" "") | ||
| 295 | (string-to-number (nth 5 elem))) | ||
| 296 | forum-contents)) | ||
| 297 | (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)" | ||
| 298 | nil t) | ||
| 299 | (setq url (match-string 1) | ||
| 300 | time (nnwfm-date-to-time (gnus-url-unhex-string | ||
| 301 | (match-string 2)))) | ||
| 302 | (when (and (nnwfm-new-threads-p group time) | ||
| 303 | (not (member | ||
| 304 | (setq url (concat | ||
| 305 | nnwfm-address | ||
| 306 | (mm-url-decode-entities-string url))) | ||
| 307 | fetched-urls))) | ||
| 308 | (push url furls)))) | ||
| 309 | ;; The main idea here is to map Gnus article numbers to | ||
| 310 | ;; nnwfm article numbers. Say there are three topics in | ||
| 311 | ;; this forum, the first with 4 articles, the seconds with 2, | ||
| 312 | ;; and the third with 1. Then this will translate into 7 Gnus | ||
| 313 | ;; article numbers, where 1-4 comes from the first topic, 5-6 | ||
| 314 | ;; from the second and 7 from the third. Now, then next time | ||
| 315 | ;; the group is entered, there's 2 new articles in topic one | ||
| 316 | ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 | ||
| 317 | ;; in topic one and 10 will be the 2 in topic three. | ||
| 318 | (dolist (elem (nreverse forum-contents)) | ||
| 319 | (setq subject (nth 1 elem) | ||
| 320 | topic (nth 0 elem) | ||
| 321 | garticles (nth 2 elem)) | ||
| 322 | (if (setq tinfo (assq topic topics)) | ||
| 323 | (progn | ||
| 324 | (setq old-max (cadr tinfo)) | ||
| 325 | (setcar (cdr tinfo) garticles)) | ||
| 326 | (setq old-max 0) | ||
| 327 | (push (list topic garticles subject) topics) | ||
| 328 | (setcar (nthcdr 4 entry) topics)) | ||
| 329 | (when (not (= old-max garticles)) | ||
| 330 | (setq inc (- garticles old-max)) | ||
| 331 | (setq mapping (nconc mapping | ||
| 332 | (list | ||
| 333 | (list | ||
| 334 | old-total (1- (incf old-total inc)) | ||
| 335 | topic (1+ old-max))))) | ||
| 336 | (incf old-max inc) | ||
| 337 | (setcar (nthcdr 5 entry) mapping) | ||
| 338 | (setcar (nthcdr 6 entry) old-total)))) | ||
| 339 | (setcar (nthcdr 7 entry) current-time) | ||
| 340 | (setcar (nthcdr 1 entry) (1- old-total)) | ||
| 341 | (nnwfm-write-groups) | ||
| 342 | mapping)) | ||
| 343 | |||
| 344 | (defun nnwfm-possibly-change-server (&optional group server) | ||
| 345 | (nnwfm-init server) | ||
| 346 | (when (and server | ||
| 347 | (not (nnwfm-server-opened server))) | ||
| 348 | (nnwfm-open-server server)) | ||
| 349 | (unless nnwfm-groups-alist | ||
| 350 | (nnwfm-read-groups) | ||
| 351 | (setq nnwfm-groups (cdr (assoc nnwfm-address | ||
| 352 | nnwfm-groups-alist))))) | ||
| 353 | |||
| 354 | (deffoo nnwfm-open-server (server &optional defs connectionless) | ||
| 355 | (nnheader-init-server-buffer) | ||
| 356 | (if (nnwfm-server-opened server) | ||
| 357 | t | ||
| 358 | (unless (assq 'nnwfm-address defs) | ||
| 359 | (setq defs (append defs (list (list 'nnwfm-address server))))) | ||
| 360 | (nnoo-change-server 'nnwfm server defs))) | ||
| 361 | |||
| 362 | (defun nnwfm-read-groups () | ||
| 363 | (setq nnwfm-groups-alist nil) | ||
| 364 | (let ((file (expand-file-name "groups" nnwfm-directory))) | ||
| 365 | (when (file-exists-p file) | ||
| 366 | (mm-with-unibyte-buffer | ||
| 367 | (insert-file-contents file) | ||
| 368 | (goto-char (point-min)) | ||
| 369 | (setq nnwfm-groups-alist (read (current-buffer))))))) | ||
| 370 | |||
| 371 | (defun nnwfm-write-groups () | ||
| 372 | (setq nnwfm-groups-alist | ||
| 373 | (delq (assoc nnwfm-address nnwfm-groups-alist) | ||
| 374 | nnwfm-groups-alist)) | ||
| 375 | (push (cons nnwfm-address nnwfm-groups) | ||
| 376 | nnwfm-groups-alist) | ||
| 377 | (with-temp-file (expand-file-name "groups" nnwfm-directory) | ||
| 378 | (prin1 nnwfm-groups-alist (current-buffer)))) | ||
| 379 | |||
| 380 | (defun nnwfm-init (server) | ||
| 381 | "Initialize buffers and such." | ||
| 382 | (unless (file-exists-p nnwfm-directory) | ||
| 383 | (gnus-make-directory nnwfm-directory))) | ||
| 384 | |||
| 385 | (defun nnwfm-generate-active () | ||
| 386 | (save-excursion | ||
| 387 | (set-buffer nntp-server-buffer) | ||
| 388 | (erase-buffer) | ||
| 389 | (dolist (elem nnwfm-groups) | ||
| 390 | (insert (prin1-to-string (car elem)) | ||
| 391 | " " (number-to-string (cadr elem)) " 1 y\n")))) | ||
| 392 | |||
| 393 | (defun nnwfm-find-forum-table (contents) | ||
| 394 | (catch 'found | ||
| 395 | (nnwfm-find-forum-table-1 contents))) | ||
| 396 | |||
| 397 | (defun nnwfm-find-forum-table-1 (contents) | ||
| 398 | (dolist (element contents) | ||
| 399 | (unless (stringp element) | ||
| 400 | (when (and (eq (car element) 'table) | ||
| 401 | (nnwfm-forum-table-p element)) | ||
| 402 | (throw 'found element)) | ||
| 403 | (when (nth 2 element) | ||
| 404 | (nnwfm-find-forum-table-1 (nth 2 element)))))) | ||
| 405 | |||
| 406 | (defun nnwfm-forum-table-p (parse) | ||
| 407 | (when (not (apply 'gnus-or | ||
| 408 | (mapcar | ||
| 409 | (lambda (p) | ||
| 410 | (nnweb-parse-find 'table p)) | ||
| 411 | (nth 2 parse)))) | ||
| 412 | (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) | ||
| 413 | case-fold-search) | ||
| 414 | (when (and href (string-match nnwfm-table-regexp href)) | ||
| 415 | t)))) | ||
| 416 | |||
| 417 | (defun nnwfm-date-to-time (date) | ||
| 418 | (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]")))) | ||
| 419 | (encode-time 0 (nth 4 time) (nth 3 time) | ||
| 420 | (nth 0 time) (nth 1 time) | ||
| 421 | (if (< (nth 2 time) 70) | ||
| 422 | (+ 2000 (nth 2 time)) | ||
| 423 | (+ 1900 (nth 2 time)))))) | ||
| 424 | |||
| 425 | (provide 'nnwfm) | ||
| 426 | |||
| 427 | ;; Local Variables: | ||
| 428 | ;; coding: iso-8859-1 | ||
| 429 | ;; End: | ||
| 430 | |||
| 431 | ;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536 | ||
| 432 | ;;; nnwfm.el ends here | ||