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