Mercurial > emacs
annotate lisp/gnus/nnlistserv.el @ 29248:3401d9822c14
*** empty log message ***
author | Dave Love <fx@gnu.org> |
---|---|
date | Fri, 26 May 2000 13:47:12 +0000 |
parents | 006eeb212983 |
children | 9968f55ad26e |
rev | line source |
---|---|
24358 | 1 ;;; nnlistserv.el --- retrieving articles via web mailing list archives |
2 ;; Copyright (C) 1997,98 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
5 ;; Keywords: news, mail | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 ;; Boston, MA 02111-1307, USA. | |
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) | |
24577
006eeb212983
When compiling, ignore errors in nnweb.
Richard M. Stallman <rms@gnu.org>
parents:
24358
diff
changeset
|
34 (eval-when-compile (ignore-errors (require 'nnweb))) |
006eeb212983
When compiling, ignore errors in nnweb.
Richard M. Stallman <rms@gnu.org>
parents:
24358
diff
changeset
|
35 (eval '(require 'nnweb)) |
24358 | 36 |
37 (nnoo-declare nnlistserv | |
38 nnweb) | |
39 | |
40 (defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") | |
41 "Where nnlistserv will save its files." | |
42 nnweb-directory) | |
43 | |
44 (defvoo nnlistserv-name 'kk | |
45 "What search engine type is being used." | |
46 nnweb-type) | |
47 | |
48 (defvoo nnlistserv-type-definition | |
49 '((kk | |
50 (article . nnlistserv-kk-wash-article) | |
51 (map . nnlistserv-kk-create-mapping) | |
52 (search . nnlistserv-kk-search) | |
53 (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") | |
54 (pages "fra160396" "fra160796" "fra061196" "fra160197" | |
55 "fra090997" "fra040797" "fra130397" "nye") | |
56 (index . "date.html") | |
57 (identifier . nnlistserv-kk-identity))) | |
58 "Type-definition alist." | |
59 nnweb-type-definition) | |
60 | |
61 (defvoo nnlistserv-search nil | |
62 "Search string to feed to DejaNews." | |
63 nnweb-search) | |
64 | |
65 (defvoo nnlistserv-ephemeral-p nil | |
66 "Whether this nnlistserv server is ephemeral." | |
67 nnweb-ephemeral-p) | |
68 | |
69 ;;; Internal variables | |
70 | |
71 ;;; Interface functions | |
72 | |
73 (nnoo-define-basics nnlistserv) | |
74 | |
75 (nnoo-import nnlistserv | |
76 (nnweb)) | |
77 | |
78 ;;; Internal functions | |
79 | |
80 ;;; | |
81 ;;; KK functions. | |
82 ;;; | |
83 | |
84 (defun nnlistserv-kk-create-mapping () | |
85 "Perform the search and create an number-to-url alist." | |
86 (save-excursion | |
87 (set-buffer nnweb-buffer) | |
88 (let ((case-fold-search t) | |
89 (active (or (cadr (assoc nnweb-group nnweb-group-alist)) | |
90 (cons 1 0))) | |
91 (pages (nnweb-definition 'pages)) | |
92 map url page subject from ) | |
93 (while (setq page (pop pages)) | |
94 (erase-buffer) | |
95 (when (funcall (nnweb-definition 'search) page) | |
96 ;; Go through all the article hits on this page. | |
97 (goto-char (point-min)) | |
98 (nnweb-decode-entities) | |
99 (goto-char (point-min)) | |
100 (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t) | |
101 (setq url (match-string 1) | |
102 subject (match-string 2) | |
103 from (match-string 3)) | |
104 (setq url (concat (format (nnweb-definition 'address) page) url)) | |
105 (unless (nnweb-get-hashtb url) | |
106 (push | |
107 (list | |
108 (incf (cdr active)) | |
109 (make-full-mail-header | |
110 (cdr active) subject from "" | |
111 (concat "<" (nnweb-identifier url) "@kk>") | |
112 nil 0 0 url)) | |
113 map) | |
114 (nnweb-set-hashtb (cadar map) (car map)) | |
115 (nnheader-message 5 "%s %s %s" (cdr active) (point) pages) | |
116 )))) | |
117 ;; Return the articles in the right order. | |
118 (setq nnweb-articles | |
119 (sort (nconc nnweb-articles map) 'car-less-than-car))))) | |
120 | |
121 (defun nnlistserv-kk-wash-article () | |
122 (let ((case-fold-search t) | |
123 (headers '(sent name email subject id)) | |
124 sent name email subject id) | |
125 (nnweb-decode-entities) | |
126 (while headers | |
127 (goto-char (point-min)) | |
128 (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers) nil t)) | |
129 (set (pop headers) (match-string 1))) | |
130 (goto-char (point-min)) | |
131 (search-forward "<!-- body" nil t) | |
132 (delete-region (point-min) (progn (forward-line 1) (point))) | |
133 (goto-char (point-max)) | |
134 (search-backward "<!-- body" nil t) | |
135 (delete-region (point-max) (progn (beginning-of-line) (point))) | |
136 (nnweb-remove-markup) | |
137 (goto-char (point-min)) | |
138 (insert (format "From: %s <%s>\n" name email) | |
139 (format "Subject: %s\n" subject) | |
140 (format "Message-ID: %s\n" id) | |
141 (format "Date: %s\n\n" sent)))) | |
142 | |
143 (defun nnlistserv-kk-search (search) | |
144 (url-insert-file-contents | |
145 (concat (format (nnweb-definition 'address) search) | |
146 (nnweb-definition 'index))) | |
147 t) | |
148 | |
149 (defun nnlistserv-kk-identity (url) | |
150 "Return an unique identifier based on URL." | |
151 url) | |
152 | |
153 (provide 'nnlistserv) | |
154 | |
155 ;;; nnlistserv.el ends here |