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