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 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 2, or (at your option)
14;; 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; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;; Code:
29
30(eval-when-compile (require 'cl))
31
32(require 'nnoo)
33(require 'mm-url)
34(require 'nnweb)
35
36(nnoo-declare nnlistserv
37  nnweb)
38
39(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
40  "Where nnlistserv will save its files."
41  nnweb-directory)
42
43(defvoo nnlistserv-name 'kk
44  "What search engine type is being used."
45  nnweb-type)
46
47(defvoo nnlistserv-type-definition
48    '((kk
49       (article . nnlistserv-kk-wash-article)
50       (map . nnlistserv-kk-create-mapping)
51       (search . nnlistserv-kk-search)
52       (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
53       (pages "fra160396" "fra160796" "fra061196" "fra160197"
54	      "fra090997" "fra040797" "fra130397" "nye")
55       (index . "date.html")
56       (identifier . nnlistserv-kk-identity)))
57  "Type-definition alist."
58  nnweb-type-definition)
59
60(defvoo nnlistserv-search nil
61  "Search string to feed to DejaNews."
62  nnweb-search)
63
64(defvoo nnlistserv-ephemeral-p nil
65  "Whether this nnlistserv server is ephemeral."
66  nnweb-ephemeral-p)
67
68;;; Internal variables
69
70;;; Interface functions
71
72(nnoo-define-basics nnlistserv)
73
74(nnoo-import nnlistserv
75  (nnweb))
76
77;;; Internal functions
78
79;;;
80;;; KK functions.
81;;;
82
83(defun nnlistserv-kk-create-mapping ()
84  "Perform the search and create a number-to-url alist."
85  (save-excursion
86    (set-buffer nnweb-buffer)
87    (let ((case-fold-search t)
88	  (active (or (cadr (assoc nnweb-group nnweb-group-alist))
89		      (cons 1 0)))
90	  (pages (nnweb-definition 'pages))
91	  map url page subject from )
92      (while (setq page (pop pages))
93	(erase-buffer)
94	(when (funcall (nnweb-definition 'search) page)
95	  ;; Go through all the article hits on this page.
96	  (goto-char (point-min))
97	  (mm-url-decode-entities)
98	  (goto-char (point-min))
99	  (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
100	    (setq url (match-string 1)
101		  subject (match-string 2)
102		  from (match-string 3))
103	    (setq url (concat (format (nnweb-definition 'address) page) url))
104	    (unless (nnweb-get-hashtb url)
105	      (push
106	       (list
107		(incf (cdr active))
108		(make-full-mail-header
109		 (cdr active) subject from ""
110		 (concat "<" (nnweb-identifier url) "@kk>")
111		 nil 0 0 url))
112	       map)
113	      (nnweb-set-hashtb (cadar map) (car map))
114	      (nnheader-message 5 "%s %s %s" (cdr active) (point) pages)))))
115      ;; Return the articles in the right order.
116      (setq nnweb-articles
117	    (sort (nconc nnweb-articles map) 'car-less-than-car)))))
118
119(defun nnlistserv-kk-wash-article ()
120  (let ((case-fold-search t)
121	(headers '(sent name email subject id))
122	sent name email subject id)
123    (mm-url-decode-entities)
124    (while headers
125      (goto-char (point-min))
126      (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t)
127      (set (pop headers) (match-string 1)))
128    (goto-char (point-min))
129    (search-forward "<!-- body" nil t)
130    (delete-region (point-min) (progn (forward-line 1) (point)))
131    (goto-char (point-max))
132    (search-backward "<!-- body" nil t)
133    (delete-region (point-max) (progn (beginning-of-line) (point)))
134    (mm-url-remove-markup)
135    (goto-char (point-min))
136    (insert (format "From: %s <%s>\n" name email)
137	    (format "Subject: %s\n" subject)
138	    (format "Message-ID: %s\n" id)
139	    (format "Date: %s\n\n" sent))))
140
141(defun nnlistserv-kk-search (search)
142  (mm-url-insert
143   (concat (format (nnweb-definition 'address) search)
144	   (nnweb-definition 'index)))
145  t)
146
147(defun nnlistserv-kk-identity (url)
148  "Return an unique identifier based on URL."
149  url)
150
151(provide 'nnlistserv)
152
153;;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617
154;;; nnlistserv.el ends here
155