Commit | Line | Data |
---|---|---|
df80b09f | 1 | ;;; nnlistserv.el --- retrieving articles via web mailing list archives |
16409b0b | 2 | |
b6c2d8c6 | 3 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
e3fe4da0 | 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
df80b09f LMI |
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 | |
5a9dffec | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
df80b09f LMI |
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 | |
3a35cf56 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
df80b09f LMI |
25 | |
26 | ;;; Commentary: | |
27 | ||
df80b09f LMI |
28 | ;;; Code: |
29 | ||
30 | (eval-when-compile (require 'cl)) | |
31 | ||
32 | (require 'nnoo) | |
23f87bed MB |
33 | (require 'mm-url) |
34 | (require 'nnweb) | |
df80b09f LMI |
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 | |
16409b0b GM |
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))) | |
df80b09f LMI |
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 () | |
88ab16c8 | 84 | "Perform the search and create a number-to-url alist." |
df80b09f LMI |
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)) | |
23f87bed | 97 | (mm-url-decode-entities) |
df80b09f LMI |
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)) | |
16409b0b | 114 | (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) |
df80b09f LMI |
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) | |
23f87bed | 123 | (mm-url-decode-entities) |
df80b09f LMI |
124 | (while headers |
125 | (goto-char (point-min)) | |
557bc6f3 | 126 | (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t) |
df80b09f LMI |
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))) | |
23f87bed | 134 | (mm-url-remove-markup) |
df80b09f LMI |
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) | |
23f87bed | 142 | (mm-url-insert |
16409b0b | 143 | (concat (format (nnweb-definition 'address) search) |
df80b09f LMI |
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 | ||
cbee283d | 153 | ;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617 |
df80b09f | 154 | ;;; nnlistserv.el ends here |