Commit 261ff377 authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen Committed by Katsumi Yamaoka
Browse files

Remove nnlistserv, nnwfm and related code.

parent f7362445
......@@ -29066,8 +29066,7 @@ As the variables for the other back ends, there are
@code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil},
@code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a
non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those
variables.@footnote{Although the back end @code{nnwfm} doesn't have
its own nn*-nov-is-evil.}
variables.
@end table
 
 
2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnwfm.el: Removed.
* nnlistserv.el: Removed.
2010-09-01 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-html.el (gnus-html-image-url-blocked-p): New function.
......
......@@ -1745,8 +1745,6 @@ slower."
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
("nnrss" none)
("nnwfm" none)
("nnlistserv" none)
("nnagent" post-mail)
("nnimap" post-mail address prompt-address physical-address)
("nnmaildir" mail respool address)
......
;;; nnlistserv.el --- retrieving articles via web mailing list archives
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
;; 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 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl))
(require 'nnoo)
(require 'mm-url)
(require 'nnweb)
(nnoo-declare nnlistserv
nnweb)
(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
"Where nnlistserv will save its files."
nnweb-directory)
(defvoo nnlistserv-name 'kk
"What search engine type is being used."
nnweb-type)
(defvoo nnlistserv-type-definition
'((kk
(article . nnlistserv-kk-wash-article)
(map . nnlistserv-kk-create-mapping)
(search . nnlistserv-kk-search)
(address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
(pages "fra160396" "fra160796" "fra061196" "fra160197"
"fra090997" "fra040797" "fra130397" "nye")
(index . "date.html")
(identifier . nnlistserv-kk-identity)))
"Type-definition alist."
nnweb-type-definition)
(defvoo nnlistserv-search nil
"Search string to feed to DejaNews."
nnweb-search)
(defvoo nnlistserv-ephemeral-p nil
"Whether this nnlistserv server is ephemeral."
nnweb-ephemeral-p)
;;; Internal variables
;;; Interface functions
(nnoo-define-basics nnlistserv)
(nnoo-import nnlistserv
(nnweb))
;;; Internal functions
;;;
;;; KK functions.
;;;
(defun nnlistserv-kk-create-mapping ()
"Perform the search and create a number-to-url alist."
(save-excursion
(set-buffer nnweb-buffer)
(let ((case-fold-search t)
(active (or (cadr (assoc nnweb-group nnweb-group-alist))
(cons 1 0)))
(pages (nnweb-definition 'pages))
map url page subject from )
(while (setq page (pop pages))
(erase-buffer)
(when (funcall (nnweb-definition 'search) page)
;; Go through all the article hits on this page.
(goto-char (point-min))
(mm-url-decode-entities)
(goto-char (point-min))
(while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
(setq url (match-string 1)
subject (match-string 2)
from (match-string 3))
(setq url (concat (format (nnweb-definition 'address) page) url))
(unless (nnweb-get-hashtb url)
(push
(list
(incf (cdr active))
(make-full-mail-header
(cdr active) subject from ""
(concat "<" (nnweb-identifier url) "@kk>")
nil 0 0 url))
map)
(nnweb-set-hashtb (cadar map) (car map))
(nnheader-message 5 "%s %s %s" (cdr active) (point) pages)))))
;; Return the articles in the right order.
(setq nnweb-articles
(sort (nconc nnweb-articles map) 'car-less-than-car)))))
(defun nnlistserv-kk-wash-article ()
(let ((case-fold-search t)
(headers '(sent name email subject id))
sent name email subject id)
(mm-url-decode-entities)
(while headers
(goto-char (point-min))
(re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t)
(set (pop headers) (match-string 1)))
(goto-char (point-min))
(search-forward "<!-- body" nil t)
(delete-region (point-min) (progn (forward-line 1) (point)))
(goto-char (point-max))
(search-backward "<!-- body" nil t)
(delete-region (point-max) (progn (beginning-of-line) (point)))
(mm-url-remove-markup)
(goto-char (point-min))
(insert (format "From: %s <%s>\n" name email)
(format "Subject: %s\n" subject)
(format "Message-ID: %s\n" id)
(format "Date: %s\n\n" sent))))
(defun nnlistserv-kk-search (search)
(mm-url-insert
(concat (format (nnweb-definition 'address) search)
(nnweb-definition 'index)))
t)
(defun nnlistserv-kk-identity (url)
"Return an unique identifier based on URL."
url)
(provide 'nnlistserv)
;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617
;;; nnlistserv.el ends here
;;; nnwfm.el --- interfacing with a web forum
;; Copyright (C) 2000, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
;; 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 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Note: You need to have `url' and `w3' installed for this
;; backend to work.
;;; Code:
(eval-when-compile (require 'cl))
(require 'nnoo)
(require 'message)
(require 'gnus-util)
(require 'gnus)
(require 'nnmail)
(require 'mm-util)
(require 'mm-url)
(require 'nnweb)
(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnwfm)
(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/")
"Where nnwfm will save its files.")
(defvoo nnwfm-address ""
"The address of the Ultimate bulletin board.")
;;; Internal variables
(defvar nnwfm-groups-alist nil)
(defvoo nnwfm-groups nil)
(defvoo nnwfm-headers nil)
(defvoo nnwfm-articles nil)
(defvar nnwfm-table-regexp
"postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
;;; Interface functions
(nnoo-define-basics nnwfm)
(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old)
(nnwfm-possibly-change-server group server)
(unless gnus-nov-is-evil
(let* ((last (car (last articles)))
(did nil)
(start 1)
(entry (assoc group nnwfm-groups))
(sid (nth 2 entry))
(topics (nth 4 entry))
(mapping (nth 5 entry))
(old-total (or (nth 6 entry) 1))
(nnwfm-table-regexp "Thread.asp")
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 mmap farticle
thread-id tables hstuff bstuff time)
(setq map mapping)
(while (and (setq article (car articles))
map)
(while (and map
(or (> article (caar map))
(< (cadar map) (caar map))))
(pop map))
(when (setq mmap (car map))
(setq farticle -1)
(while (and article
(<= article (nth 1 mmap)))
;; Do we already have a fetcher for this topic?
(if (setq elem (assq (nth 2 mmap) fetchers))
;; Yes, so we just add the spec to the end.
(nconc elem (list (cons article
(+ (nth 3 mmap) (incf farticle)))))
;; No, so we add a new one.
(push (list (nth 2 mmap)
(cons article
(+ (nth 3 mmap) (incf farticle))))
fetchers))
(pop articles)
(setq article (car articles)))))
;; Now we have the mapping from/to Gnus/nnwfm article numbers,
;; so we start fetching the topics that we need to satisfy the
;; request.
(if (not fetchers)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer))
(setq nnwfm-articles nil)
(mm-with-unibyte-buffer
(dolist (elem fetchers)
(erase-buffer)
(setq subject (nth 2 (assq (car elem) topics))
thread-id (nth 0 (assq (car elem) topics)))
(mm-url-insert
(concat nnwfm-address
(format "Item.asp?GroupID=%d&ThreadID=%d" sid
thread-id)))
(goto-char (point-min))
(setq tables (caddar
(caddar
(cdr (caddar
(caddar
(ignore-errors
(w3-parse-buffer (current-buffer)))))))))
(setq tables (cdr (caddar (memq (assq 'div tables) tables))))
(setq contents nil)
(dolist (table tables)
(when (eq (car table) 'table)
(setq table (caddar (caddar (caddr table)))
hstuff (delete ":link" (nnweb-text (car table)))
bstuff (car (caddar (cdr table)))
from (car hstuff))
(when (nth 2 hstuff)
(setq time (nnwfm-date-to-time (nth 2 hstuff)))
(push (list from time bstuff) contents))))
(setq contents (nreverse contents))
(dolist (art (cdr elem))
(push (list (car art)
(nth (1- (cdr art)) contents)
subject)
nnwfm-articles))))
(setq nnwfm-articles
(sort nnwfm-articles 'car-less-than-car))
;; Now we have all the articles, conveniently in an alist
;; where the key is the Gnus article number.
(dolist (articlef nnwfm-articles)
(setq article (nth 0 articlef)
contents (nth 1 articlef)
subject (nth 2 articlef))
(setq from (nth 0 contents)
date (message-make-date (nth 1 contents)))
(push
(cons
article
(make-full-mail-header
article subject
from (or date "")
(concat "<" (number-to-string sid) "%"
(number-to-string article)
"@wfm>")
"" 0
(/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) ""))
70)
nil nil))
headers))
(setq nnwfm-headers (sort headers 'car-less-than-car))
(save-excursion
(set-buffer nntp-server-buffer)
(mm-with-unibyte-current-buffer
(erase-buffer)
(dolist (header nnwfm-headers)
(nnheader-insert-nov (cdr header))))))
'nov)))
(deffoo nnwfm-request-group (group &optional server dont-check)
(nnwfm-possibly-change-server nil server)
(when (not nnwfm-groups)
(nnwfm-request-list))
(unless dont-check
(nnwfm-create-mapping group))
(let ((elem (assoc group nnwfm-groups)))
(cond
((not elem)
(nnheader-report 'nnwfm "Group does not exist"))
(t
(nnheader-report 'nnwfm "Opened group %s" group)
(nnheader-insert
"211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
(prin1-to-string group))))))
(deffoo nnwfm-request-close ()
(setq nnwfm-groups-alist nil
nnwfm-groups nil))
(deffoo nnwfm-request-article (article &optional group server buffer)
(nnwfm-possibly-change-server group server)
(let ((contents (cdr (assq article nnwfm-articles))))
(when (setq contents (nth 2 (car contents)))
(save-excursion
(set-buffer (or buffer nntp-server-buffer))
(erase-buffer)
(nnweb-insert-html contents)
(goto-char (point-min))
(insert "Content-Type: text/html\nMIME-Version: 1.0\n")
(let ((header (cdr (assq article nnwfm-headers))))
(mm-with-unibyte-current-buffer
(nnheader-insert-header header)))
(nnheader-report 'nnwfm "Fetched article %s" article)
(cons group article)))))
(deffoo nnwfm-request-list (&optional server)
(nnwfm-possibly-change-server nil server)
(mm-with-unibyte-buffer
(mm-url-insert
(if (string-match "/$" nnwfm-address)
(concat nnwfm-address "Group.asp")
nnwfm-address))
(let* ((nnwfm-table-regexp "Thread.asp")
(contents (w3-parse-buffer (current-buffer)))
sid elem description articles a href group forum
a1 a2)
(dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table
contents))))))
(setq row (nth 2 row))
(when (setq a (nnweb-parse-find 'a row))
(setq group (car (last (nnweb-text a)))
href (cdr (assq 'href (nth 1 a))))
(setq description (car (last (nnweb-text (nth 1 row)))))
(setq articles
(string-to-number
(gnus-replace-in-string
(car (last (nnweb-text (nth 3 row)))) "," "")))
(when (and href
(string-match "GroupId=\\([0-9]+\\)" href))
(setq forum (string-to-number (match-string 1 href)))
(if (setq elem (assoc group nnwfm-groups))
(setcar (cdr elem) articles)
(push (list group articles forum description nil nil nil nil)
nnwfm-groups))))))
(nnwfm-write-groups)
(nnwfm-generate-active)
t))
(deffoo nnwfm-request-newgroups (date &optional server)
(nnwfm-possibly-change-server nil server)
(nnwfm-generate-active)
t)
(nnoo-define-skeleton nnwfm)
;;; Internal functions
(defun nnwfm-new-threads-p (group time)
"See whether we want to fetch the threads for GROUP written before TIME."
(let ((old-time (nth 7 (assoc group nnwfm-groups))))
(or (null old-time)
(time-less-p old-time time))))
(defun nnwfm-create-mapping (group)
(let* ((entry (assoc group nnwfm-groups))
(sid (nth 2 entry))
(topics (nth 4 entry))
(mapping (nth 5 entry))
(old-total (or (nth 6 entry) 1))
(current-time (current-time))
(nnwfm-table-regexp "Thread.asp")
(furls (list (concat nnwfm-address
(format "Thread.asp?GroupId=%d" sid))))
fetched-urls
contents forum-contents a subject href
garticles topic tinfo old-max inc parse elem date
url time)
(mm-with-unibyte-buffer
(while furls
(erase-buffer)
(push (car furls) fetched-urls)
(mm-url-insert (pop furls))
(goto-char (point-min))
(while (re-search-forward " wr(" nil t)
(forward-char -1)
(setq elem (message-tokenize-header
(gnus-replace-in-string
(buffer-substring
(1+ (point))
(progn
(forward-sexp 1)
(1- (point))))
"\\\\[\"\\\\]" "")))
(push (list
(string-to-number (nth 1 elem))
(gnus-replace-in-string (nth 2 elem) "\"" "")
(string-to-number (nth 5 elem)))
forum-contents))
(when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)"
nil t)
(setq url (match-string 1)
time (nnwfm-date-to-time (gnus-url-unhex-string
(match-string 2))))
(when (and (nnwfm-new-threads-p group time)
(not (member
(setq url (concat
nnwfm-address
(mm-url-decode-entities-string url)))
fetched-urls)))
(push url furls))))
;; The main idea here is to map Gnus article numbers to
;; nnwfm article numbers. Say there are three topics in
;; this forum, the first with 4 articles, the seconds with 2,
;; and the third with 1. Then this will translate into 7 Gnus
;; article numbers, where 1-4 comes from the first topic, 5-6
;; from the second and 7 from the third. Now, then next time
;; 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 (elem (nreverse forum-contents))
(setq subject (nth 1 elem)
topic (nth 0 elem)
garticles (nth 2 elem))
(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) 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))
(nnwfm-write-groups)
mapping))
(defun nnwfm-possibly-change-server (&optional group server)
(nnwfm-init server)
(when (and server
(not (nnwfm-server-opened server)))
(nnwfm-open-server server))
(unless nnwfm-groups-alist
(nnwfm-read-groups)
(setq nnwfm-groups (cdr (assoc nnwfm-address
nnwfm-groups-alist)))))
(deffoo nnwfm-open-server (server &optional defs connectionless)
(nnheader-init-server-buffer)
(if (nnwfm-server-opened server)
t
(unless (assq 'nnwfm-address defs)
(setq defs (append defs (list (list 'nnwfm-address server)))))
(nnoo-change-server 'nnwfm server defs)))
(defun nnwfm-read-groups ()
(setq nnwfm-groups-alist nil)
(let ((file (expand-file-name "groups" nnwfm-directory)))
(when (file-exists-p file)
(mm-with-unibyte-buffer
(insert-file-contents file)
(goto-char (point-min))
(setq nnwfm-groups-alist (read (current-buffer)))))))
(defun nnwfm-write-groups ()
(setq nnwfm-groups-alist
(delq (assoc nnwfm-address nnwfm-groups-alist)
nnwfm-groups-alist))
(push (cons nnwfm-address nnwfm-groups)
nnwfm-groups-alist)
(with-temp-file (expand-file-name "groups" nnwfm-directory)
(prin1 nnwfm-groups-alist (current-buffer))))
(defun nnwfm-init (server)
"Initialize buffers and such."
(unless (file-exists-p nnwfm-directory)
(gnus-make-directory nnwfm-directory)))
(defun nnwfm-generate-active ()
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (elem nnwfm-groups)
(insert (prin1-to-string (car elem))
" " (number-to-string (cadr elem)) " 1 y\n"))))
(defun nnwfm-find-forum-table (contents)
(catch 'found
(nnwfm-find-forum-table-1 contents)))
(defun nnwfm-find-forum-table-1 (contents)
(dolist (element contents)
(unless (stringp element)
(when (and (eq (car element) 'table)
(nnwfm-forum-table-p element))
(throw 'found element))
(when (nth 2 element)
(nnwfm-find-forum-table-1 (nth 2 element))))))
(defun nnwfm-forum-table-p (parse)
(when (not (apply 'gnus-or
(mapcar
(lambda (p)
(nnweb-parse-find 'table p))
(nth 2 parse))))
(let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
case-fold-search)
(when (and href (string-match nnwfm-table-regexp href))
t))))
(defun nnwfm-date-to-time (date)
(let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]"))))
(encode-time 0 (nth 4 time) (nth 3 time)
(nth 0 time) (nth 1 time)
(if (< (nth 2 time) 70)
(+ 2000 (nth 2 time))
(+ 1900 (nth 2 time))))))
(provide 'nnwfm)
;; Local Variables:
;; coding: iso-8859-1
;; End:
;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536
;;; nnwfm.el ends here