view lisp/gnus/nnlistserv.el @ 66230:4344fd52a670

Add autoloads of crypt++ and mailcrypt routines, all for encryption functionality. allout customization subgroup now positioned in `outlines' group instead of prior `editing' group. (allout-encrypt-string, allout-encryption-produce-work-buffer) (allout-encrypted-topic-p, allout-encrypted-text-type) (allout-mc-activate-passwd, allout-create-encryption-key-verifier) (allout-situate-encryption-key-verifier) (allout-get-encryption-key-verifier, allout-verify-key) (allout-next-topic-pending-encryption) (allout-encrypt-decrypted, allout-encrypted-type-prefix): New functions. (outline-topic-encryption-bullet, outline-default-encryption-scheme) (outline-key-verifier-handling, outline-key-hint-handling) (outline-encrypt-unencrypted-on-saves): New defcustoms. (allout-file-key-verifier-string, allout-encryption-scheme) (allout-key-verifier-string, allout-key-hint-string) (allout-after-save-decrypt): New variables. (allout-write-file-hook-handler, allout-auto-save-hook-handler) (allout-after-saves-handler): New hook functions. (allout-post-command-business): Do allout-after-save-decrypt. (allout-enable-file-variable-adjustment): Custom var to enable mechanism for adding and adjusting settings of Emacs file variables. (allout-adjust-file-variable, allout-file-vars-section-data): New functions, implement the mechanism. (outlineify-sticky): Use the file vars mechanism. (allout-inhibit-protection, allout-during-write-cue) (allout-override-protect, allout-before-change-protect): Removed. (allout-flag-region, allout-open-topic): Revised to adjust read-only text. (allout-open-line-not-read-only): Added to facilitate read-only text based protection. (allout-kill-line): Revised to adjust read-only text, clue the user about the inhibition. (allout-unprotected): Robustified with an unwind-protect. (allout-shift-in, allout-shift-out): Disallow manually shifting a topic deeper than the offspring depth of the previous topic - avoiding confusing "containment discontinuities". (allout-reindent-bodies): Fixed retention of body relative hanging indent during promotion of collapsed bodies. (allout-open-topic): Made it easy to open new topic with same bullet as current topic - topic creation functions provided with any universal argument provokes now prompt for bullet, defaulting to the bullet of the previous topic. (allout-plain-bullets-string, allout-distinctive-bullets-string): Plain bullet alternates '.' period and ',' comma only. All other bullets are relegated to special status (but customizable). (allout-end-of-entry): Renamed from 'allout-end-of-current-entry since it actually operates w.r.t. most immediately containing entry, visible or not. (allout-hide-current-entry, allout-show-current-entry): Use the revised version. (allout-old-expose-topic): Solidify deprecation. (allout-end-of-subtree): Added, so we can span concealed as well as visible topics. (allout-end-of-current-subtree): Use `allout-end-of-subtree'. (allout-end-of-current-heading): Tweaked to just respect the first line. (allout-get-body-text): Added. (allout-ascend-to-depth, allout-ascend): Position at end of prefix when invoked interactively. (allout-up-current-level): Use `interactive-p'. (allout-mode, allout-init): Miscellaneous docstring and operational refinements, as well as hookups of new encryption stuff. (allout-beginning-of-current-entry): Now works as advertised. (allout-end-of-current-entry): Relieved of superfluous allout-show-entry. (allout-isearch-rectification): Refine condition for isearching (allout-isearch-abort, allout-enwrap-isearch). (allout-flag-region, my-region-active-p): Relocated some macros. (allout-title): Fallback title is '(buffer-name)', not non-existing '(current-buffer-name)'. (subst-char-in-string): Define if absent (for some XEmacs versions). Corrected commentary 'keywords' to legitimate ones. Updated comentary author info (using my current email address, obscurified).

;;; nnlistserv.el --- retrieving articles via web mailing list archives

;; Copyright (C) 1997, 1998, 1999, 2000, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news, mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))

(require 'nnoo)
(require 'mm-url)
(require 'nnweb)

(nnoo-declare nnlistserv
  nnweb)

(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
  "Where nnlistserv will save its files."
  nnweb-directory)

(defvoo nnlistserv-name 'kk
  "What search engine type is being used."
  nnweb-type)

(defvoo nnlistserv-type-definition
    '((kk
       (article . nnlistserv-kk-wash-article)
       (map . nnlistserv-kk-create-mapping)
       (search . nnlistserv-kk-search)
       (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
       (pages "fra160396" "fra160796" "fra061196" "fra160197"
	      "fra090997" "fra040797" "fra130397" "nye")
       (index . "date.html")
       (identifier . nnlistserv-kk-identity)))
  "Type-definition alist."
  nnweb-type-definition)

(defvoo nnlistserv-search nil
  "Search string to feed to DejaNews."
  nnweb-search)

(defvoo nnlistserv-ephemeral-p nil
  "Whether this nnlistserv server is ephemeral."
  nnweb-ephemeral-p)

;;; Internal variables

;;; Interface functions

(nnoo-define-basics nnlistserv)

(nnoo-import nnlistserv
  (nnweb))

;;; Internal functions

;;;
;;; KK functions.
;;;

(defun nnlistserv-kk-create-mapping ()
  "Perform the search and create a number-to-url alist."
  (save-excursion
    (set-buffer nnweb-buffer)
    (let ((case-fold-search t)
	  (active (or (cadr (assoc nnweb-group nnweb-group-alist))
		      (cons 1 0)))
	  (pages (nnweb-definition 'pages))
	  map url page subject from )
      (while (setq page (pop pages))
	(erase-buffer)
	(when (funcall (nnweb-definition 'search) page)
	  ;; Go through all the article hits on this page.
	  (goto-char (point-min))
	  (mm-url-decode-entities)
	  (goto-char (point-min))
	  (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
	    (setq url (match-string 1)
		  subject (match-string 2)
		  from (match-string 3))
	    (setq url (concat (format (nnweb-definition 'address) page) url))
	    (unless (nnweb-get-hashtb url)
	      (push
	       (list
		(incf (cdr active))
		(make-full-mail-header
		 (cdr active) subject from ""
		 (concat "<" (nnweb-identifier url) "@kk>")
		 nil 0 0 url))
	       map)
	      (nnweb-set-hashtb (cadar map) (car map))
	      (nnheader-message 5 "%s %s %s" (cdr active) (point) pages)))))
      ;; Return the articles in the right order.
      (setq nnweb-articles
	    (sort (nconc nnweb-articles map) 'car-less-than-car)))))

(defun nnlistserv-kk-wash-article ()
  (let ((case-fold-search t)
	(headers '(sent name email subject id))
	sent name email subject id)
    (mm-url-decode-entities)
    (while headers
      (goto-char (point-min))
      (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t)
      (set (pop headers) (match-string 1)))
    (goto-char (point-min))
    (search-forward "<!-- body" nil t)
    (delete-region (point-min) (progn (forward-line 1) (point)))
    (goto-char (point-max))
    (search-backward "<!-- body" nil t)
    (delete-region (point-max) (progn (beginning-of-line) (point)))
    (mm-url-remove-markup)
    (goto-char (point-min))
    (insert (format "From: %s <%s>\n" name email)
	    (format "Subject: %s\n" subject)
	    (format "Message-ID: %s\n" id)
	    (format "Date: %s\n\n" sent))))

(defun nnlistserv-kk-search (search)
  (mm-url-insert
   (concat (format (nnweb-definition 'address) search)
	   (nnweb-definition 'index)))
  t)

(defun nnlistserv-kk-identity (url)
  "Return an unique identifier based on URL."
  url)

(provide 'nnlistserv)

;;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617
;;; nnlistserv.el ends here