Mercurial > emacs
annotate lisp/gnus/nnlistserv.el @ 97774:cf6404e22e31
*** empty log message ***
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Wed, 27 Aug 2008 20:21:31 +0000 |
parents | f42ef85caf91 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
24358 | 1 ;;; nnlistserv.el --- retrieving articles via web mailing list archives |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
2 |
74547 | 3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
79708 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
24358 | 5 |
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
7 ;; Keywords: news, mail | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
24358 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
24358 | 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 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
24358 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
28 (eval-when-compile (require 'cl)) | |
29 | |
30 (require 'nnoo) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
53875
diff
changeset
|
31 (require 'mm-url) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
53875
diff
changeset
|
32 (require 'nnweb) |
24358 | 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 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
46 '((kk |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
47 (article . nnlistserv-kk-wash-article) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
48 (map . nnlistserv-kk-create-mapping) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
49 (search . nnlistserv-kk-search) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
50 (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
51 (pages "fra160396" "fra160796" "fra061196" "fra160197" |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
52 "fra090997" "fra040797" "fra130397" "nye") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
53 (index . "date.html") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
54 (identifier . nnlistserv-kk-identity))) |
24358 | 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 () | |
47935
70d7c96ed22f
(nnlistserv-kk-create-mapping): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
33924
diff
changeset
|
82 "Perform the search and create a number-to-url alist." |
24358 | 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)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
53875
diff
changeset
|
95 (mm-url-decode-entities) |
24358 | 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)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
112 (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) |
24358 | 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) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
53875
diff
changeset
|
121 (mm-url-decode-entities) |
24358 | 122 (while headers |
123 (goto-char (point-min)) | |
53875
cb0bc8ce8e5a
(nnlistserv-kk-wash-article): Fix paren nesting.
Andreas Schwab <schwab@suse.de>
parents:
52401
diff
changeset
|
124 (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t) |
24358 | 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))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
53875
diff
changeset
|
132 (mm-url-remove-markup) |
24358 | 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) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
53875
diff
changeset
|
140 (mm-url-insert |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24577
diff
changeset
|
141 (concat (format (nnweb-definition 'address) search) |
24358 | 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 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79708
diff
changeset
|
151 ;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617 |
24358 | 152 ;;; nnlistserv.el ends here |