From: yamaoka <yamaoka>
Date: Fri, 2 May 2003 02:42:20 +0000 (+0000)
Subject: Feedback from the t-gnus-6_15 branch.
X-Git-Tag: before-feeding-back-t-gnus-6_16-~1
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=e6b31519e256eaa52280b45df80d5b436c1539b1;p=elisp%2Fgnus.git-

Feedback from the t-gnus-6_15 branch.
---

diff --git a/lisp/canlock-om.el b/lisp/canlock-om.el
new file mode 100644
index 0000000..831b7f5
--- /dev/null
+++ b/lisp/canlock-om.el
@@ -0,0 +1,215 @@
+;;; canlock-om.el --- Mule 2 specific functions for canlock
+;; Copyright (C) 2001 Katsumi Yamaoka
+
+;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
+;; Keywords: mule, cancel-lock
+
+;; This program 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.
+
+;; This program 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 this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This program is used to make canlock.el work with Mule 2.3 based on
+;; Emacs 19.34.  See README.ja in the canlock distribution for details.
+
+;;; Code:
+
+(eval-and-compile
+  (cond ((and (boundp 'emacs-major-version)
+	      (> emacs-major-version 19))
+	 (error "\
+Error: You should never use canlock-om.el(c) for this environment"))
+	((and (boundp 'MULE)
+	      (boundp 'emacs-major-version)
+	      (= emacs-major-version 19)
+	      (>= emacs-minor-version 29)))
+	(t
+	 (error "Error: Canlock does not support this version of Emacs"))))
+
+(eval-when-compile
+  (require 'cl))
+
+(require 'custom)
+(eval-and-compile
+  (unless (fboundp 'custom-declare-variable)
+    (error "Error: Canlock requires new custom")))
+
+(eval-when-compile
+  (unless (fboundp 'byte-compile-file-form-custom-declare-variable)
+    (defun byte-compile-file-form-custom-declare-variable (form)
+      ;; Bind defcustom'ed variables.
+      (if (memq 'free-vars byte-compile-warnings)
+	  (setq byte-compile-bound-variables
+		(cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
+      (if (memq ':version (nthcdr 4 form))
+	  ;; Make the variable uncustomizable.
+	  `(defvar ,(nth 1 (nth 1 form)) ,(nth 1 (nth 2 form))
+	     ,(substring (nth 3 form)
+			 (if (string-match "^[\t *]+" (nth 3 form))
+			     (match-end 0)
+			   0)))
+	;; Ignore unsupported keyword(s).
+	(if (memq ':set-after (nthcdr 4 form))
+	    (let ((newform (list (car form) (nth 1 form)
+				 (nth 2 form) (nth 3 form)))
+		  (args (nthcdr 4 form)))
+	      (while args
+		(or (eq (car args) ':set-after)
+		    (setq newform (nconc newform (list (car args)
+						       (car (cdr args))))))
+		(setq args (cdr (cdr args))))
+	      newform)
+	  form)))
+    (put 'custom-declare-variable 'byte-hunk-handler
+	 'byte-compile-file-form-custom-declare-variable))
+
+  (define-compiler-macro with-temp-buffer (&whole form &rest forms)
+    (let ((def (if (fboundp 'with-temp-buffer)
+		   (symbol-function 'with-temp-buffer))))
+      (if (and def
+	       (consp def)
+	       (or (eq (car def) 'macro)
+		   (and (eq (car def) 'autoload)
+			(memq (nth 4 def) '(macro t)))))
+	  form
+	;; The function definition is imported from APEL.
+	`(let ((obuffer (current-buffer))
+	       (buffer (generate-new-buffer " *temp*")))
+	   (unwind-protect
+	       (progn
+		 (set-buffer buffer)
+		 ,@forms)
+	     (if (buffer-name buffer)
+		 (kill-buffer buffer))
+	     (if (buffer-live-p obuffer)
+		 (set-buffer obuffer))))))))
+
+(autoload 'base64-encode "base64")
+
+(defcustom canlock-base64-encode-function 'base64-encode-string
+  "Function to call to base64 encode a string."
+  :type '(radio (function-item base64-encode-string)
+		(function-item base64-encode)
+		(function-item canlock-base64-encode-string-with-mmencode)
+		(function :tag "Other"))
+  :group 'canlock)
+
+(defcustom canlock-mmencode-program "mmencode"
+  "Name of mmencode program."
+  :type 'string
+  :group 'canlock)
+
+(defcustom canlock-mmencode-args-for-encoding nil
+  "Arguments passed to mmencode program for encoding."
+  :type 'sexp
+  :group 'canlock)
+
+(defun canlock-base64-encode-string-with-mmencode (string)
+  "Base64 encode a string using mmencode."
+  (with-temp-buffer
+    (setq mc-flag nil)
+    (insert string)
+    (let ((default-process-coding-system (cons *iso-2022-jp*dos *noconv*))
+	  program-coding-system-alist selective-display)
+      (apply 'call-process-region (point-min) (point-max)
+	     canlock-mmencode-program t t nil
+	     canlock-mmencode-args-for-encoding))
+    (goto-char (point-max))
+    (skip-chars-backward "\n")
+    (buffer-substring (point-min) (point))))
+
+;; The following macros will only be used to byte-compile canlock.el.
+(eval-when-compile
+  (define-compiler-macro base64-encode-string
+    (&whole form string &optional no-line-break)
+    (if (and (string-equal (buffer-name) " *Compiler Input*")
+	     (string-equal ";;; canlock.el"
+			   (buffer-substring (point-min)
+					     (min (+ (point-min) 14)
+						  (point-max)))))
+	(if no-line-break
+	    `(let ((string ,string))
+	       (if ,no-line-break
+		   (with-temp-buffer
+		     (insert (funcall canlock-base64-encode-function string))
+		     (goto-char (point-min))
+		     (while (search-forward "\n" nil t)
+		       (delete-char -1))
+		     (buffer-string))
+		 (funcall canlock-base64-encode-function string)))
+	  `(funcall canlock-base64-encode-function ,string))
+      form))
+
+  (define-compiler-macro split-string (&whole form string &optional pattern)
+    (if (and (string-equal (buffer-name) " *Compiler Input*")
+	     (string-equal ";;; canlock.el"
+			   (buffer-substring (point-min)
+					     (min (+ (point-min) 14)
+						  (point-max)))))
+	;; The function definition is imported from APEL.
+	(if pattern
+	    `(let ((string ,string)
+		   (pattern ,pattern)
+		   (start 0)
+		   parts)
+	       (while (string-match pattern string start)
+		 (setq parts (cons (substring string
+					      start (match-beginning 0))
+				   parts)
+		       start (match-end 0)))
+	       (nreverse (cons (substring string start) parts)))
+	  `(let ((string ,string)
+		 (start 0)
+		 parts)
+	     (while (string-match "[ \f\t\n\r\v]+" string start)
+	       (setq parts (cons (substring string
+					    start (match-beginning 0))
+				 parts)
+		     start (match-end 0)))
+	     (nreverse (cons (substring string start) parts))))
+      form)))
+
+;; The following variables might not be bound if the old version of
+;; canlock.el(c) exists.
+(eval-when-compile
+  (defvar canlock-openssl-args)
+  (defvar canlock-openssl-program))
+
+(defun canlock-om-sha1-with-openssl (message)
+  "Make a SHA-1 digest of MESSAGE using OpenSSL."
+  (with-temp-buffer
+    (setq mc-flag nil)
+    (insert message)
+    (let ((default-process-coding-system (cons *iso-2022-jp*dos *noconv*))
+	  program-coding-system-alist selective-display)
+      (apply 'call-process-region (point-min) (point-max)
+	     canlock-openssl-program t t nil canlock-openssl-args))
+    (goto-char (point-min))
+    (insert "\"")
+    (while (re-search-forward "\\([0-9A-Fa-f][0-9A-Fa-f]\\)" nil t)
+      (replace-match "\\\\x\\1"))
+    (insert "\"")
+    (goto-char (point-min))
+    (read (current-buffer))))
+
+;; Override the original function.
+(eval-after-load "canlock"
+  '(defalias 'canlock-sha1-with-openssl 'canlock-om-sha1-with-openssl))
+
+(provide 'canlock-om)
+
+(require 'canlock)
+
+;;; canlock-om.el ends here
diff --git a/lisp/canlock.el b/lisp/canlock.el
new file mode 100644
index 0000000..ee97fd3
--- /dev/null
+++ b/lisp/canlock.el
@@ -0,0 +1,311 @@
+;;; canlock.el --- functions for Cancel-Lock feature
+
+;; Copyright (C) 1998, 1999, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
+;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
+
+;; This program 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.
+
+;; This program 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 this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Canlock is a library for generating and verifying Cancel-Lock and/or
+;; Cancel-Key header in news articles.  This is used to protect articles
+;; from rogue cancel, supersede or replace attacks.  The method is based
+;; on draft-ietf-usefor-cancel-lock-01.txt which was released on November
+;; 3rd 1998.  For instance, you can add Cancel-Lock (and possibly Cancel-
+;; Key) header in a news article by using a hook which will be evaluated
+;; just before sending an article as follows:
+;;
+;; (add-hook '*e**a*e-header-hook 'canlock-insert-header t)
+;;
+;; Verifying Cancel-Lock is mainly a function of news servers, however,
+;; you can verify your own article using the command `canlock-verify' in
+;; the (raw) article buffer.  You will be prompted for the password for
+;; each time if the option `canlock-password' or `canlock-password-for-
+;; verify' is nil.  Note that setting these options is a bit unsafe.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(autoload 'sha1-binary "sha1-el")
+(autoload 'base64-encode-string "base64")
+(autoload 'mail-fetch-field "mail-utils")
+(defvar mail-header-separator)
+
+(defgroup canlock nil
+  "The Cancel-Lock feature."
+  :group 'applications)
+
+(defcustom canlock-sha1-function 'sha1-binary
+  "Function to call to make a SHA-1 message digest."
+  :type '(radio (function-item sha1-binary)
+		(function-item canlock-sha1-with-openssl)
+		(function :tag "Other"))
+  :group 'canlock)
+
+(defcustom canlock-sha1-function-for-verify canlock-sha1-function
+  "Function to call to make a SHA-1 message digest for verifying."
+  :type '(radio (function-item sha1-binary)
+		(function-item canlock-sha1-with-openssl)
+		(function :tag "Other"))
+  :group 'canlock)
+
+(defcustom canlock-openssl-program "openssl"
+  "Name of OpenSSL program."
+  :type 'string
+  :group 'canlock)
+
+(defcustom canlock-openssl-args '("sha1")
+  "Arguments passed to the OpenSSL program."
+  :type 'sexp
+  :group 'canlock)
+
+(defcustom canlock-ignore-errors nil
+  "If non-nil, ignore any error signals."
+  :type 'boolean
+  :group 'canlock)
+
+(defcustom canlock-password nil
+  "Password to use when signing a Cancel-Lock or a Cancel-Key header."
+  :type 'string
+  :group 'canlock)
+
+(defcustom canlock-password-for-verify canlock-password
+  "Password to use when verifying a Cancel-Lock or a Cancel-Key header."
+  :type 'string
+  :group 'canlock)
+
+(defcustom canlock-force-insert-header nil
+  "If non-nil, insert a Cancel-Lock or a Cancel-Key header even if the
+buffer does not look like a news message."
+  :type 'boolean
+  :group 'canlock)
+
+(defun canlock-sha1-with-openssl (message)
+  "Make a SHA-1 digest of MESSAGE using OpenSSL."
+  (let (default-enable-multibyte-characters)
+    (with-temp-buffer
+      (let ((coding-system-for-read 'binary)
+	    (coding-system-for-write 'binary)
+	    selective-display
+	    (case-fold-search t))
+	(insert message)
+	(apply 'call-process-region (point-min) (point-max)
+	       canlock-openssl-program t t nil canlock-openssl-args)
+	(goto-char (point-min))
+	(insert "\"")
+	(while (re-search-forward "\\([0-9a-f][0-9a-f]\\)" nil t)
+	  (replace-match "\\\\x\\1"))
+	(insert "\"")
+	(goto-char (point-min))
+	(read (current-buffer))))))
+
+(eval-when-compile
+  (defmacro canlock-string-as-unibyte (string)
+    "Return a unibyte string with the same individual bytes as STRING."
+    (if (fboundp 'string-as-unibyte)
+	(list 'string-as-unibyte string)
+      string)))
+
+(defun canlock-sha1 (message)
+  "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes."
+  (canlock-string-as-unibyte (funcall canlock-sha1-function message)))
+
+(defun canlock-make-cancel-key (message-id password)
+  "Make a Cancel-Key header."
+  (when (> (length password) 20)
+    (setq password (canlock-sha1 password)))
+  (setq password (concat password (make-string (- 64 (length password)) 0)))
+  (let ((ipad (mapconcat (lambda (byte)
+			   (char-to-string (logxor 54 byte)))
+			 password ""))
+	(opad (mapconcat (lambda (byte)
+			   (char-to-string (logxor 92 byte)))
+			 password "")))
+    (base64-encode-string
+     (canlock-sha1
+      (concat opad
+	      (canlock-sha1
+	       (concat ipad (canlock-string-as-unibyte message-id))))))))
+
+(defun canlock-narrow-to-header ()
+  "Narrow the buffer to the head of the message."
+  (let (case-fold-search)
+    (narrow-to-region
+     (goto-char (point-min))
+     (goto-char (if (re-search-forward
+		     (format "^$\\|^%s$"
+			     (regexp-quote mail-header-separator))
+		     nil t)
+		    (match-beginning 0)
+		  (point-max))))))
+
+(defun canlock-delete-headers ()
+  "Delete Cancel-Key or Cancel-Lock headers in the narrowed buffer."
+  (let ((case-fold-search t))
+    (goto-char (point-min))
+    (while (re-search-forward "^Cancel-\\(Key\\|Lock\\):" nil t)
+      (delete-region (match-beginning 0)
+		     (if (re-search-forward "^[^\t ]" nil t)
+			 (goto-char (match-beginning 0))
+		       (point-max))))))
+
+(defun canlock-fetch-fields (&optional key)
+  "Return a list of the values of Cancel-Lock header.
+If KEY is non-nil, look for a Cancel-Key header instead.  The buffer
+is expected to be narrowed to just the headers of the message."
+  (let ((field (mail-fetch-field (if key "Cancel-Key" "Cancel-Lock")))
+	fields rest
+	(case-fold-search t))
+    (when field
+      (setq fields (split-string field "[\t\n\r ,]+"))
+      (while fields
+	(when (string-match "^sha1:" (setq field (pop fields)))
+	  (push (substring field 5) rest)))
+      (nreverse rest))))
+
+(defun canlock-fetch-id-for-key ()
+  "Return a Message-ID in Cancel, Supersedes or Replaces header.
+The buffer is expected to be narrowed to just the headers of the
+message."
+  (or (let ((cancel (mail-fetch-field "Control")))
+	(and cancel
+	     (string-match "^cancel[\t ]+\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+			   cancel)
+	     (match-string 1 cancel)))
+      (mail-fetch-field "Supersedes")
+      (mail-fetch-field "Replaces")))
+
+;;;###autoload
+(defun canlock-insert-header (&optional id-for-key id-for-lock password)
+  "Insert a Cancel-Key and/or a Cancel-Lock header if possible."
+  (let (news control key-for-key key-for-lock)
+    (save-excursion
+      (save-restriction
+	(canlock-narrow-to-header)
+	(when (setq news (or canlock-force-insert-header
+			     (mail-fetch-field "Newsgroups")))
+	  (unless id-for-key
+	    (setq id-for-key (canlock-fetch-id-for-key)))
+	  (if (and (setq control (mail-fetch-field "Control"))
+		   (string-match
+		    "^cancel[\t ]+\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+		    control))
+	      (setq id-for-lock nil)
+	    (unless id-for-lock
+	      (setq id-for-lock (mail-fetch-field "Message-ID"))))
+	  (canlock-delete-headers)
+	  (goto-char (point-max))))
+      (when news
+	(if (not (or id-for-key id-for-lock))
+	    (message "There are no Message-ID(s)")
+	  (unless password
+	    (setq password (or canlock-password
+			       (read-passwd
+				"Password for Canlock: "))))
+	  (if (or (not (stringp password)) (zerop (length password)))
+	      (message "Password for Canlock is bad")
+	    (setq key-for-key (when id-for-key
+				(canlock-make-cancel-key
+				 id-for-key password))
+		  key-for-lock (when id-for-lock
+				 (canlock-make-cancel-key
+				  id-for-lock password)))
+	    (if (not (or key-for-key key-for-lock))
+		(message "Couldn't insert Canlock header")
+	      (when key-for-key
+		(insert "Cancel-Key: sha1:" key-for-key "\n"))
+	      (when key-for-lock
+		(insert "Cancel-Lock: sha1:"
+			(base64-encode-string (canlock-sha1 key-for-lock))
+			"\n")))))))))
+
+;;;###autoload
+(defun canlock-verify (&optional buffer)
+  "Verify Cancel-Lock or Cancel-Key in BUFFER.
+If BUFFER is nil, the current buffer is assumed.  Signal an error if
+it fails.  You can modify the behavior of this function to return non-
+nil instead of to signal an error by setting the option
+`canlock-ignore-errors' to non-nil."
+  (interactive)
+  (let ((canlock-sha1-function (or canlock-sha1-function-for-verify
+				   canlock-sha1-function))
+	keys locks errmsg id-for-key id-for-lock password
+	key-for-key key-for-lock match)
+    (save-excursion
+      (when buffer
+	(set-buffer buffer))
+      (save-restriction
+	(widen)
+	(canlock-narrow-to-header)
+	(setq keys (canlock-fetch-fields 'key)
+	      locks (canlock-fetch-fields))
+	(if (not (or keys locks))
+	    (setq errmsg
+		  "There are neither Cancel-Lock nor Cancel-Key headers")
+	  (setq id-for-key (canlock-fetch-id-for-key)
+		id-for-lock (mail-fetch-field "Message-ID"))
+	  (or id-for-key id-for-lock
+	      (setq errmsg "There are no Message-ID(s)")))))
+
+    (if errmsg
+	(if canlock-ignore-errors
+	    errmsg
+	  (error "%s" errmsg))
+
+      (setq password (or canlock-password-for-verify
+			 (read-passwd "Password for Canlock: ")))
+      (if (or (not (stringp password)) (zerop (length password)))
+	  (progn
+	    (setq errmsg "Password for Canlock is bad")
+	    (if canlock-ignore-errors
+		errmsg
+	      (error "%s" errmsg)))
+
+	(when keys
+	  (when id-for-key
+	    (setq key-for-key (canlock-make-cancel-key id-for-key password))
+	    (while (and keys (not match))
+	      (setq match (string-equal key-for-key (pop keys)))))
+	  (setq keys (if match "good" "bad")))
+	(setq match nil)
+
+	(when locks
+	  (when id-for-lock
+	    (setq key-for-lock
+		  (base64-encode-string
+		   (canlock-sha1 (canlock-make-cancel-key id-for-lock
+							  password))))
+	    (when (and locks (not match))
+	      (setq match (string-equal key-for-lock (pop locks)))))
+	  (setq locks (if match "good" "bad")))
+
+	(prog1
+	    (when (member "bad" (list keys locks))
+	      "bad")
+	  (cond ((and keys locks)
+		 (message "Cancel-Key is %s, Cancel-Lock is %s" keys locks))
+		(locks
+		 (message "Cancel-Lock is %s" locks))
+		(keys
+		 (message "Cancel-Key is %s" keys))))))))
+
+(provide 'canlock)
+
+;;; canlock.el ends here
diff --git a/lisp/compface.el b/lisp/compface.el
new file mode 100644
index 0000000..185f949
--- /dev/null
+++ b/lisp/compface.el
@@ -0,0 +1,57 @@
+;;; compface.el --- functions for converting X-Face headers
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###
+(defun uncompface (face)
+  "Convert FACE to pbm.
+Requires the external programs `uncompface', and `icontopbm'.  On a
+GNU/Linux system these might be in packages with names like `compface'
+or `faces-xface' and `netpbm' or `libgr-progs', for instance."
+  (with-temp-buffer
+    (insert face)
+    (and (eq 0 (apply 'call-process-region (point-min) (point-max)
+		      "uncompface"
+		      'delete '(t nil) nil))
+	 (progn
+	   (goto-char (point-min))
+	   (insert "/* Width=48, Height=48 */\n")
+	   ;; I just can't get "icontopbm" to work correctly on its
+	   ;; own in XEmacs.  And Emacs doesn't understand un-raw pbm
+	   ;; files.
+	   (if (not (featurep 'xemacs))
+	       (eq 0 (call-process-region (point-min) (point-max)
+					  "icontopbm"
+					  'delete '(t nil)))
+	     (shell-command-on-region (point-min) (point-max)
+				      "icontopbm | pnmnoraw"
+				      (current-buffer) t)
+	     t))
+	 (buffer-string))))
+
+(provide 'compface)
+
+;;; compface.el ends here
diff --git a/lisp/deuglify.el b/lisp/deuglify.el
new file mode 100644
index 0000000..89be369
--- /dev/null
+++ b/lisp/deuglify.el
@@ -0,0 +1,470 @@
+;;; deuglify.el --- deuglify broken Outlook (Express) articles
+
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002 Raymond Scholz
+
+;; Author: Raymond Scholz <rscholz@zonix.de>
+;;         Thomas Steffen (unwrapping algorithm,
+;;                         based on an idea of Stefan Monnier)
+;; Keywords: mail, news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file enables Gnus to repair broken citations produced by
+;; common user agents like MS Outlook (Express).  It may repair
+;; articles of other user agents too.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; Outlook sometimes wraps cited lines before sending a message as
+;; seen in this example:
+;;
+;; Example #1
+;; ----------
+;;
+;; John Doe wrote:
+;;
+;; > This sentence no verb.  This sentence no verb.  This sentence
+;; no
+;; > verb.  This sentence no verb.  This sentence no verb.  This
+;; > sentence no verb.
+;;
+;; The function `gnus-article-outlook-unwrap-lines' tries to recognize those
+;; erroneously wrapped lines and will unwrap them.  I.e. putting the
+;; wrapped parts ("no" in this example) back where they belong (at the
+;; end of the cited line above).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Note that some people not only use broken user agents but also
+;; practice a bad citation style by omitting blank lines between the
+;; cited text and their own text.
+;:
+;; Example #2
+;; ----------
+;;
+;; John Doe wrote:
+;;
+;; > This sentence no verb.  This sentence no verb.  This sentence no
+;; You forgot in all your sentences.
+;; > verb.  This sentence no verb.  This sentence no verb.  This
+;; > sentence no verb.
+;;
+;; Unwrapping "You forgot in all your sentences." would be illegal as
+;; this part wasn't intended to be cited text.
+;; `gnus-article-outlook-unwrap-lines' will only unwrap lines if the resulting
+;; citation line will be of a certain maximum length.  You can control
+;; this by adjusting `gnus-outlook-deuglify-unwrap-max'.  Also
+;; unwrapping will only be done if the line above the (possibly)
+;; wrapped line has a minimum length of `gnus-outlook-deuglify-unwrap-min'.
+;;
+;; Furthermore no unwrapping will be undertaken if the last character
+;; is one of the chars specified in
+;; `gnus-outlook-deuglify-unwrap-stop-chars'.  Setting this to ".?!"
+;; inhibits unwrapping if the cited line ends with a full stop,
+;; question mark or exclamation mark.  Note that this variable
+;; defaults to `nil', triggering a few false positives but generally
+;; giving you better results.
+;;
+;; Unwrapping works on every level of citation.  Thus you will be able
+;; repair broken citations of broken user agents citing broken
+;; citations of broken user agents citing broken citations...
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Citations are commonly introduced with an attribution line
+;; indicating who wrote the cited text.  Outlook adds superfluous
+;; information that can be found in the header of the message to this
+;; line and often wraps it.
+;;
+;; If that weren't enough, lots of people write their own text above
+;; the cited text and cite the complete original article below.
+;;
+;; Example #3
+;; ----------
+;;
+;; Hey, John.  There's no in all your sentences!
+;;
+;; John Doe <john.doe@some.domain> wrote in message
+;; news:a87usw8$dklsssa$2@some.news.server...
+;; > This sentence no verb.  This sentence no verb.  This sentence
+;; no
+;; > verb.  This sentence no verb.  This sentence no verb.  This
+;; > sentence no verb.
+;; >
+;; > Bye, John
+;;
+;; Repairing the attribution line will be done by function
+;; `gnus-article-outlook-repair-attribution which calls other function that
+;; try to recognize and repair broken attribution lines.  See variable
+;; `gnus-outlook-deuglify-attrib-cut-regexp' for stuff that should be
+;; cut off from the beginning of an attribution line and variable
+;; `gnus-outlook-deuglify-attrib-verb-regexp' for the verbs that are
+;; required to be found in an attribution line.  These function return
+;; the point where the repaired attribution line starts.
+;;
+;; Rearranging the article so that the cited text appears above the
+;; new text will be done by function
+;; `gnus-article-outlook-rearrange-citation'.  This function calls
+;; `gnus-article-outlook-repair-attribution to find and repair an attribution
+;; line.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Well, and that's what the message will look like after applying
+;; deuglification:
+;;
+;; Example #3 (deuglified)
+;; -----------------------
+;;
+;; John Doe <john.doe@some.domain> wrote:
+;;
+;; > This sentence no verb.  This sentence no verb.  This sentence no
+;; > verb.  This sentence no verb.  This sentence no verb.  This
+;; > sentence no verb.
+;; >
+;; > Bye, John
+;;
+;; Hey, John.  There's no in all your sentences!
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Usage
+;; -----
+;;
+;; Press `W k' in the Summary Buffer.
+;;
+;; Non recommended usage :-)
+;; ---------------------
+;;
+;; To automatically invoke deuglification on every article you read,
+;; put something like that in your .gnus:
+;;
+;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-unwrap-lines)
+;;
+;; or _one_ of the following lines:
+;;
+;; ;; repair broken attribution lines
+;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-repair-attribution)
+;;
+;; ;; repair broken attribution lines and citations
+;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-rearrange-citation)
+;;
+;; Note that there always may be some false positives, so I suggest
+;; using the manual invocation.  After deuglification you may want to
+;; refill the whole article using `W w'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Limitations
+;; -----------
+;;
+;; As I said before there may (or will) be a few false positives on
+;; unwrapping cited lines with `gnus-article-outlook-unwrap-lines'.
+;;
+;; `gnus-article-outlook-repair-attribution will only fix the first
+;; attribution line found in the article.  Furthermore it fixed to
+;; certain kinds of attributions.  And there may be horribly many
+;; false positives, vanishing lines and so on -- so don't trust your
+;; eyes.  Again I recommend manual invocation.
+;;
+;; `gnus-article-outlook-rearrange-citation' carries all the limitations of
+;; `gnus-article-outlook-repair-attribution.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; See ChangeLog for other changes.
+;;
+;; Revision 1.5  2002/01/27 14:39:17  rscholz
+;; * New variable `gnus-outlook-deuglify-no-wrap-chars' to inhibit
+;;   unwrapping if one these chars is first in the possibly wrapped line.
+;; * Improved rearranging of the article.
+;; * New function `gnus-outlook-repair-attribution-block' for repairing
+;;   those big "Original Message (following some headers)" attributions.
+;;
+;; Revision 1.4  2002/01/03 14:05:00  rscholz
+;; Renamed `gnus-outlook-deuglify-article' to
+;; `gnus-article-outlook-deuglify-article'.
+;; Made it easier to deuglify the article while being in Gnus' Article
+;; Edit Mode. (suggested by Phil Nitschke)
+;;
+;;
+;; Revision 1.3  2002/01/02 23:35:54  rscholz
+;; Fix a bug that caused succeeding long attribution lines to be
+;; unwrapped.  Minor doc fixes and regular expression tuning.
+;;
+;; Revision 1.2  2001/12/30 20:14:34  rscholz
+;; Clean up source.
+;;
+;; Revision 1.1  2001/12/30 20:13:32  rscholz
+;; Initial revision
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Code:
+
+(require 'gnus-art)
+(require 'gnus-sum)
+
+(defconst gnus-outlook-deuglify-version "1.5 Gnus version"
+  "Version of gnus-outlook-deuglify.")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-outlook-deuglify nil
+  "Deuglify articles generated by broken user agents like MS Outlook (Express).")
+
+;;;###autoload
+(defcustom gnus-outlook-deuglify-unwrap-min 45
+  "Minimum length of the cited line above the (possibly) wrapped line."
+  :type 'number
+  :group 'gnus-outlook-deuglify)
+
+;;;###autoload
+(defcustom gnus-outlook-deuglify-unwrap-max 95
+  "Maximum length of the cited line after unwrapping."
+  :type 'number
+  :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-cite-marks ">|#%"
+  "Characters that indicate cited lines."
+  :type 'string
+  :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
+  "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line."
+  :type 'string
+  :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
+  "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line."
+  :type 'string
+  :group 'gnus-outlook-deuglify)
+
+(defcustom  gnus-outlook-deuglify-attrib-cut-regexp
+  "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
+  "Regular expression matching the beginning of an attribution line that should be cut off."
+  :type 'string
+  :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-verb-regexp
+  "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió"
+  "Regular expression matching the verb used in an attribution line."
+  :type 'string
+  :group 'gnus-outlook-deuglify)
+
+(defcustom  gnus-outlook-deuglify-attrib-end-regexp
+  ": *\\|\\.\\.\\."
+  "Regular expression matching the end of an attribution line."
+  :type 'string
+  :group 'gnus-outlook-deuglify)
+
+;;;###autoload
+(defcustom gnus-outlook-display-hook nil
+  "A hook called after an deuglified article has been prepared.
+It is run after `gnus-article-prepare-hook'."
+  :type 'hook
+  :group 'gnus-outlook-deuglify)
+
+;; Functions
+
+(defun gnus-outlook-display-article-buffer ()
+  "Redisplay current buffer or article buffer."
+  (with-current-buffer (or gnus-article-buffer (current-buffer))
+    ;; "Emulate" `gnus-article-prepare-display' without calling
+    ;; it. Calling `gnus-article-prepare-display' on an already
+    ;; prepared article removes all MIME parts.  I'm unsure whether
+    ;; this is a bug or not.
+    (gnus-article-highlight t)
+    (gnus-treat-article nil)
+    (gnus-run-hooks 'gnus-article-prepare-hook
+		    'gnus-outlook-display-hook)))
+
+;;;###autoload
+(defun gnus-article-outlook-unwrap-lines (&optional nodisplay)
+  "Unwrap lines that appear to be wrapped citation lines.  
+You can control what lines will be unwrapped by frobbing
+`gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max',
+indicating the miminum and maximum length of an unwrapped citation line.  If
+NODISPLAY is non-nil, don't redisplay the article buffer."
+  (interactive "P")
+  (save-excursion
+    (let ((case-fold-search nil)
+	  (inhibit-read-only t)
+	  (cite-marks gnus-outlook-deuglify-cite-marks)
+	  (no-wrap gnus-outlook-deuglify-no-wrap-chars)
+	  (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
+      (gnus-with-article-buffer
+	(article-goto-body)
+	(while (re-search-forward
+		(concat
+		 "^\\([ \t" cite-marks "]*\\)"
+		 "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
+		 "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
+              nil t)
+	  (let ((len12 (- (match-end 2) (match-beginning 1)))
+	      (len3 (- (match-end 3) (match-beginning 3))))
+	    (if (and (> len12 gnus-outlook-deuglify-unwrap-min)
+		     (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
+		(progn
+		  (replace-match "\\1\\2 \\3")
+		  (goto-char (match-beginning 0)))))))))
+  (unless nodisplay (gnus-outlook-display-article-buffer)))
+
+(defun gnus-outlook-rearrange-article (attr-start)
+  "Put the text from `attr-start' to the end of buffer at the top of the article buffer."
+  (save-excursion
+    (let ((inhibit-read-only t)
+	  (cite-marks gnus-outlook-deuglify-cite-marks))
+      (gnus-with-article-buffer
+	(article-goto-body)
+	;; article does not start with attribution
+	(unless (= (point) attr-start)
+	  (gnus-kill-all-overlays)
+	  (let ((cur (point))
+		;; before signature or end of buffer
+		(to (if (gnus-article-search-signature)
+			(point)
+		      (point-max))))
+	    ;; handle the case where the full quote is below the
+	    ;; signature
+	    (if (< to attr-start)
+		(setq to (point-max)))
+	    (transpose-regions cur attr-start attr-start to)))))))
+
+;; John Doe <john.doe@some.domain> wrote in message
+;; news:a87usw8$dklsssa$2@some.news.server...
+
+(defun gnus-outlook-repair-attribution-outlook ()
+  "Repair a broken attribution line (Outlook)."
+  (save-excursion
+    (let ((case-fold-search nil)
+	  (inhibit-read-only t)
+	  (cite-marks gnus-outlook-deuglify-cite-marks))
+      (gnus-with-article-buffer
+	(article-goto-body)
+	(if (re-search-forward
+	     (concat "^\\([^" cite-marks "].+\\)"
+		     "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
+		     "\\(.*\n?[^\n" cite-marks "].*\\)?"
+		     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
+	     nil t)
+	    (progn
+	      (gnus-kill-all-overlays)
+	      (replace-match "\\1\\2\\4")
+	      (match-beginning 0)))))))
+
+
+;; ----- Original Message -----
+;; From: "John Doe" <john.doe@some.domain>
+;; To: "Doe Foundation" <info@doefnd.org>
+;; Sent: Monday, November 19, 2001 12:13 PM
+;; Subject: More Doenuts
+
+(defun gnus-outlook-repair-attribution-block ()
+  "Repair a big broken attribution block."
+  (save-excursion
+    (let ((case-fold-search nil)
+	  (inhibit-read-only t)
+	  (cite-marks gnus-outlook-deuglify-cite-marks))
+      (gnus-with-article-buffer
+	(article-goto-body)
+	(if (re-search-forward
+            (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
+		     "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
+		     "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
+	     nil t)
+	    (progn
+	      (gnus-kill-all-overlays)
+	      (replace-match "\\1 wrote:\n")
+	      (match-beginning 0)))))))
+
+;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
+
+(defun gnus-outlook-repair-attribution-other ()
+  "Repair a broken attribution line (other user agents than Outlook)."
+  (save-excursion
+    (let ((case-fold-search nil)
+	  (inhibit-read-only t)
+	  (cite-marks gnus-outlook-deuglify-cite-marks))
+      (gnus-with-article-buffer
+	(article-goto-body)
+	(if (re-search-forward
+	     (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
+		     "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
+		     "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
+		     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
+	     nil t)
+	    (progn
+	      (gnus-kill-all-overlays)
+	      (replace-match "\\4 \\5\\6\\7")
+	      (match-beginning 0)))))))
+
+;;;###autoload
+(defun gnus-article-outlook-repair-attribution (&optional nodisplay)
+  "Repair a broken attribution line.
+If NODISPLAY is non-nil, don't redisplay the article buffer."
+  (interactive "P")
+  (let ((attrib-start
+	 (or
+	  (gnus-outlook-repair-attribution-other)
+	  (gnus-outlook-repair-attribution-block)
+	  (gnus-outlook-repair-attribution-outlook))))
+    (unless nodisplay (gnus-outlook-display-article-buffer))
+    attrib-start))
+
+(defun gnus-article-outlook-rearrange-citation (&optional nodisplay)
+  "Repair broken citations.
+If NODISPLAY is non-nil, don't redisplay the article buffer."
+  (interactive "P")
+  (let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay)))
+    ;; rearrange citations if an attribution line has been recognized
+    (if attrib-start
+	(gnus-outlook-rearrange-article attrib-start)))
+  (unless nodisplay (gnus-outlook-display-article-buffer)))
+
+;;;###autoload
+(defun gnus-outlook-deuglify-article (&optional nodisplay)
+  "Full deuglify of broken Outlook (Express) articles.
+Treat dumbquotes, unwrap lines, repair attribution and rearrange citation.  If
+NODISPLAY is non-nil, don't redisplay the article buffer."
+  (interactive "P")
+  ;; apply treatment of dumb quotes
+  (gnus-article-treat-dumbquotes)
+  ;; repair wrapped cited lines
+  (gnus-article-outlook-unwrap-lines 'nodisplay)
+  ;; repair attribution line and rearrange citation.
+  (gnus-article-outlook-rearrange-citation 'nodisplay)
+  (unless nodisplay (gnus-outlook-display-article-buffer)))
+
+;;;###autoload
+(defun gnus-article-outlook-deuglify-article ()
+  "Deuglify broken Outlook (Express) articles and redisplay."
+  (interactive)
+  (gnus-outlook-deuglify-article nil))
+
+(provide 'deuglify)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; deuglify.el ends here
diff --git a/lisp/dig.el b/lisp/dig.el
new file mode 100644
index 0000000..e71d6db
--- /dev/null
+++ b/lisp/dig.el
@@ -0,0 +1,188 @@
+;;; dig.el --- Domain Name System dig interface
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: DNS BIND dig
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This provide an interface for "dig".
+;;
+;; For interactive use, try M-x dig and type a hostname.  Use `q' to quit
+;; dig buffer.
+;;
+;; For use in elisp programs, call `dig-invoke' and use
+;; `dig-extract-rr' to extract resource records.
+
+;;; Release history:
+
+;; 2000-10-28  posted on gnu.emacs.sources
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defgroup dig nil
+  "Dig configuration.")
+
+(defcustom dig-program "dig"
+  "Name of dig (domain information groper) binary."
+  :type 'file
+  :group 'dig)
+
+(defcustom dig-dns-server nil
+  "DNS server to query.
+If nil, use system defaults."
+  :type '(choice (const :tag "System defaults")
+		 string)
+  :group 'dig)
+
+(defcustom dig-font-lock-keywords
+  '(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face)
+    ("^;;.*" 0 font-lock-comment-face)
+    ("^; <<>>.*" 0 font-lock-type-face)
+    ("^;.*" 0 font-lock-function-name-face))
+  "Default expressions to highlight in dig mode."
+  :type 'sexp
+  :group 'dig)
+
+(defun dig-invoke (domain &optional
+			  query-type query-class query-option
+			  dig-option server)
+  "Call dig with given arguments and return buffer containing output.
+DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string
+with a DNS type. QUERY-CLASS is an optional string with a DNS class.
+QUERY-OPTION is an optional string with dig \"query options\".
+DIG-OPTIONS is an optional string with parameters for the dig program.
+SERVER is an optional string with a domain name server to query.
+
+Dig is an external program found in the BIND name server distribution,
+and is a commonly available debugging tool."
+  (let (buf cmdline)
+    (setq buf (generate-new-buffer "*dig output*"))
+    (if dig-option (push dig-option cmdline))
+    (if query-option (push query-option cmdline))
+    (if query-class (push query-class cmdline))
+    (if query-type (push query-type cmdline))
+    (push domain cmdline)
+    (if server (push (concat "@" server) cmdline)
+      (if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
+    (apply 'call-process dig-program nil buf nil cmdline)
+    buf))
+
+(defun dig-extract-rr (domain &optional type class)
+  "Extract resource records for DOMAIN, TYPE and CLASS from buffer.
+Buffer should contain output generated by `dig-invoke'."
+  (save-excursion
+    (goto-char (point-min))
+    (if (re-search-forward
+	 (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
+		 (upcase (or class "IN")) "[\t ]+" (upcase (or type "A")))
+	 nil t)
+	(let (b e)
+	  (end-of-line)
+	  (setq e (point))
+	  (beginning-of-line)
+	  (setq b (point))
+	  (when (search-forward " (" e t)
+	    (search-forward " )"))
+	  (end-of-line)
+	  (setq e (point))
+	  (buffer-substring b e))
+      (and (re-search-forward (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
+				      (upcase (or class "IN"))
+				      "[\t ]+CNAME[\t ]+\\(.*\\)$") nil t)
+	   (dig-extract-rr (match-string 1) type class)))))
+
+(defun dig-rr-get-pkix-cert (rr)
+  (let (b e str)
+    (string-match "[^\t ]+[\t ]+[0-9wWdDhHmMsS]+[\t ]+IN[\t ]+CERT[\t ]+\\(1\\|PKIX\\)[\t ]+[0-9]+[\t ]+[0-9]+[\t ]+(?" rr)
+    (setq b (match-end 0))
+    (string-match ")" rr)
+    (setq e (match-beginning 0))
+    (setq str (substring rr b e))
+    (while (string-match "[\t \n\r]" str)
+      (setq str (replace-match "" nil nil str)))
+    str))
+
+;; XEmacs does it like this.  For Emacs, we have to set the
+;; `font-lock-defaults' buffer-local variable.
+(put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t))
+
+(put 'dig-mode 'mode-class 'special)
+
+(defvar dig-mode-map nil)
+(unless dig-mode-map
+  (setq dig-mode-map (make-sparse-keymap))
+  (suppress-keymap dig-mode-map)
+
+  (define-key dig-mode-map "q" 'dig-exit))
+
+(defun dig-mode ()
+  "Major mode for displaying dig output."
+  (interactive)
+  (kill-all-local-variables)
+  (setq mode-name "dig")
+  (setq major-mode 'dig-mode)
+  (use-local-map dig-mode-map)
+  (buffer-disable-undo)
+  (unless (featurep 'xemacs)
+    (set (make-local-variable 'font-lock-defaults)
+	 '(dig-font-lock-keywords t)))
+  (when (featurep 'font-lock)
+    (font-lock-set-defaults)))
+
+(defun dig-exit ()
+  "Quit dig output buffer."
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+(defun dig (domain &optional
+		   query-type query-class query-option dig-option server)
+  "Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
+Optional arguments are passed to `dig-invoke'."
+  (interactive "sHost: ")
+  (switch-to-buffer
+   (dig-invoke domain query-type query-class query-option dig-option server))
+  (goto-char (point-min))
+  (and (search-forward ";; ANSWER SECTION:" nil t)
+       (forward-line))
+  (dig-mode)
+  (setq buffer-read-only t)
+  (set-buffer-modified-p nil))
+
+;; named for consistency with query-dns in dns.el
+(defun query-dig (domain &optional
+			 query-type query-class query-option dig-option server)
+  "Query addresses of a DOMAIN using dig.
+It works by calling `dig-invoke' and `dig-extract-rr'.  Optional
+arguments are passed to `dig-invoke' and `dig-extract-rr'.  Returns
+nil for domain/class/type queries that results in no data."
+(let ((buffer (dig-invoke domain query-type query-class
+			  query-option dig-option server)))
+  (when buffer
+    (switch-to-buffer buffer)
+    (let ((digger (dig-extract-rr domain query-type query-class)))
+      (kill-buffer buffer)
+      digger))))
+
+(provide 'dig)
+
+;;; dig.el ends here
diff --git a/lisp/dns.el b/lisp/dns.el
new file mode 100644
index 0000000..44a002a
--- /dev/null
+++ b/lisp/dns.el
@@ -0,0 +1,358 @@
+;;; dns.el --- Domain Name Service lookups
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: network
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mm-util)
+
+(defvar dns-timeout 5
+  "How many seconds to wait when doing DNS queries.")
+
+(defvar dns-servers nil
+  "Which DNS servers to query.
+If nil, /etc/resolv.conf will be consulted.")
+
+;;; Internal code:
+
+(defvar dns-query-types
+  '((A 1)
+    (NS 2)
+    (MD 3)
+    (MF 4)
+    (CNAME 5)
+    (SOA 6)
+    (MB 7)
+    (MG 8)
+    (MR 9)
+    (NULL 10)
+    (WKS 11)
+    (PRT 12)
+    (HINFO 13)
+    (MINFO 14)
+    (MX 15)
+    (TXT 16)
+    (AXFR 252)
+    (MAILB 253)
+    (MAILA 254)
+    (* 255))
+  "Names of query types and their values.")
+
+(defvar dns-classes
+  '((IN 1)
+    (CS 2)
+    (CH 3)
+    (HS 4))
+  "Classes of queries.")
+
+(defun dns-write-bytes (value &optional length)
+  (let (bytes)
+    (dotimes (i (or length 1))
+      (push (% value 256) bytes)
+      (setq value (/ value 256)))
+    (dolist (byte bytes)
+      (insert byte))))
+
+(defun dns-read-bytes (length)
+  (let ((value 0))
+    (dotimes (i length)
+      (setq value (logior (* value 256) (following-char)))
+      (forward-char 1))
+    value))
+
+(defun dns-get (type spec)
+  (cadr (assq type spec)))
+
+(defun dns-inverse-get (value spec)
+  (let ((found nil))
+    (while (and (not found)
+		spec)
+      (if (eq value (cadr (car spec)))
+	  (setq found (caar spec))
+	(pop spec)))
+    found))
+
+(defun dns-write-name (name)
+  (dolist (part (split-string name "\\."))
+    (dns-write-bytes (length part))
+    (insert part))
+  (dns-write-bytes 0))
+
+(defun dns-read-string-name (string buffer)
+  (mm-with-unibyte-buffer
+    (insert string)
+    (goto-char (point-min))
+    (dns-read-name buffer)))
+
+(defun dns-read-name (&optional buffer)
+  (let ((ended nil)
+	(name nil)
+	length)
+    (while (not ended)
+      (setq length (dns-read-bytes 1))
+      (if (= 192 (logand length (lsh 3 6)))
+	  (let ((offset (+ (* (logand 63 length) 256)
+			   (dns-read-bytes 1))))
+	    (save-excursion
+	      (when buffer
+		(set-buffer buffer))
+	      (goto-char (1+ offset))
+	      (setq ended (dns-read-name buffer))))
+	(if (zerop length)
+	    (setq ended t)
+	  (push (buffer-substring (point)
+				  (progn (forward-char length) (point)))
+		name))))
+    (if (stringp ended)
+	(if (null name)
+	    ended
+	  (concat (mapconcat 'identity (nreverse name) ".") "." ended))
+      (mapconcat 'identity (nreverse name) "."))))
+
+(defun dns-write (spec &optional tcp-p)
+  "Write a DNS packet according to SPEC.
+If TCP-P, the first two bytes of the package with be the length field."
+  (with-temp-buffer
+    (dns-write-bytes (dns-get 'id spec) 2)
+    (dns-write-bytes
+     (logior
+      (lsh (if (dns-get 'response-p spec) 1 0) -7)
+      (lsh
+       (cond
+	((eq (dns-get 'opcode spec) 'query) 0)
+	((eq (dns-get 'opcode spec) 'inverse-query) 1)
+	((eq (dns-get 'opcode spec) 'status) 2)
+	(t (error "No such opcode: %s" (dns-get 'opcode spec))))
+       -3)
+      (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
+      (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
+      (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
+    (dns-write-bytes
+     (cond 
+      ((eq (dns-get 'response-code spec) 'no-error) 0)
+      ((eq (dns-get 'response-code spec) 'format-error) 1)
+      ((eq (dns-get 'response-code spec) 'server-failure) 2)
+      ((eq (dns-get 'response-code spec) 'name-error) 3)
+      ((eq (dns-get 'response-code spec) 'not-implemented) 4)
+      ((eq (dns-get 'response-code spec) 'refused) 5)
+      (t 0)))
+    (dns-write-bytes (length (dns-get 'queries spec)) 2)
+    (dns-write-bytes (length (dns-get 'answers spec)) 2)
+    (dns-write-bytes (length (dns-get 'authorities spec)) 2)
+    (dns-write-bytes (length (dns-get 'additionals spec)) 2)
+    (dolist (query (dns-get 'queries spec))
+      (dns-write-name (car query))
+      (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
+				   dns-query-types)) 2)
+      (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
+				   dns-classes)) 2))
+    (dolist (slot '(answers authorities additionals))
+      (dolist (resource (dns-get slot spec))
+	(dns-write-name (car resource))
+      (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
+		       2)
+      (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
+		       2)
+      (dns-write-bytes (dns-get 'ttl resource) 4)
+      (dns-write-bytes (length (dns-get 'data resource)) 2)
+      (insert (dns-get 'data resource))))
+    (when tcp-p
+      (goto-char (point-min))
+      (dns-write-bytes (buffer-size) 2))
+    (buffer-string)))
+
+(defun dns-read (packet)
+  (mm-with-unibyte-buffer
+    (let ((spec nil)
+	  queries answers authorities additionals)
+      (insert packet)
+      (goto-char (point-min))
+      (push (list 'id (dns-read-bytes 2)) spec)
+      (let ((byte (dns-read-bytes 1)))
+	(push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
+	      spec)
+	(let ((opcode (logand byte (lsh 7 3))))
+	  (push (list 'opcode
+		      (cond ((eq opcode 0) 'query)
+			    ((eq opcode 1) 'inverse-query)
+			    ((eq opcode 2) 'status)))
+		spec))
+	(push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
+					 nil t)) spec)
+	(push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
+	      spec)
+	(push (list 'recursion-desired-p
+		    (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
+      (let ((rc (logand (dns-read-bytes 1) 15)))
+	(push (list 'response-code
+		    (cond
+		     ((eq rc 0) 'no-error)
+		     ((eq rc 1) 'format-error)
+		     ((eq rc 2) 'server-failure)
+		     ((eq rc 3) 'name-error)
+		     ((eq rc 4) 'not-implemented)
+		     ((eq rc 5) 'refused)))
+	      spec))
+      (setq queries (dns-read-bytes 2))
+      (setq answers (dns-read-bytes 2))
+      (setq authorities (dns-read-bytes 2))
+      (setq additionals (dns-read-bytes 2))
+      (let ((qs nil))
+	(dotimes (i queries)
+	  (push (list (dns-read-name)
+		      (list 'type (dns-inverse-get (dns-read-bytes 2)
+						   dns-query-types))
+		      (list 'class (dns-inverse-get (dns-read-bytes 2)
+						    dns-classes)))
+		qs))
+	(push (list 'queries qs) spec))
+    (dolist (slot '(answers authorities additionals))
+      (let ((qs nil)
+	    type)
+	(dotimes (i (symbol-value slot))
+	  (push (list (dns-read-name)
+		      (list 'type
+			    (setq type (dns-inverse-get (dns-read-bytes 2)
+							dns-query-types)))
+		      (list 'class (dns-inverse-get (dns-read-bytes 2)
+						    dns-classes))
+		      (list 'ttl (dns-read-bytes 4))
+		      (let ((length (dns-read-bytes 2)))
+			(list 'data
+			      (dns-read-type
+			       (buffer-substring
+				(point)
+				(progn (forward-char length) (point)))
+			       type))))
+		qs))
+	(push (list slot qs) spec)))
+    (nreverse spec))))
+
+(defun dns-read-type (string type)
+  (let ((buffer (current-buffer))
+	(point (point)))
+    (prog1
+	(mm-with-unibyte-buffer
+	  (insert string)
+	  (goto-char (point-min))
+	  (cond
+	   ((eq type 'A)
+	    (let ((bytes nil))
+	      (dotimes (i 4)
+		(push (dns-read-bytes 1) bytes))
+	      (mapconcat 'number-to-string (nreverse bytes) ".")))
+	   ((eq type 'NS)
+	    (dns-read-string-name string buffer))
+	   ((eq type 'CNAME)
+	    (dns-read-string-name string buffer))
+	   (t string)))
+      (goto-char point))))
+
+(defun dns-parse-resolv-conf ()
+  (when (file-exists-p "/etc/resolv.conf")
+    (with-temp-buffer
+      (insert-file-contents "/etc/resolv.conf")
+      (goto-char (point-min))
+      (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
+	(push (match-string 1) dns-servers))
+      (setq dns-servers (nreverse dns-servers)))))
+
+;;; Interface functions.
+
+(autoload 'gnus-xmacs-open-network-stream "gnus-xmas" nil nil 'macro)
+
+(defmacro dns-make-network-process (server)
+  (if (featurep 'xemacs)
+      `(let ((coding-system-for-read 'binary)
+	     (coding-system-for-write 'binary))
+	 (gnus-xmas-open-network-stream "dns" (current-buffer)
+					,server "domain" 'udp))
+    `(let ((server ,server)
+	   (coding-system-for-read 'binary)
+	   (coding-system-for-write 'binary)
+	   (default-process-coding-system '(binary . binary))
+	   program-coding-system-alist)
+       (if (fboundp 'make-network-process)
+	   (make-network-process
+	    :name "dns"
+	    :coding 'binary
+	    :buffer (current-buffer)
+	    :host server
+	    :service "domain"
+	    :type 'datagram)
+	 ;; Older versions of Emacs doesn't have
+	 ;; `make-network-process', so we fall back on opening a TCP
+	 ;; connection to the DNS server.
+	 (open-network-stream "dns" (current-buffer) server "domain")))))
+
+(defun query-dns (name &optional type fullp)
+  "Query a DNS server for NAME of TYPE.
+If FULLP, return the entire record returned."
+  (setq type (or type 'A))
+  (unless dns-servers
+    (dns-parse-resolv-conf)
+    (unless dns-servers
+      (error "No DNS server configuration found")))
+  (mm-with-unibyte-buffer
+    (let ((process (condition-case ()
+		       (dns-make-network-process (car dns-servers))
+		     (error
+		      (message "dns: Got an error while trying to talk to %s"
+			       (car dns-servers))
+		      nil)))
+	  (tcp-p (and (not (fboundp 'make-network-process))
+		      (not (featurep 'xemacs))))
+	  (step 100)
+	  (times (* dns-timeout 1000))
+	  (id (random 65000)))
+      (when process
+	(process-send-string
+	 process
+	 (dns-write `((id ,id)
+		      (opcode query)
+		      (queries ((,name (type ,type))))
+		      (recursion-desired-p t))
+		    tcp-p))
+	(while (and (zerop (buffer-size))
+		    (> times 0))
+	  (accept-process-output process 0 step)
+	  (decf times step))
+	(ignore-errors
+	  (delete-process process))
+	(when tcp-p
+	  (goto-char (point-min))
+	  (delete-region (point) (+ (point) 2)))
+	(unless (zerop (buffer-size))
+	  (let ((result (dns-read (buffer-string))))
+	    (if fullp
+		result
+	      (let ((answer (car (dns-get 'answers result))))
+		(when (eq type (dns-get 'type answer))
+		  (dns-get 'data answer))))))))))
+
+(provide 'dns)
+
+;;; dns.el ends here
diff --git a/lisp/gnus-delay.el b/lisp/gnus-delay.el
new file mode 100644
index 0000000..cc212fa
--- /dev/null
+++ b/lisp/gnus-delay.el
@@ -0,0 +1,195 @@
+;;; gnus-delay.el --- Delayed posting of articles
+
+;; Copyright (C) 2001, 2002, 2003  Free Software Foundation, Inc.
+
+;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+;; Keywords: mail, news, extensions
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Provide delayed posting of articles.
+
+;;; Todo:
+
+;; * `gnus-delay-send-queue' barfs when group does not exist.
+;; * Integrate gnus-delay.el into the rest of Gnus automatically.  How
+;;   should this be done?  Basically, we need to do what
+;;   `gnus-delay-initialize' does.  But in which files?
+
+;;; Code:
+
+(require 'nndraft)
+(require 'gnus-draft)
+
+;;;###autoload
+(defgroup gnus-delay nil
+  "Arrange for sending postings later."
+  :group 'gnus)
+
+(defcustom gnus-delay-group "delayed"
+  "Group name for storing delayed articles."
+  :type 'string
+  :group 'gnus-delay)
+
+(defcustom gnus-delay-header "X-Gnus-Delayed"
+  "Header name for storing info about delayed articles."
+  :type 'string
+  :group 'gnus-delay)
+
+(defcustom gnus-delay-default-delay "3d"
+  "*Default length of delay."
+  :type 'string
+  :group 'gnus-delay)
+
+(defcustom gnus-delay-default-hour 8
+  "*If deadline is given as date, then assume this time of day."
+  :type 'integer
+  :group 'gnus-delay)
+
+;;;###autoload
+(defun gnus-delay-article (delay)
+  "Delay this article by some time.
+DELAY is a string, giving the length of the time.  Possible values are:
+
+* <digits><units> for <units> in minutes (`m'), hours (`h'), days (`d'),
+  weeks (`w'), months (`M'), or years (`Y');
+
+* YYYY-MM-DD for a specific date.  The time of day is given by the
+  variable `gnus-delay-default-hour', minute and second are zero.
+
+* hh:mm for a specific time.  Use 24h format.  If it is later than this
+  time, then the deadline is tomorrow, else today."
+  (interactive
+   (list (read-string
+	  "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
+	  gnus-delay-default-delay)))
+  (let (num unit days year month day hour minute deadline)
+    (cond ((string-match
+	    "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
+	    delay)
+	   (setq year  (string-to-number (match-string 1 delay))
+		 month (string-to-number (match-string 2 delay))
+		 day   (string-to-number (match-string 3 delay)))
+	   (setq deadline
+		 (message-make-date
+		  (encode-time 0 0      ; second and minute
+			       gnus-delay-default-hour
+			       day month year))))
+	  ((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay)
+	   (setq hour   (string-to-number (match-string 1 delay))
+		 minute (string-to-number (match-string 2 delay)))
+	   ;; Use current time, except...
+	   (setq deadline (apply 'vector (decode-time (current-time))))
+	   ;; ... for minute and hour.
+	   (aset deadline 1 minute)
+	   (aset deadline 2 hour)
+	   ;; Convert to seconds.
+	   (setq deadline (time-to-seconds (apply 'encode-time
+						  (append deadline nil))))
+	   ;; If this time has passed already, add a day.
+	   (when (< deadline (time-to-seconds (current-time)))
+	     (setq deadline (+ 3600 deadline))) ;3600 secs/day
+	   ;; Convert seconds to date header.
+	   (setq deadline (message-make-date
+			   (seconds-to-time deadline))))
+	  ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay)
+	   (setq num (match-string 1 delay))
+	   (setq unit (match-string 2 delay))
+	   ;; Start from seconds, then multiply into needed units.
+	   (setq num (string-to-number num))
+	   (cond ((string= unit "Y")
+		  (setq delay (* num 60 60 24 365)))
+		 ((string= unit "M")
+		  (setq delay (* num 60 60 24 30)))
+		 ((string= unit "w")
+		  (setq delay (* num 60 60 24 7)))
+		 ((string= unit "d")
+		  (setq delay (* num 60 60 24)))
+		 ((string= unit "h")
+		  (setq delay (* num 60 60)))
+		 (t
+		  (setq delay (* num 60))))
+	   (setq deadline (message-make-date
+			   (seconds-to-time (+ (time-to-seconds (current-time))
+					       delay)))))
+	  (t (error "Malformed delay `%s'" delay)))
+    (message-add-header (format "%s: %s" gnus-delay-header deadline)))
+  (set-buffer-modified-p t)
+  ;; If group does not exist, create it.
+  (let ((group (format "nndraft:%s" gnus-delay-group)))
+    (gnus-agent-queue-setup gnus-delay-group))
+  (message-disassociate-draft)
+  (nndraft-request-associate-buffer gnus-delay-group)
+  (save-buffer 0)
+  (kill-buffer (current-buffer))
+  (message-do-actions message-postpone-actions))
+
+;;;###autoload
+(defun gnus-delay-send-queue ()
+  "Send all the delayed messages that are due now."
+  (interactive)
+  (save-excursion
+    (let* ((group (format "nndraft:%s" gnus-delay-group))
+	   (message-send-hook (copy-sequence message-send-hook))
+	   articles
+	   article deadline)
+      (when (gnus-gethash group gnus-newsrc-hashtb)
+	(gnus-activate-group group)
+	(add-hook 'message-send-hook
+		  '(lambda ()
+		     (message-remove-header gnus-delay-header)))
+	(setq articles (nndraft-articles))
+	(while (setq article (pop articles))
+	  (gnus-request-head article group)
+	  (set-buffer nntp-server-buffer)
+	  (goto-char (point-min))
+	  (if (re-search-forward
+	       (concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
+	       nil t)
+	      (progn
+		(setq deadline (nnheader-header-value))
+		(setq deadline (apply 'encode-time
+				      (parse-time-string deadline)))
+		(setq deadline (time-since deadline))
+		(when (and (>= (nth 0 deadline) 0)
+			   (>= (nth 1 deadline) 0))
+		  (message "Sending delayed article %d" article)
+		  (gnus-draft-send article group)
+		  (message "Sending delayed article %d...done" article)))
+	    (message "Delay header missing for article %d" article)))))))
+
+;;;###autoload
+(defun gnus-delay-initialize (&optional no-keymap no-check)
+  "Initialize the gnus-delay package.
+This sets up a key binding in `message-mode' to delay a message.
+This tells Gnus to look for delayed messages after getting new news.
+
+The optional arg NO-KEYMAP is ignored.
+Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
+  (unless no-check
+    (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue)))
+
+(provide 'gnus-delay)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; gnus-delay.el ends here
diff --git a/lisp/gnus-diary.el b/lisp/gnus-diary.el
new file mode 100644
index 0000000..dafb8c3
--- /dev/null
+++ b/lisp/gnus-diary.el
@@ -0,0 +1,469 @@
+;;; gnus-diary.el --- Wrapper around the NNDiary Gnus backend
+
+;; Copyright (c) 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001 Didier Verna.
+
+;; Author:        Didier Verna <didier@xemacs.org>
+;; Maintainer:    Didier Verna <didier@xemacs.org>
+;; Created:       Tue Jul 20 10:42:55 1999
+;; Keywords:      calendar mail news
+
+;; 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 of the License,
+;; 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+;; Description:
+;; ===========
+
+;; Gnus-Diary is a wrapper around the NNDiary Gnus backend.  It is here to
+;; make your nndiary-user life easier in different ways.  So, you don't have
+;; to use it if you don't want to.  But, really, you should.
+
+;; Gnus-Diary offers the following features on top of the NNDiary backend:
+
+;;  - A nice summary line format:
+;;    Displaying diary messages in standard summary line format (usually
+;;    something like "<From Joe>: <Subject>") is pretty useless.  Most of the
+;;    time, you're the one who wrote the message, and you mostly want to see
+;;    the event's date.  Gnus-Diary offers you a nice summary line format
+;;    which will do this.  By default, a summary line will appear like this:
+;;
+;;     <Event Date>: <Subject> <Remaining time>
+;;
+;;   for example, here's how Joe's birthday is displayed in my
+;;   "nndiary:birhdays" summary buffer (the message is expirable, but will
+;;   never be deleted, as it specifies a regular event):
+;;
+;;   E  Sat, Sep 22 01, 12:00: Joe's birthday (in 6 months, 1 week)
+
+;;  - More article sorting functions:
+;;    Gnus-Diary adds a new sorting function called
+;;    `gnus-summary-sort-by-schedule'.  This function lets you organize your
+;;    diary summary buffers from the closest event to the farthest one.
+
+;;  - Automatic generation of diary group parameters:
+;;    When you create a new diary group, or visit one, Gnus-Diary checks your
+;;    group parameters, and if needed, sets the summary line format to the
+;;    diary-specific value, adds the diary-specific sorting functions, and
+;;    also adds the different `X-Diary-*' headers to the group's
+;;    posting-style.  It is then easier to send a diary message, because if
+;;    you use `C-u a' or `C-u m' on a diary group to prepare a message, these
+;;    headers will be inserted automatically (but not filled with proper
+;;    values yet).
+
+;;  - An interactive mail-to-diary convertion function:
+;;    The function `gnus-diary-check-message' ensures that the current message
+;;    contains all the required diary headers, and prompts you for values /
+;;    correction if needed.  This function is hooked in the nndiary backend so
+;;    that moving an article to an nndiary group will trigger it
+;;    automatically.  It is also bound to `C-c D c' in message-mode and
+;;    article-edit-mode in order to ease the process of converting a usual
+;;    mail to a diary one.  This function takes a prefix argument which will
+;;    force prompting of all diary headers, regardless of their
+;;    presence/validity.  That way, you can very easily reschedule a diary
+;;    message for instance.
+
+
+;; Usage:
+;; =====
+
+;; 0/ Don't use any `gnus-user-format-function-[d|D]'.  Gnus-Diary provides
+;;    both of these (sorry if you used them before).
+;; 1/ Add '(require 'gnus-diary) to your gnusrc file.
+;; 2/ Customize your gnus-diary options to suit your needs.
+
+
+
+;; Bugs / Todo:
+;; ===========
+
+
+;;; Code:
+
+(require 'nndiary)
+(require 'message)
+(require 'gnus-art)
+
+(defgroup gnus-diary nil
+  "Utilities on top of the nndiary backend for Gnus.")
+
+(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n"
+  "*Summary line format for nndiary groups."
+  :type 'string
+  :group 'gnus-diary
+  :group 'gnus-summary-format)
+
+(defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M"
+  "*Time format to display appointements in nndiary summary buffers.
+Please refer to `format-time-string' for information on possible values."
+  :type 'string
+  :group 'gnus-diary)
+
+(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english
+  "*Function called to format a diary delay string.
+It is passed two arguments.  The first one is non nil if the delay is in
+the past.  The second one is of the form ((NUM . UNIT) ...) where NUM is
+an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute.
+It should return strings like \"In 2 months, 3 weeks\", \"3 hours,
+1 minute ago\" and so on.
+
+There are currently two built-in format functions:
+`gnus-diary-delay-format-english' (the default)
+`gnus-diary-delay-format-french'"
+  :type '(choice (const  :tag "english" gnus-diary-delay-format-english)
+		 (const  :tag "french"  gnus-diary-delay-format-french)
+		 (symbol :tag "other"))
+  :group 'gnus-diary)
+
+(defconst gnus-diary-version nndiary-version
+  "Current Diary backend version.")
+
+
+;; Compatibility functions ==================================================
+
+(eval-and-compile
+  (if (fboundp 'kill-entire-line)
+      (defalias 'gnus-diary-kill-entire-line 'kill-entire-line)
+    (defun gnus-diary-kill-entire-line ()
+      (beginning-of-line)
+      (let ((kill-whole-line t))
+	(kill-line)))))
+
+
+;; Summary line format ======================================================
+
+(defun gnus-diary-delay-format-french (past delay)
+  (if (null delay)
+      "maintenant!"
+    ;; Keep only a precision of two degrees
+    (and (> (length delay) 1) (setcdr (cdr delay) nil))
+    (concat (if past "il y a " "dans ")
+	    (let ((str "")
+		  del)
+	      (while (setq del (pop delay))
+		(setq str (concat str
+				  (int-to-string (car del)) " "
+				  (cond ((eq (cdr del) 'year)
+					 "an")
+					((eq (cdr del) 'month)
+					 "mois")
+					((eq (cdr del) 'week)
+					 "semaine")
+					((eq (cdr del) 'day)
+					 "jour")
+					((eq (cdr del) 'hour)
+					 "heure")
+					((eq (cdr del) 'minute)
+					 "minute"))
+				  (unless (or (eq (cdr del) 'month)
+					      (= (car del) 1))
+				    "s")
+				  (if delay ", "))))
+	      str))))
+
+
+(defun gnus-diary-delay-format-english (past delay)
+  (if (null delay)
+      "now!"
+    ;; Keep only a precision of two degrees
+    (and (> (length delay) 1) (setcdr (cdr delay) nil))
+    (concat (unless past "in ")
+	    (let ((str "")
+		  del)
+	      (while (setq del (pop delay))
+		(setq str (concat str
+				  (int-to-string (car del)) " "
+				  (symbol-name (cdr del))
+				  (and (> (car del) 1) "s")
+				  (if delay ", "))))
+	      str)
+	    (and past " ago"))))
+
+
+(defun gnus-diary-header-schedule (headers)
+  ;; Same as `nndiary-schedule', but given a set of headers HEADERS
+  (mapcar
+   (lambda (elt)
+     (let ((head (cdr (assoc (intern (format "X-Diary-%s" (car elt)))
+			     headers))))
+       (when head
+	 (nndiary-parse-schedule-value head (cadr elt) (caddr elt)))))
+   nndiary-headers))
+
+;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
+;; message, with all fields set to nil here. I don't know what it is for, and
+;; I just ignore it.
+(defun gnus-user-format-function-d (header)
+  ;; Returns an aproximative delay string for the next occurence of this
+  ;; message. The delay is given only in the first non zero unit.
+  ;; Code partly stolen from article-make-date-line
+  (let* ((extras (mail-header-extra header))
+	 (sched (gnus-diary-header-schedule extras))
+	 (occur (nndiary-next-occurence sched (current-time)))
+	 (now (current-time))
+	 (real-time (subtract-time occur now)))
+    (if (null real-time)
+	"?????"
+      (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time)))
+	     (past (< sec 0))
+	     delay)
+	(and past (setq sec (- sec)))
+	(unless (zerop sec)
+	  ;; This is a bit convoluted, but basically we go through the time
+	  ;; units for years, weeks, etc, and divide things to see whether
+	  ;; that results in positive answers.
+	  (let ((units `((year . ,(* 365.25 24 3600))
+			 (month . ,(* 31 24 3600))
+			 (week . ,(* 7 24 3600))
+			 (day . ,(* 24 3600))
+			 (hour . 3600)
+			 (minute . 60)))
+		unit num)
+	    (while (setq unit (pop units))
+	      (unless (zerop (setq num (ffloor (/ sec (cdr unit)))))
+		(setq delay (append delay `((,(floor num) . ,(car unit))))))
+	      (setq sec (- sec (* num (cdr unit)))))))
+	(funcall gnus-diary-delay-format-function past delay)))
+    ))
+
+;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
+;; message, with all fields set to nil here. I don't know what it is for, and
+;; I just ignore it.
+(defun gnus-user-format-function-D (header)
+  ;; Returns a formatted time string for the next occurence of this message.
+  (let* ((extras (mail-header-extra header))
+	 (sched (gnus-diary-header-schedule extras))
+	 (occur (nndiary-next-occurence sched (current-time))))
+    (format-time-string gnus-diary-time-format occur)))
+
+
+;; Article sorting functions ================================================
+
+(defun gnus-article-sort-by-schedule (h1 h2)
+  (let* ((now (current-time))
+	 (e1 (mail-header-extra h1))
+	 (e2 (mail-header-extra h2))
+	 (s1 (gnus-diary-header-schedule e1))
+	 (s2 (gnus-diary-header-schedule e2))
+	 (o1 (nndiary-next-occurence s1 now))
+	 (o2 (nndiary-next-occurence s2 now)))
+    (if (and (= (car o1) (car o2)) (= (cadr o1) (cadr o2)))
+	(< (mail-header-number h1) (mail-header-number h2))
+      (time-less-p o1 o2))))
+
+
+(defun gnus-thread-sort-by-schedule (h1 h2)
+  (gnus-article-sort-by-schedule (gnus-thread-header h1)
+				 (gnus-thread-header h2)))
+
+(defun gnus-summary-sort-by-schedule (&optional reverse)
+  "Sort nndiary summary buffers by schedule of appointements.
+Optional prefix (or REVERSE argument) means sort in reverse order."
+  (interactive "P")
+  (gnus-summary-sort 'schedule reverse))
+
+(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
+;; The function `easy-menu-add-item' is not available under Emacs
+;; versions prior to 20.3.  Could anyone try to emulate it?
+(if (eval-when-compile
+      (require 'easymenu)
+      (or (fboundp 'easy-menu-add-item)
+	  (progn
+	    (defalias 'easy-menu-add-item 'ignore)
+	    nil)))
+(add-hook 'gnus-summary-menu-hook
+	  (lambda ()
+	    (easy-menu-add-item gnus-summary-misc-menu
+				'("Sort")
+				["Sort by schedule"
+				 gnus-summary-sort-by-schedule
+				 (eq (car (gnus-find-method-for-group
+					   gnus-newsgroup-name))
+				     'nndiary)]
+				"Sort by number")))
+  )
+
+
+
+;; Group parameters autosetting =============================================
+
+(defun gnus-diary-update-group-parameters (group)
+  ;; Ensure that nndiary groups have convenient group parameters:
+  ;; - a posting style containing X-Diary headers
+  ;; - a nice summary line format
+  ;; - NNDiary specific sorting by schedule functions
+  ;; In general, try not to mess with what the user might have modified.
+  (let ((posting-style (gnus-group-get-parameter group 'posting-style t)))
+    ;; Posting style:
+    (mapcar (lambda (elt)
+	      (let ((header (format "X-Diary-%s" (car elt))))
+		(unless (assoc header posting-style)
+		  (setq posting-style (append posting-style
+					      `((,header "*")))))
+		))
+	    nndiary-headers)
+    (gnus-group-set-parameter group 'posting-style posting-style)
+    ;; Summary line format:
+    (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
+      (gnus-group-set-parameter group 'gnus-summary-line-format
+				`(,gnus-diary-summary-line-format)))
+    ;; Sorting by schedule:
+    (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
+      (gnus-group-set-parameter group 'gnus-article-sort-functions
+				'((append gnus-article-sort-functions
+					  (list
+					   'gnus-article-sort-by-schedule)))))
+    (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
+      (gnus-group-set-parameter group 'gnus-thread-sort-functions
+				'((append gnus-thread-sort-functions
+					  (list
+					   'gnus-thread-sort-by-schedule)))))
+    ))
+
+;; Called when a group is subscribed. This is needed because groups created
+;; because of mail splitting are *not* created with the backend function.
+;; Thus, `nndiary-request-create-group-hooks' is inoperative.
+(defun gnus-diary-maybe-update-group-parameters (group)
+  (when (eq (car (gnus-find-method-for-group group)) 'nndiary)
+    (gnus-diary-update-group-parameters group)))
+
+(add-hook 'nndiary-request-create-group-hooks
+	  'gnus-diary-update-group-parameters)
+;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed
+;; anymore. Maybe I should remove this completely.
+(add-hook 'nndiary-request-update-info-hooks
+	  'gnus-diary-update-group-parameters)
+(add-hook 'gnus-subscribe-newsgroup-hooks
+	  'gnus-diary-maybe-update-group-parameters)
+
+
+;; Diary Message Checking ===================================================
+
+(defvar gnus-diary-header-value-history nil
+  ;; History variable for header value prompting
+  )
+
+(defun gnus-diary-narrow-to-headers ()
+  "Narrow the current buffer to the header part.
+Point is left at the beginning of the region.
+The buffer is assumed to contain a message, but the format is unknown."
+  (cond ((eq major-mode 'message-mode)
+	 (message-narrow-to-headers))
+	(t
+	 (goto-char (point-min))
+	 (when (search-forward "\n\n" nil t)
+	   (narrow-to-region (point-min) (- (point) 1))
+	   (goto-char (point-min))))
+	))
+
+(defun gnus-diary-add-header (str)
+  "Add a header to the current buffer.
+The buffer is assumed to contain a message, but the format is unknown."
+  (cond ((eq major-mode 'message-mode)
+	 (message-add-header str))
+	(t
+	 (save-restriction
+	   (gnus-diary-narrow-to-headers)
+	   (goto-char (point-max))
+	   (if (string-match "\n$" str)
+	       (insert str)
+	     (insert str ?\n))))
+	))
+
+(defun gnus-diary-check-message (arg)
+  "Ensure that the current message is a valid for NNDiary.
+This function checks that all NNDiary required headers are present and
+valid, and prompts for values / correction otherwise.
+
+If ARG (or prefix) is non-nil, force prompting for all fields."
+  (interactive "P")
+  (save-excursion
+    (mapcar
+     (lambda (head)
+       (let ((header (concat "X-Diary-" (car head)))
+	     (ask arg)
+	     value invalid)
+	 ;; First, try to find the header, and checks for validity:
+	 (save-restriction
+	   (gnus-diary-narrow-to-headers)
+	   (when (re-search-forward (concat "^" header ":") nil t)
+	     (unless (eq (char-after) ? )
+	       (insert " "))
+	     (setq value (buffer-substring (point) (gnus-point-at-eol)))
+	     (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value)
+		  (setq value (match-string 1 value)))
+	     (condition-case ()
+		 (nndiary-parse-schedule-value value
+					       (nth 1 head) (nth 2 head))
+	       (t
+		(setq invalid t)))
+	     ;; #### NOTE: this (along with the `gnus-diary-add-header'
+	     ;; function) could be rewritten in a better way, in particular
+	     ;; not to blindly remove an already present header and reinsert
+	     ;; it somewhere else afterwards.
+	     (when (or ask invalid)
+	       (gnus-diary-kill-entire-line))
+	     ))
+	 ;; Now, loop until a valid value is provided:
+	 (while (or ask (not value) invalid)
+	   (let ((prompt (concat (and invalid
+				      (prog1 "(current value invalid) "
+					(beep)))
+				 header ": ")))
+	     (setq value
+		   (if (listp (nth 1 head))
+		       (completing-read prompt (cons '("*" nil) (nth 1 head))
+					nil t value
+					gnus-diary-header-value-history)
+		     (read-string prompt value
+				  gnus-diary-header-value-history))))
+	   (setq ask nil)
+	   (setq invalid nil)
+	   (condition-case ()
+	       (nndiary-parse-schedule-value value
+					     (nth 1 head) (nth 2 head))
+	     (t
+	      (setq invalid t))))
+	 (gnus-diary-add-header (concat header ": " value))
+	 ))
+     nndiary-headers)
+    ))
+
+(add-hook 'nndiary-request-accept-article-hooks
+	  (lambda () (gnus-diary-check-message nil)))
+
+(define-key message-mode-map "\C-cDc" 'gnus-diary-check-message)
+(define-key gnus-article-edit-mode-map "\C-cDc" 'gnus-diary-check-message)
+
+
+;; The end ==================================================================
+
+(defun gnus-diary-version ()
+  "Current Diary backend version."
+  (interactive)
+  (message "NNDiary version %s" nndiary-version))
+
+(define-key message-mode-map "\C-cDv" 'gnus-diary-version)
+(define-key gnus-article-edit-mode-map "\C-cDv" 'gnus-diary-version)
+
+
+(provide 'gnus-diary)
+
+;;; gnus-diary.el ends here
diff --git a/lisp/gnus-dired.el b/lisp/gnus-dired.el
new file mode 100644
index 0000000..cf54427
--- /dev/null
+++ b/lisp/gnus-dired.el
@@ -0,0 +1,206 @@
+;;; gnus-dired.el --- utility functions where gnus and dired meet
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003
+;;        Free Software Foundation, Inc.
+
+;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
+;;          Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: mail, news, extensions
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides utility functions for intersections of gnus
+;; and dired.  To enable the gnus-dired-mode minor mode which will
+;; have the effect of installing keybindings in dired-mode, place the
+;; following in your ~/.gnus:
+
+;; (require 'gnus-dired) ;, isn't needed due to autoload cookies
+;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
+
+;; Note that if you visit dired buffers before your ~/.gnus file has
+;; been read, those dired buffers won't have the keybindings in
+;; effect.  To get around that problem, you may want to add the above
+;; statements to your ~/.emacs instead.
+
+;;; Code:
+
+(require 'dired)
+(require 'gnus-ems)
+(require 'gnus-msg)
+(require 'gnus-util)
+(require 'message)
+(require 'mm-encode)
+(require 'mml)
+
+(defvar gnus-dired-mode nil
+  "Minor mode for intersections of gnus and dired.")
+
+(defvar gnus-dired-mode-map nil)
+
+(unless gnus-dired-mode-map
+  (setq gnus-dired-mode-map (make-sparse-keymap))
+
+  (gnus-define-keys gnus-dired-mode-map
+    "\C-c\C-a" gnus-dired-attach
+    "\C-c\C-l" gnus-dired-find-file-mailcap
+    "\C-cP" gnus-dired-print))
+
+(defun gnus-dired-mode (&optional arg)
+  "Minor mode for intersections of gnus and dired.
+
+\\{gnus-dired-mode-map}"
+  (interactive "P")
+  (when (eq major-mode 'dired-mode)
+    (set (make-local-variable 'gnus-dired-mode)
+	 (if (null arg) (not gnus-dired-mode)
+	   (> (prefix-numeric-value arg) 0)))
+    (when gnus-dired-mode
+      (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
+      (gnus-run-hooks 'gnus-dired-mode-hook))))
+
+;;;###autoload
+(defun turn-on-gnus-dired-mode ()
+  "Convenience method to turn on gnus-dired-mode."
+  (gnus-dired-mode 1))
+
+;; Method to attach files to a gnus composition.
+(defun gnus-dired-attach (files-to-attach)
+  "Attach dired's marked files to a gnus message composition.
+If called non-interactively, FILES-TO-ATTACH should be a list of
+filenames."
+  (interactive
+   (list
+    (delq nil
+	  (mapcar
+	   ;; don't attach directories
+	   (lambda (f) (if (file-directory-p f) nil f))
+	   (nreverse (dired-map-over-marks (dired-get-filename) nil))))))
+  (let ((destination nil)
+	(files-str nil)
+	(bufs nil))
+    ;; warn if user tries to attach without any files marked
+    (if (null files-to-attach)
+	(error "No files to attach")
+      (setq files-str
+	    (mapconcat
+	     (lambda (f) (file-name-nondirectory f))
+	     files-to-attach ", "))
+      (setq bufs (message-buffers))
+
+      ;; set up destination message buffer
+      (if (and bufs
+	       (y-or-n-p "Attach files to existing message buffer? "))
+	  (setq destination
+		(if (= (length bufs) 1)
+		    (get-buffer (car bufs))
+		  (completing-read "Attach to which message buffer: "
+				   (mapcar
+				    (lambda (b)
+				      (cons b (get-buffer b)))
+				    bufs)
+				   nil t)))
+	;; setup a new gnus message buffer
+	(gnus-setup-message 'message (message-mail))
+	(setq destination (current-buffer)))
+
+      ;; set buffer to destination buffer, and attach files
+      (set-buffer destination)
+      (goto-char (point-max))		;attach at end of buffer
+      (while files-to-attach
+	(mml-attach-file (car files-to-attach)
+			 (or (mm-default-file-encoding (car files-to-attach))
+			     "application/octet-stream") nil)
+	(setq files-to-attach (cdr files-to-attach)))
+      (message "Attached file(s) %s" files-str))))
+
+(autoload 'mailcap-parse-mailcaps "mailcap" "" t)
+
+(defun gnus-dired-find-file-mailcap (&optional file-name arg)
+  "In dired, visit FILE-NAME according to the mailcap file.
+If ARG is non-nil, open it in a new buffer."
+  (interactive (list
+		(file-name-sans-versions (dired-get-filename) t)
+		current-prefix-arg))
+  (mailcap-parse-mailcaps)
+  (if (file-exists-p file-name)
+      (let (mime-type method)
+	(if (and (not arg)
+		 (not (file-directory-p file-name))
+		 (string-match "\\.[^\\.]+$" file-name)
+		 (setq mime-type
+		       (mailcap-extension-to-mime
+			(match-string 0 file-name)))
+		 (stringp
+		  (setq method
+			(cdr (assoc 'viewer
+				    (car (mailcap-mime-info mime-type
+							    'all)))))))
+	    (let ((view-command (mm-mailcap-command method file-name nil)))
+	      (message "viewing via %s" view-command)
+	      (start-process "*display*"
+			     nil
+			     shell-file-name
+			     shell-command-switch
+			     view-command))
+	  (find-file file-name)))
+    (if (file-symlink-p file-name)
+	(error "File is a symlink to a nonexistent target")
+      (error "File no longer exists; type `g' to update Dired buffer"))))
+
+(defun gnus-dired-print (&optional file-name print-to)
+  "In dired, print FILE-NAME according to the mailcap file.
+
+If there is no print command, print in a PostScript image. If the
+optional argument PRINT-TO is nil, send the image to the printer. If
+PRINT-TO is a string, save the PostScript image in a file with that
+name.  If PRINT-TO is a number, prompt the user for the name of the
+file to save in."
+  (interactive (list
+		(file-name-sans-versions (dired-get-filename) t)
+		(ps-print-preprint current-prefix-arg)))
+  (mailcap-parse-mailcaps)
+  (cond
+   ((file-directory-p file-name)
+    (error "Can't print a directory"))
+   ((file-exists-p file-name)
+    (let (mime-type method)
+      (if (and (string-match "\\.[^\\.]+$" file-name)
+	       (setq mime-type
+		     (mailcap-extension-to-mime
+		      (match-string 0 file-name)))
+	       (stringp
+		(setq method (mailcap-mime-info mime-type "print"))))
+	  (call-process shell-file-name nil
+			(generate-new-buffer " *mm*")
+			nil
+			shell-command-switch
+			(mm-mailcap-command method file-name mime-type))
+	(with-temp-buffer
+	  (insert-file-contents file-name)
+	  (gnus-print-buffer))
+	(ps-despool print-to))))
+   ((file-symlink-p file-name)
+     (error "File is a symlink to a nonexistent target"))
+    (t
+     (error "File no longer exists; type `g' to update Dired buffer"))))
+
+(provide 'gnus-dired)
+
+;;; gnus-dired.el ends here
diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
new file mode 100644
index 0000000..8791640
--- /dev/null
+++ b/lisp/gnus-fun.el
@@ -0,0 +1,251 @@
+;;; gnus-fun.el --- various frivolous extension functions to Gnus
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl)
+  (require 'mm-util))
+
+(defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory)
+  "*Directory where X-Face PBM files are stored."
+  :group 'gnus-fun
+  :type 'directory)
+
+(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
+  "Command for converting a PBM to an X-Face."
+  :group 'gnus-fun
+  :type 'string)
+
+(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
+  "Command for converting an image to an X-Face.
+By default it takes a GIF filename and output the X-Face header data
+on stdout."
+  :group 'gnus-fun
+  :type 'string)
+
+(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng"
+  "Command for converting an image to an Face.
+By default it takes a JPEG filename and output the Face header data
+on stdout."
+  :group 'gnus-fun
+  :type 'string)
+
+(defun gnus-shell-command-to-string (command)
+  "Like `shell-command-to-string' except not mingling ERROR."
+  (with-output-to-string
+    (call-process shell-file-name nil (list standard-output nil)
+		  nil shell-command-switch command)))
+
+(defun gnus-shell-command-on-region (start end command)
+  "A simplified `shell-command-on-region'.
+Output to the current buffer, replace text, and don't mingle error."
+  (call-process-region start end shell-file-name t
+		       (list (current-buffer) nil)
+		       nil shell-command-switch command))
+
+;;;###autoload
+(defun gnus-random-x-face ()
+  "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
+  (interactive)
+  (when (file-exists-p gnus-x-face-directory)
+    (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
+	   (file (nth (random (length files)) files)))
+      (when file
+	(gnus-shell-command-to-string
+	 (format gnus-convert-pbm-to-x-face-command
+		 (shell-quote-argument file)))))))
+
+;;;###autoload
+(defun gnus-insert-random-x-face-header ()
+  "Insert a random X-Face header from `gnus-x-face-directory'."
+  (interactive)
+  (let ((data (gnus-random-x-face)))
+    (save-excursion
+      (message-goto-eoh)
+      (if data
+	  (insert "X-Face: " data)
+	(message
+	 "No face returned by `gnus-random-x-face'.  Does %s/*.pbm exist?"
+	 gnus-x-face-directory)))))
+
+;;;###autoload
+(defun gnus-x-face-from-file (file)
+  "Insert an X-Face header based on an image file."
+  (interactive "fImage file name (by default GIF): ")
+  (when (file-exists-p file)
+    (gnus-shell-command-to-string
+     (format gnus-convert-image-to-x-face-command
+	     (shell-quote-argument (expand-file-name file))))))
+
+;;;###autoload
+(defun gnus-face-from-file (file)
+  "Return an Face header based on an image file."
+  (interactive "fImage file name (by default JPEG): ")
+  (when (file-exists-p file)
+    (let ((done nil)
+	  (attempt "")
+	  (quant 16))
+      (while (and (not done)
+		  (> quant 1))
+	(setq attempt
+	      (let ((coding-system-for-read 'binary))
+		(gnus-shell-command-to-string
+		 (format gnus-convert-image-to-face-command
+			 (shell-quote-argument (expand-file-name file))
+			 quant))))
+	(if (> (length attempt) 726)
+	    (progn
+	      (setq quant (- quant 2))
+	      (message "Length %d; trying quant %d"
+		       (length attempt) quant))
+	  (setq done t)))
+      (if done
+	  (mm-with-unibyte-buffer
+	    (insert attempt)
+	    (gnus-face-encode))
+	nil))))
+
+(defun gnus-face-encode ()
+  (let ((step 72))
+    (base64-encode-region (point-min) (point-max))
+    (goto-char (point-min))
+    (while (search-forward "\n" nil t)
+      (replace-match ""))
+    (goto-char (point-min))
+    (while (> (- (point-max) (point))
+	      step)
+      (forward-char step)
+      (insert "\n ")
+      (setq step 76))
+    (buffer-string)))
+
+;;;###autoload
+(defun gnus-convert-face-to-png (face)
+  "Convert FACE (which is base64-encoded) to a PNG.
+The PNG is returned as a string."
+  (mm-with-unibyte-buffer
+    (insert face)
+    (ignore-errors
+      (base64-decode-region (point-min) (point-max)))
+    (buffer-string)))
+
+;;;###autoload
+(defun gnus-convert-png-to-face (file)
+  "Convert FILE to a Face.
+FILE should be a PNG file that's 48x48 and smaller than or equal to
+726 bytes."
+  (mm-with-unibyte-buffer
+    (insert-file-contents file)
+    (when (> (buffer-size) 726)
+      (error "The file is %d bytes long, which is too long"
+	     (buffer-size)))
+    (gnus-face-encode)))
+
+(defface gnus-x-face '((t (:foreground "black" :background "white")))
+  "Face to show X-Face.
+The colors from this face are used as the foreground and background
+colors of the displayed X-Faces."
+  :group 'gnus-article-headers)
+
+(defun gnus-display-x-face-in-from (data)
+  "Display the X-Face DATA in the From header."
+  (let ((default-enable-multibyte-characters nil)
+	pbm)
+    (when (or (gnus-image-type-available-p 'xface)
+	      (and (gnus-image-type-available-p 'pbm)
+		   (setq pbm (uncompface data))))
+      (save-excursion
+	(save-restriction
+	  (article-narrow-to-head)
+	  (gnus-article-goto-header "from")
+	  (when (bobp)
+	    (insert "From: [no `from' set]\n")
+	    (forward-char -17))
+	  (gnus-add-image
+	   'xface
+	   (gnus-put-image
+	    (if (gnus-image-type-available-p 'xface)
+		(gnus-create-image
+		 (concat "X-Face: " data)
+		 'xface t :ascent 'center :face 'gnus-x-face)
+	      (gnus-create-image
+	       pbm 'pbm t :ascent 'center :face 'gnus-x-face))))
+	  (gnus-add-wash-type 'xface))))))
+
+(defun gnus-grab-cam-x-face ()
+  "Grab a picture off the camera and make it into an X-Face."
+  (interactive)
+  (shell-command "xawtv-remote snap ppm")
+  (let ((file nil))
+    (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
+					     t "snap.*ppm")))
+      (sleep-for 1))
+    (setq file (car file))
+    (with-temp-buffer
+      (shell-command
+       (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
+	       file)
+       (current-buffer))
+      ;;(sleep-for 3)
+      (delete-file file)
+      (buffer-string))))
+
+(defun gnus-grab-cam-face ()
+  "Grab a picture off the camera and make it into an X-Face."
+  (interactive)
+  (shell-command "xawtv-remote snap ppm")
+  (let ((file nil)
+	result)
+    (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
+					     t "snap.*ppm")))
+      (sleep-for 1))
+    (setq file (car file))
+    (shell-command
+     (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > /tmp/gnus.face.ppm"
+	     file))
+    (let ((gnus-convert-image-to-face-command
+	   (format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng"
+		   (gnus-fun-ppm-change-string))))
+      (setq result (gnus-face-from-file "/tmp/gnus.face.ppm")))
+    (delete-file file)
+    ;;(delete-file "/tmp/gnus.face.ppm")
+    result))
+
+(defun gnus-fun-ppm-change-string ()
+  (let* ((possibilites '("%02x0000" "00%02x00" "0000%02x"
+			"%02x%02x00" "00%02x%02x" "%02x00%02x"))
+	 (format (concat "'#%02x%02x%02x' '#"
+			 (nth (random 6) possibilites)
+			 "'"))
+	 (values nil))
+  (dotimes (i 255)
+    (push (format format i i i i i i)
+	  values))
+  (mapconcat 'identity values " ")))
+
+(provide 'gnus-fun)
+
+;;; gnus-fun.el ends here
diff --git a/lisp/gnus-namazu.el b/lisp/gnus-namazu.el
new file mode 100644
index 0000000..5ef95eb
--- /dev/null
+++ b/lisp/gnus-namazu.el
@@ -0,0 +1,907 @@
+;;; gnus-namazu.el --- Search mail with Namazu -*- coding: iso-2022-7bit; -*-
+
+;; Copyright (C) 2000,2001,2002 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+;; Keywords: mail searching namazu
+
+;; This file is a part of Semi-Gnus.
+
+;; This program 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.
+
+;; This program 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 this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; This file defines the command to search mails and persistent
+;; articles with Namazu and to browse its results with Gnus.
+;;
+;; Namazu is a full-text search engine intended for easy use.  For
+;; more detail about Namazu, visit the following page:
+;;
+;;     http://namazu.org/
+
+
+;;; Quick Start:
+
+;; If this module has already been installed, only 3 steps are
+;; required to search articles with this module.
+;;
+;;   (1) Install Namazu.
+;;   (2) Start Gnus and type M-x gnus-namazu-create-index RET to make
+;;       index of articles.
+;;   (3) In group buffer or in summary buffer, type C-c C-n query RET.
+
+
+;;; Install:
+
+;; Before installing this module, you must install Namazu.
+;;
+;; This file is a part of T-gnus but is not *YET* a part of Gnus.
+;; When you would like to use this module in Gnus (not T-gnus), put
+;; this file into the lisp/ directory in the Gnus source tree and run
+;; `make install'.  And then, put the following expression into your
+;; ~/.gnus.
+;;
+;;      (require 'gnus-namazu)
+;;      (gnus-namazu-insinuate)
+;;
+;; In order to make index of articles with Namazu before using this
+;; module, type M-x gnus-namazu-create-index RET.  Otherwise, you can
+;; create index by yourself with the following commands:
+;;
+;;      % mkdir ~/News/namazu
+;;      % mknmz -a -h -O ~/News/namazu ~/Mail ~/News/cache
+;;
+;; The first command makes the directory for index files, and the
+;; second command generates index files of mails and persistent
+;; articles.
+;;
+;; In order to update indices for incoming articles, this module
+;; automatically runs mknmz, the indexer of Namazu, at an interval of
+;; 3 days; this period is set to `gnus-namazu-index-update-interval'.
+;;
+;; Indices will be updated when `gnus-namazu-search' is called.  If
+;; you want to update indices everywhen Gnus is started, you can put
+;; the following expression to your ~/.gnus.
+;;
+;;      (add-hook 'gnus-startup-hook 'gnus-namazu-update-all-indices)
+;;
+;; In order to control mknmz closely, disable the automatic updating
+;; feature and run mknmz by yourself.  In this case, set nil to the
+;; above option.
+;;
+;;      (setq gnus-namazu-index-update-interval nil)
+;;
+;; When your index is put into the directory other than the default
+;; one (~/News/namazu), it is necessary to set its place to
+;; `gnus-namazu-index-directories' as follows:
+;;
+;;      (setq gnus-namazu-index-directories
+;;            (list (expand-file-name "~/namazu")))
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'nnoo)
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus-sum)
+
+;; It is required for Mule 2.3.  See the file Mule23@1934.en.
+(eval-and-compile
+  (autoload 'regexp-opt "regexp-opt"))
+
+;; To suppress byte-compile warning.
+(eval-when-compile
+  (defvar nnml-directory)
+  (defvar nnmh-directory))
+
+
+(defgroup gnus-namazu nil
+  "Search nnmh and nnml groups in Gnus with Namazu."
+  :group 'namazu
+  :group 'gnus
+  :prefix "gnus-namazu-")
+
+(defconst gnus-namazu-default-index-directory
+  (expand-file-name "namazu" gnus-directory)
+  "Default place of Namazu index files.")
+
+(defcustom gnus-namazu-index-directories
+  (list
+   (or (and (boundp 'gnus-namazu-index-directory)
+	    (symbol-value 'gnus-namazu-index-directory))
+       (and (boundp 'nnir-namazu-index-directory)
+	    (symbol-value 'nnir-namazu-index-directory))
+       gnus-namazu-default-index-directory))
+  "*Places of Namazu index files."
+  :type '(repeat directory)
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-command
+  (or (and (boundp 'namazu-command)
+	   (symbol-value 'namazu-command))
+      (and (boundp 'nnir-namazu-program)
+	   (symbol-value 'nnir-namazu-program))
+      "namazu")
+  "*Name of the executable file of Namazu."
+  :type 'string
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-additional-arguments nil
+  "*Additional arguments of Namazu.
+The options `-q', `-a', and `-l' are always used, very few other
+options make any sense in this context."
+  :type '(repeat string)
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-index-update-interval
+  259200				; 3 days == 259200 seconds.
+  "*Number of seconds between running the indexer of Namazu."
+  :type '(choice (const :tag "Never run the indexer" nil)
+		 (integer :tag "Number of seconds"))
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-make-index-command "mknmz"
+  "*Name of the executable file of the indexer of Namazu."
+  :type 'string
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-make-index-arguments
+  (nconc
+   (list "--all" "--mailnews" "--deny=^.*[^0-9].*$")
+   (when (or (and (boundp 'current-language-environment)
+		  (string= "Japanese"
+			   (symbol-value 'current-language-environment)))
+	     (boundp 'MULE))
+     (list "--indexing-lang=ja")))
+  "*Arguments of the indexer of Namazu."
+  :type '(repeat string)
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-field-keywords
+  '("date" "from" "newsgroups" "size" "subject" "summary" "to" "uri")
+  "*List of keywords to do field-search."
+  :type '(repeat string)
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-coding-system
+  (if (memq system-type '(windows-nt OS/2 emx))
+      (if (boundp 'MULE) '*sjis* 'shift_jis)
+    (if (boundp 'MULE) '*euc-japan* 'euc-japan))
+  "*Coding system for Namazu process."
+  :type 'coding-system
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-need-path-normalization
+  (and (memq system-type '(windows-nt OS/2 emx)) t)
+  "*Non-nil means that outputs of namazu may contain drive letters."
+  :type 'boolean
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-case-sensitive-filesystem
+  (not (eq system-type 'windows-nt))
+  "*Non-nil means that the using file system distinguishes cases of characters."
+  :type 'boolean
+  :group 'gnus-namazu)
+
+(defcustom gnus-namazu-query-highlight t
+  "Non-nil means that queried words is highlighted."
+  :type 'boolean
+  :group 'gnus-namazu)
+
+(defface gnus-namazu-query-highlight-face
+  '((((type tty pc) (class color))
+     (:background "magenta4" :foreground "cyan1"))
+    (((class color) (background light))
+     (:background "magenta4" :foreground "lightskyblue1"))
+    (((class color) (background dark))
+     (:background "palevioletred2" :foreground "brown4"))
+    (t (:inverse-video t)))
+  "Face used for namazu query matching words."
+  :group 'gnus-namazu)
+
+;;; Internal Variable:
+(defconst gnus-namazu/group-name-regexp "\\`nnvirtual:namazu-search\\?")
+
+;; Multibyte group name:
+(and
+ (fboundp 'gnus-group-decoded-name)
+ (let ((gnus-group-name-charset-group-alist
+	(list (cons gnus-namazu/group-name-regexp gnus-namazu-coding-system)))
+       (query (decode-coding-string
+	       (string 27 36 66 52 65 59 122 27 40 66)
+	       (if (boundp 'MULE) '*iso-2022-jp* 'iso-2022-7bit))))
+   (not (string-match query
+		      (gnus-summary-buffer-name
+		       (encode-coding-string
+			(concat "nnvirtual:namazu-search?query=" query)
+			gnus-namazu-coding-system)))))
+ (let (current-load-list)
+   (defadvice gnus-summary-buffer-name
+     (before gnus-namazu-summary-buffer-name activate compile)
+     "Advised by `gnus-namazu' to handle encoded group names."
+     (ad-set-arg 0 (gnus-group-decoded-name (ad-get-arg 0))))))
+
+(defmacro gnus-namazu/make-article (group number)
+  `(cons ,group ,number))
+(defmacro gnus-namazu/article-group  (x) `(car ,x))
+(defmacro gnus-namazu/article-number (x) `(cdr ,x))
+
+(defsubst gnus-namazu/indexed-servers ()
+  "Choice appropriate servers from opened ones, and return thier list."
+  (append
+   (gnus-servers-using-backend 'nnml)
+   (gnus-servers-using-backend 'nnmh)))
+
+(defsubst gnus-namazu/default-index-directory ()
+  (if (member gnus-namazu-default-index-directory
+	      gnus-namazu-index-directories)
+      gnus-namazu-default-index-directory
+    (car gnus-namazu-index-directories)))
+
+(defun gnus-namazu/setup ()
+  (and (boundp 'gnus-group-name-charset-group-alist)
+       (not (member (cons gnus-namazu/group-name-regexp
+			  gnus-namazu-coding-system)
+		    gnus-group-name-charset-group-alist))
+       (let ((pair (assoc gnus-namazu/group-name-regexp
+			  gnus-group-name-charset-group-alist)))
+	 (if pair
+	     (setcdr pair gnus-namazu-coding-system)
+	   (push (cons gnus-namazu/group-name-regexp
+		       gnus-namazu-coding-system)
+		 gnus-group-name-charset-group-alist))))
+  (gnus-namazu-update-all-indices))
+
+(defun gnus-namazu/server-directory (server)
+  "Return the top directory of the server SERVER."
+  (and (memq (car server) '(nnml nnmh))
+       (nnoo-change-server (car server) (nth 1 server) (nthcdr 2 server))
+       (file-name-as-directory
+	(expand-file-name (if (eq 'nnml (car server))
+			      nnml-directory
+			    nnmh-directory)))))
+
+;;; Functions to call Namazu.
+(defsubst gnus-namazu/normalize-results ()
+  "Normalize file names returned by Namazu in this current buffer."
+  (goto-char (point-min))
+  (while (not (eobp))
+    (when (looking-at "file://")
+      (delete-region (point) (match-end 0)))
+    (when (if gnus-namazu-need-path-normalization
+	      (or (not (looking-at "/\\(.\\)|/"))
+		  (replace-match "\\1:/"))
+	    (eq ?~ (char-after (point))))
+      (insert (expand-file-name
+	       (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))
+      (delete-region (point) (gnus-point-at-eol)))
+    (forward-line 1)))
+
+(defsubst gnus-namazu/call-namazu (query)
+  (let ((coding-system-for-read gnus-namazu-coding-system)
+	(coding-system-for-write gnus-namazu-coding-system)
+	(input-coding-system gnus-namazu-coding-system)
+	(output-coding-system gnus-namazu-coding-system)
+	(default-process-coding-system
+	  (cons gnus-namazu-coding-system gnus-namazu-coding-system))
+	program-coding-system-alist
+	(file-name-coding-system gnus-namazu-coding-system)
+	(pathname-coding-system gnus-namazu-coding-system))
+    (apply 'call-process
+	   `(,gnus-namazu-command
+	     nil			; input from /dev/null
+	     t				; output
+	     nil			; don't redisplay
+	     "-q"			; don't be verbose
+	     "-a"			; show all matches
+	     "-l"			; use list format
+	     ,@gnus-namazu-additional-arguments
+	     ,query
+	     ,@gnus-namazu-index-directories))))
+
+(defsubst gnus-namazu/group-prefixed-name (group method)
+  "Return the whole name from GROUP and METHOD."
+  (if gnus-namazu-case-sensitive-filesystem
+      (gnus-group-prefixed-name group method)
+    (let* ((orig (gnus-group-prefixed-name group method))
+	   (name (downcase orig)))
+      (catch 'found-group
+	(mapatoms (lambda (sym)
+		    (when (string= name (downcase (symbol-name sym)))
+		      (throw 'found-group (symbol-name sym))))
+		  gnus-newsrc-hashtb)
+	orig))))
+
+(defun gnus-namazu/real-group-name (cond str)
+  "Generate the real group name from the partial path, STR."
+  (if cond
+      str
+    (catch 'found-group
+      (dolist (group (gnus-namazu/possible-real-groups
+		      (nnheader-replace-chars-in-string str ?/ ?.)))
+	(when (gnus-gethash group gnus-newsrc-hashtb)
+	  (throw 'found-group group))))))
+
+(defun gnus-namazu/possible-real-groups (str)
+  "Regard the string STR as the partial path of the cached article and
+generate possible group names from it."
+  (if (string-match "_\\(_\\(_\\)?\\)?" str)
+      (let ((prefix (substring str 0 (match-beginning 0)))
+	    (suffix (substring str (match-end 0))))
+	(cond
+	 ((match-beginning 2) ;; The number of discoverd underscores = 3
+	  (nconc
+	   (gnus-namazu/possible-real-groups (concat prefix "/__" suffix))
+	   (gnus-namazu/possible-real-groups (concat prefix ".._" suffix))))
+	 ((match-beginning 1) ;; The number of discoverd underscores = 2
+	  (nconc
+	   (gnus-namazu/possible-real-groups (concat prefix "//" suffix))
+	   (gnus-namazu/possible-real-groups (concat prefix ".." suffix))))
+	 (t ;; The number of discoverd underscores = 1
+	  (gnus-namazu/possible-real-groups (concat prefix "/" suffix)))))
+    (if (string-match "\\." str)
+	;; Handle the first occurence of period.
+	(list (concat (substring str 0 (match-beginning 0))
+		      ":"
+		      (substring str (match-end 0)))
+	      str)
+      (list str))))
+
+(defun gnus-namazu/search (groups query)
+  (with-temp-buffer
+    (let ((exit-status (gnus-namazu/call-namazu query)))
+      (unless (zerop exit-status)
+	(error "Namazu finished abnormally: %d" exit-status))
+      (let* ((articles)
+	     (server-alist
+	      (delq nil
+		    (let (dir)
+		      (mapcar
+		       (lambda (s)
+			 (when (setq dir (gnus-namazu/server-directory s))
+			   (cons (file-name-as-directory dir) s)))
+		       (gnus-namazu/indexed-servers)))))
+	     (topdir-regexp (regexp-opt (mapcar 'car server-alist)))
+	     (cache-regexp (concat
+			    (regexp-quote
+			     (file-name-as-directory
+			      (expand-file-name gnus-cache-directory)))
+			    "\\(.*\\)/\\([0-9]+\\)$"))
+	     (agent-regexp (concat
+			    (regexp-quote
+			     (file-name-as-directory
+			      (expand-file-name gnus-agent-directory)))
+			    "\\(.*\\)/\\([0-9]+\\)$")))
+	(gnus-namazu/normalize-results)
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (let (server group file)
+	    (and (or
+		  ;; Check the discoverd file is the persistent article.
+		  (and (looking-at cache-regexp)
+		       (setq file (match-string-no-properties 2)
+			     group (gnus-namazu/real-group-name
+				    (gnus-use-long-file-name 'not-cache)
+				    (match-string-no-properties 1))))
+		  ;; Check the discoverd file is covered by the agent.
+		  (and (looking-at agent-regexp)
+		       (setq file (match-string-no-properties 2)
+			     group (gnus-namazu/real-group-name
+				    nnmail-use-long-file-names
+				    (match-string-no-properties 1))))
+		  ;; Check the discovered file is managed by Gnus servers.
+		  (and (looking-at topdir-regexp)
+		       (setq file (buffer-substring-no-properties
+				   (match-end 0) (gnus-point-at-eol))
+			     server (cdr (assoc (match-string-no-properties 0)
+						server-alist)))
+		       ;; Check validity of the file name.
+		       (string-match "/\\([0-9]+\\)\\'" file)
+		       (progn
+			 (setq group (substring file 0 (match-beginning 0))
+			       file (match-string 1 file))
+			 (setq group
+			       (gnus-namazu/group-prefixed-name
+				(if nnmail-use-long-file-names
+				    group
+				  (nnheader-replace-chars-in-string group
+								    ?/ ?.))
+				server)))))
+		 (or (not groups)
+		     (member group groups))
+		 (push (gnus-namazu/make-article group (string-to-number file))
+		       articles)))
+	  (forward-line 1))
+	(nreverse articles)))))
+
+
+;;; User Interface:
+(defun gnus-namazu/get-target-groups ()
+  (cond
+   ((eq major-mode 'gnus-group-mode)
+    ;; In Group buffer.
+    (cond
+     (current-prefix-arg
+      (gnus-group-process-prefix current-prefix-arg))
+     (gnus-group-marked
+      (prog1 gnus-group-marked (gnus-group-unmark-all-groups)))))
+   ((eq major-mode 'gnus-summary-mode)
+    ;; In Summary buffer.
+    (if current-prefix-arg
+	(list (gnus-read-group "Group: "))
+      (if (and
+	   (gnus-ephemeral-group-p gnus-newsgroup-name)
+	   (string-match gnus-namazu/group-name-regexp gnus-newsgroup-name))
+	  (cadr (assq 'gnus-namazu-target-groups
+		      (gnus-info-method (gnus-get-info gnus-newsgroup-name))))
+	(list gnus-newsgroup-name))))))
+
+(defun gnus-namazu/get-current-query ()
+  (and (eq major-mode 'gnus-summary-mode)
+       (gnus-ephemeral-group-p gnus-newsgroup-name)
+       (string-match gnus-namazu/group-name-regexp gnus-newsgroup-name)
+       (cadr (assq 'gnus-namazu-current-query
+		   (gnus-info-method (gnus-get-info gnus-newsgroup-name))))))
+
+(defvar gnus-namazu/read-query-original-buffer nil)
+(defvar gnus-namazu/read-query-prompt nil)
+(defvar gnus-namazu/read-query-history nil)
+
+(defun gnus-namazu/get-current-subject ()
+  (and gnus-namazu/read-query-original-buffer
+       (bufferp gnus-namazu/read-query-original-buffer)
+       (with-current-buffer gnus-namazu/read-query-original-buffer
+	 (when (eq major-mode 'gnus-summary-mode)
+	   (let ((s (gnus-summary-article-subject)))
+	     ;; Remove typically prefixes of mailing lists.
+	     (when (string-match
+		    "^\\(\\[[^]]*[0-9]+\\]\\|([^)]*[0-9]+)\\)\\s-*" s)
+	       (setq s (substring s (match-end 0))))
+	     (when (string-match
+		    "^\\(Re\\(\\^?\\([0-9]+\\|\\[[0-9]+\\]\\)\\)?:\\s-*\\)+" s)
+	       (setq s (substring s (match-end 0))))
+	     (when (string-match "\\s-*(\\(re\\|was\\)\\b" s)
+	       (setq s (substring s 0 (match-beginning 0))))
+	     s)))))
+
+(defun gnus-namazu/get-current-from ()
+  (and gnus-namazu/read-query-original-buffer
+       (bufferp gnus-namazu/read-query-original-buffer)
+       (with-current-buffer gnus-namazu/read-query-original-buffer
+	 (when (eq major-mode 'gnus-summary-mode)
+	   (cadr (mail-extract-address-components
+		  (mail-header-from
+		   (gnus-summary-article-header))))))))
+
+(defun gnus-namazu/get-current-to ()
+  (and gnus-namazu/read-query-original-buffer
+       (bufferp gnus-namazu/read-query-original-buffer)
+       (with-current-buffer gnus-namazu/read-query-original-buffer
+	 (when (eq major-mode 'gnus-summary-mode)
+	   (cadr (mail-extract-address-components
+		  (cdr (assq 'To (mail-header-extra
+				  (gnus-summary-article-header))))))))))
+
+(defmacro gnus-namazu/minibuffer-prompt-end ()
+  (if (fboundp 'minibuffer-prompt-end)
+      '(minibuffer-prompt-end)
+    '(point-min)))
+
+(defun gnus-namazu/message (string &rest arguments)
+  (let* ((s1 (concat
+	      gnus-namazu/read-query-prompt
+	      (buffer-substring (gnus-namazu/minibuffer-prompt-end)
+				(point-max))))
+	 (s2 (apply (function format) string arguments))
+	 (w (- (window-width)
+	       (string-width s1)
+	       (string-width s2)
+	       1)))
+    (message (if (>= w 0)
+		 (concat s1 (make-string w ?\ ) s2)
+	       s2))
+    (if (sit-for 0.3) (message s1))
+    s2))
+
+(defun gnus-namazu/complete-query ()
+  (interactive)
+  (let ((pos (point)))
+    (cond
+     ((and (re-search-backward "\\+\\([-a-z]*\\)" nil t)
+	   (= pos (match-end 0)))
+      (let* ((partial (match-string 1))
+	     (completions
+	      (all-completions
+	       partial
+	       (mapcar 'list gnus-namazu-field-keywords))))
+	(cond
+	 ((null completions)
+	  (gnus-namazu/message "No completions of %s" partial))
+	 ((= 1 (length completions))
+	  (goto-char (match-beginning 1))
+	  (delete-region (match-beginning 1) (match-end 1))
+	  (insert (car completions) ":")
+	  (setq pos (point))
+	  (gnus-namazu/message "Completed"))
+	 (t
+	  (let ((x (try-completion partial (mapcar 'list completions))))
+	    (if (string= x partial)
+		(if (and (eq last-command
+			     'gnus-namazu/field-keyword-completion)
+			 completion-auto-help)
+		    (with-output-to-temp-buffer "*Completions*"
+		      (display-completion-list completions))
+		  (gnus-namazu/message "Sole completion"))
+	      (goto-char (match-beginning 1))
+	      (delete-region (match-beginning 1) (match-end 1))
+	      (insert x)
+	      (setq pos (point))))))))
+     ((and (looking-at "\\+subject:")
+	   (= pos (match-end 0)))
+      (let ((s (gnus-namazu/get-current-subject)))
+	(when s
+	  (goto-char pos)
+	  (insert "\"" s "\"")
+	  (setq pos (point)))))
+     ((and (looking-at "\\+from:")
+	   (= pos (match-end 0)))
+      (let ((f (gnus-namazu/get-current-from)))
+	(when f
+	  (goto-char pos)
+	  (insert "\"" f "\"")
+	  (setq pos (point)))))
+     ((and (looking-at "\\+to:")
+	   (= pos (match-end 0)))
+      (let ((to (gnus-namazu/get-current-to)))
+	(when to
+	  (goto-char pos)
+	  (insert "\"" to "\"")
+	  (setq pos (point))))))
+    (goto-char pos)))
+
+(defvar gnus-namazu/read-query-map
+  (let ((keymap (copy-keymap minibuffer-local-map)))
+    (define-key keymap "\t" 'gnus-namazu/complete-query)
+    keymap))
+
+(defun gnus-namazu/read-query (prompt &optional initial)
+  (let ((gnus-namazu/read-query-original-buffer (current-buffer))
+	(gnus-namazu/read-query-prompt prompt))
+    (unless initial
+      (when (setq initial (gnus-namazu/get-current-query))
+	(setq initial (cons initial 0))))
+    (read-from-minibuffer prompt initial gnus-namazu/read-query-map nil
+			  'gnus-namazu/read-query-history)))
+
+(defun gnus-namazu/highlight-words (query)
+  (with-temp-buffer
+    (insert " " query)
+    ;; Remove tokens for NOT search
+    (goto-char (point-min))
+    (while (re-search-forward "[$B!!(B \t\r\f\n]+not[$B!!(B \t\r\f\n]+\
+\\([^$B!!(B \t\r\f\n\"{(/]+\\|\"[^\"]+\"\\|{[^}]+}\\|([^)]+)\\|/[^/]+/\\)+" nil t)
+      (delete-region (match-beginning 0) (match-end 0)))
+    ;; Remove tokens for Field search
+    (goto-char (point-min))
+    (while (re-search-forward "[$B!!(B \t\r\f\n]+\\+[^$B!!(B \t\r\f\n:]+:\
+\\([^$B!!(B \t\r\f\n\"{(/]+\\|\"[^\"]+\"\\|{[^}]+}\\|([^)]+)\\|/[^/]+/\\)+" nil t)
+      (delete-region (match-beginning 0) (match-end 0)))
+    ;; Remove tokens for Regexp search
+    (goto-char (point-min))
+    (while (re-search-forward "/[^/]+/" nil t)
+      (delete-region (match-beginning 0) (match-end 0)))
+    ;; Remove brackets, double quote, asterisk and operators
+    (goto-char (point-min))
+    (while (re-search-forward "\\([(){}\"*]\\|\\b\\(and\\|or\\)\\b\\)" nil t)
+      (delete-region (match-beginning 0) (match-end 0)))
+    ;; Collect all keywords
+    (setq query nil)
+    (goto-char (point-min))
+    (while (re-search-forward "[^$B!!(B \t\r\f\n]+" nil t)
+      (push (match-string 0) query))
+    (when query
+      (let (en ja)
+	(dolist (q query)
+	  (if (string-match "\\cj" q)
+	      (push q ja)
+	    (push q en)))
+	(append
+	 (when en
+	   (list (list (concat "\\b\\(" (regexp-opt en) "\\)\\b")
+		       0 0 'gnus-namazu-query-highlight-face)))
+	 (when ja
+	   (list (list (regexp-opt ja)
+		       0 0 'gnus-namazu-query-highlight-face))))))))
+
+(defun gnus-namazu/truncate-article-list (articles)
+  (let ((hit (length articles)))
+    (when (and gnus-large-newsgroup
+	       (> hit gnus-large-newsgroup))
+      (let* ((cursor-in-echo-area nil)
+	     (input (read-from-minibuffer
+		     (format "\
+Too many articles were retrieved.  How many articles (max %d): "
+			     hit)
+		     (cons (number-to-string gnus-large-newsgroup) 0))))
+	(unless (string-match "\\`[ \t]*\\'" input)
+	  (setcdr (nthcdr (min (1- (string-to-number input)) hit) articles)
+		  nil)))))
+  articles)
+
+;;;###autoload
+(defun gnus-namazu-search (groups query)
+  "Search QUERY through GROUPS with Namazu,
+and make a virtual group contains its results."
+  (interactive
+   (list
+    (gnus-namazu/get-target-groups)
+    (gnus-namazu/read-query "Enter query: ")))
+  (gnus-namazu/setup)
+  (let ((articles (gnus-namazu/search groups query)))
+    (if articles
+	(let ((real-groups groups)
+	      (vgroup
+	       (apply (function format)
+		      "nnvirtual:namazu-search?query=%s&groups=%s&id=%d%d%d"
+		      query
+		      (if groups (mapconcat 'identity groups ",") "ALL")
+		      (current-time))))
+	  (gnus-namazu/truncate-article-list articles)
+	  (unless real-groups
+	    (dolist (a articles)
+	      (add-to-list 'real-groups (gnus-namazu/article-group a))))
+	  ;; Generate virtual group which includes all results.
+	  (when (fboundp 'gnus-group-decoded-name)
+	    (setq vgroup
+		  (encode-coding-string vgroup gnus-namazu-coding-system)))
+	  (setq vgroup
+		(gnus-group-read-ephemeral-group
+		 vgroup
+		 `(nnvirtual ,vgroup
+			     (nnvirtual-component-groups ,real-groups)
+			     (gnus-namazu-target-groups ,groups)
+			     (gnus-namazu-current-query ,query))
+		 t (cons (current-buffer) (current-window-configuration)) t))
+	  (when gnus-namazu-query-highlight
+	    (gnus-group-set-parameter vgroup 'highlight-words
+				      (gnus-namazu/highlight-words query)))
+	  ;; Generate new summary buffer which contains search results.
+	  (gnus-group-read-group
+	   t t vgroup
+	   (sort (delq nil ;; Ad-hoc fix, to avoid wrong-type-argument error.
+		       (mapcar
+			(lambda (a)
+			  (nnvirtual-reverse-map-article
+			   (gnus-namazu/article-group a)
+			   (gnus-namazu/article-number a)))
+			articles))
+		 '<)))
+      (message "No entry."))))
+
+(defmacro gnus-namazu/lock-file-name (&optional directory)
+  `(expand-file-name "NMZ.lock2" ,directory))
+
+(defmacro gnus-namazu/status-file-name (&optional directory)
+  `(expand-file-name "NMZ.status" ,directory))
+
+(defmacro gnus-namazu/index-file-name (&optional directory)
+  `(expand-file-name "NMZ.i" ,directory))
+
+(defun gnus-namazu/mknmz-cleanup (directory)
+  (let ((lockfile (gnus-namazu/lock-file-name directory)))
+    (when (file-exists-p lockfile)
+      (delete-file lockfile)
+      (dolist (tmpfile (directory-files directory t "\\`NMZ\\..*\\.tmp\\'" t))
+	(delete-file tmpfile)))))
+
+;;;###autoload
+(defun gnus-namazu-create-index (directory &optional target-directories force)
+  "Create index under DIRECTORY."
+  (interactive
+   (list
+    (if (and current-prefix-arg (> (length gnus-namazu-index-directories) 1))
+	(completing-read "Directory: "
+			 (mapcar 'list gnus-namazu-index-directories) nil t)
+      (gnus-namazu/default-index-directory))
+    nil t))
+  (setq directory (file-name-as-directory (expand-file-name directory)))
+  (unless target-directories
+    (setq target-directories
+	  (delq nil
+		(mapcar (lambda (dir)
+			  (when (file-directory-p dir) dir))
+			(append
+			 (mapcar 'gnus-namazu/server-directory
+				 (gnus-namazu/indexed-servers))
+			 (list
+			  (expand-file-name gnus-cache-directory)
+			  (expand-file-name gnus-agent-directory)))))))
+  (if (file-exists-p (gnus-namazu/lock-file-name directory))
+      (when force
+	(error "Found lock file: %s" (gnus-namazu/lock-file-name directory)))
+    (with-current-buffer
+	(get-buffer-create (concat " *mknmz*" directory))
+      (erase-buffer)
+      (unless (file-directory-p directory)
+	(make-directory directory t))
+      (setq default-directory directory)
+      (let ((args (append gnus-namazu-make-index-arguments
+			  target-directories)))
+	(insert "% " gnus-namazu-make-index-command " "
+		(mapconcat 'identity args " ") "\n")
+	(goto-char (point-max))
+	(when force
+	  (pop-to-buffer (current-buffer)))
+	(message "Make index at %s..." directory)
+	(unwind-protect
+	    (apply 'call-process gnus-namazu-make-index-command nil t t args)
+	  (gnus-namazu/mknmz-cleanup directory))
+	(message "Make index at %s...done" directory)
+	(unless force
+	  (kill-buffer (current-buffer)))))))
+
+(defun gnus-namazu/lapse-seconds (start end)
+  "Return lapse seconds from START to END.
+START and END are lists which represent time in Emacs-style."
+  (+ (* (- (car end) (car start)) 65536)
+     (cadr end)
+     (- (cadr start))))
+
+(defun gnus-namazu/index-old-p (directory)
+  "Return non-nil value when the index under the DIRECTORY is older
+than the period that is set to `gnus-namazu-index-update-interval'"
+  (let ((file (gnus-namazu/index-file-name directory)))
+    (or (not (file-exists-p file))
+	(and (integerp gnus-namazu-index-update-interval)
+	     (>= (gnus-namazu/lapse-seconds
+		  (nth 5 (file-attributes file))
+		  (current-time))
+		 gnus-namazu-index-update-interval)))))
+
+(defvar gnus-namazu/update-directories nil)
+(defvar gnus-namazu/update-process nil)
+
+(defun gnus-namazu/update-p (directory &optional force)
+  "Return the DIRECTORY when the index undef the DIRECTORY should be updated."
+  (setq directory (file-name-as-directory (expand-file-name directory)))
+  (labels ((error-message (format &rest args)
+			  (apply (if force 'error 'message) format args)
+			  nil))
+    (if gnus-namazu/update-process
+	(error-message "%s" "Can not run two update processes simultaneously")
+      (and (or force
+	       (gnus-namazu/index-old-p directory))
+	   (let ((status-file (gnus-namazu/status-file-name directory)))
+	     (or (file-exists-p status-file)
+		 (error-message "Can not find status file: %s" status-file)))
+	   (let ((lock-file (gnus-namazu/lock-file-name directory)))
+	     (or (not (file-exists-p lock-file))
+		 (error-message "Found lock file: %s" lock-file)))
+	   directory))))
+
+;;;###autoload
+(defun gnus-namazu-update-index (directory &optional force)
+  "Update the index under the DIRECTORY."
+  (interactive
+   (list
+    (if (and current-prefix-arg (> (length gnus-namazu-index-directories) 1))
+	(completing-read "Directory: "
+			 (mapcar 'list gnus-namazu-index-directories) nil t)
+      (gnus-namazu/default-index-directory))
+    t))
+  (when (setq directory (gnus-namazu/update-p directory force))
+    (with-current-buffer (get-buffer-create (concat " *mknmz*" directory))
+      (buffer-disable-undo)
+      (erase-buffer)
+      (unless (file-directory-p directory)
+	(make-directory directory t))
+      (setq default-directory directory)
+      (let ((proc (start-process gnus-namazu-make-index-command
+				 (current-buffer)
+				 gnus-namazu-make-index-command
+				 (format "--update=%s" directory))))
+	(if (processp proc)
+	    (prog1 (setq gnus-namazu/update-process proc)
+	      (process-kill-without-query proc)
+	      (set-process-sentinel proc 'gnus-namazu/update-sentinel)
+	      (add-hook 'kill-emacs-hook 'gnus-namazu-stop-update)
+	      (message "Update index at %s..." directory))
+	  (goto-char (point-min))
+	  (if (re-search-forward "^ERROR:.*$" nil t)
+	      (progn
+		(pop-to-buffer (current-buffer))
+		(funcall (if force 'error 'message)
+			 "Update index at %s...%s" directory (match-string 0)))
+	    (kill-buffer (current-buffer))
+	    (funcall (if force 'error 'message)
+		     "Can not start %s" gnus-namazu-make-index-command))
+	  nil)))))
+
+;;;###autoload
+(defun gnus-namazu-update-all-indices (&optional directories force)
+  "Update all indices which is set to `gnus-namazu-index-directories'."
+  (interactive (list nil t))
+  (when (setq directories
+	      (delq nil (mapcar
+			 (lambda (d) (gnus-namazu/update-p d force))
+			 (or directories gnus-namazu-index-directories))))
+    (setq gnus-namazu/update-directories (cdr directories))
+    (gnus-namazu-update-index (car directories))))
+
+(defun gnus-namazu/update-sentinel (process event)
+  (let ((buffer (process-buffer process)))
+    (when (buffer-name buffer)
+      (with-current-buffer buffer
+	(gnus-namazu/mknmz-cleanup default-directory)
+	(goto-char (point-min))
+	(cond
+	 ((re-search-forward "^ERROR:.*$" nil t)
+	  (pop-to-buffer (current-buffer))
+	  (message "Update index at %s...%s"
+		   default-directory (match-string 0))
+	  (setq gnus-namazu/update-directories nil))
+	 ((and (eq 'exit (process-status process))
+	       (zerop (process-exit-status process)))
+	  (message "Update index at %s...done" default-directory)
+	  (unless (or debug-on-error debug-on-quit)
+	    (kill-buffer buffer)))))))
+  (setq gnus-namazu/update-process nil)
+  (when gnus-namazu/update-directories
+    (gnus-namazu-update-all-indices gnus-namazu/update-directories)))
+
+;;;###autoload
+(defun gnus-namazu-stop-update ()
+  "Stop the running indexer of Namazu."
+  (interactive)
+  (setq gnus-namazu/update-directories nil)
+  (and gnus-namazu/update-process
+       (processp gnus-namazu/update-process)
+       (kill-process gnus-namazu/update-process)))
+
+(let (current-load-list)
+  (defadvice gnus-offer-save-summaries
+    (before gnus-namazu-kill-summary-buffers activate compile)
+    "Advised by `gnus-namazu'.
+In order to avoid annoying questions, kill summary buffers which
+generated by `gnus-namazu' itself before `gnus-offer-save-summaries'
+is called."
+    (let ((buffers (buffer-list)))
+      (while buffers
+	(when (with-current-buffer (car buffers)
+		(and (eq major-mode 'gnus-summary-mode)
+		     (gnus-ephemeral-group-p gnus-newsgroup-name)
+		     (string-match gnus-namazu/group-name-regexp
+				   gnus-newsgroup-name)))
+	  (kill-buffer (car buffers)))
+	(setq buffers (cdr buffers))))))
+
+;;;###autoload
+(defun gnus-namazu-insinuate ()
+  (add-hook
+   'gnus-group-mode-hook
+   (lambda ()
+     (define-key gnus-group-mode-map "\C-c\C-n" 'gnus-namazu-search)))
+  (add-hook
+   'gnus-summary-mode-hook
+   (lambda ()
+     (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-namazu-search))))
+
+(provide 'gnus-namazu)
+
+;; gnus-namazu.el ends here.
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
new file mode 100644
index 0000000..324155d
--- /dev/null
+++ b/lisp/gnus-registry.el
@@ -0,0 +1,245 @@
+;;; gnus-registry.el --- article registry for Gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;;        Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; Keywords: news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-int)
+(require 'gnus-sum)
+(require 'nnmail)
+
+(defgroup gnus-registry nil
+  "The Gnus registry."
+  :group 'gnus)
+
+(defvar gnus-registry-hashtb nil
+  "*The article registry by Message ID.")
+
+(defvar gnus-registry-headers-hashtb nil
+  "*The article header registry by Message ID.  Unused for now.")
+
+(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue")
+  "List of groups that gnus-registry-split-fancy-with-parent won't follow.
+The group names are matched, they don't have to be fully qualified."
+  :group 'gnus-registry
+  :type '(repeat string))
+
+(defcustom gnus-registry-unregistered-group-regex "^nntp"
+  "Group name regex that gnus-registry-register-message-ids won't process."
+  :group 'gnus-registry
+  :type 'regexp)
+
+;; Function(s) missing in Emacs 20
+(when (memq nil (mapcar 'fboundp '(puthash)))
+  (require 'cl)
+  (unless (fboundp 'puthash)
+    ;; alias puthash is missing from Emacs 20 cl-extra.el
+    (defalias 'puthash 'cl-puthash)))
+
+(defun gnus-registry-translate-to-alist ()
+  (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb)))
+
+(defun gnus-registry-translate-from-alist ()
+  (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)))
+
+(defun alist-to-hashtable (alist)
+  "Build a hashtable from the values in ALIST."
+  (let ((ht (make-hash-table 			    
+	     :size 4096
+	     :test 'equal)))
+    (mapc
+     (lambda (kv-pair)
+       (puthash (car kv-pair) (cdr kv-pair) ht))
+     alist)
+     ht))
+
+(defun hashtable-to-alist (hash)
+  "Build an alist from the values in HASH."
+  (let ((list nil))
+    (maphash
+     (lambda (key value)
+       (setq list (cons (cons key value) list)))
+     hash)
+    list))
+
+(defun gnus-register-action (action data-header from &optional to method)
+  (let* ((id (mail-header-id data-header))
+	(from (gnus-group-guess-full-name from))
+	(to (if to (gnus-group-guess-full-name to) nil))
+	(to-name (if to to "the Bit Bucket"))
+	(old-entry (gethash id gnus-registry-hashtb)))
+    (gnus-message 5 "Registry: article %s %s from %s to %s"
+		  id
+		  (if method "respooling" "going")
+		  from
+		  to)
+
+    ;; All except copy will need a delete
+    (gnus-registry-delete-group id from)
+
+    (when (equal 'copy action) 
+      (gnus-registry-add-group id from)) ; undo the delete
+
+    (gnus-registry-add-group id to)))
+
+(defun gnus-register-spool-action (id group)
+  ;; do not process the draft IDs
+;  (unless (string-match "totally-fudged-out-message-id" id)
+;    (let ((group (gnus-group-guess-full-name group)))
+  (when (string-match "\r$" id)
+    (setq id (substring id 0 -1)))
+  (gnus-message 5 "Registry: article %s spooled to %s"
+		id
+		group)
+  (gnus-registry-add-group id group))
+;)
+
+;; Function for nn{mail|imap}-split-fancy: look up all references in
+;; the cache and if a match is found, return that group.
+(defun gnus-registry-split-fancy-with-parent ()
+  "Split this message into the same group as its parent.  The parent
+is obtained from the registry.  This function can be used as an entry
+in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
+this: (: gnus-registry-split-fancy-with-parent) 
+
+For a message to be split, it looks for the parent message in the
+References or In-Reply-To header and then looks in the registry to
+see which group that message was put in.  This group is returned.
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
+  (let ((refstr (or (message-fetch-field "references")
+		    (message-fetch-field "in-reply-to")))
+	(references nil)
+	(res nil))
+    (when refstr
+      (setq references (nreverse (gnus-split-references refstr)))
+      (mapcar (lambda (x)
+		(setq res (or (gnus-registry-fetch-group x) res))
+		(when (or (gnus-registry-grep-in-list 
+			   res
+			   gnus-registry-unfollowed-groups)
+			  (gnus-registry-grep-in-list 
+			   res 
+			   nnmail-split-fancy-with-parent-ignore-groups))
+		  (setq res nil)))
+	      references)
+      (gnus-message 
+       5 
+       "gnus-registry-split-fancy-with-parent traced %s to group %s"
+       refstr (if res res "nil"))
+      res)))
+
+(defun gnus-registry-register-message-ids ()
+  "Register the Message-ID of every article in the group"
+  (unless (and gnus-registry-unregistered-group-regex
+	       (string-match gnus-registry-unregistered-group-regex gnus-newsgroup-name))
+    (dolist (article gnus-newsgroup-articles)
+      (let ((id (gnus-registry-fetch-message-id-fast article)))
+	(unless (gnus-registry-fetch-group id)
+	  (gnus-message 9 "Registry: Registering article %d with group %s" 
+			article gnus-newsgroup-name)
+	  (gnus-registry-add-group (gnus-registry-fetch-message-id-fast article)
+				   gnus-newsgroup-name))))))
+
+(defun gnus-registry-fetch-message-id-fast (article)
+  "Fetch the Message-ID quickly, using the internal gnus-data-list function"
+  (if (and (numberp article)
+	   (assoc article (gnus-data-list nil)))
+      (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
+    nil))
+
+(defun gnus-registry-grep-in-list (word list)
+  (when word
+    (memq nil
+	  (mapcar 'not
+		  (mapcar 
+		   (lambda (x)
+		     (string-match x word))
+		   list)))))
+
+(defun gnus-registry-fetch-group (id)
+  "Get the group of a message, based on the message ID.
+Returns the first place where the trail finds a spool action."
+  (when id
+    (let ((trail (gethash id gnus-registry-hashtb)))
+      (if trail
+	  (car trail)
+	nil))))
+
+(defun gnus-registry-delete-group (id group)
+  "Get the group of a message, based on the message ID.
+Returns the first place where the trail finds a spool action."
+  (when group
+    (when id
+      (let ((trail (gethash id gnus-registry-hashtb))
+	    (group (gnus-group-short-name group)))
+	(puthash id (if trail
+			(delete group trail)
+		      nil)
+		 gnus-registry-hashtb))
+      ;; now, clear the entry if it's empty
+      (unless (gethash id gnus-registry-hashtb)
+	(remhash id gnus-registry-hashtb)))))
+
+(defun gnus-registry-add-group (id group)
+  "Get the group of a message, based on the message ID.
+Returns the first place where the trail finds a spool action."
+  ;; make sure there are no duplicate entries
+  (when group
+    (when id
+      (let ((group (gnus-group-short-name group)))
+	(gnus-registry-delete-group id group)	
+	(let ((trail (gethash id gnus-registry-hashtb)))
+	  (puthash id (if trail
+			  (cons group trail)
+			(list group))
+		   gnus-registry-hashtb))))))
+
+(defun gnus-registry-clear ()
+  "Clear the Gnus registry."
+  (interactive)
+  (setq gnus-registry-alist nil 
+	gnus-registry-headers-alist nil)
+  (gnus-registry-translate-from-alist))
+
+; also does copy, respool, and crosspost
+(add-hook 'gnus-summary-article-move-hook 'gnus-register-action) 
+(add-hook 'gnus-summary-article-delete-hook 'gnus-register-action)
+(add-hook 'gnus-summary-article-expire-hook 'gnus-register-action)
+(add-hook 'nnmail-spool-hook 'gnus-register-spool-action)
+
+(add-hook 'gnus-save-newsrc-hook 'gnus-registry-translate-to-alist)
+(add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-translate-from-alist)
+
+(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
+
+;; TODO: a lot of things
+
+(provide 'gnus-registry)
+
+;;; gnus-registry.el ends here
diff --git a/lisp/gnus-sieve.el b/lisp/gnus-sieve.el
new file mode 100644
index 0000000..b11ade5
--- /dev/null
+++ b/lisp/gnus-sieve.el
@@ -0,0 +1,239 @@
+;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: NAGY Andras <nagya@inf.elte.hu>,
+;;	Simon Josefsson <simon@josefsson.org>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Gnus glue to generate complete Sieve scripts from Gnus Group
+;; Parameters with "if" test predicates.
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-sum)
+(require 'format-spec)
+(autoload 'sieve-mode "sieve-mode")
+(eval-when-compile
+  (require 'sieve))
+
+;; Variables
+
+(defgroup gnus-sieve nil
+  "Manage sieve scripts in Gnus."
+  :group 'gnus)
+
+(defcustom gnus-sieve-file "~/.sieve"
+  "Path to your Sieve script."
+  :type 'file
+  :group 'gnus-sieve)
+
+(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n"
+  "Line indicating the start of the autogenerated region in
+your Sieve script."
+  :type 'string
+  :group 'gnus-sieve)
+
+(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n"
+  "Line indicating the end of the autogenerated region in
+your Sieve script."
+  :type 'string
+  :group 'gnus-sieve)
+
+(defcustom gnus-sieve-select-method nil
+  "Which select method we generate the Sieve script for.
+
+For example: \"nnimap:mailbox\""
+  :group 'gnus-sieve)
+
+(defcustom gnus-sieve-crosspost t
+  "Whether the generated Sieve script should do crossposting."
+  :type 'bool
+  :group 'gnus-sieve)
+
+(defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s"
+  "Shell command to execute after updating your Sieve script.  The following
+formatting characters are recognized:
+
+%f    Script's file name (gnus-sieve-file)
+%s    Server name (from gnus-sieve-select-method)"
+  :type 'string
+  :group 'gnus-sieve)
+
+;;;###autoload
+(defun gnus-sieve-update ()
+  "Update the Sieve script in gnus-sieve-file, by replacing the region
+between gnus-sieve-region-start and gnus-sieve-region-end with
+\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then
+execute gnus-sieve-update-shell-command.
+See the documentation for these variables and functions for details."
+  (interactive)
+  (gnus-sieve-generate)
+  (save-buffer)
+  (shell-command
+   (format-spec gnus-sieve-update-shell-command
+		(format-spec-make ?f gnus-sieve-file
+				  ?s (or (cadr (gnus-server-get-method
+						nil gnus-sieve-select-method))
+					 "")))))
+
+;;;###autoload
+(defun gnus-sieve-generate ()
+  "Generate the Sieve script in gnus-sieve-file, by replacing the region
+between gnus-sieve-region-start and gnus-sieve-region-end with
+\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\).
+See the documentation for these variables and functions for details."
+  (interactive)
+  (require 'sieve)
+  (find-file gnus-sieve-file)
+  (goto-char (point-min))
+  (if (re-search-forward (regexp-quote gnus-sieve-region-start) nil t)
+      (delete-region (match-end 0)
+		     (or (re-search-forward (regexp-quote
+					     gnus-sieve-region-end) nil t)
+			 (point)))
+    (insert sieve-template))
+  (insert gnus-sieve-region-start
+	  (gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost)
+	  gnus-sieve-region-end))
+
+(defun gnus-sieve-guess-rule-for-article ()
+  "Guess a sieve rule based on RFC822 article in buffer.
+Return nil if no rule could be guessed."
+  (when (message-fetch-field "sender")
+    `(sieve address "sender" ,(message-fetch-field "sender"))))
+
+;;;###autoload
+(defun gnus-sieve-article-add-rule ()
+  (interactive)
+  (gnus-summary-select-article nil 'force)
+  (with-current-buffer gnus-original-article-buffer
+    (let ((rule (gnus-sieve-guess-rule-for-article))
+	  (info (gnus-get-info gnus-newsgroup-name)))
+      (if (null rule)
+	  (error "Could not guess rule for article.")
+	(gnus-info-set-params info (cons rule (gnus-info-params info)))
+	(message "Added rule in group %s for article: %s" gnus-newsgroup-name
+		 rule)))))
+
+;; Internals
+
+;; FIXME: do proper quoting of " etc
+(defun gnus-sieve-string-list (list)
+  "Convert an elisp string list to a Sieve string list.
+
+For example:
+\(gnus-sieve-string-list '(\"to\" \"cc\"))
+  => \"[\\\"to\\\", \\\"cc\\\"]\"
+"
+  (concat "[\"" (mapconcat 'identity list "\", \"") "\"]"))
+
+(defun gnus-sieve-test-list (list)
+  "Convert an elisp test list to a Sieve test list.
+
+For example:
+\(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K)))
+  => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\""
+  (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")"))
+
+;; FIXME: do proper quoting
+(defun gnus-sieve-test-token (token)
+  "Convert an elisp test token to a Sieve test token.
+
+For example:
+\(gnus-sieve-test-token 'address)
+  => \"address\"
+
+\(gnus-sieve-test-token \"sender\")
+  => \"\\\"sender\\\"\"
+
+\(gnus-sieve-test-token '(\"to\" \"cc\"))
+  => \"[\\\"to\\\", \\\"cc\\\"]\""
+  (cond
+   ((symbolp token)            ;; Keyword
+    (symbol-name token))
+
+   ((stringp token)            ;; String
+    (concat "\"" token "\""))
+
+   ((and (listp token)         ;; String list
+	 (stringp (car token)))
+    (gnus-sieve-string-list token))
+
+   ((and (listp token)         ;; Test list
+	 (listp (car token)))
+    (gnus-sieve-test-list token))))
+
+(defun gnus-sieve-test (test)
+  "Convert an elisp test to a Sieve test.
+
+For example:
+\(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\"))
+  => \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\"
+
+\(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\")
+			  (size :over 100K))))
+  => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\",
+	     size :over 100K)\""
+  (mapconcat 'gnus-sieve-test-token test " "))
+
+(defun gnus-sieve-script (&optional method crosspost)
+  "Generate a Sieve script based on groups with select method METHOD
+\(or all groups if nil\).  Only groups having a `sieve' parameter are
+considered.  This parameter should contain an elisp test
+\(see the documentation of gnus-sieve-test for details\).  For each
+such group, a Sieve IF control structure is generated, having the
+test as the condition and { fileinto \"group.name\"; } as the body.
+
+If CROSSPOST is nil, each conditional body contains a \"stop\" command
+which stops execution after a match is found.
+
+For example: If the INBOX.list.sieve group has the
+
+  (sieve address \"sender\" \"sieve-admin@extundo.com\")
+
+group parameter, (gnus-sieve-script) results in:
+
+  if address \"sender\" \"sieve-admin@extundo.com\" {
+          fileinto \"INBOX.list.sieve\";
+  }
+
+This is returned as a string."
+  (let* ((newsrc (cdr gnus-newsrc-alist))
+	 script)
+    (dolist (info newsrc)
+      (when (or (not method)
+		(gnus-server-equal method (gnus-info-method info)))
+	(let* ((group (gnus-info-group info))
+	       (spec (gnus-group-find-parameter group 'sieve t)))
+	  (when spec
+	    (push (concat "if " (gnus-sieve-test spec) " {\n"
+			  "\tfileinto \"" (gnus-group-real-name group) "\";\n"
+			  (if crosspost
+			      ""
+			    "\tstop;\n")
+			  "}")
+		  script)))))
+    (mapconcat 'identity script "\n")))
+
+(provide 'gnus-sieve)
+
+;;; gnus-sieve.el ends here
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
new file mode 100644
index 0000000..6936bf3
--- /dev/null
+++ b/lisp/hex-util.el
@@ -0,0 +1,73 @@
+;;; hex-util.el --- Functions to encode/decode hexadecimal string.
+
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: data
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program 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.
+
+;; This program 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 this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+  (defmacro hex-char-to-num (chr)
+    (` (let ((chr (, chr)))
+	 (cond
+	  ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
+	  ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
+	  ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
+	  (t (error "Invalid hexadecimal digit `%c'" chr))))))
+  (defmacro num-to-hex-char (num)
+    (` (aref "0123456789abcdef" (, num)))))
+
+(defun decode-hex-string (string)
+  "Decode hexadecimal STRING to octet string."
+  (let* ((len (length string))
+	 (dst (make-string (/ len 2) 0))
+	 (idx 0)(pos 0))
+    (while (< pos len)
+;;; logior and lsh are not byte-coded.
+;;;  (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
+;;; 			    (hex-char-to-num (aref string (1+ pos)))))
+      (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
+		       (hex-char-to-num (aref string (1+ pos)))))
+      (setq idx (1+ idx)
+	    pos (+ 2 pos)))
+    dst))
+
+(defun encode-hex-string (string)
+  "Encode octet STRING to hexadecimal string."
+  (let* ((len (length string))
+	 (dst (make-string (* len 2) 0))
+	 (idx 0)(pos 0))
+    (while (< pos len)
+;;; logand and lsh are not byte-coded.
+;;;  (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
+      (aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
+      (setq idx (1+ idx))
+;;;  (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
+      (aset dst idx (num-to-hex-char (% (aref string pos) 16)))
+      (setq idx (1+ idx)
+	    pos (1+ pos)))
+    dst))
+
+(provide 'hex-util)
+
+;;; hex-util.el ends here
diff --git a/lisp/html2text.el b/lisp/html2text.el
new file mode 100644
index 0000000..4b89f8f
--- /dev/null
+++ b/lisp/html2text.el
@@ -0,0 +1,551 @@
+;;; html2text.el --- a simple html to plain text converter
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Joakim Hove <hove@phys.ntnu.no>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; These functions provide a simple way to wash/clean html infected
+;; mails.  Definitely do not work in all cases, but some improvement
+;; in readability is generally obtained. Formatting is only done in
+;; the buffer, so the next time you enter the article it will be
+;; "re-htmlized".
+;;
+;; The main function is "html2text"
+
+;;; Code:
+
+;;
+;; <Global variables>
+;;
+
+(eval-when-compile
+  (require 'cl))
+
+(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
+
+(defvar html2text-replace-list
+  '(("&nbsp;" . " ") ("&gt;" . ">") ("&lt;" . "<") ("&quot;" . "\""))
+  "The map of entity to text.
+
+This is an alist were each element is a dotted pair consisting of an
+old string, and a replacement string. This replacement is done by the
+function \"html2text-substitute\" which basically performs a
+replace-string operation for every element in the list. This is
+completely verbatim - without any use of REGEXP.")
+
+(defvar html2text-remove-tag-list
+  '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta")
+  "A list of removable tags.
+
+This is a list of tags which should be removed, without any
+formatting.  Observe that if you the tags in the list are presented
+*without* any \"<\" or \">\". All occurences of a tag appearing in
+this list are removed, irrespective of whether it is a closing or
+opening tag, or if the tag has additional attributes. The actual
+deletion is done by the function \"html2text-remove-tags\".
+
+For instance the text:
+
+\"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\"
+
+will be reduced to:
+
+\"Here comes something big.\"
+
+If this list contains the element \"font\".")
+
+(defvar html2text-format-tag-list
+  '(("b" 	  . html2text-clean-bold)
+    ("u" 	  . html2text-clean-underline)
+    ("i" 	  . html2text-clean-italic)
+    ("blockquote" . html2text-clean-blockquote)
+    ("a"          . html2text-clean-anchor)
+    ("ul"         . html2text-clean-ul)
+    ("ol"         . html2text-clean-ol)
+    ("dl"         . html2text-clean-dl)
+    ("center"     . html2text-clean-center))
+  "An alist of tags and processing functions.
+
+This is an alist where each dotted pair consists of a tag, and then
+the name of a function to be called when this tag is found. The
+function is called with the arguments p1, p2, p3 and p4. These are
+demontrated below:
+
+\"<b> This is bold text </b>\"
+ ^   ^                 ^    ^
+ |   |                 |    |
+p1  p2                p3   p4
+
+Then the called function will typically format the text somewhat and
+remove the tags.")
+
+(defvar html2text-remove-tag-list2  '("li" "dt" "dd" "meta")
+  "Another list of removable tags.
+
+This is a list of tags which are removed similarly to the list
+`html2text-remove-tag-list' - but these tags are retained for the
+formatting, and then moved afterward.")
+
+;;
+;; </Global variables>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Utility functions>
+;;
+
+(defun html2text-buffer-head ()
+  (if (string= mode-name "Article")
+      (beginning-of-buffer)
+    (beginning-of-buffer)
+    )
+  )
+
+(defun html2text-replace-string (from-string to-string p1 p2)
+  (goto-char p1)
+  (let ((delta (- (string-width to-string) (string-width from-string)))
+	(change 0))
+    (while (search-forward from-string p2 t)
+      (replace-match to-string)
+      (setq change (+ change delta))
+      )
+    change
+    )
+  )
+
+;;
+;; </Utility functions>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions related to attributes> i.e. <font size=+3>
+;;
+
+(defun html2text-attr-value (attr-list attr)
+  (nth 1 (assoc attr attr-list))
+  )
+
+(defun html2text-get-attr (p1 p2 tag)
+  (goto-char p1)
+  (re-search-forward " +[^ ]" p2 t)
+  (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
+	 (tmp-list (split-string attr-string))
+	 (attr-list)
+	 (counter 0)
+	 (prev (car tmp-list))
+	 (this (nth 1 tmp-list))
+	 (next (nth 2 tmp-list))
+	 (index 1))
+
+    (cond
+     ;; size=3
+     ((string-match "[^ ]=[^ ]" prev)
+      (let ((attr  (nth 0 (split-string prev "=")))
+	    (value (nth 1 (split-string prev "="))))
+	(setq attr-list (cons (list attr value) attr-list))
+	)
+      )
+     ;; size= 3
+     ((string-match "[^ ]=\\'" prev)
+      (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))
+      )
+     )
+
+    (while (< index (length tmp-list))
+      (cond
+       ;; size=3
+       ((string-match "[^ ]=[^ ]" this)
+	(let ((attr  (nth 0 (split-string this "=")))
+	      (value (nth 1 (split-string this "="))))
+	  (setq attr-list (cons (list attr value) attr-list))
+	  )
+	)
+       ;; size =3
+       ((string-match "\\`=[^ ]" this)
+	(setq attr-list (cons (list prev (substring this 1)) attr-list)))
+
+       ;; size= 3
+       ((string-match "[^ ]=\\'" this)
+	(setq attr-list (cons (list (substring this 0 -1) next) attr-list))
+	)
+
+       ;; size = 3
+       ((string= "=" this)
+	(setq attr-list (cons (list prev next) attr-list))
+	)
+       )
+      (setq index (1+ index))
+      (setq prev this)
+      (setq this next)
+      (setq next (nth (1+ index) tmp-list))
+      )
+
+    ;;
+    ;; Tags with no accompanying "=" i.e. value=nil
+    ;;
+    (setq prev (car tmp-list))
+    (setq this (nth 1 tmp-list))
+    (setq next (nth 2 tmp-list))
+    (setq index 1)
+
+    (if (not (string-match "=" prev))
+	(progn
+	  (if (not (string= (substring this 0 1) "="))
+	      (setq attr-list (cons (list prev nil) attr-list))
+	    )
+	  )
+      )
+
+    (while (< index (1- (length tmp-list)))
+      (if (not (string-match "=" this))
+	  (if (not (or (string= (substring next 0 1) "=")
+		       (string= (substring prev -1) "=")))
+	      (setq attr-list (cons (list this nil) attr-list))
+	    )
+	)
+      (setq index (1+ index))
+      (setq prev this)
+      (setq this next)
+      (setq next (nth (1+ index) tmp-list))
+      )
+
+    (if this
+	(progn
+	  (if (not (string-match "=" this))
+	      (progn
+		(if (not (string= (substring prev -1) "="))
+		    (setq attr-list (cons (list this nil) attr-list))
+		  )
+		)
+	    )
+	  )
+      )
+    attr-list ;; return - value
+    )
+  )
+
+;;
+;; </Functions related to attributes>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to format a tag-pair>
+;;
+(defun html2text-clean-list-items (p1 p2 list-type)
+  (goto-char p1)
+  (let ((item-nr 0)
+	(items   0))
+    (while (re-search-forward "<li>" p2 t)
+      (setq items (1+ items)))
+    (goto-char p1)
+    (while (< item-nr items)
+      (setq item-nr (1+ item-nr))
+      (re-search-forward "<li>" (point-max) t)
+      (cond
+       ((string= list-type "ul") (insert " o "))
+       ((string= list-type "ol") (insert (format " %s: " item-nr)))
+       (t (insert " x ")))
+      )
+    )
+  )
+
+(defun html2text-clean-dtdd (p1 p2)
+  (goto-char p1)
+  (let ((items   0)
+	(item-nr 0))
+    (while (re-search-forward "<dt>" p2 t)
+      (setq items (1+ items)))
+    (goto-char p1)
+    (while (< item-nr items)
+      (setq item-nr (1+ item-nr))
+      (re-search-forward "<dt>\\([ ]*\\)" (point-max) t)
+      (when (match-string 1)
+	(delete-region (point) (- (point) (string-width (match-string 1)))))
+      (let ((def-p1 (point))
+	    (def-p2 0))
+	(re-search-forward "\\([ ]*\\)\\(</dt>\\|<dd>\\)" (point-max) t)
+	(if (match-string 1)
+	    (progn
+	      (let* ((mw1 (string-width (match-string 1)))
+		     (mw2 (string-width (match-string 2)))
+		     (mw  (+ mw1 mw2)))
+		(goto-char (- (point) mw))
+		(delete-region (point) (+ (point) mw1))
+		(setq def-p2 (point))))
+	  (setq def-p2 (- (point) (string-width (match-string 2)))))
+	(put-text-property def-p1 def-p2 'face 'bold)))))
+
+(defun html2text-delete-tags (p1 p2 p3 p4)
+  (delete-region p1 p2)
+  (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1))))
+
+(defun html2text-delete-single-tag (p1 p2)
+  (delete-region p1 p2))
+
+(defun html2text-clean-hr (p1 p2)
+  (html2text-delete-single-tag p1 p2)
+  (goto-char p1)
+  (newline 1)
+  (insert (make-string fill-column ?-))
+  )
+
+(defun html2text-clean-ul (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")
+  )
+
+(defun html2text-clean-ol (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")
+  )
+
+(defun html2text-clean-dl (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (html2text-clean-dtdd p1 (- p3 (- p1 p2)))
+  )
+
+(defun html2text-clean-center (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (center-region p1 (- p3 (- p2 p1)))
+  )
+
+(defun html2text-clean-bold (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'bold)
+  (html2text-delete-tags p1 p2 p3 p4)
+  )
+
+(defun html2text-clean-title (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'bold)
+  (html2text-delete-tags p1 p2 p3 p4)
+  )
+
+(defun html2text-clean-underline (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'underline)
+  (html2text-delete-tags p1 p2 p3 p4)
+  )
+
+(defun html2text-clean-italic (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'italic)
+  (html2text-delete-tags p1 p2 p3 p4)
+  )
+
+(defun html2text-clean-font (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  )
+
+(defun html2text-clean-blockquote (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  )
+
+(defun html2text-clean-anchor (p1 p2 p3 p4)
+  ;; If someone can explain how to make the URL clickable I will
+  ;; surely improve upon this.
+  (let* ((attr-list (html2text-get-attr p1 p2 "a"))
+	 (href (html2text-attr-value attr-list "href")))
+    (delete-region p1 p4)
+    (when href
+      (goto-char p1)
+      (insert (substring href 1 -1 ))
+      (put-text-property p1 (point) 'face 'bold))))
+
+;;
+;; </Functions to be called to format a tag-pair>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to fix up paragraphs>
+;;
+
+(defun html2text-fix-paragraph (p1 p2)
+  (goto-char p1)
+  (let ((has-br-line)
+	(refill-start)
+	(refill-stop))
+    (if (re-search-forward "<br>$" p2 t)
+	(setq has-br-line t)
+      )
+    (if has-br-line
+	(progn
+	  (goto-char p1)
+	  (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
+	      (progn
+		(beginning-of-line)
+		(setq refill-start (point))
+		(goto-char p2)
+		(re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
+		(next-line 1)
+		(end-of-line)
+		;; refill-stop should ideally be adjusted to
+		;; accomodate the "<br>" strings which are removed
+		;; between refill-start and refill-stop.  Can simply
+		;; be returned from my-replace-string
+		(setq refill-stop (+ (point)
+				     (html2text-replace-string
+				      "<br>" ""
+				      refill-start (point))))
+		;; (message "Point = %s  refill-stop = %s" (point) refill-stop)
+		;; (sleep-for 4)
+		(fill-region refill-start refill-stop)
+		)
+	    )
+	  )
+      )
+    )
+  (html2text-replace-string "<br>" "" p1 p2)
+  )
+
+;;
+;; This one is interactive ...
+;;
+(defun html2text-fix-paragraphs ()
+  "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook
+fashion, quite close to pure guess-work. It does work in some cases though."
+  (interactive)
+  (html2text-buffer-head)
+  (replace-regexp "^<br>$" "")
+  ;; Removing lonely <br> on a single line, if they are left intact we
+  ;; dont have any paragraphs at all.
+  (html2text-buffer-head)
+  (while (not (eobp))
+    (let ((p1 (point)))
+      (forward-paragraph 1)
+      ;;(message "Kaller fix med p1=%s  p2=%s " p1 (1- (point))) (sleep-for 5)
+      (html2text-fix-paragraph p1 (1- (point)))
+      (goto-char p1)
+      (when (not (eobp))
+	(forward-paragraph 1)))))
+
+;;
+;; </Functions to be called to fix up paragraphs>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Interactive functions>
+;;
+
+(defun html2text-remove-tags (tag-list)
+  "Removes the tags listed in the list \"html2text-remove-tag-list\".
+See the documentation for that variable."
+  (interactive)
+  (dolist (tag tag-list)
+    (html2text-buffer-head)
+    (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
+      (let ((p1 (point)))
+	(search-backward "<")
+	(delete-region (point) p1)))))
+
+(defun html2text-format-tags ()
+  "See the variable \"html2text-format-tag-list\" for documentation"
+  (interactive)
+  (dolist (tag-and-function html2text-format-tag-list)
+    (let ((tag      (car tag-and-function))
+	  (function (cdr tag-and-function)))
+      (html2text-buffer-head)
+      (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+				(point-max) t)
+	(let ((p1)
+	      (p2 (point))
+	      (p3) (p4)
+	      (attr (match-string 1)))
+	  (search-backward "<" (point-min) t)
+	  (setq p1 (point))
+	  (re-search-forward (format "</%s>" tag) (point-max) t)
+	  (setq p4 (point))
+	  (search-backward "</" (point-min) t)
+	  (setq p3 (point))
+	  (funcall function p1 p2 p3 p4)
+	  (goto-char p1)
+	  )
+	)
+      )
+    )
+  )
+
+(defun html2text-substitute ()
+  "See the variable \"html2text-replace-list\" for documentation"
+  (interactive)
+  (dolist (e html2text-replace-list)
+    (html2text-buffer-head)
+    (let ((old-string (car e))
+	  (new-string (cdr e)))
+      (html2text-replace-string old-string new-string (point-min) (point-max))
+      )
+    )
+  )
+
+(defun html2text-format-single-elements ()
+  ""
+  (interactive)
+  (dolist (tag-and-function html2text-format-single-element-list)
+    (let ((tag      (car tag-and-function))
+	  (function (cdr tag-and-function)))
+      (html2text-buffer-head)
+      (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+				(point-max) t)
+	(let ((p1)
+	      (p2 (point)))
+	  (search-backward "<" (point-min) t)
+	  (setq p1 (point))
+	  (funcall function p1 p2)
+	  )
+	)
+      )
+    )
+  )
+
+;;
+;; Main function
+;;
+
+;;;###autoload
+(defun html2text ()
+  "Convert HTML to plain text in the current buffer."
+  (interactive)
+  (save-excursion
+    (let ((case-fold-search t)
+	  (buffer-read-only))
+      (html2text-remove-tags html2text-remove-tag-list)
+      (html2text-format-tags)
+      (html2text-remove-tags html2text-remove-tag-list2)
+      (html2text-substitute)
+      (html2text-format-single-elements)
+      (html2text-fix-paragraphs))))
+
+;;
+;; </Interactive functions>
+;;
+
+;;; html2text.el ends here
diff --git a/lisp/mailheader.el b/lisp/mailheader.el
new file mode 100644
index 0000000..796ae75
--- /dev/null
+++ b/lisp/mailheader.el
@@ -0,0 +1,182 @@
+;;; mail-header.el --- Mail header parsing, merging, formatting
+
+;; Copyright (C) 1996 by Free Software Foundation, Inc.
+
+;; Author: Erik Naggum <erik@arcana.naggum.no>
+;; Keywords: tools, mail, news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides an abstraction to RFC822-style messages, used in
+;; mail news, and some other systems.  The simple syntactic rules for such
+;; headers, such as quoting and line folding, are routinely reimplemented
+;; in many individual packages.  This package removes the need for this
+;; redundancy by representing message headers as association lists,
+;; offering functions to extract the set of headers from a message, to
+;; parse individual headers, to merge sets of headers, and to format a set
+;; of headers.
+
+;; The car of each element in the message-header alist is a symbol whose
+;; print name is the name of the header, in all lower-case.  The cdr of an
+;; element depends on the operation.  After extracting headers from a
+;; message, it is a string, the value of the header.  An extracted set of
+;; headers may be parsed further, which may turn it into a list, whose car
+;; is the original value and whose subsequent elements depend on the
+;; header.  For formatting, it is evaluated to obtain the strings to be
+;; inserted.  For merging, one set of headers consists of strings, while
+;; the other set will be evaluated with the symbols in the first set of
+;; headers bound to their respective values.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;; Make the byte-compiler shut up.
+(defvar headers)
+
+(defun mail-header-extract ()
+  "Extract headers from current buffer after point.
+Returns a header alist, where each element is a cons cell (name . value),
+where NAME is a symbol, and VALUE is the string value of the header having
+that name."
+  (let ((message-headers ()) (top (point))
+	start end)
+    (while (and (setq start (point))
+		(> (skip-chars-forward "^\0- :") 0)
+		(eq (char-after) ?:)
+		(setq end (point))
+		(progn (forward-char)
+		       (> (skip-chars-forward " \t") 0)))
+      (let ((header (intern (downcase (buffer-substring start end))))
+	    (value (list (buffer-substring
+			  (point) (progn (end-of-line) (point))))))
+	(while (progn (forward-char) (> (skip-chars-forward " \t") 0))
+	  (push (buffer-substring (point) (progn (end-of-line) (point)))
+		value))
+	(push (if (cdr value)
+		  (cons header (mapconcat #'identity (nreverse value) " "))
+		(cons header (car value)))
+	      message-headers)))
+    (goto-char top)
+    (nreverse message-headers)))
+
+(defun mail-header-extract-no-properties ()
+  "Extract headers from current buffer after point, without properties.
+Returns a header alist, where each element is a cons cell (name . value),
+where NAME is a symbol, and VALUE is the string value of the header having
+that name."
+  (mapcar
+   (lambda (elt)
+     (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
+     elt)
+   (mail-header-extract)))
+
+(defun mail-header-parse (parsing-rules headers)
+  "Apply PARSING-RULES to HEADERS.
+PARSING-RULES is an alist whose keys are header names (symbols) and whose
+value is a parsing function.  The function takes one argument, a string,
+and return a list of values, which will destructively replace the value
+associated with the key in HEADERS, after being prepended with the original
+value."
+  (dolist (rule parsing-rules)
+    (let ((header (assq (car rule) headers)))
+      (when header
+	(if (consp (cdr header))
+	    (setf (cddr header) (funcall (cdr rule) (cadr header)))
+	  (setf (cdr header)
+		(cons (cdr header) (funcall (cdr rule) (cdr header))))))))
+  headers)
+
+(defsubst mail-header (header &optional header-alist)
+  "Return the value associated with header HEADER in HEADER-ALIST.
+If the value is a string, it is the original value of the header.  If the
+value is a list, its first element is the original value of the header,
+with any subsequent elements being the result of parsing the value.
+If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+  (cdr (assq header (or header-alist headers))))
+
+(defun mail-header-set (header value &optional header-alist)
+  "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
+HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
+See `mail-header' for the semantics of VALUE."
+  (let* ((alist (or header-alist headers))
+	 (entry (assq header alist)))
+    (if entry
+	(setf (cdr entry) value)
+      (nconc alist (list (cons header value)))))
+  value)
+
+(defsetf mail-header (header &optional header-alist) (value)
+  `(mail-header-set ,header ,value ,header-alist))
+
+(defun mail-header-merge (merge-rules headers)
+  "Return a new header alist with MERGE-RULES applied to HEADERS.
+MERGE-RULES is an alist whose keys are header names (symbols) and whose
+values are forms to evaluate, the results of which are the new headers.  It
+should be a string or a list of string.  The first element may be nil to
+denote that the formatting functions must use the remaining elements, or
+skip the header altogether if there are no other elements.
+  The macro `mail-header' can be used to access headers in HEADERS."
+  (mapcar
+   (lambda (rule)
+     (cons (car rule) (eval (cdr rule))))
+   merge-rules))
+
+(defvar mail-header-format-function
+  (lambda (header value)
+    "Function to format headers without a specified formatting function."
+    (insert (capitalize (symbol-name header))
+	    ": "
+	    (if (consp value) (car value) value)
+	    "\n")))
+
+(defun mail-header-format (format-rules headers)
+  "Use FORMAT-RULES to format HEADERS and insert into current buffer.
+FORMAT-RULES is an alist whose keys are header names (symbols), and whose
+values are functions that format the header, the results of which are
+inserted, unless it is nil.  The function takes two arguments, the header
+symbol, and the value of that header.  If the function itself is nil, the
+default action is to insert the value of the header, unless it is nil.
+The headers are inserted in the order of the FORMAT-RULES.
+A key of t represents any otherwise unmentioned headers.
+A key of nil has as its value a list of defaulted headers to ignore."
+  (let ((ignore (append (cdr (assq nil format-rules))
+			(mapcar #'car format-rules))))
+    (dolist (rule format-rules)
+      (let* ((header (car rule))
+	     (value (mail-header header)))
+	(cond ((null header) 'ignore)
+	      ((eq header t)
+	       (dolist (defaulted headers)
+		 (unless (memq (car defaulted) ignore)
+		   (let* ((header (car defaulted))
+			  (value (cdr defaulted)))
+		     (if (cdr rule)
+			 (funcall (cdr rule) header value)
+		       (funcall mail-header-format-function header value))))))
+	      (value
+	       (if (cdr rule)
+		   (funcall (cdr rule) header value)
+		 (funcall mail-header-format-function header value))))))
+    (insert "\n")))
+
+(provide 'mailheader)
+
+;;; mail-header.el ends here
diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el
new file mode 100644
index 0000000..2627397
--- /dev/null
+++ b/lisp/mm-extern.el
@@ -0,0 +1,168 @@
+;;; mm-extern.el --- showing message/external-body
+;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: message external-body
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mm-util)
+(require 'mm-decode)
+(require 'mm-url)
+
+(defvar mm-extern-function-alist
+  '((local-file . mm-extern-local-file)
+    (url . mm-extern-url)
+    (anon-ftp . mm-extern-anon-ftp)
+    (ftp . mm-extern-ftp)
+;;;     (tftp . mm-extern-tftp)
+    (mail-server . mm-extern-mail-server)
+;;;     (afs . mm-extern-afs))
+    ))
+
+(defvar mm-extern-anonymous "anonymous")
+
+(defun mm-extern-local-file (handle)
+  (erase-buffer)
+  (let ((name (cdr (assq 'name (cdr (mm-handle-type handle)))))
+	(coding-system-for-read mm-binary-coding-system))
+    (unless name
+      (error "The filename is not specified"))
+    (mm-disable-multibyte-mule4)
+    (if (file-exists-p name)
+	(mm-insert-file-contents name nil nil nil nil t)
+      (error (format "File %s is gone" name)))))
+
+(defun mm-extern-url (handle)
+  (erase-buffer)
+  (let ((url (cdr (assq 'url (cdr (mm-handle-type handle)))))
+	(name buffer-file-name)
+	(coding-system-for-read mm-binary-coding-system))
+    (unless url
+      (error "URL is not specified"))
+    (mm-with-unibyte-current-buffer-mule4
+      (mm-url-insert-file-contents url))
+    (mm-disable-multibyte-mule4)
+    (setq buffer-file-name name)))
+
+(defun mm-extern-anon-ftp (handle)
+  (erase-buffer)
+  (let* ((params (cdr (mm-handle-type handle)))
+	 (name (cdr (assq 'name params)))
+	 (site (cdr (assq 'site params)))
+	 (directory (cdr (assq 'directory params)))
+	 (mode (cdr (assq 'mode params)))
+	 (path (concat "/" (or mm-extern-anonymous
+			       (read-string (format "ID for %s: " site)))
+		       "@" site ":" directory "/" name))
+	 (coding-system-for-read mm-binary-coding-system))
+    (unless name
+      (error "The filename is not specified"))
+    (mm-disable-multibyte-mule4)
+    (mm-insert-file-contents path nil nil nil nil t)))
+
+(defun mm-extern-ftp (handle)
+  (let (mm-extern-anonymous)
+    (mm-extern-anon-ftp handle)))
+
+(defun mm-extern-mail-server (handle)
+  (require 'message)
+  (let* ((params (cdr (mm-handle-type handle)))
+	 (server (cdr (assq 'server params)))
+	 (subject (or (cdr (assq 'subject params)) "none"))
+	 (buf (current-buffer))
+	 info)
+    (if (y-or-n-p (format "Send a request message to %s?" server))
+	(save-window-excursion
+	  (message-mail server subject)
+	  (message-goto-body)
+	  (delete-region (point) (point-max))
+	  (insert-buffer-substring buf)
+	  (message "Requesting external body...")
+	  (message-send-and-exit)
+	  (setq info "Request is sent.")
+	  (message info))
+      (setq info "Request is not sent."))
+    (goto-char (point-min))
+    (insert "[" info "]\n\n")))
+
+;;;###autoload
+(defun mm-inline-external-body (handle &optional no-display)
+  "Show the external-body part of HANDLE.
+This function replaces the buffer of HANDLE with a buffer contains
+the entire message.
+If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
+  (let* ((access-type (cdr (assq 'access-type
+				 (cdr (mm-handle-type handle)))))
+	 (func (cdr (assq (intern
+			   (downcase
+			    (or access-type
+				(error "Couldn't find access type"))))
+			  mm-extern-function-alist)))
+	 gnus-displaying-mime buf
+	 handles)
+    (unless (mm-handle-cache handle)
+      (unless func
+	(error (format "Access type (%s) is not supported" access-type)))
+      (with-temp-buffer
+	(mm-insert-part handle)
+	(goto-char (point-max))
+	(insert "\n\n")
+	(setq handles (mm-dissect-buffer t)))
+      (unless (bufferp (car handles))
+	(mm-destroy-parts handles)
+	(error "Multipart external body is not supported"))
+      (save-excursion ;; single part
+	(set-buffer (setq buf (mm-handle-buffer handles)))
+	(let (good)
+	  (unwind-protect
+	      (progn
+		(funcall func handle)
+		(setq good t))
+	    (unless good
+	      (mm-destroy-parts handles))))
+	(mm-handle-set-cache handle handles))
+      (setq gnus-article-mime-handles
+	    (mm-merge-handles gnus-article-mime-handles handles)))
+    (unless no-display
+      (save-excursion
+	(save-restriction
+	  (narrow-to-region (point) (point))
+	  (gnus-display-mime (mm-handle-cache handle))
+	  (mm-handle-set-undisplayer
+	   handle
+	   `(lambda ()
+	      (let (buffer-read-only)
+		(condition-case nil
+		    ;; This is only valid on XEmacs.
+		    (mapcar (lambda (prop)
+			      (remove-specifier
+			       (face-property 'default prop) (current-buffer)))
+			    '(background background-pixmap foreground))
+		  (error nil))
+		(delete-region ,(point-min-marker) ,(point-max-marker))))))))))
+
+(provide 'mm-extern)
+
+;;; mm-extern.el ends here
diff --git a/lisp/mm-url.el b/lisp/mm-url.el
new file mode 100644
index 0000000..42d3fce
--- /dev/null
+++ b/lisp/mm-url.el
@@ -0,0 +1,445 @@
+;;; mm-url.el --- a wrapper of url functions/commands for Gnus
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Some codes are stolen from w3 and url packages. Some are moved from
+;; nnweb.
+
+;; TODO: Support POST, cookie.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mm-util)
+(require 'gnus)
+
+(eval-and-compile
+  (autoload 'exec-installed-p "path-util"))
+
+(eval-when-compile
+  (require 'timer))
+
+(defgroup mm-url nil
+  "A wrapper of url package and external url command for Gnus."
+  :group 'gnus)
+
+(defcustom mm-url-use-external (not
+				(condition-case nil
+				    (require 'url)
+				  (error nil)))
+  "*If non-nil, use external grab program `mm-url-program'."
+  :type 'boolean
+  :group 'mm-url)
+
+(defvar mm-url-predefined-programs
+  '((wget "wget" "-q" "-O" "-")
+    (w3m  "w3m" "-dump_source")
+    (lynx "lynx" "-source")
+    (curl "curl")))
+
+(defcustom mm-url-program
+  (cond
+   ((exec-installed-p "wget") 'wget)
+   ((exec-installed-p "w3m") 'w3m)
+   ((exec-installed-p "lynx") 'lynx)
+   ((exec-installed-p "curl") 'curl)
+   (t "GET"))
+  "The url grab program.
+Likely values are `wget', `w3m', `lynx' and `curl'."
+  :type '(choice
+	  (symbol :tag "wget" wget)
+	  (symbol :tag "w3m" w3m)
+	  (symbol :tag "lynx" lynx)
+	  (symbol :tag "curl" curl)
+	  (string :tag "other"))
+  :group 'mm-url)
+
+(defcustom mm-url-arguments nil
+  "The arguments for `mm-url-program'."
+  :type '(repeat string)
+  :group 'mm-url)
+
+
+;;; Internal variables
+
+(defvar mm-url-package-name
+  (gnus-replace-in-string
+   (gnus-replace-in-string gnus-version " v.*$" "")
+   " " "-"))
+
+(defvar	mm-url-package-version gnus-version-number)
+
+;; Stolen from w3.
+(defvar mm-url-html-entities
+  '(
+    ;;(excl        .  33)
+    (quot        .  34)
+    ;;(num         .  35)
+    ;;(dollar      .  36)
+    ;;(percent     .  37)
+    (amp         .  38)
+    (rsquo       .  39)			; should be U+8217
+    ;;(apos        .  39)
+    ;;(lpar        .  40)
+    ;;(rpar        .  41)
+    ;;(ast         .  42)
+    ;;(plus        .  43)
+    ;;(comma       .  44)
+    ;;(period      .  46)
+    ;;(colon       .  58)
+    ;;(semi        .  59)
+    (lt          .  60)
+    ;;(equals      .  61)
+    (gt          .  62)
+    ;;(quest       .  63)
+    ;;(commat      .  64)
+    ;;(lsqb        .  91)
+    ;;(rsqb        .  93)
+    (uarr        .  94)			; should be U+8593
+    ;;(lowbar      .  95)
+    (lsquo       .  96)			; should be U+8216
+    (lcub        . 123)
+    ;;(verbar      . 124)
+    (rcub        . 125)
+    (tilde       . 126)
+    (nbsp        . 160)
+    (iexcl       . 161)
+    (cent        . 162)
+    (pound       . 163)
+    (curren      . 164)
+    (yen         . 165)
+    (brvbar      . 166)
+    (sect        . 167)
+    (uml         . 168)
+    (copy        . 169)
+    (ordf        . 170)
+    (laquo       . 171)
+    (not         . 172)
+    (shy         . 173)
+    (reg         . 174)
+    (macr        . 175)
+    (deg         . 176)
+    (plusmn      . 177)
+    (sup2        . 178)
+    (sup3        . 179)
+    (acute       . 180)
+    (micro       . 181)
+    (para        . 182)
+    (middot      . 183)
+    (cedil       . 184)
+    (sup1        . 185)
+    (ordm        . 186)
+    (raquo       . 187)
+    (frac14      . 188)
+    (frac12      . 189)
+    (frac34      . 190)
+    (iquest      . 191)
+    (Agrave      . 192)
+    (Aacute      . 193)
+    (Acirc       . 194)
+    (Atilde      . 195)
+    (Auml        . 196)
+    (Aring       . 197)
+    (AElig       . 198)
+    (Ccedil      . 199)
+    (Egrave      . 200)
+    (Eacute      . 201)
+    (Ecirc       . 202)
+    (Euml        . 203)
+    (Igrave      . 204)
+    (Iacute      . 205)
+    (Icirc       . 206)
+    (Iuml        . 207)
+    (ETH         . 208)
+    (Ntilde      . 209)
+    (Ograve      . 210)
+    (Oacute      . 211)
+    (Ocirc       . 212)
+    (Otilde      . 213)
+    (Ouml        . 214)
+    (times       . 215)
+    (Oslash      . 216)
+    (Ugrave      . 217)
+    (Uacute      . 218)
+    (Ucirc       . 219)
+    (Uuml        . 220)
+    (Yacute      . 221)
+    (THORN       . 222)
+    (szlig       . 223)
+    (agrave      . 224)
+    (aacute      . 225)
+    (acirc       . 226)
+    (atilde      . 227)
+    (auml        . 228)
+    (aring       . 229)
+    (aelig       . 230)
+    (ccedil      . 231)
+    (egrave      . 232)
+    (eacute      . 233)
+    (ecirc       . 234)
+    (euml        . 235)
+    (igrave      . 236)
+    (iacute      . 237)
+    (icirc       . 238)
+    (iuml        . 239)
+    (eth         . 240)
+    (ntilde      . 241)
+    (ograve      . 242)
+    (oacute      . 243)
+    (ocirc       . 244)
+    (otilde      . 245)
+    (ouml        . 246)
+    (divide      . 247)
+    (oslash      . 248)
+    (ugrave      . 249)
+    (uacute      . 250)
+    (ucirc       . 251)
+    (uuml        . 252)
+    (yacute      . 253)
+    (thorn       . 254)
+    (yuml        . 255)
+
+    ;; Special handling of these
+    (frac56      . "5/6")
+    (frac16      . "1/6")
+    (frac45      . "4/5")
+    (frac35      . "3/5")
+    (frac25      . "2/5")
+    (frac15      . "1/5")
+    (frac23      . "2/3")
+    (frac13      . "1/3")
+    (frac78      . "7/8")
+    (frac58      . "5/8")
+    (frac38      . "3/8")
+    (frac18      . "1/8")
+
+    ;; The following 5 entities are not mentioned in the HTML 2.0
+    ;; standard, nor in any other HTML proposed standard of which I
+    ;; am aware.  I am not even sure they are ISO entity names.  ***
+    ;; Hence, some arrangement should be made to give a bad HTML
+    ;; message when they are seen.
+    (ndash       .  45)
+    (mdash       .  45)
+    (emsp        .  32)
+    (ensp        .  32)
+    (sim         . 126)
+    (le          . "<=")
+    (agr         . "alpha")
+    (rdquo       . "''")
+    (ldquo       . "``")
+    (trade       . "(TM)")
+    ;; To be done
+    ;; (shy      . ????) ; soft hyphen
+    )
+  "*An assoc list of entity names and how to actually display them.")
+
+(defconst mm-url-unreserved-chars
+  '(
+    ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
+    ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
+    ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+    ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
+  "A list of characters that are _NOT_ reserved in the URL spec.
+This is taken from RFC 2396.")
+
+(defun mm-url-load-url ()
+  "Load `url-insert-file-contents'."
+  (unless (condition-case ()
+	      (require 'url-handlers)
+	    (error nil))
+    ;; w3-4.0pre0.46 or earlier version.
+    (require 'w3-vars)
+    (require 'url)))
+
+(defun mm-url-insert-file-contents (url)
+  (if mm-url-use-external
+      (progn
+	(if (string-match "^file:/+" url)
+	    (insert-file-contents (substring url (1- (match-end 0))))
+	  (mm-url-insert-file-contents-external url))
+	(goto-char (point-min))
+	(if (fboundp 'url-generic-parse-url)
+	    (setq url-current-object 
+		  (url-generic-parse-url url)))
+	(list url (buffer-size)))
+    (mm-url-load-url)
+    (let ((name buffer-file-name)
+	  (url-request-extra-headers (list (cons "Connection" "Close")))
+	  (url-package-name (or mm-url-package-name
+				url-package-name))
+	  (url-package-version (or mm-url-package-version
+				   url-package-version))
+	  result)
+      (setq result (url-insert-file-contents url))
+      (save-excursion
+	(goto-char (point-min))
+	(while (re-search-forward "\r 1000\r ?" nil t)
+	  (replace-match "")))
+      (setq buffer-file-name name)
+      (if (and (fboundp 'url-generic-parse-url)
+	       (listp result))
+	  (setq url-current-object (url-generic-parse-url
+				    (car result))))
+      result)))
+
+(defun mm-url-insert-file-contents-external (url)
+  (let (program args)
+    (if (symbolp mm-url-program)
+	(let ((item (cdr (assq mm-url-program mm-url-predefined-programs))))
+	  (setq program (car item)
+		args (append (cdr item) (list url))))
+      (setq program mm-url-program
+	    args (append mm-url-arguments (list url))))
+    (apply 'call-process program nil t nil args)))
+
+(defvar mm-url-timeout 30
+  "The number of seconds before timing out an URL fetch.")
+
+(defvar mm-url-retries 10
+  "The number of retries after timing out when fetching an URL.")
+
+(defun mm-url-insert (url &optional follow-refresh)
+  "Insert the contents from an URL in the current buffer.
+If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
+  (let ((times mm-url-retries)
+	(done nil)
+	(first t)
+	result)
+    (while (and (not (zerop (decf times)))
+		(not done))
+      (with-timeout (mm-url-timeout)
+	(unless first
+	  (message "Trying again (%s)..." (- mm-url-retries times)))
+	(setq first nil)
+	(if follow-refresh
+	    (save-restriction
+	      (narrow-to-region (point) (point))
+	      (mm-url-insert-file-contents url)
+	      (goto-char (point-min))
+	      (when (re-search-forward
+		     "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
+		(let ((url (match-string 1)))
+		  (delete-region (point-min) (point-max))
+		  (setq result (mm-url-insert url t)))))
+	  (setq result (mm-url-insert-file-contents url)))
+	(setq done t)))
+    result))
+
+(defun mm-url-decode-entities ()
+  "Decode all HTML entities."
+  (goto-char (point-min))
+  (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
+    (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
+			(let ((c
+			       (string-to-number (substring
+						  (match-string 1) 1))))
+			  (if (mm-char-or-char-int-p c) c 32))
+		      (or (cdr (assq (intern (match-string 1))
+				     mm-url-html-entities))
+			  ?#))))
+      (unless (stringp elem)
+	(setq elem (char-to-string elem)))
+      (replace-match elem t t))))
+
+(defun mm-url-decode-entities-nbsp ()
+  "Decode all HTML entities and &nbsp; to a space."
+  (let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities)))
+    (mm-url-decode-entities)))
+
+(defun mm-url-decode-entities-string (string)
+  (with-temp-buffer
+    (insert string)
+    (mm-url-decode-entities)
+    (buffer-string)))
+
+(defun mm-url-form-encode-xwfu (chunk)
+  "Escape characters in a string for application/x-www-form-urlencoded.
+Blasphemous crap because someone didn't think %20 was good enough for encoding
+spaces.  Die Die Die."
+  ;; This will get rid of the 'attributes' specified by the file type,
+  ;; which are useless for an application/x-www-form-urlencoded form.
+  (if (consp chunk)
+      (setq chunk (cdr chunk)))
+
+  (mapconcat
+   (lambda (char)
+     (cond
+      ((= char ?  ) "+")
+      ((memq char mm-url-unreserved-chars) (char-to-string char))
+      (t (upcase (format "%%%02x" char)))))
+   ;; Fixme: Should this actually be accepting multibyte?  Is there a
+   ;; better way in XEmacs?
+   (if (featurep 'mule)
+       (encode-coding-string chunk
+			     (if (fboundp 'find-coding-systems-string)
+				 (car (find-coding-systems-string chunk))
+			       (static-if (boundp 'MULE)
+				   file-coding-system
+				 buffer-file-coding-system)))
+     chunk)
+   ""))
+
+(defun mm-url-encode-www-form-urlencoded (pairs)
+  "Return PAIRS encoded for forms."
+  (mapconcat
+   (lambda (data)
+     (concat (mm-url-form-encode-xwfu (car data)) "="
+	     (mm-url-form-encode-xwfu (cdr data))))
+   pairs "&"))
+
+(defun mm-url-fetch-form (url pairs)
+  "Fetch a form from URL with PAIRS as the data using the POST method."
+  (mm-url-load-url)
+  (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs))
+	(url-request-method "POST")
+	(url-request-extra-headers
+	 '(("Content-type" . "application/x-www-form-urlencoded"))))
+    (url-insert-file-contents url)
+    (setq buffer-file-name nil))
+  t)
+
+(defun mm-url-fetch-simple (url content)
+  (mm-url-load-url)
+  (let ((url-request-data content)
+	(url-request-method "POST")
+	(url-request-extra-headers
+	 '(("Content-type" . "application/x-www-form-urlencoded"))))
+    (url-insert-file-contents url)
+    (setq buffer-file-name nil))
+  t)
+
+(defun mm-url-remove-markup ()
+  "Remove all HTML markup, leaving just plain text."
+  (goto-char (point-min))
+  (while (search-forward "<!--" nil t)
+    (delete-region (match-beginning 0)
+		   (or (search-forward "-->" nil t)
+		       (point-max))))
+  (goto-char (point-min))
+  (while (re-search-forward "<[^>]+>" nil t)
+    (replace-match "" t t)))
+
+(provide 'mm-url)
+
+;;; mm-url.el ends here
diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el
new file mode 100644
index 0000000..c18cf2f
--- /dev/null
+++ b/lisp/mml-sec.el
@@ -0,0 +1,275 @@
+;;; mml-sec.el --- A package with security functions for MML documents
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'mml-smime)
+(eval-when-compile (require 'cl))
+(autoload 'mml2015-sign "mml2015")
+(autoload 'mml2015-encrypt "mml2015")
+(autoload 'mml1991-sign "mml1991")
+(autoload 'mml1991-encrypt "mml1991")
+(autoload 'message-goto-body "message")
+(autoload 'mml-insert-tag "mml")
+
+(defvar mml-sign-alist
+  '(("smime"     mml-smime-sign-buffer     mml-smime-sign-query)
+    ("pgp"       mml-pgp-sign-buffer       list)
+    ("pgpauto"   mml-pgpauto-sign-buffer  list)
+    ("pgpmime"   mml-pgpmime-sign-buffer   list))
+  "Alist of MIME signer functions.")
+
+(defvar mml-default-sign-method (caar mml-sign-alist)
+  "Default sign method.")
+
+(defvar mml-encrypt-alist
+  '(("smime"     mml-smime-encrypt-buffer     mml-smime-encrypt-query)
+    ("pgp"       mml-pgp-encrypt-buffer       list)
+    ("pgpauto"   mml-pgpauto-sign-buffer  list)
+    ("pgpmime"   mml-pgpmime-encrypt-buffer   list))
+  "Alist of MIME encryption functions.")
+
+(defvar mml-default-encrypt-method (caar mml-encrypt-alist)
+  "Default encryption method.")
+
+(defcustom mml-signencrypt-style-alist
+  '(("smime"   separate)
+    ("pgp"     separate)
+    ("pgpauto" separate)
+    ("pgpmime" separate))
+  "Alist specifying if `signencrypt' results in two separate operations or not.
+The first entry indicates the MML security type, valid entries include
+the strings \"smime\", \"pgp\", and \"pgpmime\".  The second entry is
+a symbol `separate' or `combined' where `separate' means that MML signs
+and encrypt messages in a two step process, and `combined' means that MML
+signs and encrypt the message in one step.
+Note that the `combined' mode is NOT supported by all OpenPGP implementations,
+in particular PGP version 2 does not support it!"
+  :type '(repeat (list (choice (const :tag "S/MIME" "smime")
+			       (const :tag "PGP" "pgp")
+			       (const :tag "PGP/MIME" "pgpmime")
+			       (string :tag "User defined"))
+		       (choice (const :tag "Separate" separate)
+			       (const :tag "Combined" combined)))))
+			      
+;;; Configuration/helper functions
+
+(defun mml-signencrypt-style (method &optional style)
+  "Function for setting/getting the signencrypt-style used.  Takes two
+arguments, the method (e.g. \"pgp\") and optionally the mode
+\(e.g. combined).  If the mode is omitted, the current value is returned.
+
+For example, if you prefer to use combined sign & encrypt with
+smime, putting the following in your Gnus startup file will
+enable that behavior:
+
+\(mml-set-signencrypt-style \"smime\" combined)
+
+You can also customize or set `mml-signencrypt-style-alist' instead."
+  (let ((style-item (assoc method mml-signencrypt-style-alist)))
+    (if style-item
+	(if (or (eq style 'separate)
+		(eq style 'combined))
+	    ;; valid style setting?
+	    (setf (second style-item) style)
+	  ;; otherwise, just return the current value
+	  (second style-item))
+      (gnus-message 3 "Warning, attempt to set invalid signencrypt-style"))))
+
+;;; Security functions
+
+(defun mml-smime-sign-buffer (cont)
+  (or (mml-smime-sign cont)
+      (error "Signing failed... inspect message logs for errors")))
+
+(defun mml-smime-encrypt-buffer (cont &optional sign)
+  (when sign
+    (message "Combined sign and encrypt S/MIME not support yet")
+    (sit-for 1))
+  (or (mml-smime-encrypt cont)
+      (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgp-sign-buffer (cont)
+  (or (mml1991-sign cont)
+      (error "Signing failed... inspect message logs for errors")))
+
+(defun mml-pgp-encrypt-buffer (cont &optional sign)
+  (or (mml1991-encrypt cont sign)
+      (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgpmime-sign-buffer (cont)
+  (or (mml2015-sign cont)
+      (error "Signing failed... inspect message logs for errors")))
+
+(defun mml-pgpmime-encrypt-buffer (cont &optional sign)
+  (or (mml2015-encrypt cont sign)
+      (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgpauto-sign-buffer (cont)
+  (message-goto-body)
+  (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way...
+	  (mml2015-sign cont)
+	(mml1991-sign cont))
+      (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgpauto-encrypt-buffer (cont &optional sign)
+  (message-goto-body)
+  (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way...
+	  (mml2015-encrypt cont sign)
+	(mml1991-encrypt cont sign))
+      (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-secure-part (method &optional sign)
+  (save-excursion
+    (let ((tags (funcall (nth 2 (assoc method (if sign mml-sign-alist
+						mml-encrypt-alist))))))
+      (cond ((re-search-backward
+	      "<#\\(multipart\\|part\\|external\\|mml\\)" nil t)
+	     (goto-char (match-end 0))
+	     (insert (if sign " sign=" " encrypt=") method)
+	     (while tags
+	       (let ((key (pop tags))
+		     (value (pop tags)))
+		 (when value
+		   ;; Quote VALUE if it contains suspicious characters.
+		   (when (string-match "[\"'\\~/*;() \t\n]" value)
+		     (setq value (prin1-to-string value)))
+		   (insert (format " %s=%s" key value))))))
+	    ((or (re-search-backward
+		  (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+		 (re-search-forward
+		  (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
+	     (goto-char (match-end 0))
+	     (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt)
+						(cons method tags))))
+	    (t (error "The message is corrupted. No mail header separator"))))))
+
+(defun mml-secure-sign-pgp ()
+  "Add MML tags to PGP sign this MML part."
+  (interactive)
+  (mml-secure-part "pgp" 'sign))
+
+(defun mml-secure-sign-pgpauto ()
+  "Add MML tags to PGP-auto sign this MML part."
+  (interactive)
+  (mml-secure-part "pgpauto" 'sign))
+
+(defun mml-secure-sign-pgpmime ()
+  "Add MML tags to PGP/MIME sign this MML part."
+  (interactive)
+  (mml-secure-part "pgpmime" 'sign))
+
+(defun mml-secure-sign-smime ()
+  "Add MML tags to S/MIME sign this MML part."
+  (interactive)
+  (mml-secure-part "smime" 'sign))
+
+(defun mml-secure-encrypt-pgp ()
+  "Add MML tags to PGP encrypt this MML part."
+  (interactive)
+  (mml-secure-part "pgp"))
+
+(defun mml-secure-encrypt-pgpmime ()
+  "Add MML tags to PGP/MIME encrypt this MML part."
+  (interactive)
+  (mml-secure-part "pgpmime"))
+
+(defun mml-secure-encrypt-smime ()
+  "Add MML tags to S/MIME encrypt this MML part."
+  (interactive)
+  (mml-secure-part "smime"))
+
+;; defuns that add the proper <#secure ...> tag to the top of the message body
+(defun mml-secure-message (method &optional modesym)
+  (let ((mode (prin1-to-string modesym))
+	insert-loc)
+    (mml-unsecure-message)
+    (save-excursion
+      (goto-char (point-min))
+      (cond ((re-search-forward
+	      (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+	     (goto-char (setq insert-loc (match-end 0)))
+	     (unless (looking-at "<#secure")
+	       (mml-insert-tag
+		'secure 'method method 'mode mode)))
+	    (t (error
+		"The message is corrupted. No mail header separator"))))
+    (when (eql insert-loc (point))
+      (forward-line 1))))
+
+(defun mml-unsecure-message ()
+  "Remove security related MML tags from message."
+  (interactive)
+  (save-excursion
+    (goto-char (point-max))
+    (when (re-search-backward "^<#secure.*>\n" nil t)
+      (delete-region (match-beginning 0) (match-end 0)))))
+
+(defun mml-secure-message-sign-smime ()
+  "Add MML tag to encrypt/sign the entire message."
+  (interactive)
+  (mml-secure-message "smime" 'sign))
+
+(defun mml-secure-message-sign-pgp ()
+  "Add MML tag to encrypt/sign the entire message."
+  (interactive)
+  (mml-secure-message "pgp" 'sign))
+
+(defun mml-secure-message-sign-pgpmime ()
+  "Add MML tag to encrypt/sign the entire message."
+  (interactive)
+  (mml-secure-message "pgpmime" 'sign))
+
+(defun mml-secure-message-sign-pgpauto ()
+  "Add MML tag to encrypt/sign the entire message."
+  (interactive)
+  (mml-secure-message "pgpauto" 'sign))
+
+(defun mml-secure-message-encrypt-smime (&optional dontsign)
+  "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+  (interactive "P")
+  (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt)))
+
+(defun mml-secure-message-encrypt-pgp (&optional dontsign)
+  "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+  (interactive "P")
+  (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt)))
+
+(defun mml-secure-message-encrypt-pgpmime (&optional dontsign)
+  "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+  (interactive "P")
+  (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt)))
+
+(defun mml-secure-message-encrypt-pgpauto (&optional dontsign)
+  "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+  (interactive "P")
+  (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt)))
+
+(provide 'mml-sec)
+
+;;; mml-sec.el ends here
diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el
new file mode 100644
index 0000000..bccc8a1
--- /dev/null
+++ b/lisp/mml-smime.el
@@ -0,0 +1,196 @@
+;;; mml-smime.el --- S/MIME support for MML
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: Gnus, MIME, S/MIME, MML
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'smime)
+(require 'mm-decode)
+
+(defun mml-smime-sign (cont)
+  (when (null smime-keys)
+    (customize-variable 'smime-keys)
+    (error "No S/MIME keys configured, use customize to add your key"))
+  (smime-sign-buffer (cdr (assq 'keyfile cont)))
+  (goto-char (point-max)))
+
+(defun mml-smime-encrypt (cont)
+  (let (certnames certfiles tmp file tmpfiles)
+    ;; xxx tmp files are always an security issue
+    (while (setq tmp (pop cont))
+      (if (and (consp tmp) (eq (car tmp) 'certfile))
+	  (push (cdr tmp) certnames)))
+    (while (setq tmp (pop certnames))
+      (if (not (and (not (file-exists-p tmp))
+		    (get-buffer tmp)))
+	  (push tmp certfiles)
+	(setq file (mm-make-temp-file (expand-file-name "mml." 
+							mm-tmp-directory)))
+	(with-current-buffer tmp
+	  (write-region (point-min) (point-max) file))
+	(push file certfiles)
+	(push file tmpfiles)))
+    (if (smime-encrypt-buffer certfiles)
+	(progn
+	  (while (setq tmp (pop tmpfiles))
+	    (delete-file tmp))
+	  t)
+      (while (setq tmp (pop tmpfiles))
+	(delete-file tmp))
+      nil))
+  (goto-char (point-max)))
+
+(defun mml-smime-sign-query ()
+  ;; query information (what certificate) from user when MML tag is
+  ;; added, for use later by the signing process
+  (when (null smime-keys)
+    (customize-variable 'smime-keys)
+    (error "No S/MIME keys configured, use customize to add your key"))
+  (list 'keyfile
+	(if (= (length smime-keys) 1)
+	    (cadar smime-keys)
+	  (or (let ((from (cadr (funcall gnus-extract-address-components
+					 (or (save-excursion
+					       (save-restriction
+						 (message-narrow-to-headers)
+						 (message-fetch-field "from")))
+					     "")))))
+		(and from (smime-get-key-by-email from)))
+	      (smime-get-key-by-email
+	       (completing-read "Sign this part with what signature? "
+				smime-keys nil nil
+				(and (listp (car-safe smime-keys))
+				     (caar smime-keys))))))))
+
+(defun mml-smime-get-file-cert ()
+  (ignore-errors
+    (list 'certfile (read-file-name
+		     "File with recipient's S/MIME certificate: "
+		     smime-certificate-directory nil t ""))))
+
+(defun mml-smime-get-dns-cert ()
+  ;; todo: deal with comma separated multiple recipients
+  (let (result who bad cert)
+    (condition-case ()
+	(while (not result)
+	  (setq who (read-from-minibuffer
+		     (format "%sLookup certificate for: " (or bad ""))
+		     (cadr (funcall gnus-extract-address-components
+				    (or (save-excursion
+					  (save-restriction
+					    (message-narrow-to-headers)
+					    (message-fetch-field "to")))
+					"")))))
+	  (if (setq cert (smime-cert-by-dns who))
+	      (setq result (list 'certfile (buffer-name cert)))
+	    (setq bad (format "`%s' not found. " who))))
+      (quit))
+    result))
+
+(defun mml-smime-encrypt-query ()
+  ;; todo: add ldap support (xemacs ldap api?)
+  ;; todo: try dns/ldap automatically first, before prompting user
+  (let (certs done)
+    (while (not done)
+      (ecase (read (gnus-completing-read-with-default
+		    "dns" "Fetch certificate from"
+		    '(("dns") ("file")) nil t))
+	(dns (setq certs (append certs
+				 (mml-smime-get-dns-cert))))
+	(file (setq certs (append certs
+				  (mml-smime-get-file-cert)))))
+      (setq done (not (y-or-n-p "Add more recipients? "))))
+    certs))
+
+(defun mml-smime-verify (handle ctl)
+  (with-temp-buffer
+    (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
+    (goto-char (point-min))
+    (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))
+    (insert (format "protocol=\"%s\"; "
+		    (mm-handle-multipart-ctl-parameter ctl 'protocol)))
+    (insert (format "micalg=\"%s\"; "
+		    (mm-handle-multipart-ctl-parameter ctl 'micalg)))
+    (insert (format "boundary=\"%s\"\n\n"
+		    (mm-handle-multipart-ctl-parameter ctl 'boundary)))
+    (when (get-buffer smime-details-buffer)
+      (kill-buffer smime-details-buffer))
+    (let ((buf (current-buffer))
+	  (good-signature (smime-noverify-buffer))
+	  (good-certificate (and (or smime-CA-file smime-CA-directory)
+				 (smime-verify-buffer)))
+	  addresses openssl-output)
+      (setq openssl-output (with-current-buffer smime-details-buffer
+			     (buffer-string)))
+      (if (not good-signature)
+	  (progn
+	    ;; we couldn't verify message, fail with openssl output as message
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-info "Failed")
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-details
+	     (concat "OpenSSL failed to verify message integrity:\n"
+		     "-------------------------------------------\n"
+		     openssl-output)))
+	;; verify mail addresses in mail against those in certificate
+	(when (and (smime-pkcs7-region (point-min) (point-max))
+		   (smime-pkcs7-certificates-region (point-min) (point-max)))
+	  (with-temp-buffer
+	    (insert-buffer-substring buf)
+	    (goto-char (point-min))
+	    (while (re-search-forward "-----END CERTIFICATE-----" nil t)
+	      (when (smime-pkcs7-email-region (point-min) (point))
+		(setq addresses (append (smime-buffer-as-string-region
+					 (point-min) (point)) addresses)))
+	      (delete-region (point-min) (point)))
+	    (setq addresses (mapcar 'downcase addresses))))
+	(if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses))
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-info "Sender address forged")
+	  (if good-certificate
+	      (mm-set-handle-multipart-parameter
+	       mm-security-handle 'gnus-info "Ok (sender authenticated)")
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-info "Ok (sender not trusted)")))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-details
+	 (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"
+		 (if addresses
+		     (concat "Addresses in certificate: "
+			     (mapconcat 'identity addresses ", "))
+		   "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)")
+		 "\n" "\n"
+		 "OpenSSL output:\n"
+		 "---------------\n" openssl-output "\n"
+		 "Certificate(s) inside S/MIME signature:\n"
+		 "---------------------------------------\n"
+		 (buffer-string) "\n")))))
+  handle)
+
+(defun mml-smime-verify-test (handle ctl)
+  smime-openssl-program)
+
+(provide 'mml-smime)
+
+;;; mml-smime.el ends here
diff --git a/lisp/mml1991.el b/lisp/mml1991.el
new file mode 100644
index 0000000..741cfe2
--- /dev/null
+++ b/lisp/mml1991.el
@@ -0,0 +1,298 @@
+;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
+;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Sascha Ldecke <sascha@meta-x.de>,
+;;	Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
+;; Keywords PGP
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl)
+  (require 'mm-util))
+
+(autoload 'quoted-printable-decode-region "qp")
+(autoload 'quoted-printable-encode-region "qp")
+
+(defvar mml1991-use mml2015-use
+  "The package used for PGP.")
+
+(defvar mml1991-function-alist
+  '((mailcrypt mml1991-mailcrypt-sign
+	       mml1991-mailcrypt-encrypt)
+    (gpg mml1991-gpg-sign
+	 mml1991-gpg-encrypt)
+    (pgg mml1991-pgg-sign
+	 mml1991-pgg-encrypt))
+  "Alist of PGP functions.")
+
+;;; mailcrypt wrapper
+
+(eval-and-compile
+  (autoload 'mc-sign-generic "mc-toplev"))
+
+(defvar mml1991-decrypt-function 'mailcrypt-decrypt)
+(defvar mml1991-verify-function 'mailcrypt-verify)
+
+(defun mml1991-mailcrypt-sign (cont)
+  (let ((text (current-buffer))
+	headers signature
+	(result-buffer (get-buffer-create "*GPG Result*")))
+    ;; Save MIME Content[^ ]+: headers from signing
+    (goto-char (point-min))
+    (while (looking-at "^Content[^ ]+:") (forward-line))
+    (unless (bobp)
+      (setq headers (buffer-string))
+      (delete-region (point-min) (point)))
+    (goto-char (point-max))
+    (unless (bolp)
+      (insert "\n"))
+    (quoted-printable-decode-region (point-min) (point-max))
+    (with-temp-buffer
+      (setq signature (current-buffer))
+      (insert-buffer-substring text)
+      (unless (mc-sign-generic (message-options-get 'message-sender)
+			       nil nil nil nil)
+	(unless (> (point-max) (point-min))
+	  (pop-to-buffer result-buffer)
+	  (error "Sign error")))
+      (goto-char (point-min))
+      (while (re-search-forward "\r+$" nil t)
+	(replace-match "" t t))
+      (quoted-printable-encode-region (point-min) (point-max))
+      (set-buffer text)
+      (delete-region (point-min) (point-max))
+      (if headers (insert headers))
+      (insert "\n")
+      (insert-buffer-substring signature)
+      (goto-char (point-max)))))
+
+(defun mml1991-mailcrypt-encrypt (cont &optional sign)
+  (let ((text (current-buffer))
+	(mc-pgp-always-sign
+	 (or mc-pgp-always-sign
+	     sign
+	     (eq t (or (message-options-get 'message-sign-encrypt)
+		       (message-options-set
+			'message-sign-encrypt
+			(or (y-or-n-p "Sign the message? ")
+			    'not))))
+	     'never))
+	cipher
+	(result-buffer (get-buffer-create "*GPG Result*")))
+    ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+    (goto-char (point-min))
+    (while (looking-at "^Content[^ ]+:") (forward-line))
+    (unless (bobp)
+      (delete-region (point-min) (point)))
+    (mm-with-unibyte-current-buffer-mule4
+      (with-temp-buffer
+	(setq cipher (current-buffer))
+	(insert-buffer-substring text)
+	(unless (mc-encrypt-generic
+		 (or
+		  (message-options-get 'message-recipients)
+		  (message-options-set 'message-recipients
+				       (read-string "Recipients: ")))
+		 nil
+		 (point-min) (point-max)
+		 (message-options-get 'message-sender)
+		 'sign)
+	  (unless (> (point-max) (point-min))
+	    (pop-to-buffer result-buffer)
+	    (error "Encrypt error")))
+	(goto-char (point-min))
+	(while (re-search-forward "\r+$" nil t)
+	  (replace-match "" t t))
+	(set-buffer text)
+	(delete-region (point-min) (point-max))
+	;;(insert "Content-Type: application/pgp-encrypted\n\n")
+	;;(insert "Version: 1\n\n")
+	(insert "\n")
+	(insert-buffer-substring cipher)
+	(goto-char (point-max))))))
+
+;;; gpg wrapper
+
+(eval-and-compile
+  (autoload 'gpg-sign-cleartext "gpg"))
+
+(defun mml1991-gpg-sign (cont)
+  (let ((text (current-buffer))
+	headers signature
+	(result-buffer (get-buffer-create "*GPG Result*")))
+    ;; Save MIME Content[^ ]+: headers from signing
+    (goto-char (point-min))
+    (while (looking-at "^Content[^ ]+:") (forward-line))
+    (unless (bobp)
+      (setq headers (buffer-string))
+      (delete-region (point-min) (point)))
+    (goto-char (point-max))
+    (unless (bolp)
+      (insert "\n"))
+    (quoted-printable-decode-region (point-min) (point-max))
+    (with-temp-buffer
+      (unless (gpg-sign-cleartext text (setq signature (current-buffer))
+				  result-buffer
+				  nil
+				  (message-options-get 'message-sender))
+	(unless (> (point-max) (point-min))
+	  (pop-to-buffer result-buffer)
+	  (error "Sign error")))
+      (goto-char (point-min))
+      (while (re-search-forward "\r+$" nil t)
+	(replace-match "" t t))
+      (quoted-printable-encode-region (point-min) (point-max))
+      (set-buffer text)
+      (delete-region (point-min) (point-max))
+      (if headers (insert headers))
+      (insert "\n")
+      (insert-buffer-substring signature)
+      (goto-char (point-max)))))
+
+(defun mml1991-gpg-encrypt (cont &optional sign)
+  (let ((text (current-buffer))
+	cipher
+	(result-buffer (get-buffer-create "*GPG Result*")))
+    ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+    (goto-char (point-min))
+    (while (looking-at "^Content[^ ]+:") (forward-line))
+    (unless (bobp)
+      (delete-region (point-min) (point)))
+    (mm-with-unibyte-current-buffer-mule4
+      (with-temp-buffer
+	(flet ((gpg-encrypt-func 
+		(sign plaintext ciphertext result recipients &optional
+		      passphrase sign-with-key armor textmode)
+		(if sign
+		    (gpg-sign-encrypt
+		     plaintext ciphertext result recipients passphrase
+		     sign-with-key armor textmode)
+		  (gpg-encrypt
+		   plaintext ciphertext result recipients passphrase
+		   armor textmode))))
+	  (unless (gpg-encrypt-func
+		   sign
+		   text (setq cipher (current-buffer))
+		   result-buffer
+		   (split-string
+		    (or
+		     (message-options-get 'message-recipients)
+		     (message-options-set 'message-recipients
+					  (read-string "Recipients: ")))
+		    "[ \f\t\n\r\v,]+")
+		   nil
+		   (message-options-get 'message-sender)
+		   t t) ; armor & textmode
+	    (unless (> (point-max) (point-min))
+	      (pop-to-buffer result-buffer)
+	      (error "Encrypt error"))))
+	(goto-char (point-min))
+	(while (re-search-forward "\r+$" nil t)
+	  (replace-match "" t t))
+	(set-buffer text)
+	(delete-region (point-min) (point-max))
+	;;(insert "Content-Type: application/pgp-encrypted\n\n")
+	;;(insert "Version: 1\n\n")
+	(insert "\n")
+	(insert-buffer-substring cipher)
+	(goto-char (point-max))))))
+
+;; pgg wrapper
+
+(defvar pgg-output-buffer)
+(defvar pgg-errors-buffer)
+
+(defun mml1991-pgg-sign (cont)
+  (let (headers)
+    ;; Don't sign headers.
+    (goto-char (point-min))
+    (while (not (looking-at "^$"))
+      (forward-line))
+    (unless (eobp) ;; no headers?
+      (setq headers (buffer-substring (point-min) (point)))
+      (forward-line) ;; skip header/body separator
+      (delete-region (point-min) (point)))
+    (quoted-printable-decode-region (point-min) (point-max))
+    (unless (let ((pgg-default-user-id
+		   (or (message-options-get 'message-sender)
+		       pgg-default-user-id)))
+	      (pgg-sign-region (point-min) (point-max) t))
+      (pop-to-buffer pgg-errors-buffer)
+      (error "Encrypt error"))
+    (delete-region (point-min) (point-max))
+    (insert-buffer-substring pgg-output-buffer)
+    (goto-char (point-min))
+    (while (re-search-forward "\r+$" nil t)
+      (replace-match "" t t))
+    (quoted-printable-encode-region (point-min) (point-max))
+    (goto-char (point-min))
+    (if headers (insert headers))
+    (insert "\n")
+    t))
+
+(defun mml1991-pgg-encrypt (cont &optional sign)
+  (let (headers)
+    ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+    (goto-char (point-min))
+    (while (looking-at "^Content[^ ]+:") (forward-line))
+    (unless (bobp)
+      (delete-region (point-min) (point)))
+    (unless (pgg-encrypt-region
+	     (point-min) (point-max) 
+	     (split-string
+	      (or
+	       (message-options-get 'message-recipients)
+	       (message-options-set 'message-recipients
+				    (read-string "Recipients: ")))
+	      "[ \f\t\n\r\v,]+")
+	     sign)
+      (pop-to-buffer pgg-errors-buffer)
+      (error "Encrypt error"))
+    (delete-region (point-min) (point-max))
+    ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+    ;;(insert "Version: 1\n\n")
+    (insert "\n")
+    (insert-buffer-substring pgg-output-buffer)
+    t))
+
+;;;###autoload
+(defun mml1991-encrypt (cont &optional sign)
+  (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
+    (if func
+	(funcall func cont sign)
+      (error "Cannot find encrypt function"))))
+
+;;;###autoload
+(defun mml1991-sign (cont)
+  (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
+    (if func
+	(funcall func cont)
+      (error "Cannot find sign function"))))
+
+(provide 'mml1991)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; mml1991.el ends here
diff --git a/lisp/mml2015.el b/lisp/mml2015.el
new file mode 100644
index 0000000..ef2fe9f
--- /dev/null
+++ b/lisp/mml2015.el
@@ -0,0 +1,921 @@
+;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: PGP MIME MML
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; RFC 2015 is updated by RFC 3156, this file should be compatible
+;; with both.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
+(require 'mm-decode)
+(require 'mm-util)
+
+(defvar mml2015-use (or
+		     (progn
+		       (ignore-errors
+			 (require 'pgg))
+		       (and (fboundp 'pgg-sign-region)
+			    'pgg))
+		     (progn
+		       (ignore-errors
+			 (require 'gpg))
+		       (and (fboundp 'gpg-sign-detached)
+			    'gpg))
+		     (progn (ignore-errors
+			      (load "mc-toplev"))
+			    (and (fboundp 'mc-encrypt-generic)
+				 (fboundp 'mc-sign-generic)
+				 (fboundp 'mc-cleanup-recipient-headers)
+				 'mailcrypt)))
+  "The package used for PGP/MIME.")
+
+;; Something is not RFC2015.
+(defvar mml2015-function-alist
+  '((mailcrypt mml2015-mailcrypt-sign
+	       mml2015-mailcrypt-encrypt
+	       mml2015-mailcrypt-verify
+	       mml2015-mailcrypt-decrypt
+	       mml2015-mailcrypt-clear-verify
+	       mml2015-mailcrypt-clear-decrypt)
+    (gpg mml2015-gpg-sign
+	 mml2015-gpg-encrypt
+	 mml2015-gpg-verify
+	 mml2015-gpg-decrypt
+	 mml2015-gpg-clear-verify
+	 mml2015-gpg-clear-decrypt)
+  (pgg mml2015-pgg-sign
+       mml2015-pgg-encrypt
+       mml2015-pgg-verify
+       mml2015-pgg-decrypt
+       mml2015-pgg-clear-verify
+       mml2015-pgg-clear-decrypt))
+  "Alist of PGP/MIME functions.")
+
+(defvar mml2015-result-buffer nil)
+
+(defcustom mml2015-unabbrev-trust-alist
+  '(("TRUST_UNDEFINED" . nil)
+    ("TRUST_NEVER"     . nil)
+    ("TRUST_MARGINAL"  . t)
+    ("TRUST_FULLY"     . t)
+    ("TRUST_ULTIMATE"  . t))
+  "Map GnuPG trust output values to a boolean saying if you trust the key."
+  :type '(repeat (cons (regexp :tag "GnuPG output regexp")
+		       (boolean :tag "Trust key"))))
+
+;;; mailcrypt wrapper
+
+(eval-and-compile
+  (autoload 'mailcrypt-decrypt "mailcrypt")
+  (autoload 'mailcrypt-verify "mailcrypt")
+  (autoload 'mc-pgp-always-sign "mailcrypt")
+  (autoload 'mc-encrypt-generic "mc-toplev")
+  (autoload 'mc-cleanup-recipient-headers "mc-toplev")
+  (autoload 'mc-sign-generic "mc-toplev"))
+
+(eval-when-compile
+  (defvar mc-default-scheme)
+  (defvar mc-schemes))
+
+(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
+(defvar mml2015-verify-function 'mailcrypt-verify)
+
+(defun mml2015-format-error (err)
+  (if (stringp (cadr err))
+      (cadr err)
+    (format "%S" (cdr err))))
+
+(defun mml2015-mailcrypt-decrypt (handle ctl)
+  (catch 'error
+    (let (child handles result)
+      (unless (setq child (mm-find-part-by-type
+			   (cdr handle)
+			   "application/octet-stream" nil t))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
+      (with-temp-buffer
+	(mm-insert-part child)
+	(setq result
+	      (condition-case err
+		  (funcall mml2015-decrypt-function)
+		(error
+		 (mm-set-handle-multipart-parameter
+		  mm-security-handle 'gnus-details (mml2015-format-error err))
+		 nil)
+		(quit
+		 (mm-set-handle-multipart-parameter
+		  mm-security-handle 'gnus-details "Quit.")
+		 nil)))
+	(unless (car result)
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-info "Failed")
+	  (throw 'error handle))
+	(setq handles (mm-dissect-buffer t)))
+      (mm-destroy-parts handle)
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info
+       (concat "OK"
+	       (let ((sig (with-current-buffer mml2015-result-buffer
+			    (mml2015-gpg-extract-signature-details))))
+		 (concat ", Signer: " sig))))
+      (if (listp (car handles))
+	  handles
+	(list handles)))))
+
+(defun mml2015-mailcrypt-clear-decrypt ()
+  (let (result)
+    (setq result
+	  (condition-case err
+	      (funcall mml2015-decrypt-function)
+	    (error
+	     (mm-set-handle-multipart-parameter
+	      mm-security-handle 'gnus-details (mml2015-format-error err))
+	     nil)
+	    (quit
+	     (mm-set-handle-multipart-parameter
+	      mm-security-handle 'gnus-details "Quit.")
+	     nil)))
+    (if (car result)
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "OK")
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-fix-micalg (alg)
+  (and alg
+       ;; Mutt/1.2.5i has seen sending micalg=php-sha1
+       (upcase (if (string-match "^p[gh]p-" alg)
+		   (substring alg (match-end 0))
+		 alg))))
+
+(defun mml2015-mailcrypt-verify (handle ctl)
+  (catch 'error
+    (let (part)
+      (unless (setq part (mm-find-raw-part-by-type
+			  ctl (or (mm-handle-multipart-ctl-parameter
+				   ctl 'protocol)
+				  "application/pgp-signature")
+			  t))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
+      (with-temp-buffer
+	(insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
+	(insert (format "Hash: %s\n\n"
+			(or (mml2015-fix-micalg
+			     (mm-handle-multipart-ctl-parameter
+			      ctl 'micalg))
+			    "SHA1")))
+	(save-restriction
+	  (narrow-to-region (point) (point))
+	  (insert part "\n")
+	  (goto-char (point-min))
+	  (while (not (eobp))
+	    (if (looking-at "^-")
+		(insert "- "))
+	    (forward-line)))
+	(unless (setq part (mm-find-part-by-type
+			    (cdr handle) "application/pgp-signature" nil t))
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-info "Corrupted")
+	  (throw 'error handle))
+	(save-restriction
+	  (narrow-to-region (point) (point))
+	  (mm-insert-part part)
+	  (goto-char (point-min))
+	  (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
+	      (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
+	  (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
+	      (replace-match "-----END PGP SIGNATURE-----" t t)))
+	(let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+	  (unless (condition-case err
+		      (prog1
+			  (funcall mml2015-verify-function)
+			(if (get-buffer " *mailcrypt stderr temp")
+			    (mm-set-handle-multipart-parameter
+			     mm-security-handle 'gnus-details
+			     (with-current-buffer " *mailcrypt stderr temp"
+			       (buffer-string))))
+			(if (get-buffer " *mailcrypt stdout temp")
+			    (kill-buffer " *mailcrypt stdout temp"))
+			(if (get-buffer " *mailcrypt stderr temp")
+			    (kill-buffer " *mailcrypt stderr temp"))
+			(if (get-buffer " *mailcrypt status temp")
+			    (kill-buffer " *mailcrypt status temp"))
+			(if (get-buffer mc-gpg-debug-buffer)
+			    (kill-buffer mc-gpg-debug-buffer)))
+		    (error
+		     (mm-set-handle-multipart-parameter
+		      mm-security-handle 'gnus-details (mml2015-format-error err))
+		     nil)
+		    (quit
+		     (mm-set-handle-multipart-parameter
+		      mm-security-handle 'gnus-details "Quit.")
+		     nil))
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-info "Failed")
+	    (throw 'error handle))))
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info "OK")
+      handle)))
+
+(defun mml2015-mailcrypt-clear-verify ()
+  (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+    (if (condition-case err
+	    (prog1
+		(funcall mml2015-verify-function)
+	      (if (get-buffer " *mailcrypt stderr temp")
+		  (mm-set-handle-multipart-parameter
+		   mm-security-handle 'gnus-details
+		   (with-current-buffer " *mailcrypt stderr temp"
+		     (buffer-string))))
+	      (if (get-buffer " *mailcrypt stdout temp")
+		  (kill-buffer " *mailcrypt stdout temp"))
+	      (if (get-buffer " *mailcrypt stderr temp")
+		  (kill-buffer " *mailcrypt stderr temp"))
+	      (if (get-buffer " *mailcrypt status temp")
+		  (kill-buffer " *mailcrypt status temp"))
+	      (if (get-buffer mc-gpg-debug-buffer)
+		  (kill-buffer mc-gpg-debug-buffer)))
+	  (error
+	   (mm-set-handle-multipart-parameter
+	    mm-security-handle 'gnus-details (mml2015-format-error err))
+	   nil)
+	  (quit
+	   (mm-set-handle-multipart-parameter
+	    mm-security-handle 'gnus-details "Quit.")
+	   nil))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "OK")
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-mailcrypt-sign (cont)
+  (mc-sign-generic (message-options-get 'message-sender)
+		   nil nil nil nil)
+  (let ((boundary
+	 (funcall mml-boundary-function (incf mml-multipart-number)))
+	hash point)
+    (goto-char (point-min))
+    (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
+      (error "Cannot find signed begin line"))
+    (goto-char (match-beginning 0))
+    (forward-line 1)
+    (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
+      (error "Cannot not find PGP hash"))
+    (setq hash (match-string 1))
+    (unless (re-search-forward "^$" nil t)
+      (error "Cannot not find PGP message"))
+    (forward-line 1)
+    (delete-region (point-min) (point))
+    (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+		    boundary))
+    (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
+		    (downcase hash)))
+    (insert (format "\n--%s\n" boundary))
+    (setq point (point))
+    (goto-char (point-max))
+    (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
+      (error "Cannot find signature part"))
+    (replace-match "-----END PGP MESSAGE-----" t t)
+    (goto-char (match-beginning 0))
+    (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
+				nil t)
+      (error "Cannot find signature part"))
+    (replace-match "-----BEGIN PGP MESSAGE-----" t t)
+    (goto-char (match-beginning 0))
+    (save-restriction
+      (narrow-to-region point (point))
+      (goto-char point)
+      (while (re-search-forward "^- -" nil t)
+	(replace-match "-" t t))
+      (goto-char (point-max)))
+    (insert (format "--%s\n" boundary))
+    (insert "Content-Type: application/pgp-signature\n\n")
+    (goto-char (point-max))
+    (insert (format "--%s--\n" boundary))
+    (goto-char (point-max))))
+
+(defun mml2015-mailcrypt-encrypt (cont &optional sign)
+  (let ((mc-pgp-always-sign
+	 (or mc-pgp-always-sign
+	     sign
+	     (eq t (or (message-options-get 'message-sign-encrypt)
+		       (message-options-set
+			'message-sign-encrypt
+			(or (y-or-n-p "Sign the message? ")
+			    'not))))
+	     'never)))
+    (mm-with-unibyte-current-buffer-mule4
+      (mc-encrypt-generic
+       (or (message-options-get 'message-recipients)
+	   (message-options-set 'message-recipients
+				(mc-cleanup-recipient-headers
+				 (read-string "Recipients: "))))
+       nil nil nil
+       (message-options-get 'message-sender))))
+  (goto-char (point-min))
+  (unless (looking-at "-----BEGIN PGP MESSAGE-----")
+    (error "Fail to encrypt the message"))
+  (let ((boundary
+	 (funcall mml-boundary-function (incf mml-multipart-number))))
+    (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+		    boundary))
+    (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+    (insert (format "--%s\n" boundary))
+    (insert "Content-Type: application/pgp-encrypted\n\n")
+    (insert "Version: 1\n\n")
+    (insert (format "--%s\n" boundary))
+    (insert "Content-Type: application/octet-stream\n\n")
+    (goto-char (point-max))
+    (insert (format "--%s--\n" boundary))
+    (goto-char (point-max))))
+
+;;; gpg wrapper
+
+(eval-and-compile
+  (autoload 'gpg-decrypt "gpg")
+  (autoload 'gpg-verify "gpg")
+  (autoload 'gpg-verify-cleartext "gpg")
+  (autoload 'gpg-sign-detached "gpg")
+  (autoload 'gpg-sign-encrypt "gpg")
+  (autoload 'gpg-encrypt "gpg")
+  (autoload 'gpg-passphrase-read "gpg"))
+
+(defun mml2015-gpg-passphrase ()
+  (or (message-options-get 'gpg-passphrase)
+      (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
+
+(defun mml2015-gpg-decrypt-1 ()
+  (let ((cipher (current-buffer)) plain result)
+    (if (with-temp-buffer
+	  (prog1
+	      (gpg-decrypt cipher (setq plain (current-buffer))
+			   mml2015-result-buffer nil)
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-details
+	     (with-current-buffer mml2015-result-buffer
+	       (buffer-string)))
+	    (set-buffer cipher)
+	    (erase-buffer)
+	    (insert-buffer-substring plain)
+	    (goto-char (point-min))
+	    (while (search-forward "\r\n" nil t)
+	      (replace-match "\n" t t))))
+	'(t)
+      ;; Some wrong with the return value, check plain text buffer.
+      (if (> (point-max) (point-min))
+	  '(t)
+	nil))))
+
+(defun mml2015-gpg-decrypt (handle ctl)
+  (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
+    (mml2015-mailcrypt-decrypt handle ctl)))
+
+(defun mml2015-gpg-clear-decrypt ()
+  (let (result)
+    (setq result (mml2015-gpg-decrypt-1))
+    (if (car result)
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "OK")
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-gpg-pretty-print-fpr (fingerprint)
+  (let* ((result "")
+	 (fpr-length (string-width fingerprint))
+	 (n-slice 0)
+	 slice)
+    (setq fingerprint (string-to-list fingerprint))
+    (while fingerprint
+      (setq fpr-length (- fpr-length 4))
+      (setq slice (butlast fingerprint fpr-length))
+      (setq fingerprint (nthcdr 4 fingerprint))
+      (setq n-slice (1+ n-slice))
+      (setq result
+	    (concat
+	     result
+	     (case n-slice
+	       (1  slice)
+	       (otherwise (concat " " slice))))))
+    result))
+
+(defun mml2015-gpg-extract-signature-details ()
+  (goto-char (point-min))
+  (let* ((expired (re-search-forward
+		   "^\\[GNUPG:\\] SIGEXPIRED$"
+		   nil t))
+	 (signer (and (re-search-forward
+		       "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
+		       nil t)
+		      (cons (match-string 1) (match-string 2))))
+	 (fprint (and (re-search-forward
+		       "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
+		       nil t)
+		      (match-string 1)))
+	 (trust  (and (re-search-forward
+		       "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
+		       nil t)
+		      (match-string 1)))
+	 (trust-good-enough-p
+	  (cdr (assoc trust mml2015-unabbrev-trust-alist))))
+    (cond ((and signer fprint)
+	   (concat (cdr signer)
+		   (unless trust-good-enough-p
+		     (concat "\nUntrusted, Fingerprint: "
+			     (mml2015-gpg-pretty-print-fpr fprint)))
+		   (when expired
+		     (format "\nWARNING: Signature from expired key (%s)"
+			     (car signer)))))
+	  ((re-search-forward
+	    "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
+	   (match-string 2))
+	  (t
+	   "From unknown user"))))
+
+(defun mml2015-gpg-verify (handle ctl)
+  (catch 'error
+    (let (part message signature info-is-set-p)
+      (unless (setq part (mm-find-raw-part-by-type
+			  ctl (or (mm-handle-multipart-ctl-parameter
+				   ctl 'protocol)
+				  "application/pgp-signature")
+			  t))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
+      (with-temp-buffer
+	(setq message (current-buffer))
+	(insert part)
+	;; Convert <LF> to <CR><LF> in verify mode.  Sign and
+	;; clearsign use --textmode. The conversion is not necessary.
+	;; In clearverify, the conversion is not necessary either.
+	(goto-char (point-min))
+	(end-of-line)
+	(while (not (eobp))
+	  (unless (eq (char-before) ?\r)
+	    (insert "\r"))
+	  (forward-line)
+	  (end-of-line))
+	(with-temp-buffer
+	  (setq signature (current-buffer))
+	  (unless (setq part (mm-find-part-by-type
+			      (cdr handle) "application/pgp-signature" nil t))
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-info "Corrupted")
+	    (throw 'error handle))
+	  (mm-insert-part part)
+	  (unless (condition-case err
+		      (prog1
+			  (gpg-verify message signature mml2015-result-buffer)
+			(mm-set-handle-multipart-parameter
+			 mm-security-handle 'gnus-details
+			 (with-current-buffer mml2015-result-buffer
+			   (buffer-string))))
+		    (error
+		     (mm-set-handle-multipart-parameter
+		      mm-security-handle 'gnus-details (mml2015-format-error err))
+		     (mm-set-handle-multipart-parameter
+		      mm-security-handle 'gnus-info "Error.")
+		     (setq info-is-set-p t)
+		     nil)
+		    (quit
+		     (mm-set-handle-multipart-parameter
+		      mm-security-handle 'gnus-details "Quit.")
+		     (mm-set-handle-multipart-parameter
+		      mm-security-handle 'gnus-info "Quit.")
+		     (setq info-is-set-p t)
+		     nil))
+	    (unless info-is-set-p
+	      (mm-set-handle-multipart-parameter
+	       mm-security-handle 'gnus-info "Failed"))
+	    (throw 'error handle)))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info
+	 (with-current-buffer mml2015-result-buffer
+	   (mml2015-gpg-extract-signature-details))))
+      handle)))
+
+(defun mml2015-gpg-clear-verify ()
+  (if (condition-case err
+	  (prog1
+	      (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
+	    (mm-set-handle-multipart-parameter
+	     mm-security-handle 'gnus-details
+	     (with-current-buffer mml2015-result-buffer
+	       (buffer-string))))
+	(error
+	 (mm-set-handle-multipart-parameter
+	  mm-security-handle 'gnus-details (mml2015-format-error err))
+	 nil)
+	(quit
+	 (mm-set-handle-multipart-parameter
+	  mm-security-handle 'gnus-details "Quit.")
+	 nil))
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info
+       (with-current-buffer mml2015-result-buffer
+	 (mml2015-gpg-extract-signature-details)))
+    (mm-set-handle-multipart-parameter
+     mm-security-handle 'gnus-info "Failed")))
+
+(defun mml2015-gpg-sign (cont)
+  (let ((boundary
+	 (funcall mml-boundary-function (incf mml-multipart-number)))
+	(text (current-buffer)) signature)
+    (goto-char (point-max))
+    (unless (bolp)
+      (insert "\n"))
+    (with-temp-buffer
+      (unless (gpg-sign-detached text (setq signature (current-buffer))
+				 mml2015-result-buffer
+				 nil
+				 (message-options-get 'message-sender)
+				 t t) ; armor & textmode
+	(unless (> (point-max) (point-min))
+	  (pop-to-buffer mml2015-result-buffer)
+	  (error "Sign error")))
+      (goto-char (point-min))
+      (while (re-search-forward "\r+$" nil t)
+	(replace-match "" t t))
+      (set-buffer text)
+      (goto-char (point-min))
+      (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+		      boundary))
+      ;;; FIXME: what is the micalg?
+      (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
+      (insert (format "\n--%s\n" boundary))
+      (goto-char (point-max))
+      (insert (format "\n--%s\n" boundary))
+      (insert "Content-Type: application/pgp-signature\n\n")
+      (insert-buffer-substring signature)
+      (goto-char (point-max))
+      (insert (format "--%s--\n" boundary))
+      (goto-char (point-max)))))
+
+(defun mml2015-gpg-encrypt (cont &optional sign)
+  (let ((boundary
+	 (funcall mml-boundary-function (incf mml-multipart-number)))
+	(text (current-buffer))
+	cipher)
+    (mm-with-unibyte-current-buffer-mule4
+      (with-temp-buffer
+	;; set up a function to call the correct gpg encrypt routine
+	;; with the right arguments. (FIXME: this should be done
+	;; differently.)
+	(flet ((gpg-encrypt-func
+		 (sign plaintext ciphertext result recipients &optional
+		       passphrase sign-with-key armor textmode)
+		 (if sign
+		     (gpg-sign-encrypt
+		      plaintext ciphertext result recipients passphrase
+		      sign-with-key armor textmode)
+		   (gpg-encrypt
+		    plaintext ciphertext result recipients passphrase
+		    armor textmode))))
+	  (unless (gpg-encrypt-func
+		    sign ; passed in when using signencrypt
+		    text (setq cipher (current-buffer))
+		    mml2015-result-buffer
+		    (split-string
+		     (or
+		      (message-options-get 'message-recipients)
+		      (message-options-set 'message-recipients
+					   (read-string "Recipients: ")))
+		     "[ \f\t\n\r\v,]+")
+		    nil
+		    (message-options-get 'message-sender)
+		    t t) ; armor & textmode
+	    (unless (> (point-max) (point-min))
+	      (pop-to-buffer mml2015-result-buffer)
+	      (error "Encrypt error"))))
+	(goto-char (point-min))
+	(while (re-search-forward "\r+$" nil t)
+	  (replace-match "" t t))
+	(set-buffer text)
+	(delete-region (point-min) (point-max))
+	(insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+			boundary))
+	(insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+	(insert (format "--%s\n" boundary))
+	(insert "Content-Type: application/pgp-encrypted\n\n")
+	(insert "Version: 1\n\n")
+	(insert (format "--%s\n" boundary))
+	(insert "Content-Type: application/octet-stream\n\n")
+	(insert-buffer-substring cipher)
+	(goto-char (point-max))
+	(insert (format "--%s--\n" boundary))
+	(goto-char (point-max))))))
+
+;;; pgg wrapper
+
+(eval-when-compile
+  (defvar pgg-errors-buffer)
+  (defvar pgg-output-buffer))
+
+(eval-and-compile
+  (autoload 'pgg-decrypt-region "pgg")
+  (autoload 'pgg-verify-region "pgg")
+  (autoload 'pgg-sign-region "pgg")
+  (autoload 'pgg-encrypt-region "pgg"))
+
+(defun mml2015-pgg-decrypt (handle ctl)
+  (catch 'error
+    (let ((pgg-errors-buffer mml2015-result-buffer)
+	  child handles result decrypt-status)
+      (unless (setq child (mm-find-part-by-type
+			   (cdr handle)
+			   "application/octet-stream" nil t))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
+      (with-temp-buffer
+	(mm-insert-part child)
+	(if (condition-case err
+		(prog1
+		    (pgg-decrypt-region (point-min) (point-max))
+		  (setq decrypt-status
+			(with-current-buffer mml2015-result-buffer
+			  (buffer-string)))
+		  (mm-set-handle-multipart-parameter
+		   mm-security-handle 'gnus-details
+		   decrypt-status))
+	      (error
+	       (mm-set-handle-multipart-parameter
+		mm-security-handle 'gnus-details (mml2015-format-error err))
+	       nil)
+	      (quit
+	       (mm-set-handle-multipart-parameter
+		mm-security-handle 'gnus-details "Quit.")
+	       nil))
+	    (with-current-buffer pgg-output-buffer
+	      (goto-char (point-min))
+	      (while (search-forward "\r\n" nil t)
+		(replace-match "\n" t t))
+	      (setq handles (mm-dissect-buffer t))
+	      (mm-destroy-parts handle)
+	      (mm-set-handle-multipart-parameter
+	       mm-security-handle 'gnus-info "OK")
+	      (mm-set-handle-multipart-parameter
+	       mm-security-handle 'gnus-details
+	       (concat decrypt-status
+		       (when (stringp (car handles))
+			 "\n" (mm-handle-multipart-ctl-parameter
+			       handles 'gnus-details))))
+	      (if (listp (car handles))
+		  handles
+		(list handles)))
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-info "Failed")
+	  (throw 'error handle))))))
+
+(defun mml2015-pgg-clear-decrypt ()
+  (let ((pgg-errors-buffer mml2015-result-buffer))
+    (if (prog1
+	    (pgg-decrypt-region (point-min) (point-max))
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-details
+	   (with-current-buffer mml2015-result-buffer
+	     (buffer-string))))
+	(progn
+	  (erase-buffer)
+	  (insert-buffer-substring pgg-output-buffer)
+	  (goto-char (point-min))
+	  (while (search-forward "\r\n" nil t)
+	    (replace-match "\n" t t))
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-info "OK"))
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-pgg-verify (handle ctl)
+  (let ((pgg-errors-buffer mml2015-result-buffer)
+	signature-file part signature)
+    (if (or (null (setq part (mm-find-raw-part-by-type
+			      ctl (or (mm-handle-multipart-ctl-parameter
+				       ctl 'protocol)
+				      "application/pgp-signature")
+			      t)))
+	    (null (setq signature (mm-find-part-by-type
+				   (cdr handle) "application/pgp-signature" nil t))))
+	(progn
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-info "Corrupted")
+	  handle)
+      (with-temp-buffer
+	(insert part)
+	;; Convert <LF> to <CR><LF> in verify mode.  Sign and
+	;; clearsign use --textmode. The conversion is not necessary.
+	;; In clearverify, the conversion is not necessary either.
+	(goto-char (point-min))
+	(end-of-line)
+	(while (not (eobp))
+	  (unless (eq (char-before) ?\r)
+	    (insert "\r"))
+	  (forward-line)
+	  (end-of-line))
+	(with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
+	  (mm-insert-part signature))
+	(if (condition-case err
+		(prog1
+		    (pgg-verify-region (point-min) (point-max)
+				       signature-file t)
+		  (goto-char (point-min))
+		  (while (search-forward "\r\n" nil t)
+		    (replace-match "\n" t t))
+		  (mm-set-handle-multipart-parameter
+		   mm-security-handle 'gnus-details
+		   (concat (with-current-buffer pgg-output-buffer
+			     (buffer-string))
+			   (with-current-buffer pgg-errors-buffer
+			     (buffer-string)))))
+	      (error
+	       (mm-set-handle-multipart-parameter
+		mm-security-handle 'gnus-details (mml2015-format-error err))
+	       nil)
+	      (quit
+	       (mm-set-handle-multipart-parameter
+		mm-security-handle 'gnus-details "Quit.")
+	       nil))
+	    (progn
+	      (delete-file signature-file)
+	      (mm-set-handle-multipart-parameter
+	       mm-security-handle 'gnus-info
+	       (with-current-buffer pgg-errors-buffer
+		 (mml2015-gpg-extract-signature-details))))
+	  (delete-file signature-file)
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-info "Failed")))))
+  handle)
+
+(defun mml2015-pgg-clear-verify ()
+  (let ((pgg-errors-buffer mml2015-result-buffer)
+	(text (buffer-string))
+	(coding-system buffer-file-coding-system))
+    (if (condition-case err
+	    (prog1
+		(mm-with-unibyte-buffer
+		  (insert (encode-coding-string text coding-system))
+		  (pgg-verify-region (point-min) (point-max) nil t))
+	      (goto-char (point-min))
+	      (while (search-forward "\r\n" nil t)
+		(replace-match "\n" t t))
+	      (mm-set-handle-multipart-parameter
+	       mm-security-handle 'gnus-details
+	       (concat (with-current-buffer pgg-output-buffer
+			 (buffer-string))
+		       (with-current-buffer pgg-errors-buffer
+			 (buffer-string)))))
+	  (error
+	   (mm-set-handle-multipart-parameter
+	    mm-security-handle 'gnus-details (mml2015-format-error err))
+	   nil)
+	  (quit
+	   (mm-set-handle-multipart-parameter
+	    mm-security-handle 'gnus-details "Quit.")
+	   nil))
+	(mm-set-handle-multipart-parameter
+	 mm-security-handle 'gnus-info
+	 (with-current-buffer pgg-errors-buffer
+	   (mml2015-gpg-extract-signature-details)))
+      (mm-set-handle-multipart-parameter
+       mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-pgg-sign (cont)
+  (let ((pgg-errors-buffer mml2015-result-buffer)
+	(boundary (funcall mml-boundary-function (incf mml-multipart-number)))
+	(pgg-default-user-id (or (message-options-get 'mml-sender)
+				 pgg-default-user-id)))
+    (unless (pgg-sign-region (point-min) (point-max))
+      (pop-to-buffer mml2015-result-buffer)
+      (error "Sign error"))
+    (goto-char (point-min))
+    (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+		    boundary))
+      ;;; FIXME: what is the micalg?
+    (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
+    (insert (format "\n--%s\n" boundary))
+    (goto-char (point-max))
+    (insert (format "\n--%s\n" boundary))
+    (insert "Content-Type: application/pgp-signature\n\n")
+    (insert-buffer-substring pgg-output-buffer)
+    (goto-char (point-max))
+    (insert (format "--%s--\n" boundary))
+    (goto-char (point-max))))
+
+(defun mml2015-pgg-encrypt (cont &optional sign)
+  (let ((pgg-errors-buffer mml2015-result-buffer)
+	(boundary (funcall mml-boundary-function (incf mml-multipart-number))))
+    (unless (pgg-encrypt-region (point-min) (point-max)
+				(split-string
+				 (or
+				  (message-options-get 'message-recipients)
+				  (message-options-set 'message-recipients
+						       (read-string "Recipients: ")))
+				 "[ \f\t\n\r\v,]+")
+				sign)
+      (pop-to-buffer mml2015-result-buffer)
+      (error "Encrypt error"))
+    (delete-region (point-min) (point-max))
+    (goto-char (point-min))
+    (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+		    boundary))
+    (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+    (insert (format "--%s\n" boundary))
+    (insert "Content-Type: application/pgp-encrypted\n\n")
+    (insert "Version: 1\n\n")
+    (insert (format "--%s\n" boundary))
+    (insert "Content-Type: application/octet-stream\n\n")
+    (insert-buffer-substring pgg-output-buffer)
+    (goto-char (point-max))
+    (insert (format "--%s--\n" boundary))
+    (goto-char (point-max))))
+
+;;; General wrapper
+
+(defun mml2015-clean-buffer ()
+  (if (gnus-buffer-live-p mml2015-result-buffer)
+      (with-current-buffer mml2015-result-buffer
+	(erase-buffer)
+	t)
+    (setq mml2015-result-buffer
+	  (gnus-get-buffer-create "*MML2015 Result*"))
+    nil))
+
+(defsubst mml2015-clear-decrypt-function ()
+  (nth 6 (assq mml2015-use mml2015-function-alist)))
+
+(defsubst mml2015-clear-verify-function ()
+  (nth 5 (assq mml2015-use mml2015-function-alist)))
+
+;;;###autoload
+(defun mml2015-decrypt (handle ctl)
+  (mml2015-clean-buffer)
+  (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
+    (if func
+	(funcall func handle ctl)
+      handle)))
+
+;;;###autoload
+(defun mml2015-decrypt-test (handle ctl)
+  mml2015-use)
+
+;;;###autoload
+(defun mml2015-verify (handle ctl)
+  (mml2015-clean-buffer)
+  (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
+    (if func
+	(funcall func handle ctl)
+      handle)))
+
+;;;###autoload
+(defun mml2015-verify-test (handle ctl)
+  mml2015-use)
+
+;;;###autoload
+(defun mml2015-encrypt (cont &optional sign)
+  (mml2015-clean-buffer)
+  (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
+    (if func
+	(funcall func cont sign)
+      (error "Cannot find encrypt function"))))
+
+;;;###autoload
+(defun mml2015-sign (cont)
+  (mml2015-clean-buffer)
+  (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
+    (if func
+	(funcall func cont)
+      (error "Cannot find sign function"))))
+
+;;;###autoload
+(defun mml2015-self-encrypt ()
+  (mml2015-encrypt nil))
+
+(provide 'mml2015)
+
+;;; mml2015.el ends here
diff --git a/lisp/netrc.el b/lisp/netrc.el
new file mode 100644
index 0000000..3bfc76d
--- /dev/null
+++ b/lisp/netrc.el
@@ -0,0 +1,128 @@
+;;; netrc.el --- .netrc parsing functionality
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;;        Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Modularizer: Ted Zlatanov <tzz@lifelogs.com>
+;; Keywords: news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Just the .netrc parsing functionality, abstracted so other packages
+;; besides Gnus can use it.
+
+;;; Code:
+
+;;;
+;;; .netrc and .authinforc parsing
+;;;
+
+(eval-and-compile
+  (defalias 'netrc-point-at-eol
+    (if (fboundp 'point-at-eol)
+	'point-at-eol
+      'line-end-position)))
+
+(defun netrc-parse (file)
+  "Parse FILE and return an list of all entries in the file."
+  (when (file-exists-p file)
+    (with-temp-buffer
+      (let ((tokens '("machine" "default" "login"
+		      "password" "account" "macdef" "force"
+		      "port"))
+	    alist elem result pair)
+	(insert-file-contents file)
+	(goto-char (point-min))
+	;; Go through the file, line by line.
+	(while (not (eobp))
+	  (narrow-to-region (point) (netrc-point-at-eol))
+	  ;; For each line, get the tokens and values.
+	  (while (not (eobp))
+	    (skip-chars-forward "\t ")
+	    ;; Skip lines that begin with a "#".
+	    (if (eq (char-after) ?#)
+		(goto-char (point-max))
+	      (unless (eobp)
+		(setq elem
+		      (if (= (following-char) ?\")
+			  (read (current-buffer))
+			(buffer-substring
+			 (point) (progn (skip-chars-forward "^\t ")
+					(point)))))
+		(cond
+		 ((equal elem "macdef")
+		  ;; We skip past the macro definition.
+		  (widen)
+		  (while (and (zerop (forward-line 1))
+			      (looking-at "$")))
+		  (narrow-to-region (point) (point)))
+		 ((member elem tokens)
+		  ;; Tokens that don't have a following value are ignored,
+		  ;; except "default".
+		  (when (and pair (or (cdr pair)
+				      (equal (car pair) "default")))
+		    (push pair alist))
+		  (setq pair (list elem)))
+		 (t
+		  ;; Values that haven't got a preceding token are ignored.
+		  (when pair
+		    (setcdr pair elem)
+		    (push pair alist)
+		    (setq pair nil)))))))
+	  (when alist
+	    (push (nreverse alist) result))
+	  (setq alist nil
+		pair nil)
+	  (widen)
+	  (forward-line 1))
+	(nreverse result)))))
+
+(defun netrc-machine (list machine &optional port defaultport)
+  "Return the netrc values from LIST for MACHINE or for the default entry.
+If PORT specified, only return entries with matching port tokens.
+Entries without port tokens default to DEFAULTPORT."
+  (let ((rest list)
+	result)
+    (while list
+      (when (equal (cdr (assoc "machine" (car list))) machine)
+	(push (car list) result))
+      (pop list))
+    (unless result
+      ;; No machine name matches, so we look for default entries.
+      (while rest
+	(when (assoc "default" (car rest))
+	  (push (car rest) result))
+	(pop rest)))
+    (when result
+      (setq result (nreverse result))
+      (while (and result
+		  (not (equal (or port defaultport "nntp")
+			      (or (netrc-get (car result) "port")
+				  defaultport "nntp"))))
+	(pop result))
+      (car result))))
+
+(defun netrc-get (alist type)
+  "Return the value of token TYPE from ALIST."
+  (cdr (assoc type alist)))
+
+(provide 'netrc)
+
+;;; netrc.el ends here
diff --git a/lisp/nndiary.el b/lisp/nndiary.el
new file mode 100644
index 0000000..42cb838
--- /dev/null
+++ b/lisp/nndiary.el
@@ -0,0 +1,1709 @@
+;;; nndiary.el --- A diary backend for Gnus
+
+;; Copyright (C) 1999, 2000, 2001, 2003
+;;        Free Software Foundation, Inc.
+
+;; Author:        Didier Verna <didier@xemacs.org>
+;; Maintainer:    Didier Verna <didier@xemacs.org>
+;; Created:       Fri Jul 16 18:55:42 1999
+;; Keywords:      calendar mail news
+
+;; 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 of the License, 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+;; Description:
+;; ===========
+
+;; This package implements NNDiary, a diary backend for Gnus.  NNDiary is a
+;; mail backend, pretty similar to nnml in its functionnning (it has all the
+;; features of nnml, actually), but in which messages are treated as event
+;; reminders.
+
+;; Here is a typical scenario:
+;; - You've got a date with Andy Mc Dowell or Bruce Willis (select according
+;;   to your sexual preference) in one month.  You don't want to forget it.
+;; - Send a (special) diary message to yourself (see below).
+;; - Forget all about it and keep on getting and reading new mail, as usual.
+;; - From time to time, as you type `g' in the group buffer and as the date
+;;   is getting closer, the message will pop up again, just like if it were
+;;   new and unread.
+;; - Read your "new" messages, this one included, and start dreaming of the
+;;   night you're gonna have.
+;; - Once the date is over (you actually fell asleep just after dinner), the
+;;   message will be automatically deleted if it is marked as expirable.
+
+;; Some more notes on the diary backend:
+;; - NNDiary is a *real* mail backend.  You *really* send real diary
+;;   messsages.  This means for instance that you can give appointements to
+;;   anybody (provided they use Gnus and NNDiary) by sending the diary message
+;;   to them as well.
+;; - However, since NNDiary also has a 'request-post method, you can also
+;;  `C-u a' instead of `C-u m' on a diary group and the message won't actually
+;;   be sent; just stored in the group.
+;; - The events you want to remember need not be punctual.  You can set up
+;;   reminders for regular dates (like once each week, each monday at 13:30
+;;   and so on).  Diary messages of this kind will never be deleted (unless
+;;   you do it explicitely).  But that, you guessed.
+
+
+;; Usage:
+;; =====
+
+;;  1/ NNDiary has two modes of operation: traditional (the default) and
+;;     autonomous.
+;;     a/ In traditional mode, NNDiary does not get new mail by itself.  You
+;;        have to move mails from your primary mail backend to nndiary
+;;        groups.
+;;     b/ In autonomous mode, NNDiary retrieves its own mail and handles it
+;;        independantly of your primary mail backend.  To use NNDiary in
+;;        autonomous mode, you have several things to do:
+;;           i/ Put (setq nndiary-get-new-mail t) in your gnusrc file.
+;;          ii/ Diary messages contain several `X-Diary-*' special headers.
+;;              You *must* arrange that these messages be split in a private
+;;              folder *before* Gnus treat them.  You need this because Gnus
+;;              is not able yet to manage multiple backends for mail
+;;              retrieval.  Getting them from a separate source will
+;;              compensate this misfeature to some extent, as we will see.
+;;              As an example, here's my procmailrc entry to store diary files
+;;              in ~/.nndiary (the default nndiary mail source file):
+;;
+;;              :0 HD :
+;;              * ^X-Diary
+;;              .nndiary
+;;         iii/ Customize the variables `nndiary-mail-sources' and
+;;              `nndiary-split-methods'.  These are replacements for the usual
+;;              mail sources and split methods which, and will be used in
+;;              autonomous mode.  `nndiary-mail-sources' defaults to
+;;              '(file :path "~/.nndiary").
+;;  2/ Install nndiary somewhere Emacs / Gnus can find it.  Normally, you
+;;     *don't* have to '(require 'nndiary) anywhere.  Gnus will do so when
+;;     appropriate as long as nndiary is somewhere in the load path.
+;;  3/ Now, customize the rest of nndiary.  In particular, you should
+;;     customize `nndiary-reminders', the list of times when you want to be
+;;     reminded of your appointements (e.g. 3 weeks before, then 2 days
+;;     before, then 1 hour before and that's it).
+;;  4/ You *must* use the group timestamp feature of Gnus.  This adds a
+;;     timestamp to each groups' parameters (please refer to the Gnus
+;;     documentation ("Group Timestamp" info node) to see how it's done.
+;;  5/ Once you have done this, you may add a permanent nndiary virtual server
+;;     (something like '(nndiary "")) to your `gnus-secondary-select-methods'.
+;;     Yes, this server will be able to retrieve mails and split them when you
+;;     type `g' in the group buffer, just as if it were your only mail backend.
+;;     This is the benefit of using a private folder.
+;;  6/ Hopefully, almost everything (see the TODO section below) will work as
+;;     expected when you restart Gnus: in the group buffer, `g' and `M-g' will
+;;     also get your new diary mails, `F' will find your new diary groups etc.
+
+
+;; How to send diary messages:
+;; ==========================
+
+;; There are 7 special headers in diary messages. These headers are of the
+;; form `X-Diary-<something>', the <something> being one of `Minute', `Hour',
+;; `Dom', `Month', `Year', `Time-Zone' and `Dow'. `Dom' means "Day of Month",
+;; and `dow' means "Day of Week".  These headers actually behave like crontab
+;; specifications and define the event date(s).
+
+;; For all headers but the `Time-Zone' one, a header value is either a
+;; star (meaning all possible values), or a list of fields (separated by a
+;; comma).  A field is either an integer, or a range.  A range is two integers
+;; separated by a dash.  Possible integer values are 0-59 for `Minute', 0-23
+;; for `Hour', 1-31 for `Dom', `1-12' for Month, above 1971 for `Year' and 0-6
+;; for `Dow' (0 = sunday).  As a special case, a star in either `Dom' or `Dow'
+;; doesn't mean "all possible values", but "use only the other field".  Note
+;; that if both are star'ed, the use of either one gives the same result :-),
+
+;; The `Time-Zone' header is special in that it can have only one value (you
+;; bet ;-).
+;; A star doesn't mean "all possible values" (because it has no sense), but
+;; "the current local time zone".
+
+;; As an example, here's how you would say "Each Monday and each 1st of month,
+;; at 12:00, 20:00, 21:00, 22:00, 23:00 and 24:00, from 1999 to 2010" (I let
+;; you find what to do then):
+;;
+;;   X-Diary-Minute: 0
+;;   X-Diary-Hour: 12, 20-24
+;;   X-Diary-Dom: 1
+;;   X-Diary-Month: *
+;;   X-Diary-Year: 1999-2010
+;;   X-Diary-Dow: 1
+;;   X-Diary-Time-Zone: *
+;;
+;;
+;; Sending a diary message is not different from sending any other kind of
+;; mail, except that such messages are identified by the presence of these
+;; special headers.
+
+
+
+;; Bugs / Todo:
+;; ===========
+
+;; * Respooling doesn't work because contrary to the request-scan function,
+;;   Gnus won't allow me to override the split methods when calling the
+;;   respooling backend functions.
+;; * There's a bug in the time zone mechanism with variable TZ locations.
+;; * We could allow a keyword like `ask' in X-Diary-* headers, that would mean
+;;   "ask for value upon reception of the message".
+;; * We could add an optional header X-Diary-Reminders to specify a special
+;;   reminders value for this message. Suggested by Jody Klymak.
+;; * We should check messages validity in other circumstances than just
+;;   moving an article from sonwhere else (request-accept). For instance, when
+;;   editing / saving and so on.
+
+
+;; Remarks:
+;; =======
+
+;; * nnoo.
+;;   NNDiary is very similar to nnml.  This makes the idea of using nnoo (to
+;;   derive nndiary from nnml) natural.  However, my experience with nnoo is
+;;   that for reasonably complex backends like this one, noo is a burden
+;;   rather than an help.  It's tricky to use, not everything can be
+;;   inherited, what can be inherited and when is not very clear, and you've
+;;   got to be very careful because a little mistake can fuck up your your
+;;   other backends, especially because their variables will be use instead of
+;;   your real ones.  Finally, I found it easier to just clone the needed
+;;   parts of nnml, and tracking nnml updates is not a big deal.
+
+;;   IMHO, nnoo is actually badly designed.  A much simpler, and yet more
+;;   powerful one would be to make *real* functions and variables for a new
+;;   backend based on another. Lisp is a reflexive language so that's a very
+;;   easy thing to do: inspect the function's form, replace occurences of
+;;   <nnfrom> (even in strings) with <nnto>, and you're done.
+
+;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods:
+;;   NNDiary has some experimental parts, in the sense Gnus normally uses only
+;;   one mail backends for mail retreival and splitting.  This backend is also
+;;   an attempt to make it behave differently.  For Gnus developpers: as you
+;;   can see if you snarf into the code, that was not a very difficult thing
+;;   to do.  Something should be done about the respooling breakage though.
+
+
+;;; Code:
+
+(require 'nnoo)
+(require 'nnheader)
+(require 'nnmail)
+(eval-when-compile (require 'cl))
+
+(require 'gnus-start)
+(require 'gnus-sum)
+
+;; Compatibility Functions  =================================================
+
+(eval-and-compile
+  (if (fboundp 'signal-error)
+      (defun nndiary-error (&rest args)
+	(apply #'signal-error 'nndiary args))
+    (defun nndiary-error (&rest args)
+      (apply #'error args))))
+
+
+;; Backend behavior customization ===========================================
+
+(defgroup nndiary nil
+  "The Gnus Diary backend."
+  :group 'gnus-diary)
+
+(defcustom nndiary-mail-sources
+  `((file :path ,(expand-file-name "~/.nndiary")))
+  "*NNDiary specific mail sources.
+This variable is used by nndiary in place of the standard `mail-sources'
+variable when `nndiary-get-new-mail' is set to non-nil.  These sources
+must contain diary messages ONLY."
+  :group 'nndiary
+  :group 'mail-source
+  :type 'sexp)
+
+(defcustom nndiary-split-methods '(("diary" ""))
+  "*NNDiary specific split methods.
+This variable is used by nndiary in place of the standard
+`nnmail-split-methods' variable when `nndiary-get-new-mail' is set to
+non-nil."
+  :group 'nndiary
+  :group 'nnmail-split
+  :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
+		 (function-item nnmail-split-fancy)
+		 (function :tag "Other")))
+
+
+(defcustom nndiary-reminders '((0 . day))
+  "*Different times when you want to be reminded of your appointements.
+Diary articles will appear again, as if they'd been just received.
+
+Entries look like (3 . day) which means something like \"Please
+Hortense, would you be so kind as to remind me of my appointments 3 days
+before the date, thank you very much. Anda, hmmm... by the way, are you
+doing anything special tonight ?\".
+
+The units of measure are 'minute 'hour 'day 'week 'month and 'year (no,
+not 'century, sorry).
+
+NOTE: the units of measure actually express dates, not durations: if you
+use 'week, messages will pop up on Sundays at 00:00 (or Mondays if
+`nndiary-week-starts-on-monday' is non nil) and *not* 7 days before the
+appointement, if you use 'month, messages will pop up on the first day of
+each months, at 00:00 and so on.
+
+If you really want to specify a duration (like 24 hours exactly), you can
+use the equivalent in minutes (the smallest unit).  A fuzz of 60 seconds
+maximum in the reminder is not that painful, I think.  Although this
+scheme might appear somewhat weird at a first glance, it is very powerful.
+In order to make this clear, here are some examples:
+
+- '(0 . day): this is the default value of `nndiary-reminders'.  It means
+  pop up the appointements of the day each morning at 00:00.
+
+- '(1 . day): this means pop up the appointements the day before, at 00:00.
+
+- '(6 . hour): for an appointement at 18:30, this would pop up the
+  appointement message at 12:00.
+
+- '(360 . minute): for an appointement at 18:30 and 15 seconds, this would
+  pop up the appointement message at 12:30."
+  :group 'nndiary
+  :type '(repeat (cons :format "%v\n"
+		       (integer :format "%v")
+		       (choice :format "%[%v(s)%] before...\n"
+			       :value day
+			       (const :format "%v" minute)
+			       (const :format "%v" hour)
+			       (const :format "%v" day)
+			       (const :format "%v" week)
+			       (const :format "%v" month)
+			       (const :format "%v" year)))))
+
+(defcustom nndiary-week-starts-on-monday nil
+  "*Whether a week starts on monday (otherwise, sunday)."
+  :type 'boolean
+  :group 'nndiary)
+
+
+(defcustom nndiary-request-create-group-hooks nil
+  "*Hooks to run after `nndiary-request-create-group' is executed.
+The hooks will be called with the full group name as argument."
+  :group 'nndiary
+  :type 'hook)
+
+(defcustom nndiary-request-update-info-hooks nil
+  "*Hooks to run after `nndiary-request-update-info-group' is executed.
+The hooks will be called with the full group name as argument."
+  :group 'nndiary
+  :type 'hook)
+
+(defcustom nndiary-request-accept-article-hooks nil
+  "*Hooks to run before accepting an article.
+Executed near the beginning of `nndiary-request-accept-article'.
+The hooks will be called with the article in the current buffer."
+  :group 'nndiary
+  :type 'hook)
+
+(defcustom nndiary-check-directory-twice t
+  "*If t, check directories twice to avoid NFS failures."
+  :group 'nndiary
+  :type 'boolean)
+
+
+;; Backend declaration ======================================================
+
+;; Well, most of this is nnml clonage.
+
+(nnoo-declare nndiary)
+
+(defvoo nndiary-directory (nnheader-concat gnus-directory "diary/")
+  "Spool directory for the nndiary backend.")
+
+(defvoo nndiary-active-file
+    (expand-file-name "active" nndiary-directory)
+  "Active file for the nndiary backend.")
+
+(defvoo nndiary-newsgroups-file
+    (expand-file-name "newsgroups" nndiary-directory)
+  "Newsgroups description file for the nndiary backend.")
+
+(defvoo nndiary-get-new-mail nil
+  "Whether nndiary gets new mail and split it.
+Contrary to traditional mail backends, this variable can be set to t
+even if your primary mail backend also retreives mail. In such a case,
+NDiary uses its own mail-sources and split-methods.")
+
+(defvoo nndiary-nov-is-evil nil
+  "If non-nil, Gnus will never use nov databases for nndiary groups.
+Using nov databases will speed up header fetching considerably.
+This variable shouldn't be flipped much.  If you have, for some reason,
+set this to t, and want to set it to nil again, you should always run
+the `nndiary-generate-nov-databases' command.  The function will go
+through all nnml directories and generate nov databases for them
+all.  This may very well take some time.")
+
+(defvoo nndiary-prepare-save-mail-hook nil
+  "*Hook run narrowed to an article before saving.")
+
+(defvoo nndiary-inhibit-expiry nil
+  "If non-nil, inhibit expiry.")
+
+
+
+(defconst nndiary-version "0.2-b14"
+  "Current Diary backend version.")
+
+(defun nndiary-version ()
+  "Current Diary backend version."
+  (interactive)
+  (message "NNDiary version %s" nndiary-version))
+
+(defvoo nndiary-nov-file-name ".overview")
+
+(defvoo nndiary-current-directory nil)
+(defvoo nndiary-current-group nil)
+(defvoo nndiary-status-string "" )
+(defvoo nndiary-nov-buffer-alist nil)
+(defvoo nndiary-group-alist nil)
+(defvoo nndiary-active-timestamp nil)
+(defvoo nndiary-article-file-alist nil)
+
+(defvoo nndiary-generate-active-function 'nndiary-generate-active-info)
+(defvoo nndiary-nov-buffer-file-name nil)
+(defvoo nndiary-file-coding-system nnmail-file-coding-system)
+
+(defconst nndiary-headers
+  '(("Minute" 0 59)
+    ("Hour" 0 23)
+    ("Dom" 1 31)
+    ("Month" 1 12)
+    ("Year" 1971)
+    ("Dow" 0 6)
+    ("Time-Zone" (("Y" -43200)
+
+		  ("X" -39600)
+
+		  ("W" -36000)
+
+		  ("V" -32400)
+
+		  ("U" -28800)
+		  ("PST" -28800)
+
+		  ("T"   -25200)
+		  ("MST" -25200)
+		  ("PDT" -25200)
+
+		  ("S"   -21600)
+		  ("CST" -21600)
+		  ("MDT" -21600)
+
+		  ("R"   -18000)
+		  ("EST" -18000)
+		  ("CDT" -18000)
+
+		  ("Q"   -14400)
+		  ("AST" -14400)
+		  ("EDT" -14400)
+
+		  ("P"   -10800)
+		  ("ADT" -10800)
+
+		  ("O" -7200)
+
+		  ("N" -3600)
+
+		  ("Z"   0)
+		  ("GMT" 0)
+		  ("UT"  0)
+		  ("UTC" 0)
+		  ("WET" 0)
+
+		  ("A"    3600)
+		  ("CET"  3600)
+		  ("MET"  3600)
+		  ("MEZ"  3600)
+		  ("BST"  3600)
+		  ("WEST" 3600)
+
+		  ("B"    7200)
+		  ("EET"  7200)
+		  ("CEST" 7200)
+		  ("MEST" 7200)
+		  ("MESZ" 7200)
+
+		  ("C" 10800)
+
+		  ("D" 14400)
+
+		  ("E" 18000)
+
+		  ("F" 21600)
+
+		  ("G" 25200)
+
+		  ("H" 28800)
+
+		  ("I"   32400)
+		  ("JST" 32400)
+
+		  ("K"   36000)
+		  ("GST" 36000)
+
+		  ("L" 39600)
+
+		  ("M"    43200)
+		  ("NZST" 43200)
+
+		  ("NZDT" 46800))))
+  ;; List of NNDiary headers that specify the time spec. Each header name is
+  ;; followed by either two integers (specifying a range of possible values
+  ;; for this header) or one list (specifying all the possible values for this
+  ;; header). In the latter case, the list does NOT include the unspecifyed
+  ;; spec (*).
+  ;; For time zone values, we have symbolic time zone names associated with
+  ;; the (relative) number of seconds ahead GMT.
+  )
+
+(defsubst nndiary-schedule ()
+  (let (head)
+    (condition-case arg
+	(mapcar
+	 (lambda (elt)
+	   (setq head (nth 0 elt))
+	   (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt)))
+	 nndiary-headers)
+      (t
+       (nnheader-report 'nndiary "X-Diary-%s header parse error: %s."
+			head (cdr arg))
+       nil))
+    ))
+
+;;; Interface functions =====================================================
+
+(nnoo-define-basics nndiary)
+
+(deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old)
+  (when (nndiary-possibly-change-directory group server)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (erase-buffer)
+      (let* ((file nil)
+	     (number (length sequence))
+	     (count 0)
+	     (file-name-coding-system nnmail-pathname-coding-system)
+	     beg article
+	     (nndiary-check-directory-twice
+	      (and nndiary-check-directory-twice
+		   ;; To speed up, disable it in some case.
+		   (or (not (numberp nnmail-large-newsgroup))
+		       (<= number nnmail-large-newsgroup)))))
+	(if (stringp (car sequence))
+	    'headers
+	  (if (nndiary-retrieve-headers-with-nov sequence fetch-old)
+	      'nov
+	    (while sequence
+	      (setq article (car sequence))
+	      (setq file (nndiary-article-to-file article))
+	      (when (and file
+			 (file-exists-p file)
+			 (not (file-directory-p file)))
+		(insert (format "221 %d Article retrieved.\n" article))
+		(setq beg (point))
+		(nnheader-insert-head file)
+		(goto-char beg)
+		(if (search-forward "\n\n" nil t)
+		    (forward-char -1)
+		  (goto-char (point-max))
+		  (insert "\n\n"))
+		(insert ".\n")
+		(delete-region (point) (point-max)))
+	      (setq sequence (cdr sequence))
+	      (setq count (1+ count))
+	      (and (numberp nnmail-large-newsgroup)
+		   (> number nnmail-large-newsgroup)
+		   (zerop (% count 20))
+		   (nnheader-message 6 "nndiary: Receiving headers... %d%%"
+				     (/ (* count 100) number))))
+
+	    (and (numberp nnmail-large-newsgroup)
+		 (> number nnmail-large-newsgroup)
+		 (nnheader-message 6 "nndiary: Receiving headers...done"))
+
+	    (nnheader-fold-continuation-lines)
+	    'headers))))))
+
+(deffoo nndiary-open-server (server &optional defs)
+  (nnoo-change-server 'nndiary server defs)
+  (when (not (file-exists-p nndiary-directory))
+    (ignore-errors (make-directory nndiary-directory t)))
+  (cond
+   ((not (file-exists-p nndiary-directory))
+    (nndiary-close-server)
+    (nnheader-report 'nndiary "Couldn't create directory: %s"
+		     nndiary-directory))
+   ((not (file-directory-p (file-truename nndiary-directory)))
+    (nndiary-close-server)
+    (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory))
+   (t
+    (nnheader-report 'nndiary "Opened server %s using directory %s"
+		     server nndiary-directory)
+    t)))
+
+(deffoo nndiary-request-regenerate (server)
+  (nndiary-possibly-change-directory nil server)
+  (nndiary-generate-nov-databases server)
+  t)
+
+(deffoo nndiary-request-article (id &optional group server buffer)
+  (nndiary-possibly-change-directory group server)
+  (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
+	 (file-name-coding-system nnmail-pathname-coding-system)
+	 path gpath group-num)
+    (if (stringp id)
+	(when (and (setq group-num (nndiary-find-group-number id))
+		   (cdr
+		    (assq (cdr group-num)
+			  (nnheader-article-to-file-alist
+			   (setq gpath
+				 (nnmail-group-pathname
+				  (car group-num)
+				  nndiary-directory))))))
+	  (setq path (concat gpath (int-to-string (cdr group-num)))))
+      (setq path (nndiary-article-to-file id)))
+    (cond
+     ((not path)
+      (nnheader-report 'nndiary "No such article: %s" id))
+     ((not (file-exists-p path))
+      (nnheader-report 'nndiary "No such file: %s" path))
+     ((file-directory-p path)
+      (nnheader-report 'nndiary "File is a directory: %s" path))
+     ((not (save-excursion (let ((nnmail-file-coding-system
+				  nndiary-file-coding-system))
+			     (nnmail-find-file path))))
+      (nnheader-report 'nndiary "Couldn't read file: %s" path))
+     (t
+      (nnheader-report 'nndiary "Article %s retrieved" id)
+      ;; We return the article number.
+      (cons (if group-num (car group-num) group)
+	    (string-to-int (file-name-nondirectory path)))))))
+
+(deffoo nndiary-request-group (group &optional server dont-check)
+  (let ((file-name-coding-system nnmail-pathname-coding-system))
+    (cond
+     ((not (nndiary-possibly-change-directory group server))
+      (nnheader-report 'nndiary "Invalid group (no such directory)"))
+     ((not (file-exists-p nndiary-current-directory))
+      (nnheader-report 'nndiary "Directory %s does not exist"
+		       nndiary-current-directory))
+     ((not (file-directory-p nndiary-current-directory))
+      (nnheader-report 'nndiary "%s is not a directory"
+		       nndiary-current-directory))
+     (dont-check
+      (nnheader-report 'nndiary "Group %s selected" group)
+      t)
+     (t
+      (nnheader-re-read-dir nndiary-current-directory)
+      (nnmail-activate 'nndiary)
+      (let ((active (nth 1 (assoc group nndiary-group-alist))))
+	(if (not active)
+	    (nnheader-report 'nndiary "No such group: %s" group)
+	  (nnheader-report 'nndiary "Selected group %s" group)
+	  (nnheader-insert "211 %d %d %d %s\n"
+			   (max (1+ (- (cdr active) (car active))) 0)
+			   (car active) (cdr active) group)))))))
+
+(deffoo nndiary-request-scan (&optional group server)
+  ;; Use our own mail sources and split methods while Gnus doesn't let us have
+  ;; multiple backends for retrieving mail.
+  (let ((mail-sources nndiary-mail-sources)
+	(nnmail-split-methods nndiary-split-methods))
+    (setq nndiary-article-file-alist nil)
+    (nndiary-possibly-change-directory group server)
+    (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group)))
+
+(deffoo nndiary-close-group (group &optional server)
+  (setq nndiary-article-file-alist nil)
+  t)
+
+(deffoo nndiary-request-create-group (group &optional server args)
+  (nndiary-possibly-change-directory nil server)
+  (nnmail-activate 'nndiary)
+  (cond
+   ((assoc group nndiary-group-alist)
+    t)
+   ((and (file-exists-p (nnmail-group-pathname group nndiary-directory))
+	 (not (file-directory-p (nnmail-group-pathname
+				 group nndiary-directory))))
+    (nnheader-report 'nndiary "%s is a file"
+		     (nnmail-group-pathname group nndiary-directory)))
+   (t
+    (let (active)
+      (push (list group (setq active (cons 1 0)))
+	    nndiary-group-alist)
+      (nndiary-possibly-create-directory group)
+      (nndiary-possibly-change-directory group server)
+      (let ((articles (nnheader-directory-articles nndiary-current-directory)))
+	(when articles
+	  (setcar active (apply 'min articles))
+	  (setcdr active (apply 'max articles))))
+      (nnmail-save-active nndiary-group-alist nndiary-active-file)
+      (run-hook-with-args 'nndiary-request-create-group-hooks
+			  (gnus-group-prefixed-name group
+						    (list "nndiary" server)))
+      t))
+   ))
+
+(deffoo nndiary-request-list (&optional server)
+  (save-excursion
+    (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
+	  (file-name-coding-system nnmail-pathname-coding-system))
+      (nnmail-find-file nndiary-active-file))
+    (setq nndiary-group-alist (nnmail-get-active))
+    t))
+
+(deffoo nndiary-request-newgroups (date &optional server)
+  (nndiary-request-list server))
+
+(deffoo nndiary-request-list-newsgroups (&optional server)
+  (save-excursion
+    (nnmail-find-file nndiary-newsgroups-file)))
+
+(deffoo nndiary-request-expire-articles (articles group &optional server force)
+  (nndiary-possibly-change-directory group server)
+  (let ((active-articles
+	 (nnheader-directory-articles nndiary-current-directory))
+	article rest number)
+    (nnmail-activate 'nndiary)
+    ;; Articles not listed in active-articles are already gone,
+    ;; so don't try to expire them.
+    (setq articles (gnus-intersection articles active-articles))
+    (while articles
+      (setq article (nndiary-article-to-file (setq number (pop articles))))
+      (if (and (nndiary-deletable-article-p group number)
+	       ;; Don't use nnmail-expired-article-p. Our notion of expiration
+	       ;; is a bit peculiar ...
+	       (or force (nndiary-expired-article-p article)))
+	  (progn
+	    ;; Allow a special target group.
+	    (unless (eq nnmail-expiry-target 'delete)
+	      (with-temp-buffer
+		(nndiary-request-article number group server (current-buffer))
+		(let ((nndiary-current-directory nil))
+		  (nnmail-expiry-target-group nnmail-expiry-target group)))
+	      (nndiary-possibly-change-directory group server))
+	    (nnheader-message 5 "Deleting article %s in %s" number group)
+	    (condition-case ()
+		(funcall nnmail-delete-file-function article)
+	      (file-error (push number rest)))
+	    (setq active-articles (delq number active-articles))
+	    (nndiary-nov-delete-article group number))
+	(push number rest)))
+    (let ((active (nth 1 (assoc group nndiary-group-alist))))
+      (when active
+	(setcar active (or (and active-articles
+				(apply 'min active-articles))
+			   (1+ (cdr active)))))
+      (nnmail-save-active nndiary-group-alist nndiary-active-file))
+    (nndiary-save-nov)
+    (nconc rest articles)))
+
+(deffoo nndiary-request-move-article
+    (article group server accept-form &optional last)
+  (let ((buf (get-buffer-create " *nndiary move*"))
+	result)
+    (nndiary-possibly-change-directory group server)
+    (nndiary-update-file-alist)
+    (and
+     (nndiary-deletable-article-p group article)
+     (nndiary-request-article article group server)
+     (let (nndiary-current-directory
+	   nndiary-current-group
+	   nndiary-article-file-alist)
+       (save-excursion
+	 (set-buffer buf)
+	 (insert-buffer-substring nntp-server-buffer)
+	 (setq result (eval accept-form))
+	 (kill-buffer (current-buffer))
+	 result))
+     (progn
+       (nndiary-possibly-change-directory group server)
+       (condition-case ()
+	   (funcall nnmail-delete-file-function
+		    (nndiary-article-to-file  article))
+	 (file-error nil))
+       (nndiary-nov-delete-article group article)
+       (when last
+	 (nndiary-save-nov)
+	 (nnmail-save-active nndiary-group-alist nndiary-active-file))))
+    result))
+
+(deffoo nndiary-request-accept-article (group &optional server last)
+  (nndiary-possibly-change-directory group server)
+  (nnmail-check-syntax)
+  (run-hooks 'nndiary-request-accept-article-hooks)
+  (when (nndiary-schedule)
+    (let (result)
+      (when nnmail-cache-accepted-message-ids
+	(nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+      (if (stringp group)
+	  (and
+	   (nnmail-activate 'nndiary)
+	   (setq result
+		 (car (nndiary-save-mail
+		       (list (cons group (nndiary-active-number group))))))
+	   (progn
+	     (nnmail-save-active nndiary-group-alist nndiary-active-file)
+	     (and last (nndiary-save-nov))))
+	(and
+	 (nnmail-activate 'nndiary)
+	 (if (and (not (setq result
+			     (nnmail-article-group 'nndiary-active-number)))
+		  (yes-or-no-p "Moved to `junk' group; delete article? "))
+	     (setq result 'junk)
+	   (setq result (car (nndiary-save-mail result))))
+	 (when last
+	   (nnmail-save-active nndiary-group-alist nndiary-active-file)
+	   (when nnmail-cache-accepted-message-ids
+	     (nnmail-cache-close))
+	   (nndiary-save-nov))))
+      result))
+  )
+
+(deffoo nndiary-request-post (&optional server)
+  (nnmail-do-request-post 'nndiary-request-accept-article server))
+
+(deffoo nndiary-request-replace-article (article group buffer)
+  (nndiary-possibly-change-directory group)
+  (save-excursion
+    (set-buffer buffer)
+    (nndiary-possibly-create-directory group)
+    (let ((chars (nnmail-insert-lines))
+	  (art (concat (int-to-string article) "\t"))
+	  headers)
+      (when (ignore-errors
+	      (nnmail-write-region
+	       (point-min) (point-max)
+	       (or (nndiary-article-to-file article)
+		   (expand-file-name (int-to-string article)
+				     nndiary-current-directory))
+	       nil (if (nnheader-be-verbose 5) nil 'nomesg))
+	      t)
+	(setq headers (nndiary-parse-head chars article))
+	;; Replace the NOV line in the NOV file.
+	(save-excursion
+	  (set-buffer (nndiary-open-nov group))
+	  (goto-char (point-min))
+	  (if (or (looking-at art)
+		  (search-forward (concat "\n" art) nil t))
+	      ;; Delete the old NOV line.
+	      (delete-region (progn (beginning-of-line) (point))
+			     (progn (forward-line 1) (point)))
+	    ;; The line isn't here, so we have to find out where
+	    ;; we should insert it.  (This situation should never
+	    ;; occur, but one likes to make sure...)
+	    (while (and (looking-at "[0-9]+\t")
+			(< (string-to-int
+			    (buffer-substring
+			     (match-beginning 0) (match-end 0)))
+			   article)
+			(zerop (forward-line 1)))))
+	  (beginning-of-line)
+	  (nnheader-insert-nov headers)
+	  (nndiary-save-nov)
+	  t)))))
+
+(deffoo nndiary-request-delete-group (group &optional force server)
+  (nndiary-possibly-change-directory group server)
+  (when force
+    ;; Delete all articles in GROUP.
+    (let ((articles
+	   (directory-files
+	    nndiary-current-directory t
+	    (concat nnheader-numerical-short-files
+		    "\\|" (regexp-quote nndiary-nov-file-name) "$")))
+	  article)
+      (while articles
+	(setq article (pop articles))
+	(when (file-writable-p article)
+	  (nnheader-message 5 "Deleting article %s in %s..." article group)
+	  (funcall nnmail-delete-file-function article))))
+    ;; Try to delete the directory itself.
+    (ignore-errors (delete-directory nndiary-current-directory)))
+  ;; Remove the group from all structures.
+  (setq nndiary-group-alist
+	(delq (assoc group nndiary-group-alist) nndiary-group-alist)
+	nndiary-current-group nil
+	nndiary-current-directory nil)
+  ;; Save the active file.
+  (nnmail-save-active nndiary-group-alist nndiary-active-file)
+  t)
+
+(deffoo nndiary-request-rename-group (group new-name &optional server)
+  (nndiary-possibly-change-directory group server)
+  (let ((new-dir (nnmail-group-pathname new-name nndiary-directory))
+	(old-dir (nnmail-group-pathname group nndiary-directory)))
+    (when (ignore-errors
+	    (make-directory new-dir t)
+	    t)
+      ;; We move the articles file by file instead of renaming
+      ;; the directory -- there may be subgroups in this group.
+      ;; One might be more clever, I guess.
+      (let ((files (nnheader-article-to-file-alist old-dir)))
+	(while files
+	  (rename-file
+	   (concat old-dir (cdar files))
+	   (concat new-dir (cdar files)))
+	  (pop files)))
+      ;; Move .overview file.
+      (let ((overview (concat old-dir nndiary-nov-file-name)))
+	(when (file-exists-p overview)
+	  (rename-file overview (concat new-dir nndiary-nov-file-name))))
+      (when (<= (length (directory-files old-dir)) 2)
+	(ignore-errors (delete-directory old-dir)))
+      ;; That went ok, so we change the internal structures.
+      (let ((entry (assoc group nndiary-group-alist)))
+	(when entry
+	  (setcar entry new-name))
+	(setq nndiary-current-directory nil
+	      nndiary-current-group nil)
+	;; Save the new group alist.
+	(nnmail-save-active nndiary-group-alist nndiary-active-file)
+	t))))
+
+(deffoo nndiary-set-status (article name value &optional group server)
+  (nndiary-possibly-change-directory group server)
+  (let ((file (nndiary-article-to-file article)))
+    (cond
+     ((not (file-exists-p file))
+      (nnheader-report 'nndiary "File %s does not exist" file))
+     (t
+      (with-temp-file file
+	(nnheader-insert-file-contents file)
+	(nnmail-replace-status name value))
+      t))))
+
+
+;;; Interface optional functions ============================================
+
+(deffoo nndiary-request-update-info (group info &optional server)
+  (nndiary-possibly-change-directory group)
+  (let ((timestamp (gnus-group-parameter-value (gnus-info-params info)
+					       'timestamp t)))
+    (if (not timestamp)
+	(nnheader-report 'nndiary "Group %s doesn't have a timestamp" group)
+      ;; else
+      ;; Figure out which articles should be re-new'ed
+      (let ((articles (nndiary-flatten (gnus-info-read info) 0))
+	    article file unread buf)
+	(save-excursion
+	  (setq buf (nnheader-set-temp-buffer " *nndiary update*"))
+	  (while (setq article (pop articles))
+	    (setq file (concat nndiary-current-directory
+			       (int-to-string article)))
+	    (and (file-exists-p file)
+		 (nndiary-renew-article-p file timestamp)
+		 (push article unread)))
+	  ;;(message "unread: %s" unread)
+	  (sit-for 1)
+	  (kill-buffer buf))
+	(setq unread (sort unread '<))
+	(and unread
+	     (gnus-info-set-read info (gnus-update-read-articles
+				       (gnus-info-group info) unread t)))
+	))
+    (run-hook-with-args 'nndiary-request-update-info-hooks
+			(gnus-info-group info))
+    t))
+
+
+
+;;; Internal functions ======================================================
+
+(defun nndiary-article-to-file (article)
+  (nndiary-update-file-alist)
+  (let (file)
+    (if (setq file (cdr (assq article nndiary-article-file-alist)))
+	(expand-file-name file nndiary-current-directory)
+      ;; Just to make sure nothing went wrong when reading over NFS --
+      ;; check once more.
+      (if nndiary-check-directory-twice
+	  (when (file-exists-p
+		 (setq file (expand-file-name (number-to-string article)
+					      nndiary-current-directory)))
+	    (nndiary-update-file-alist t)
+	    file)))))
+
+(defun nndiary-deletable-article-p (group article)
+  "Say whether ARTICLE in GROUP can be deleted."
+  (let (path)
+    (when (setq path (nndiary-article-to-file article))
+      (when (file-writable-p path)
+	(or (not nnmail-keep-last-article)
+	    (not (eq (cdr (nth 1 (assoc group nndiary-group-alist)))
+		     article)))))))
+
+;; Find an article number in the current group given the Message-ID.
+(defun nndiary-find-group-number (id)
+  (save-excursion
+    (set-buffer (get-buffer-create " *nndiary id*"))
+    (let ((alist nndiary-group-alist)
+	  number)
+      ;; We want to look through all .overview files, but we want to
+      ;; start with the one in the current directory.  It seems most
+      ;; likely that the article we are looking for is in that group.
+      (if (setq number (nndiary-find-id nndiary-current-group id))
+	  (cons nndiary-current-group number)
+	;; It wasn't there, so we look through the other groups as well.
+	(while (and (not number)
+		    alist)
+	  (or (string= (caar alist) nndiary-current-group)
+	      (setq number (nndiary-find-id (caar alist) id)))
+	  (or number
+	      (setq alist (cdr alist))))
+	(and number
+	     (cons (caar alist) number))))))
+
+(defun nndiary-find-id (group id)
+  (erase-buffer)
+  (let ((nov (expand-file-name nndiary-nov-file-name
+			       (nnmail-group-pathname group
+						      nndiary-directory)))
+	number found)
+    (when (file-exists-p nov)
+      (nnheader-insert-file-contents nov)
+      (while (and (not found)
+		  (search-forward id nil t)) ; We find the ID.
+	;; And the id is in the fourth field.
+	(if (not (and (search-backward "\t" nil t 4)
+		      (not (search-backward"\t" (gnus-point-at-bol) t))))
+	    (forward-line 1)
+	  (beginning-of-line)
+	  (setq found t)
+	  ;; We return the article number.
+	  (setq number
+		(ignore-errors (read (current-buffer))))))
+      number)))
+
+(defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old)
+  (if (or gnus-nov-is-evil nndiary-nov-is-evil)
+      nil
+    (let ((nov (expand-file-name nndiary-nov-file-name
+				 nndiary-current-directory)))
+      (when (file-exists-p nov)
+	(save-excursion
+	  (set-buffer nntp-server-buffer)
+	  (erase-buffer)
+	  (nnheader-insert-file-contents nov)
+	  (if (and fetch-old
+		   (not (numberp fetch-old)))
+	      t				; Don't remove anything.
+	    (nnheader-nov-delete-outside-range
+	     (if fetch-old (max 1 (- (car articles) fetch-old))
+	       (car articles))
+	     (car (last articles)))
+	    t))))))
+
+(defun nndiary-possibly-change-directory (group &optional server)
+  (when (and server
+	     (not (nndiary-server-opened server)))
+    (nndiary-open-server server))
+  (if (not group)
+      t
+    (let ((pathname (nnmail-group-pathname group nndiary-directory))
+	  (file-name-coding-system nnmail-pathname-coding-system))
+      (when (not (equal pathname nndiary-current-directory))
+	(setq nndiary-current-directory pathname
+	      nndiary-current-group group
+	      nndiary-article-file-alist nil))
+      (file-exists-p nndiary-current-directory))))
+
+(defun nndiary-possibly-create-directory (group)
+  (let ((dir (nnmail-group-pathname group nndiary-directory)))
+    (unless (file-exists-p dir)
+      (make-directory (directory-file-name dir) t)
+      (nnheader-message 5 "Creating mail directory %s" dir))))
+
+(defun nndiary-save-mail (group-art)
+  "Called narrowed to an article."
+  (let (chars headers)
+    (setq chars (nnmail-insert-lines))
+    (nnmail-insert-xref group-art)
+    (run-hooks 'nnmail-prepare-save-mail-hook)
+    (run-hooks 'nndiary-prepare-save-mail-hook)
+    (goto-char (point-min))
+    (while (looking-at "From ")
+      (replace-match "X-From-Line: ")
+      (forward-line 1))
+    ;; We save the article in all the groups it belongs in.
+    (let ((ga group-art)
+	  first)
+      (while ga
+	(nndiary-possibly-create-directory (caar ga))
+	(let ((file (concat (nnmail-group-pathname
+			     (caar ga) nndiary-directory)
+			    (int-to-string (cdar ga)))))
+	  (if first
+	      ;; It was already saved, so we just make a hard link.
+	      (funcall nnmail-crosspost-link-function first file t)
+	    ;; Save the article.
+	    (nnmail-write-region (point-min) (point-max) file nil
+				 (if (nnheader-be-verbose 5) nil 'nomesg))
+	    (setq first file)))
+	(setq ga (cdr ga))))
+    ;; Generate a nov line for this article.  We generate the nov
+    ;; line after saving, because nov generation destroys the
+    ;; header.
+    (setq headers (nndiary-parse-head chars))
+    ;; Output the nov line to all nov databases that should have it.
+    (let ((ga group-art))
+      (while ga
+	(nndiary-add-nov (caar ga) (cdar ga) headers)
+	(setq ga (cdr ga))))
+    group-art))
+
+(defun nndiary-active-number (group)
+  "Compute the next article number in GROUP."
+  (let ((active (cadr (assoc group nndiary-group-alist))))
+    ;; The group wasn't known to nndiary, so we just create an active
+    ;; entry for it.
+    (unless active
+      ;; Perhaps the active file was corrupt?  See whether
+      ;; there are any articles in this group.
+      (nndiary-possibly-create-directory group)
+      (nndiary-possibly-change-directory group)
+      (unless nndiary-article-file-alist
+	(setq nndiary-article-file-alist
+	      (sort
+	       (nnheader-article-to-file-alist nndiary-current-directory)
+	       'car-less-than-car)))
+      (setq active
+	    (if nndiary-article-file-alist
+		(cons (caar nndiary-article-file-alist)
+		      (caar (last nndiary-article-file-alist)))
+	      (cons 1 0)))
+      (push (list group active) nndiary-group-alist))
+    (setcdr active (1+ (cdr active)))
+    (while (file-exists-p
+	    (expand-file-name (int-to-string (cdr active))
+			      (nnmail-group-pathname group nndiary-directory)))
+      (setcdr active (1+ (cdr active))))
+    (cdr active)))
+
+(defun nndiary-add-nov (group article headers)
+  "Add a nov line for the GROUP base."
+  (save-excursion
+    (set-buffer (nndiary-open-nov group))
+    (goto-char (point-max))
+    (mail-header-set-number headers article)
+    (nnheader-insert-nov headers)))
+
+(defsubst nndiary-header-value ()
+  (buffer-substring (match-end 0) (progn (end-of-line) (point))))
+
+(defun nndiary-parse-head (chars &optional number)
+  "Parse the head of the current buffer."
+  (save-excursion
+    (save-restriction
+      (unless (zerop (buffer-size))
+	(narrow-to-region
+	 (goto-char (point-min))
+	 (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
+      (let ((headers (nnheader-parse-naked-head)))
+	(mail-header-set-chars headers chars)
+	(mail-header-set-number headers number)
+	headers))))
+
+(defun nndiary-open-nov (group)
+  (or (cdr (assoc group nndiary-nov-buffer-alist))
+      (let ((buffer (get-buffer-create (format " *nndiary overview %s*"
+					       group))))
+	(save-excursion
+	  (set-buffer buffer)
+	  (set (make-local-variable 'nndiary-nov-buffer-file-name)
+	       (expand-file-name
+		nndiary-nov-file-name
+		(nnmail-group-pathname group nndiary-directory)))
+	  (erase-buffer)
+	  (when (file-exists-p nndiary-nov-buffer-file-name)
+	    (nnheader-insert-file-contents nndiary-nov-buffer-file-name)))
+	(push (cons group buffer) nndiary-nov-buffer-alist)
+	buffer)))
+
+(defun nndiary-save-nov ()
+  (save-excursion
+    (while nndiary-nov-buffer-alist
+      (when (buffer-name (cdar nndiary-nov-buffer-alist))
+	(set-buffer (cdar nndiary-nov-buffer-alist))
+	(when (buffer-modified-p)
+	  (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name
+			       nil 'nomesg))
+	(set-buffer-modified-p nil)
+	(kill-buffer (current-buffer)))
+      (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist)))))
+
+;;;###autoload
+(defun nndiary-generate-nov-databases (&optional server)
+  "Generate NOV databases in all nndiary directories."
+  (interactive (list (or (nnoo-current-server 'nndiary) "")))
+  ;; Read the active file to make sure we don't re-use articles
+  ;; numbers in empty groups.
+  (nnmail-activate 'nndiary)
+  (unless (nndiary-server-opened server)
+    (nndiary-open-server server))
+  (setq nndiary-directory (expand-file-name nndiary-directory))
+  ;; Recurse down the directories.
+  (nndiary-generate-nov-databases-1 nndiary-directory nil t)
+  ;; Save the active file.
+  (nnmail-save-active nndiary-group-alist nndiary-active-file))
+
+(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active)
+  "Regenerate the NOV database in DIR."
+  (interactive "DRegenerate NOV in: ")
+  (setq dir (file-name-as-directory dir))
+  ;; Only scan this sub-tree if we haven't been here yet.
+  (unless (member (file-truename dir) seen)
+    (push (file-truename dir) seen)
+    ;; We descend recursively
+    (let ((dirs (directory-files dir t nil t))
+	  dir)
+      (while (setq dir (pop dirs))
+	(when (and (not (string-match "^\\." (file-name-nondirectory dir)))
+		   (file-directory-p dir))
+	  (nndiary-generate-nov-databases-1 dir seen))))
+    ;; Do this directory.
+    (let ((files (sort (nnheader-article-to-file-alist dir)
+		       'car-less-than-car)))
+      (if (not files)
+	  (let* ((group (nnheader-file-to-group
+			 (directory-file-name dir) nndiary-directory))
+		 (info (cadr (assoc group nndiary-group-alist))))
+	    (when info
+	      (setcar info (1+ (cdr info)))))
+	(funcall nndiary-generate-active-function dir)
+	;; Generate the nov file.
+	(nndiary-generate-nov-file dir files)
+	(unless no-active
+	  (nnmail-save-active nndiary-group-alist nndiary-active-file))))))
+
+(eval-when-compile (defvar files))
+(defun nndiary-generate-active-info (dir)
+  ;; Update the active info for this group.
+  (let* ((group (nnheader-file-to-group
+		 (directory-file-name dir) nndiary-directory))
+	 (entry (assoc group nndiary-group-alist))
+	 (last (or (caadr entry) 0)))
+    (setq nndiary-group-alist (delq entry nndiary-group-alist))
+    (push (list group
+		(cons (or (caar files) (1+ last))
+		      (max last
+			   (or (let ((f files))
+				 (while (cdr f) (setq f (cdr f)))
+				 (caar f))
+			       0))))
+	  nndiary-group-alist)))
+
+(defun nndiary-generate-nov-file (dir files)
+  (let* ((dir (file-name-as-directory dir))
+	 (nov (concat dir nndiary-nov-file-name))
+	 (nov-buffer (get-buffer-create " *nov*"))
+	 chars file headers)
+    (save-excursion
+      ;; Init the nov buffer.
+      (set-buffer nov-buffer)
+      (buffer-disable-undo)
+      (erase-buffer)
+      (set-buffer nntp-server-buffer)
+      ;; Delete the old NOV file.
+      (when (file-exists-p nov)
+	(funcall nnmail-delete-file-function nov))
+      (while files
+	(unless (file-directory-p (setq file (concat dir (cdar files))))
+	  (erase-buffer)
+	  (nnheader-insert-file-contents file)
+	  (narrow-to-region
+	   (goto-char (point-min))
+	   (progn
+	     (search-forward "\n\n" nil t)
+	     (setq chars (- (point-max) (point)))
+	     (max 1 (1- (point)))))
+	  (unless (zerop (buffer-size))
+	    (goto-char (point-min))
+	    (setq headers (nndiary-parse-head chars (caar files)))
+	    (save-excursion
+	      (set-buffer nov-buffer)
+	      (goto-char (point-max))
+	      (nnheader-insert-nov headers)))
+	  (widen))
+	(setq files (cdr files)))
+      (save-excursion
+	(set-buffer nov-buffer)
+	(nnmail-write-region 1 (point-max) nov nil 'nomesg)
+	(kill-buffer (current-buffer))))))
+
+(defun nndiary-nov-delete-article (group article)
+  (save-excursion
+    (set-buffer (nndiary-open-nov group))
+    (when (nnheader-find-nov-line article)
+      (delete-region (point) (progn (forward-line 1) (point)))
+      (when (bobp)
+	(let ((active (cadr (assoc group nndiary-group-alist)))
+	      num)
+	  (when active
+	    (if (eobp)
+		(setf (car active) (1+ (cdr active)))
+	      (when (and (setq num (ignore-errors (read (current-buffer))))
+			 (numberp num))
+		(setf (car active) num)))))))
+    t))
+
+(defun nndiary-update-file-alist (&optional force)
+  (when (or (not nndiary-article-file-alist)
+	    force)
+    (setq nndiary-article-file-alist
+	  (nnheader-article-to-file-alist nndiary-current-directory))))
+
+
+(defun nndiary-string-to-int (str min &optional max)
+  ;; Like `string-to-int' but barf if STR is not exactly an integer, and not
+  ;; within the specified bounds.
+  ;; Signals are caught by `nndiary-schedule'.
+  (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str))
+      (nndiary-error "not an integer value")
+    ;; else
+    (let ((val (string-to-int str)))
+      (and (or (< val min)
+	       (and max (> val max)))
+	   (nndiary-error "value out of range"))
+      val)))
+
+(defun nndiary-parse-schedule-value (str min-or-values max)
+  ;; Parse the schedule string STR, or signal an error.
+  ;; Signals are caught by `nndary-schedule'.
+  (if (string-match "[ \t]*\\*[ \t]*" str)
+      ;; unspecifyed
+      nil
+    ;; specifyed
+    (if (listp min-or-values)
+	;; min-or-values is values
+	;; #### NOTE: this is actually only a hack for time zones.
+	(let ((val (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" str)
+			(match-string 1 str))))
+	  (if (and val (setq val (assoc val min-or-values)))
+	      (list (cadr val))
+	    (nndiary-error "invalid syntax")))
+      ;; min-or-values is min
+      (mapcar
+       (lambda (val)
+	 (let ((res (split-string val "-")))
+	   (cond
+	    ((= (length res) 1)
+	     (nndiary-string-to-int (car res) min-or-values max))
+	    ((= (length res) 2)
+	     ;; don't know if crontab accepts this, but ensure
+	     ;; that BEG is <= END
+	     (let ((beg (nndiary-string-to-int (car res) min-or-values max))
+		   (end (nndiary-string-to-int (cadr res) min-or-values max)))
+	       (cond ((< beg end)
+		      (cons beg end))
+		     ((= beg end)
+		      beg)
+		     (t
+		      (cons end beg)))))
+	    (t
+	     (nndiary-error "invalid syntax")))
+	   ))
+       (split-string str ",")))
+    ))
+
+;; ### FIXME: remove this function if it's used only once.
+(defun nndiary-parse-schedule (head min-or-values max)
+  ;; Parse the cron-like value of header X-Diary-HEAD in current buffer.
+  ;; - Returns nil if `*'
+  ;; - Otherwise returns a list of integers and/or ranges (BEG . END)
+  ;; The exception is the Timze-Zone value which is always of the form (STR).
+  ;; Signals are caught by `nndary-schedule'.
+  (let ((header (format "^X-Diary-%s: \\(.*\\)$" head)))
+    (goto-char (point-min))
+    (if (not (re-search-forward header nil t))
+	(nndiary-error "header missing")
+      ;; else
+      (nndiary-parse-schedule-value (match-string 1) min-or-values max))
+    ))
+
+(defun nndiary-max (spec)
+  ;; Returns the max of specification SPEC, or nil for permanent schedules.
+  (unless (null spec)
+    (let ((elts spec)
+	  (max 0)
+	  elt)
+      (while (setq elt (pop elts))
+	(if (integerp elt)
+	    (and (> elt max) (setq max elt))
+	  (and (> (cdr elt) max) (setq max (cdr elt)))))
+      max)))
+
+(defun nndiary-flatten (spec min &optional max)
+  ;; flatten the spec by expanding ranges to all possible values.
+  (let (flat n)
+    (cond ((null spec)
+	   ;; this happens when I flatten something else than one of my
+	   ;; schedules (a list of read articles for instance).
+	   (unless (null max)
+	     (setq n min)
+	     (while (<= n max)
+	       (push n flat)
+	       (setq n (1+ n)))))
+	  (t
+	   (let ((elts spec)
+		 elt)
+	     (while (setq elt (pop elts))
+	       (if (integerp elt)
+		   (push elt flat)
+		 ;; else
+		 (setq n (car elt))
+		 (while (<= n (cdr elt))
+		   (push n flat)
+		   (setq n (1+ n))))))))
+    flat))
+
+(defun nndiary-unflatten (spec)
+  ;; opposite of flatten: build ranges if possible
+  (setq spec (sort spec '<))
+  (let (min max res)
+    (while (setq min (pop spec))
+      (setq max min)
+      (while (and (car spec) (= (car spec) (1+ max)))
+	(setq max (1+ max))
+	(pop spec))
+      (if (= max min)
+	  (setq res (append res (list min)))
+	(setq res (append res (list (cons min max))))))
+    res))
+
+(defun nndiary-compute-reminders (date)
+  ;; Returns a list of times corresponding to the reminders of date DATE.
+  ;; See the comment in `nndiary-reminders' about rounding.
+  (let* ((reminders nndiary-reminders)
+	 (date-elts (decode-time date))
+	 ;; ### NOTE: out-of-range values are accepted by encode-time. This
+	 ;; makes our life easier.
+	 (monday (- (nth 3 date-elts)
+		    (if nndiary-week-starts-on-monday
+			(if (zerop (nth 6 date-elts))
+			    6
+			  (- (nth 6 date-elts) 1))
+		      (nth 6 date-elts))))
+	 reminder res)
+    ;; remove the DOW and DST entries
+    (setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts))
+    (while (setq reminder (pop reminders))
+      (push
+       (cond ((eq (cdr reminder) 'minute)
+	      (subtract-time
+	       (apply 'encode-time 0 (nthcdr 1 date-elts))
+	       (seconds-to-time (* (car reminder) 60.0))))
+	     ((eq (cdr reminder) 'hour)
+	      (subtract-time
+	       (apply 'encode-time 0 0 (nthcdr 2 date-elts))
+	       (seconds-to-time (* (car reminder) 3600.0))))
+	     ((eq (cdr reminder) 'day)
+	      (subtract-time
+	       (apply 'encode-time 0 0 0 (nthcdr 3 date-elts))
+	       (seconds-to-time (* (car reminder) 86400.0))))
+	     ((eq (cdr reminder) 'week)
+	      (subtract-time
+	       (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts))
+	       (seconds-to-time (* (car reminder) 604800.0))))
+	     ((eq (cdr reminder) 'month)
+	      (subtract-time
+	       (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts))
+	       (seconds-to-time (* (car reminder) 18748800.0))))
+	     ((eq (cdr reminder) 'year)
+	      (subtract-time
+	       (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts))
+	       (seconds-to-time (* (car reminder) 400861056.0)))))
+       res))
+    (sort res 'time-less-p)))
+
+(defun nndiary-last-occurence (sched)
+  ;; Returns the last occurence of schedule SCHED as an Emacs time struct, or
+  ;; nil for permanent schedule or errors.
+  (let ((minute (nndiary-max (nth 0 sched)))
+	(hour (nndiary-max (nth 1 sched)))
+	(year (nndiary-max (nth 4 sched)))
+	(time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
+		       (current-time-zone))))
+    (when year
+      (or minute (setq minute 59))
+      (or hour (setq hour 23))
+      ;; I'll just compute all possible values and test them by decreasing
+      ;; order until one succeeds. This is probably quide rude, but I got
+      ;; bored in finding a good algorithm for doing that ;-)
+      ;; ### FIXME: remove identical entries.
+      (let ((dom-list (nth 2 sched))
+	    (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>))
+	    (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>))
+	    (dow-list (nth 5 sched)))
+	;; Special case: an asterisk in one of the days specifications means
+	;; that only the other should be taken into account. If both are
+	;; unspecified, you would get all possible days in both.
+	(cond ((null dow-list)
+	       ;; this gets all days if dom-list is nil
+	       (setq dom-list (nndiary-flatten dom-list 1 31)))
+	      ((null dom-list)
+	       ;; this also gets all days if dow-list is nil
+	       (setq dow-list (nndiary-flatten dow-list 0 6)))
+	      (t
+	       (setq dom-list (nndiary-flatten dom-list 1 31))
+	       (setq dow-list (nndiary-flatten dow-list 0 6))))
+	(or
+	 (catch 'found
+	   (while (setq year (pop year-list))
+	     (let ((months month-list)
+		   month)
+	       (while (setq month (pop months))
+		 ;; Now we must merge the Dows with the Doms. To do that, we
+		 ;; have to know which day is the 1st one for this month.
+		 ;; Maybe there's simpler, but decode-time(encode-time) will
+		 ;; give us the answer.
+		 (let ((first (nth 6 (decode-time
+				      (encode-time 0 0 0 1 month year
+						   time-zone))))
+		       (max (cond ((= month 2)
+				   (if (date-leap-year-p year) 29 28))
+				  ((<= month 7)
+				   (if (zerop (% month 2)) 30 31))
+				  (t
+				   (if (zerop (% month 2)) 31 30))))
+		       (doms dom-list)
+		       (dows dow-list)
+		       day days)
+		   ;; first, review the doms to see if they are valid.
+		   (while (setq day (pop doms))
+		     (and (<= day max)
+			  (push day days)))
+		   ;; second add all possible dows
+		   (while (setq day (pop dows))
+		     ;; days start at 1.
+		     (setq day (1+ (- day first)))
+		     (and (< day 0) (setq day (+ 7 day)))
+		     (while (<= day max)
+		       (push day days)
+		       (setq day (+ 7 day))))
+		   ;; Finally, if we have some days, they are valid
+		   (when days
+		     (sort days '>)
+		     (throw 'found
+			    (encode-time 0 minute hour
+					 (car days) month year time-zone)))
+		   )))))
+	 ;; There's an upper limit, but we didn't find any last occurence.
+	 ;; This means that the schedule is undecidable. This can happen if
+	 ;; you happen to say something like "each Feb 31 until 2038".
+	 (progn
+	   (nnheader-report 'nndiary "Undecidable schedule")
+	   nil))
+	))))
+
+(defun nndiary-next-occurence (sched now)
+  ;; Returns the next occurence of schedule SCHED, starting from time NOW.
+  ;; If there's no next occurence, returns the last one (if any) which is then
+  ;; in the past.
+  (let* ((today (decode-time now))
+	 (this-minute (nth 1 today))
+	 (this-hour (nth 2 today))
+	 (this-day (nth 3 today))
+	 (this-month (nth 4 today))
+	 (this-year (nth 5 today))
+	 (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
+	 (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
+	 (dom-list (nth 2 sched))
+	 (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<))
+	 (years (if (nth 4 sched)
+		    (sort (nndiary-flatten (nth 4 sched) 1971) '<)
+		  t))
+	 (dow-list (nth 5 sched))
+	 (year (1- this-year))
+	 (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
+			(current-time-zone))))
+    ;; Special case: an asterisk in one of the days specifications means that
+    ;; only the other should be taken into account. If both are unspecified,
+    ;; you would get all possible days in both.
+    (cond ((null dow-list)
+	   ;; this gets all days if dom-list is nil
+	   (setq dom-list (nndiary-flatten dom-list 1 31)))
+	  ((null dom-list)
+	   ;; this also gets all days if dow-list is nil
+	   (setq dow-list (nndiary-flatten dow-list 0 6)))
+	  (t
+	   (setq dom-list (nndiary-flatten dom-list 1 31))
+	   (setq dow-list (nndiary-flatten dow-list 0 6))))
+    ;; Remove past years.
+    (unless (eq years t)
+      (while (and (car years) (< (car years) this-year))
+	(pop years)))
+    (if years
+	;; Because we might not be limited in years, we must guard against
+	;; infinite loops. Appart from cases like Feb 31, there are probably
+	;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
+	;; decide this, so I assume that if we reach 10 years later, the
+	;; schedule is undecidable.
+	(or
+	 (catch 'found
+	   (while (if (eq years t)
+		      (and (setq year (1+ year))
+			   (<= year (+ 10 this-year)))
+		    (setq year (pop years)))
+	     (let ((months month-list)
+		   month)
+	       ;; Remove past months for this year.
+	       (and (= year this-year)
+		    (while (and (car months) (< (car months) this-month))
+		      (pop months)))
+	       (while (setq month (pop months))
+		 ;; Now we must merge the Dows with the Doms. To do that, we
+		 ;; have to know which day is the 1st one for this month.
+		 ;; Maybe there's simpler, but decode-time(encode-time) will
+		 ;; give us the answer.
+		 (let ((first (nth 6 (decode-time
+				      (encode-time 0 0 0 1 month year
+						   time-zone))))
+		       (max (cond ((= month 2)
+				   (if (date-leap-year-p year) 29 28))
+				  ((<= month 7)
+				   (if (zerop (% month 2)) 30 31))
+				  (t
+				   (if (zerop (% month 2)) 31 30))))
+		       (doms dom-list)
+		       (dows dow-list)
+		       day days)
+		   ;; first, review the doms to see if they are valid.
+		   (while (setq day (pop doms))
+		     (and (<= day max)
+			  (push day days)))
+		   ;; second add all possible dows
+		   (while (setq day (pop dows))
+		     ;; days start at 1.
+		     (setq day (1+ (- day first)))
+		     (and (< day 0) (setq day (+ 7 day)))
+		     (while (<= day max)
+		       (push day days)
+		       (setq day (+ 7 day))))
+		   ;; Aaaaaaall right. Now we have a valid list of DAYS for
+		   ;; this month and this year.
+		   (when days
+		     (setq days (sort days '<))
+		     ;; Remove past days for this year and this month.
+		     (and (= year this-year)
+			  (= month this-month)
+			  (while (and (car days) (< (car days) this-day))
+			    (pop days)))
+		     (while (setq day (pop days))
+		       (let ((hours hour-list)
+			     hour)
+			 ;; Remove past hours for this year, this month and
+			 ;; this day.
+			 (and (= year this-year)
+			      (= month this-month)
+			      (= day this-day)
+			      (while (and (car hours)
+					  (< (car hours) this-hour))
+				(pop hours)))
+			 (while (setq hour (pop hours))
+			   (let ((minutes minute-list)
+				 minute)
+			     ;; Remove past hours for this year, this month,
+			     ;; this day and this hour.
+			     (and (= year this-year)
+				  (= month this-month)
+				  (= day this-day)
+				  (= hour this-hour)
+				  (while (and (car minutes)
+					      (< (car minutes) this-minute))
+				    (pop minutes)))
+			     (while (setq minute (pop minutes))
+			       ;; Ouch! Here, we've got a complete valid
+			       ;; schedule. It's a good one if it's in the
+			       ;; future.
+			       (let ((time (encode-time 0 minute hour day
+							month year
+							time-zone)))
+				 (and (time-less-p now time)
+				      (throw 'found time)))
+			       ))))
+		       ))
+		   )))
+	     ))
+	 (nndiary-last-occurence sched))
+      ;; else
+      (nndiary-last-occurence sched))
+    ))
+
+(defun nndiary-expired-article-p (file)
+  (with-temp-buffer
+    (if (nnheader-insert-head file)
+	(let ((sched (nndiary-schedule)))
+	  ;; An article has expired if its last schedule (if any) is in the
+	  ;; past. A permanent schedule never expires.
+	  (and sched
+	       (setq sched (nndiary-last-occurence sched))
+	       (time-less-p sched (current-time))))
+      ;; else
+      (nnheader-report 'nndiary "Could not read file %s" file)
+      nil)
+    ))
+
+(defun nndiary-renew-article-p (file timestamp)
+  (erase-buffer)
+  (if (nnheader-insert-head file)
+      (let ((now (current-time))
+	    (sched (nndiary-schedule)))
+	;; The article should be re-considered as unread if there's a reminder
+	;; between the group timestamp and the current time.
+	(when (and sched (setq sched (nndiary-next-occurence sched now)))
+	  (let ((reminders ;; add the next occurence itself at the end.
+		 (append (nndiary-compute-reminders sched) (list sched))))
+	    (while (and reminders (time-less-p (car reminders) timestamp))
+	      (pop reminders))
+	    ;; The reminders might be empty if the last date is in the past,
+	    ;; or we've got at least the next occurence itself left. All past
+	    ;; dates are renewed.
+	    (or (not reminders)
+		(time-less-p (car reminders) now)))
+	  ))
+    ;; else
+    (nnheader-report 'nndiary "Could not read file %s" file)
+    nil))
+
+;; The end... ===============================================================
+
+(mapcar
+ (lambda (elt)
+   (let ((header (intern (format "X-Diary-%s" (car elt)))))
+     ;; Required for building NOV databases and some other stuff
+     (add-to-list 'gnus-extra-headers header)
+     (add-to-list 'nnmail-extra-headers header)))
+ nndiary-headers)
+
+(unless (assoc "nndiary" gnus-valid-select-methods)
+  (gnus-declare-backend "nndiary" 'post-mail 'respool 'address))
+
+(provide 'nndiary)
+
+
+;;; nndiary.el ends here
diff --git a/lisp/nnir.el b/lisp/nnir.el
new file mode 100644
index 0000000..846db89
--- /dev/null
+++ b/lisp/nnir.el
@@ -0,0 +1,1375 @@
+;;; nnir.el --- search mail with various search engines
+;; Copyright (C) 1998 Kai Großjohann
+
+;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
+;; Keywords: news, mail, searching, ir, glimpse, wais
+
+;; This file is not part of GNU Emacs.
+
+;; This 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; The most recent version of this can always be fetched from the
+;; following FTP site:
+;; ls6-ftp.cs.uni-dortmund.de:/pub/src/emacs
+
+;; This code is still in the development stage but I'd like other
+;; people to have a look at it.  Please do not hesitate to contact me
+;; with your ideas.
+
+;; What does it do?  Well, it allows you to index your mail using some
+;; search engine (freeWAIS-sf and Glimpse are currently supported),
+;; then type `G G' in the Group buffer and issue a query to the search
+;; engine.  You will then get a buffer which shows all articles
+;; matching the query, sorted by Retrieval Status Value (score).
+
+;; When looking at the retrieval result (in the Summary buffer) you
+;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an
+;; article.  You will be teleported into the group this article came
+;; from, showing the thread this article is part of.  (See below for
+;; restrictions.)
+
+;; The Lisp installation is simple: just put this file on your
+;; load-path, byte-compile it, and load it from ~/.gnus or something.
+;; This will install a new command `G G' in your Group buffer for
+;; searching your mail.  Note that you also need to configure a number
+;; of variables, as described below.
+
+;; Restrictions:
+;;
+;; * Currently, this expects that you use nnml or another
+;;   one-file-per-message backend.
+;; * It can only search one mail backend.
+;; * There are restrictions to the Glimpse setup.
+;; * There are restrictions to the Wais setup.
+;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before
+;;   limiting to the right articles.  This is much too slow, of
+;;   course.  May issue a query for number of articles to fetch; you
+;;   must accept the default of all articles at this point or things
+;;   may break.
+
+;; The Lisp setup involves setting a few variables and setting up the
+;; search engine.  The first variable to set is `nnir-mail-backend'.
+;; For me, `gnus-secondary-select-methods' contains just one select
+;; method, and this is also what I put in `nnir-mail-backend'.  Type
+;; `C-h v nnir-mail-backend RET' for more information -- the variable
+;; documentation includes more details and a few examples.  The second
+;; variable to set is `nnir-search-engine'.  Choose one of the engines
+;; listed in `nnir-engines'.  (Actually `nnir-engines' is an alist,
+;; type `C-h v nnir-engines RET' for more information; this includes
+;; examples for setting `nnir-search-engine', too.)
+
+;; You must also set up a search engine.  I'll tell you about the two
+;; search engines currently supported:
+
+;; 1. freeWAIS-sf
+;;
+;; As always with freeWAIS-sf, you need a so-called `format file'.  I
+;; use the following file:
+;;
+;; ,-----
+;; | # Kai's format file for freeWAIS-sf for indexing mails.
+;; | # Each mail is in a file, much like the MH format.
+;; |
+;; | # Document separator should never match -- each file is a document.
+;; | record-sep: /^@this regex should never match@$/
+;; |
+;; | # Searchable fields specification.
+;; |
+;; | region: /^[sS]ubject:/ /^[sS]ubject: */
+;; |         subject "Subject header" stemming TEXT BOTH
+;; | end: /^[^ \t]/
+;; |
+;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */
+;; |         to "To and Cc headers" SOUNDEX BOTH
+;; | end: /^[^ \t]/
+;; |
+;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */
+;; |         from "From header" SOUNDEX BOTH
+;; | end: /^[^ \t]/
+;; |
+;; | region: /^$/
+;; |         stemming TEXT GLOBAL
+;; | end: /^@this regex should never match@$/
+;; `-----
+;;
+;; 1998-07-22: waisindex would dump core on me for large articles with
+;; the above settings.  I used /^$/ as the end regex for the global
+;; field.  That seemed to work okay.
+
+;; There is a Perl module called `WAIS.pm' which is available from
+;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl.  This
+;; module comes with a nifty tool called `makedb', which I use for
+;; indexing.  Here's my `makedb.conf':
+;;
+;; ,-----
+;; | # Config file for makedb
+;; |
+;; | # Global options
+;; | waisindex = /usr/local/bin/waisindex
+;; | wais_opt  = -stem -t fields
+;; | # `-stem' option necessary when `stemming' is specified for the
+;; | # global field in the *.fmt file
+;; |
+;; | # Own variables
+;; | homedir = /home/kai
+;; |
+;; | # The mail database.
+;; | database        = mail
+;; | files           = `find $homedir/Mail -name \*[0-9] -print`
+;; | dbdir           = $homedir/.wais
+;; | limit           = 100
+;; `-----
+;;
+;; The Lisp setup involves the `nnir-wais-*' variables.  The most
+;; difficult to understand variable is probably
+;; `nnir-wais-remove-prefix'.  Here's what it does: the output of
+;; `waissearch' basically contains the file name and the (full)
+;; directory name.  As Gnus works with group names rather than
+;; directory names, the directory name is transformed into a group
+;; name as follows: first, a prefix is removed from the (full)
+;; directory name, then all `/' are replaced with `.'.  The variable
+;; `nnir-wais-remove-prefix' should contain a regex matching exactly
+;; this prefix.  It defaults to `$HOME/Mail/' (note the trailing
+;; slash).
+
+;; 2. Glimpse
+;;
+;; The code expects you to have one Glimpse index which contains all
+;; your mail files.  The Lisp setup involves setting the
+;; `nnir-glimpse-*' variables.  The most difficult to understand
+;; variable is probably `nnir-glimpse-remove-prefix', it corresponds
+;; to `nnir-wais-remove-prefix', see above.  The `nnir-glimpse-home'
+;; variable should be set to the value of the `-H' option which allows
+;; one to search this Glimpse index.  I have indexed my whole home
+;; directory with Glimpse, so I assume a default of `$HOME'.
+
+;; 3. Namazu
+;;
+;; The Namazu backend requires you to have one directory containing all
+;; index files, this is controlled by the `nnir-namazu-index-directory'
+;; variable.  To function the `nnir-namazu-remove-prefix' variable must
+;; also be correct, see the documentation for `nnir-wais-remove-prefix'
+;; above.
+;;
+;; It is particularly important not to pass any any switches to namazu
+;; that will change the output format.  Good switches to use include
+;; `--sort', `--ascending', `--early' and `--late'.  Refer to the Namazu
+;; documentation for further information on valid switches.
+;;
+;; To index my mail with the `mknmz' program I use the following
+;; configuration file:
+;;
+;; ,----
+;; | package conf;  # Don't remove this line!
+;; |
+;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
+;; | $EXCLUDE_PATH = "spam|sent";
+;; |
+;; | # Header fields which should be searchable. case-insensitive
+;; | $REMAIN_HEADER = "from|date|message-id|subject";
+;; |
+;; | # Searchable fields. case-insensitive
+;; | $SEARCH_FIELD = "from|date|message-id|subject";
+;; |
+;; | # The max length of a word.
+;; | $WORD_LENG_MAX = 128;
+;; |
+;; | # The max length of a field.
+;; | $MAX_FIELD_LENGTH = 256;
+;; `----
+;;
+;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and
+;; ~/Mail/archive/, so to index them I go to the directory set in
+;; `nnir-namazu-index-directory' and issue the following command.
+;;
+;;      mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
+;;
+;; For maximum searching efficiency I have a cron job set to run this
+;; command every four hours.
+
+;; Developer information:
+
+;; I have tried to make the code expandable.  Basically, it is divided
+;; into two layers.  The upper layer is somewhat like the `nnvirtual'
+;; or `nnkiboze' backends: given a specification of what articles to
+;; show from another backend, it creates a group containing exactly
+;; those articles.  The lower layer issues a query to a search engine
+;; and produces such a specification of what articles to show from the
+;; other backend.
+
+;; The interface between the two layers consists of the single
+;; function `nnir-run-query', which just selects the appropriate
+;; function for the search engine one is using.  The input to
+;; `nnir-run-query' is a string, representing the query as input by
+;; the user.  The output of `nnir-run-query' is supposed to be a
+;; vector, each element of which should in turn be a three-element
+;; vector.  The first element should be group name of the article, the
+;; second element should be the article number, and the third element
+;; should be the Retrieval Status Value (RSV) as returned from the
+;; search engine.  An RSV is the score assigned to the document by the
+;; search engine.  For Boolean search engines like Glimpse, the RSV is
+;; always 1000 (or 1 or 100, or whatever you like).
+
+;; The sorting order of the articles in the summary buffer created by
+;; nnir is based on the order of the articles in the above mentioned
+;; vector, so that's where you can do the sorting you'd like.  Maybe
+;; it would be nice to have a way of displaying the search result
+;; sorted differently?
+
+;; So what do you need to do when you want to add another search
+;; engine?  You write a function that executes the query.  Temporary
+;; data from the search engine can be put in `nnir-tmp-buffer'.  This
+;; function should return the list of articles as a vector, as
+;; described above.  Then, you need to register this backend in
+;; `nnir-engines'.  Then, users can choose the backend by setting
+;; `nnir-search-engine'.
+
+;; Todo, or future ideas:
+
+;; * Make it so that Glimpse can also be called without `-F'.
+;;
+;; * It should be possible to restrict search to certain groups.
+;;
+;; * There is currently no error checking.
+;;
+;; * The summary buffer display is currently really ugly, with all the
+;;   added information in the subjects.  How could I make this
+;;   prettier?
+;;
+;; * A function which can be called from an nnir summary buffer which
+;;   teleports you into the group the current article came from and
+;;   shows you the whole thread this article is part of.
+;;   Implementation suggestions?
+;;   (1998-07-24: There is now a preliminary implementation, but
+;;   it is much too slow and quite fragile.)
+;;
+;; * Support other mail backends.  In particular, probably quite a few
+;;   people use nnfolder.  How would one go about searching nnfolders
+;;   and producing the right data needed?  The group name and the RSV
+;;   are simple, but what about the article number?
+;;
+;; * Support compressed mail files.  Probably, just stripping off the
+;;   `.gz' or `.Z' file name extension is sufficient.
+;;
+;; * Support a find/grep combination.
+;;
+;; * At least for imap, the query is performed twice.
+;;
+;; * Support multiple mail backends.  The information that is needed
+;;   by nnir could be put in the server parameters.  (Use sensible
+;;   default values, though: include the name of the backend in the
+;;   default value such that people do not have to mess with the
+;;   server parameters if they don't want to.)  It is not clear how to
+;;   do the user interface, though.  Hm.  Maybe offer the user a
+;;   completable list of backends to search?  Or use the
+;;   process-marked groups to find out which backends to search?  Or
+;;   always search all backends?
+;;
+
+;; Have you got other ideas?
+
+;;; Setup Code:
+
+(defconst nnir-version "1.72"
+  "Version of NNIR.")
+
+(require 'cl)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'gnus-sum)
+(eval-and-compile
+  (require 'gnus-util))
+
+(nnoo-declare nnir)
+(nnoo-define-basics nnir)
+
+(gnus-declare-backend "nnir" 'mail)
+
+;;; Developer Extension Variable:
+
+(defvar nnir-engines
+  '((glimpse nnir-run-glimpse
+             ((group . "Group spec: ")))
+    (wais    nnir-run-waissearch
+             ())
+    (excite  nnir-run-excite-search
+	     ())
+    (imap    nnir-run-imap
+             ())
+    (swish++ nnir-run-swish++
+             ((group . "Group spec: ")))
+    (swish-e nnir-run-swish-e
+             ((group . "Group spec: ")))
+    (namazu nnir-run-namazu
+            ()))
+"Alist of supported search engines.
+Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
+ENGINE is a symbol designating the searching engine.  FUNCTION is also
+a symbol, giving the function that does the search.  The third element
+ARGS is a list of cons pairs (PARAM . PROMPT).  When issuing a query,
+the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
+
+The value of `nnir-search-engine' must be one of the ENGINE symbols.
+For example, use the following line for searching using freeWAIS-sf:
+    (setq nnir-search-engine 'wais)
+Use the following line if you read your mail via IMAP and your IMAP
+server supports searching:
+    (setq nnir-search-engine 'imap)
+Note that you have to set additional variables for most backends.  For
+example, the `wais' backend needs the variables `nnir-wais-program',
+`nnir-wais-database' and `nnir-wais-remove-prefix'.
+
+Add an entry here when adding a new search engine.")
+
+;;; User Customizable Variables:
+
+(defgroup nnir nil
+  "Search nnmh and nnml groups in Gnus with Glimpse, freeWAIS-sf, or EWS.")
+
+;; Mail backend.
+
+;; TODO:
+;; If `nil', use server parameters to find out which server to search. CCC
+;;
+(defcustom nnir-mail-backend '(nnml "")
+  "*Specifies which backend should be searched.
+More precisely, this is used to determine from which backend to fetch the
+messages found.
+
+This must be equal to an existing server, so maybe it is best to use
+something like the following:
+    (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods))
+The above line works fine if the mail backend you want to search is
+the first element of gnus-secondary-select-methods (`nth' starts counting
+at zero)."
+  :type '(sexp)
+  :group 'nnir)
+
+;; Search engine to use.
+
+(defcustom nnir-search-engine 'wais
+  "*The search engine to use.  Must be a symbol.
+See `nnir-engines' for a list of supported engines, and for example
+settings of `nnir-search-engine'."
+  :type '(sexp)
+  :group 'nnir)
+
+;; Glimpse engine.
+
+(defcustom nnir-glimpse-program "glimpse"
+  "*Name of Glimpse executable."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-glimpse-home (getenv "HOME")
+  "*Value of `-H' glimpse option.
+`~' and environment variables must be expanded, see the functions
+`expand-file-name' and `substitute-in-file-name'."
+  :type '(directory)
+  :group 'nnir)
+
+(defcustom nnir-glimpse-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "*The prefix to remove from each file name returned by Glimpse
+in order to get a group name (albeit with / instead of .).  This is a
+regular expression.
+
+For example, suppose that Glimpse returns file names such as
+\"/home/john/Mail/mail/misc/42\".  For this example, use the following
+setting:  (setq nnir-glimpse-remove-prefix \"/home/john/Mail/\")
+Note the trailing slash.  Removing this prefix gives \"mail/misc/42\".
+`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
+arrive at the correct group name, \"mail.misc\"."
+  :type '(regexp)
+  :group 'nnir)
+
+(defcustom nnir-glimpse-additional-switches '("-i")
+  "*A list of strings, to be given as additional arguments to glimpse.
+The switches `-H', `-W', `-l' and `-y' are always used -- calling
+glimpse without them does not make sense in our situation.
+Suggested elements to put here are `-i' and `-w'.
+
+Note that this should be a list.  Ie, do NOT use the following:
+    (setq nnir-glimpse-additional-switches \"-i -w\") ; wrong!
+Instead, use this:
+    (setq nnir-glimpse-additional-switches '(\"-i\" \"-w\"))"
+  :type '(repeat (string))
+  :group 'nnir)
+
+;; freeWAIS-sf.
+
+(defcustom nnir-wais-program "waissearch"
+  "*Name of waissearch executable."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
+  "*Name of Wais database containing the mail.
+
+Note that this should be a file name without extension.  For example,
+if you have a file /home/john/.wais/mail.fmt, use this:
+    (setq nnir-wais-database \"/home/john/.wais/mail\")
+The string given here is passed to `waissearch -d' as-is."
+  :type '(file)
+  :group 'nnir)
+
+(defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "*The prefix to remove from each directory name returned by waissearch
+in order to get a group name (albeit with / instead of .).  This is a
+regular expression.
+
+This variable is similar to `nnir-glimpse-remove-prefix', only for Wais,
+not Glimpse."
+  :type '(regexp)
+  :group 'nnir)
+
+;; EWS (Excite for Web Servers) engine.
+
+(defcustom nnir-excite-aquery-program "aquery.pl"
+  "*Name of the EWS query program.  Should be `aquery.pl' or a path to same."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-excite-collection "Mail"
+  "*Name of the EWS collection to search."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-excite-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "*The prefix to remove from each file name returned by EWS
+in order to get a group name (albeit with / instead of .).  This is a
+regular expression.
+
+This variable is very similar to `nnir-glimpse-remove-prefix', except
+that it is for EWS, not Glimpse."
+  :type '(regexp)
+  :group 'nnir)
+
+(defcustom nnir-imap-default-charset nil
+  "*Name of the charset of the strings that appear in the search criteria."
+  :type '(choice (const nil) symbol)
+  :group 'nnir)
+
+;; Swish++.  Next three variables Copyright (C) 2000, 2001 Christoph
+;; Conrad <christoph.conrad@gmx.de>.
+;; Swish++ home page: http://homepage.mac.com/pauljlucas/software/swish/
+
+(defcustom nnir-swish++-configuration-file
+  (expand-file-name "~/Mail/swish++.conf")
+  "*Configuration file for swish++."
+  :type '(file)
+  :group 'nnir)
+
+(defcustom nnir-swish++-program "search"
+  "*Name of swish++ search executable."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-swish++-additional-switches '()
+    "*A list of strings, to be given as additional arguments to swish++.
+
+Note that this should be a list.  Ie, do NOT use the following:
+    (setq nnir-swish++-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+    (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
+  :type '(repeat (string))
+  :group 'nnir)
+
+(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "*The prefix to remove from each file name returned by swish++
+in order to get a group name (albeit with / instead of .).  This is a
+regular expression.
+
+This variable is very similar to `nnir-glimpse-remove-prefix', except
+that it is for swish++, not Glimpse."
+  :type '(regexp)
+  :group 'nnir)
+
+;; Swish-E.  Next three variables Copyright (C) 2000 Christoph Conrad
+;; <christoph.conrad@gmx.de>.
+;; URL: http://sunsite.berkeley.edu/SWISH-E/
+;; New version: http://www.boe.es/swish-e
+
+(defcustom nnir-swish-e-index-file
+  (expand-file-name "~/Mail/index.swish-e")
+  "*Index file for swish-e."
+  :type '(file)
+  :group 'nnir)
+
+(defcustom nnir-swish-e-program "swish-e"
+  "*Name of swish-e search executable."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-swish-e-additional-switches '()
+  "*A list of strings, to be given as additional arguments to swish-e.
+
+Note that this should be a list.  Ie, do NOT use the following:
+    (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+    (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))"
+  :type '(repeat (string))
+  :group 'nnir)
+
+(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "*The prefix to remove from each file name returned by swish-e
+in order to get a group name (albeit with / instead of .).  This is a
+regular expression.
+
+This variable is very similar to `nnir-glimpse-remove-prefix', except
+that it is for swish-e, not Glimpse."
+  :type '(regexp)
+  :group 'nnir)
+
+;; Namazu engine, see <URL:http://ww.namazu.org/>
+
+(defcustom nnir-namazu-program "namazu"
+  "*Name of Namazu search executable."
+  :type '(string)
+  :group 'nnir)
+
+(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/")
+  "*Index directory for Namazu."
+  :type '(directory)
+  :group 'nnir)
+
+(defcustom nnir-namazu-additional-switches '()
+  "*A list of strings, to be given as additional arguments to namazu.
+The switches `-q', `-a', and `-s' are always used, very few other switches
+make any sense in this context.
+
+Note that this should be a list.  Ie, do NOT use the following:
+    (setq nnir-namazu-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+    (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
+  :type '(repeat (string))
+  :group 'nnir)
+
+(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+  "*The prefix to remove from each file name returned by Namazu
+in order to get a group name (albeit with / instead of .).
+
+This variable is very similar to `nnir-glimpse-remove-prefix', except
+that it is for Namazu, not Glimpse."
+  :type '(directory)
+  :group 'nnir)
+
+;;; Internal Variables:
+
+(defvar nnir-current-query nil
+  "Internal: stores current query (= group name).")
+
+(defvar nnir-current-server nil
+  "Internal: stores current server (does it ever change?).")
+
+(defvar nnir-current-group-marked nil
+  "Internal: stores current list of process-marked groups.")
+
+(defvar nnir-artlist nil
+  "Internal: stores search result.")
+
+(defvar nnir-tmp-buffer " *nnir*"
+  "Internal: temporary buffer.")
+
+;;; Code:
+
+;; Gnus glue.
+
+(defun gnus-group-make-nnir-group (extra-parms query)
+  "Create an nnir group.  Asks for query."
+  (interactive "P\nsQuery: ")
+  (let ((parms nil))
+    (if extra-parms
+        (setq parms (nnir-read-parms query))
+      (setq parms (list (cons 'query query))))
+    (gnus-group-read-ephemeral-group
+     (concat "nnir:" (prin1-to-string parms)) '(nnir "") t
+     (cons (current-buffer)
+           gnus-current-window-configuration)
+     nil)))
+
+;; Emacs 19 compatibility?
+(or (fboundp 'kbd) (defalias 'kbd 'read-kbd-macro))
+
+(defun nnir-group-mode-hook ()
+  (define-key gnus-group-mode-map
+    (if (fboundp 'read-kbd-macro)
+        (kbd "G G")
+      "GG")                             ; XEmacs 19 compat
+    'gnus-group-make-nnir-group))
+(add-hook 'gnus-group-mode-hook
+	  (lambda ()
+	    (unless (string-match "T-gnus" gnus-version)
+	      (nnir-group-mode-hook))))
+
+
+
+;; Summary mode commands.
+
+(defun gnus-summary-nnir-goto-thread ()
+  "Only applies to nnir groups.  Go to group this article came from
+and show thread that contains this article."
+  (interactive)
+  (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
+    (error "Can't execute this command unless in nnir group."))
+  (let* ((cur (gnus-summary-article-number))
+         (backend-group (nnir-artlist-artitem-group nnir-artlist cur))
+         (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
+    (gnus-group-read-ephemeral-group
+     backend-group
+     nnir-mail-backend
+     t                                  ; activate
+     (cons (current-buffer)
+           'summary)                    ; window config
+     nil
+     (list backend-number))
+    (gnus-summary-limit (list backend-number))
+    (gnus-summary-refer-thread)))
+
+(if (fboundp 'eval-after-load)
+    (eval-after-load "gnus-sum"
+      '(define-key gnus-summary-goto-map
+         "T" 'gnus-summary-nnir-goto-thread))
+  (add-hook 'gnus-summary-mode-hook
+            (function (lambda ()
+                        (define-key gnus-summary-goto-map
+                          "T" 'gnus-summary-nnir-goto-thread)))))
+
+
+
+;; Gnus backend interface functions.
+
+(deffoo nnir-open-server (server &optional definitions)
+  ;; Just set the server variables appropriately.
+  (nnoo-change-server 'nnir server definitions))
+
+(deffoo nnir-request-group (group &optional server fast)
+  "GROUP is the query string."
+  (nnir-possibly-change-server server)
+  ;; Check for cache and return that if appropriate.
+  (if (and (equal group nnir-current-query)
+           (equal gnus-group-marked nnir-current-group-marked)
+           (or (null server)
+               (equal server nnir-current-server)))
+      nnir-artlist
+    ;; Cache miss.
+    (setq nnir-artlist (nnir-run-query group))
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (if (zerop (length nnir-artlist))
+          (progn
+            (setq nnir-current-query nil
+                  nnir-current-server nil
+                  nnir-current-group-marked nil
+                  nnir-artlist nil)
+            (nnheader-report 'nnir "Search produced empty results."))
+        ;; Remember data for cache.
+        (setq nnir-current-query group)
+        (when server (setq nnir-current-server server))
+        (setq nnir-current-group-marked gnus-group-marked)
+        (nnheader-insert "211 %d %d %d %s\n"
+                         (nnir-artlist-length nnir-artlist) ; total #
+                         1              ; first #
+                         (nnir-artlist-length nnir-artlist) ; last #
+                         group)))))     ; group name
+
+(deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
+  (save-excursion
+    (let ((artlist (copy-sequence articles))
+          (idx 1)
+          (art nil)
+          (artitem nil)
+          (artgroup nil) (artno nil)
+          (artrsv nil)
+          (artfullgroup nil)
+          (novitem nil)
+          (novdata nil)
+          (foo nil))
+      (while (not (null artlist))
+        (setq art (car artlist))
+        (or (numberp art)
+            (nnheader-report
+             'nnir
+             "nnir-retrieve-headers doesn't grok message ids: %s"
+             art))
+        (setq artitem (nnir-artlist-article nnir-artlist art))
+        (setq artrsv (nnir-artitem-rsv artitem))
+        (setq artgroup (nnir-artitem-group artitem))
+        (setq artno (nnir-artitem-number artitem))
+        (setq artfullgroup (nnir-group-full-name artgroup))
+        ;; retrieve NOV or HEAD data for this article, transform into
+        ;; NOV data and prepend to `novdata'
+        (set-buffer nntp-server-buffer)
+        (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil))
+          (nov
+           (goto-char (point-min))
+           (setq novitem (nnheader-parse-nov))
+           (unless novitem
+             (pop-to-buffer nntp-server-buffer)
+             (error
+              "nnheader-parse-nov returned nil for article %s in group %s"
+              artno artfullgroup)))
+          (headers
+           (goto-char (point-min))
+           (setq novitem (nnheader-parse-head))
+           (unless novitem
+             (pop-to-buffer nntp-server-buffer)
+             (error
+              "nnheader-parse-head returned nil for article %s in group %s"
+              artno artfullgroup)))
+          (t (nnheader-report 'nnir "Don't support header type %s." foo)))
+        ;; replace article number in original group with article number
+        ;; in nnir group
+        (mail-header-set-number novitem idx)
+        (mail-header-set-from novitem
+                              (mail-header-from novitem))
+        (mail-header-set-subject
+         novitem
+         (format "[%d: %s/%d] %s"
+                 artrsv artgroup artno
+                 (mail-header-subject novitem)))
+        ;;-(mail-header-set-extra novitem nil)
+        (push novitem novdata)
+        (setq artlist (cdr artlist))
+        (setq idx (1+ idx)))
+      (setq novdata (nreverse novdata))
+      (set-buffer nntp-server-buffer) (erase-buffer)
+      (mapcar 'nnheader-insert-nov novdata)
+      'nov)))
+
+(deffoo nnir-request-article (article
+                              &optional group server to-buffer)
+  (save-excursion
+    (let* ((artitem (nnir-artlist-article nnir-artlist
+                                          article))
+           (artgroup (nnir-artitem-group artitem))
+           (artno (nnir-artitem-number artitem))
+           ;; Bug?
+           ;; Why must we bind nntp-server-buffer here?  It won't
+           ;; work if `buf' is used, say.  (Of course, the set-buffer
+           ;; line below must then be updated, too.)
+           (nntp-server-buffer (or to-buffer nntp-server-buffer)))
+      (set-buffer nntp-server-buffer)
+      (erase-buffer)
+      (message "Requesting article %d from group %s"
+               artno
+               (nnir-group-full-name artgroup))
+      (gnus-request-article artno (nnir-group-full-name artgroup)
+                            nntp-server-buffer)
+      (cons artgroup artno))))
+
+
+(nnoo-define-skeleton nnir)
+
+;;; Search Engine Interfaces:
+
+;; Glimpse interface.
+(defun nnir-run-glimpse (query &optional group)
+  "Run given query against glimpse.  Returns a vector of (group name, file name)
+pairs (also vectors, actually)."
+  (save-excursion
+    (let ((artlist nil)
+          (groupspec (cdr (assq 'group query)))
+          (qstring (cdr (assq 'query query))))
+      (when (and group groupspec)
+        (error (concat "It does not make sense to use a group spec"
+                       " with process-marked groups.")))
+      (when group
+        (setq groupspec (gnus-group-real-name group)))
+      (set-buffer (get-buffer-create nnir-tmp-buffer))
+      (erase-buffer)
+      (if groupspec
+          (message "Doing glimpse query %s on %s..." query groupspec)
+        (message "Doing glimpse query %s..." query))
+      (let* ((cp-list
+              `( ,nnir-glimpse-program
+                 nil                    ; input from /dev/null
+                 t                      ; output
+                 nil                    ; don't redisplay
+                 "-H" ,nnir-glimpse-home ; search home dir
+                 "-W"                   ; match pattern in file
+                 "-l" "-y"              ; misc options
+                 ,@nnir-glimpse-additional-switches
+                 "-F" ,nnir-glimpse-remove-prefix ; restrict output to mail
+                 ,qstring               ; the query, in glimpse format
+                ))
+             (exitstatus
+              (progn
+                (message "%s args: %s" nnir-glimpse-program
+                         (mapconcat 'identity (cddddr cp-list) " "))
+                (apply 'call-process cp-list))))
+        (unless (or (null exitstatus)
+                    (zerop exitstatus))
+          (nnheader-report 'nnir "Couldn't run glimpse: %s" exitstatus)
+          ;; Glimpse failure reason is in this buffer, show it if
+          ;; the user wants it.
+          (when (> gnus-verbose 6)
+            (display-buffer nnir-tmp-buffer))))
+      (when groupspec
+        (keep-lines groupspec))
+      (if groupspec
+          (message "Doing glimpse query %s on %s...done" query groupspec)
+        (message "Doing glimpse query %s...done" query))
+      (sit-for 0)
+      ;; CCC: The following work of extracting group name and article
+      ;; number from the Glimpse output can probably better be done by
+      ;; just going through the buffer once, and plucking out the
+      ;; right information from each line.
+      ;; remove superfluous stuff from glimpse output
+      (goto-char (point-min))
+      (delete-non-matching-lines "/[0-9]+$")
+      ;;(delete-matching-lines "\\.overview~?$")
+      (goto-char (point-min))
+      (while (re-search-forward (concat "^" nnir-glimpse-remove-prefix) nil t)
+        (replace-match ""))
+      ;; separate group name from article number with \t
+      ;; XEmacs compatible version
+      (goto-char (point-max))
+      (while (re-search-backward "/[0-9]+$" nil t)
+        (delete-char 1 nil)
+        (insert-char ?\t 1))
+; Emacs compatible version
+;      (goto-char (point-min))
+;      (while (re-search-forward "\\(/\\)[0-9]+$" nil t)
+;        (replace-match "\t" t t nil 1))
+      ;; replace / with . in group names
+      (subst-char-in-region (point-min) (point-max) ?/ ?. t)
+      ;; massage buffer to contain some Lisp;
+      ;; this depends on the artlist encoding internals
+      ;; maybe this dependency should be removed?
+      (goto-char (point-min))
+      (while (not (eobp))
+        (insert "[\"")
+        (skip-chars-forward "^\t")
+        (insert "\" ")
+        (end-of-line)
+        (insert " 1000 ]")              ; 1000 = score
+        (forward-line 1))
+      (insert "])\n")
+      (goto-char (point-min))
+      (insert "(setq artlist [\n")
+      (eval-buffer)
+      (sort* artlist
+             (function (lambda (x y)
+                         (if (string-lessp (nnir-artitem-group x)
+                                           (nnir-artitem-group y))
+                             t
+                           (< (nnir-artitem-number x)
+                              (nnir-artitem-number y))))))
+      )))
+
+;; freeWAIS-sf interface.
+(defun nnir-run-waissearch (query &optional group)
+  "Run given query agains waissearch.  Returns vector of (group name, file name)
+pairs (also vectors, actually)."
+  (when group
+    (error "The freeWAIS-sf backend cannot search specific groups."))
+  (save-excursion
+    (let ((qstring (cdr (assq 'query query)))
+          (artlist nil)
+          (score nil) (artno nil) (dirnam nil) (group nil))
+      (set-buffer (get-buffer-create nnir-tmp-buffer))
+      (erase-buffer)
+      (message "Doing WAIS query %s..." query)
+      (call-process nnir-wais-program
+                    nil                 ; input from /dev/null
+                    t                   ; output to current buffer
+                    nil                 ; don't redisplay
+                    "-d" nnir-wais-database ; database to search
+                    qstring)
+      (message "Massaging waissearch output...")
+      ;; remove superfluous lines
+      (keep-lines "Score:")
+      ;; extract data from result lines
+      (goto-char (point-min))
+      (while (re-search-forward
+              "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t)
+        (setq score (match-string 1)
+              artno (match-string 2)
+              dirnam (match-string 3))
+        (unless (string-match nnir-wais-remove-prefix dirnam)
+          (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
+                           dirnam nnir-wais-remove-prefix))
+        (setq group (substitute ?. ?/ (replace-match "" t t dirnam)))
+        (push (vector group
+                      (string-to-int artno)
+                      (string-to-int score))
+              artlist))
+      (message "Massaging waissearch output...done")
+      (apply 'vector
+             (sort* artlist
+                    (function (lambda (x y)
+                                (> (nnir-artitem-rsv x)
+                                   (nnir-artitem-rsv y)))))))))
+
+;; EWS (Excite for Web Servers) interface
+(defun nnir-run-excite-search (query &optional group)
+  "Run a given query against EWS.  Returns vector of (group name, file name)
+pairs (also vectors, actually)."
+  (when group
+    (error "Searching specific groups not implemented for EWS."))
+  (save-excursion
+    (let ((qstring (cdr (assq 'query query)))
+	  artlist group article-num article)
+      (setq nnir-current-query query)
+      (set-buffer (get-buffer-create nnir-tmp-buffer))
+      (erase-buffer)
+      (message "Doing EWS query %s..." qstring)
+      (call-process nnir-excite-aquery-program
+		    nil			; input from /dev/null
+		    t			; output to current buffer
+		    nil			; don't redisplay
+		    nnir-excite-collection
+		    (if (string= (substring qstring 0 1) "(")
+			qstring
+		      (format "(concept %s)" qstring)))
+      (message "Gathering query output...")
+
+      (goto-char (point-min))
+      (while (re-search-forward
+	      "^[0-9]+\\s-[0-9]+\\s-[0-9]+\\s-\\(\\S-*\\)" nil t)
+	(setq article (match-string 1))
+	(unless (string-match
+		 (concat "^" (regexp-quote nnir-excite-remove-prefix)
+			 "\\(.*\\)/\\([0-9]+\\)") article)
+	  (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
+			   article nnir-excite-remove-prefix))
+	(setq group (substitute ?. ?/ (match-string 1 article)))
+	(setq article-num (match-string 2 article))
+	(setq artlist (vconcat artlist (vector (vector group
+						       (string-to-int article-num)
+						       1000)))))
+      (message "Gathering query output...done")
+      artlist)))
+
+;; IMAP interface.  The following function is Copyright (C) 1998 Simon
+;; Josefsson <jas@pdc.kth.se>.
+;; todo:
+;; nnir invokes this two (2) times???!
+;; we should not use nnimap at all but open our own server connection
+;; we should not LIST * but use nnimap-list-pattern from defs
+;; send queries as literals
+;; handle errors
+
+(eval-when-compile
+  (defvar nnimap-server-buffer))
+
+(defun nnir-run-imap (query &optional group)
+  (require 'imap)
+  (require 'nnimap)
+  (require 'mm-util)
+  (unless group
+    (error "Must specify groups for IMAP searching."))
+  (save-excursion
+    (let ((qstring (cdr (assq 'query query)))
+	  (server (cadr nnir-mail-backend))
+	  (defs (caddr nnir-mail-backend))
+	  artlist buf)
+      (message "Opening server %s" server)
+      (condition-case ()
+	  (when (nnimap-open-server server defs) ;; xxx
+	    (setq buf nnimap-server-buffer) ;; xxx
+	    (message "Searching %s..." group)
+            (let ((arts 0)
+                  (mbx (gnus-group-real-name group))
+		  (multibyte-p (mm-multibyte-p))
+		  charset coding-system)
+              (when (imap-mailbox-select mbx nil buf)
+		(with-temp-buffer
+		  (if multibyte-p
+		      (mm-enable-multibyte))
+		  (insert qstring)
+		  (setq charset (car (mm-find-mime-charset-region
+				      (point-min)(point-max)))))
+		(unless charset
+		  (setq charset nnir-imap-default-charset))
+                (mapcar
+                 (lambda (artnum)
+                   (push (vector mbx artnum 1) artlist)
+                   (setq arts (1+ arts)))
+		 (if (and (not (eq charset 'us-ascii))
+			  (setq coding-system (mm-charset-to-coding-system
+					       charset)))
+		     (imap-search
+		      (concat "CHARSET " (symbol-name charset) " TEXT \""
+			      (mm-encode-coding-string qstring coding-system)
+			      "\"") buf)
+		   (imap-search (concat "TEXT \"" qstring "\"") buf)))
+                (message "Searching %s... %d matches" mbx arts)))
+            (message "Searching %s...done" group))
+        (quit nil))
+      (reverse artlist))))
+
+;; Swish++ interface.  The following function is Copyright (C) 2000,
+;; 2001 Christoph Conrad <christoph.conrad@gmx.de>.
+;; -cc- Todo
+;; Search by
+;; - group
+;; Sort by
+;; - rank (default)
+;; - article number
+;; - file size
+;; - group
+(defun nnir-run-swish++ (query &optional group)
+  "Run given query against swish++.
+Returns a vector of (group name, file name) pairs (also vectors,
+actually).
+
+Tested with swish++ 4.7 on GNU/Linux and with with swish++ 5.0b2 on
+Windows NT 4.0."
+
+  (when group
+    (error "The swish++ backend cannot search specific groups."))
+
+  (save-excursion
+    (let ( (qstring (cdr (assq 'query query)))
+	   (groupspec (cdr (assq 'group query)))
+           (artlist nil)
+           (score nil) (artno nil) (dirnam nil) (group nil) )
+
+      (when (equal "" qstring)
+        (error "swish++: You didn't enter anything."))
+
+      (set-buffer (get-buffer-create nnir-tmp-buffer))
+      (erase-buffer)
+
+      (if groupspec
+          (message "Doing swish++ query %s on %s..." qstring groupspec)
+        (message "Doing swish++ query %s..." qstring))
+
+      (let* ((cp-list `( ,nnir-swish++-program
+                         nil            ; input from /dev/null
+                         t              ; output
+                         nil            ; don't redisplay
+                         "--config-file" ,nnir-swish++-configuration-file
+                         ,@nnir-swish++-additional-switches
+                         ,qstring       ; the query, in swish++ format
+                         ))
+             (exitstatus
+              (progn
+                (message "%s args: %s" nnir-swish++-program
+                         (mapconcat 'identity (cddddr cp-list) " "));; ???
+                (apply 'call-process cp-list))))
+        (unless (or (null exitstatus)
+                    (zerop exitstatus))
+          (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus)
+          ;; swish++ failure reason is in this buffer, show it if
+          ;; the user wants it.
+          (when (> gnus-verbose 6)
+            (display-buffer nnir-tmp-buffer))))
+
+      ;; The results are output in the format of:
+      ;; V 4.7 Linux
+      ;; rank relative-path-name file-size file-title
+      ;; V 5.0b2:
+      ;; rank relative-path-name file-size topic??
+      ;; where rank is an integer from 1 to 100.
+      (goto-char (point-min))
+      (while (re-search-forward
+              "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
+        (setq score (match-string 1)
+              artno (file-name-nondirectory (match-string 2))
+              dirnam (file-name-directory (match-string 2)))
+
+        ;; don't match directories
+        (when (string-match "^[0-9]+$" artno)
+          (when (not (null dirnam))
+
+	    ; maybe limit results to matching groups.
+	    (when (or (not groupspec)
+		      (string-match groupspec dirnam))
+
+	      ;; remove nnir-swish++-remove-prefix from beginning of dirname
+	      (when (string-match (concat "^" nnir-swish++-remove-prefix)
+				  dirnam)
+		(setq dirnam (replace-match "" t t dirnam)))
+
+	      (setq dirnam (substring dirnam 0 -1))
+	      ;; eliminate all ".", "/", "\" from beginning. Always matches.
+	      (string-match "^[./\\]*\\(.*\\)$" dirnam)
+	      ;; "/" -> "."
+	      (setq group (substitute ?. ?/ (match-string 1 dirnam)))
+	      ;; "\\" -> "."
+	      (setq group (substitute ?. ?\\ group))
+
+	      (push (vector group
+			    (string-to-int artno)
+			    (string-to-int score))
+		    artlist)))))
+
+      (message "Massaging swish++ output...done")
+
+      ;; Sort by score
+      (apply 'vector
+             (sort* artlist
+                    (function (lambda (x y)
+                                (> (nnir-artitem-rsv x)
+                                   (nnir-artitem-rsv y)))))))))
+
+;; Swish-E interface.  The following function is Copyright (C) 2000,
+;; 2001 by Christoph Conrad <christoph.conrad@gmx.de>.
+(defun nnir-run-swish-e (query &optional group)
+  "Run given query against swish-e.
+Returns a vector of (group name, file name) pairs (also vectors,
+actually).
+
+Tested with swish-e-2.0.1 on Windows NT 4.0."
+
+  ;; swish-e crashes with empty parameter to "-w" on commandline...
+  (when group
+    (error "The swish-e backend cannot search specific groups."))
+
+  (save-excursion
+    (let ( (qstring (cdr (assq 'query query)))
+           (artlist nil)
+           (score nil) (artno nil) (dirnam nil) (group nil) )
+
+      (when (equal "" qstring)
+        (error "swish-e: You didn't enter anything."))
+
+      (set-buffer (get-buffer-create nnir-tmp-buffer))
+      (erase-buffer)
+
+      (message "Doing swish-e query %s..." query)
+      (let* ((cp-list `( ,nnir-swish-e-program
+                         nil            ; input from /dev/null
+                         t              ; output
+                         nil            ; don't redisplay
+                         "-f" ,nnir-swish-e-index-file
+                         ,@nnir-swish-e-additional-switches
+                         "-w"
+                         ,qstring       ; the query, in swish-e format
+                         ))
+             (exitstatus
+              (progn
+                (message "%s args: %s" nnir-swish-e-program
+                         (mapconcat 'identity (cddddr cp-list) " "))
+                (apply 'call-process cp-list))))
+        (unless (or (null exitstatus)
+                    (zerop exitstatus))
+          (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus)
+          ;; swish-e failure reason is in this buffer, show it if
+          ;; the user wants it.
+          (when (> gnus-verbose 6)
+            (display-buffer nnir-tmp-buffer))))
+
+      ;; The results are output in the format of:
+      ;; rank path-name file-title file-size
+      (goto-char (point-min))
+      (while (re-search-forward
+              "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
+        (setq score (match-string 1)
+              artno (match-string 3)
+              dirnam (file-name-directory (match-string 2)))
+
+        ;; don't match directories
+        (when (string-match "^[0-9]+$" artno)
+          (when (not (null dirnam))
+
+            ;; remove nnir-swish-e-remove-prefix from beginning of dirname
+            (when (string-match (concat "^" nnir-swish-e-remove-prefix)
+                                dirnam)
+              (setq dirnam (replace-match "" t t dirnam)))
+
+            (setq dirnam (substring dirnam 0 -1))
+            ;; eliminate all ".", "/", "\" from beginning. Always matches.
+            (string-match "^[./\\]*\\(.*\\)$" dirnam)
+            ;; "/" -> "."
+            (setq group (substitute ?. ?/ (match-string 1 dirnam)))
+            ;; Windows "\\" -> "."
+            (setq group (substitute ?. ?\\ group))
+
+            (push (vector group
+                          (string-to-int artno)
+                          (string-to-int score))
+                  artlist))))
+
+      (message "Massaging swish-e output...done")
+
+      ;; Sort by score
+      (apply 'vector
+             (sort* artlist
+                    (function (lambda (x y)
+                                (> (nnir-artitem-rsv x)
+                                   (nnir-artitem-rsv y)))))))))
+
+;; Namazu interface
+(defun nnir-run-namazu (query &optional group)
+  "Run given query against Namazu.  Returns a vector of (group name, file name)
+pairs (also vectors, actually).
+
+Tested with Namazu 2.0.6 on a GNU/Linux system."
+  (when group
+    (error "The Namazu backend cannot search specific groups"))
+  (save-excursion
+    (let (
+          (artlist nil)
+          (qstring (cdr (assq 'query query)))
+          (score nil)
+          (group nil)
+          (article nil)
+          )
+      (set-buffer (get-buffer-create nnir-tmp-buffer))
+      (erase-buffer)
+      (let* ((cp-list
+              `( ,nnir-namazu-program
+                 nil              ; input from /dev/null
+                 t                ; output
+                 nil              ; don't redisplay
+                 "-q"             ; don't be verbose
+                 "-a"             ; show all matches
+                 "-s"             ; use short format
+                 ,@nnir-namazu-additional-switches
+                 ,qstring         ; the query, in namazu format
+                 ,nnir-namazu-index-directory ; index directory
+                 ))
+             (exitstatus
+	      (let ((process-environment (copy-sequence process-environment)))
+		;; Disable locale.
+		(setenv "LC_ALL" "C")
+                (message "%s args: %s" nnir-namazu-program
+                         (mapconcat 'identity (cddddr cp-list) " "))
+		(apply 'call-process cp-list))))
+	(unless (or (null exitstatus)
+                    (zerop exitstatus))
+          (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus)
+          ;; Namazu failure reason is in this buffer, show it if
+          ;; the user wants it.
+          (when (> gnus-verbose 6)
+            (display-buffer nnir-tmp-buffer))))
+
+      ;; Namazu output looks something like this:
+      ;; 2. Re: Gnus agent expire broken (score: 55)
+      ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes)
+
+      (goto-char (point-min))
+      (while (re-search-forward
+              "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+              nil t)
+        (setq score (match-string 3)
+              group (file-name-directory (match-string 4))
+              article (file-name-nondirectory (match-string 4)))
+
+        ;; make sure article and group is sane
+        (when (and (string-match "^[0-9]+$" article)
+                   (not (null group)))
+          (when (string-match (concat "^" nnir-namazu-remove-prefix) group)
+            (setq group (replace-match "" t t group)))
+
+          ;; remove trailing slash from groupname
+          (setq group (substring group 0 -1))
+
+          ;; stuff results into artlist vector
+          (push (vector (substitute ?. ?/ group)
+                        (string-to-int article)
+                        (string-to-int score)) artlist)))
+
+      ;; sort artlist by score
+      (apply 'vector
+             (sort* artlist
+                    (function (lambda (x y)
+                                (> (nnir-artitem-rsv x)
+                                   (nnir-artitem-rsv y)))))))))
+
+;;; Util Code:
+
+(defun nnir-read-parms (query)
+  "Reads additional search parameters according to `nnir-engines'."
+  (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
+    (cons (cons 'query query)
+          (mapcar 'nnir-read-parm parmspec))))
+
+(defun nnir-read-parm (parmspec)
+  "Reads a single search parameter.
+`parmspec' is a cons cell, the car is a symbol, the cdr is a prompt."
+  (let ((sym (car parmspec))
+        (prompt (cdr parmspec)))
+    (cons sym (read-string prompt))))
+
+(defun nnir-run-query (query)
+  "Invoke appropriate search engine function (see `nnir-engines').
+If some groups were process-marked, run the query for each of the groups
+and concat the results."
+  (let ((search-func (cadr (assoc nnir-search-engine nnir-engines)))
+        (q (car (read-from-string query))))
+    (if gnus-group-marked
+        (apply 'append
+               (mapcar (lambda (x)
+                         (funcall search-func q x))
+                       gnus-group-marked))
+      (funcall search-func q nil))))
+
+(defun nnir-group-full-name (shortname)
+  "For the given group name, return a full Gnus group name.
+The Gnus backend/server information is added."
+  (gnus-group-prefixed-name shortname nnir-mail-backend))
+
+(defun nnir-possibly-change-server (server)
+  (unless (and server (nnir-server-opened server))
+    (nnir-open-server server)))
+
+
+;; Data type article list.
+
+(defun nnir-artlist-length (artlist)
+  "Returns number of articles in artlist."
+  (length artlist))
+
+(defun nnir-artlist-article (artlist n)
+  "Returns from ARTLIST the Nth artitem (counting starting at 1)."
+  (elt artlist (1- n)))
+
+(defun nnir-artitem-group (artitem)
+  "Returns the group from the ARTITEM."
+  (elt artitem 0))
+
+(defun nnir-artlist-artitem-group (artlist n)
+  "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
+  (nnir-artitem-group (nnir-artlist-article artlist n)))
+
+(defun nnir-artitem-number (artitem)
+  "Returns the number from the ARTITEM."
+  (elt artitem 1))
+
+(defun nnir-artlist-artitem-number (artlist n)
+  "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
+  (nnir-artitem-number (nnir-artlist-article artlist n)))
+
+(defun nnir-artitem-rsv (artitem)
+  "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
+  (elt artitem 2))
+
+(defun nnir-artlist-artitem-rsv (artlist n)
+  "Returns from ARTLIST the Retrieval Status Value of the Nth artitem
+(counting from 1)."
+  (nnir-artitem-rsv (nnir-artlist-article artlist n)))
+
+;; unused?
+(defun nnir-artlist-groups (artlist)
+  "Returns a list of all groups in the given ARTLIST."
+  (let ((res nil)
+        (with-dups nil))
+    ;; from each artitem, extract group component
+    (setq with-dups (mapcar 'nnir-artitem-group artlist))
+    ;; remove duplicates from above
+    (mapcar (function (lambda (x) (add-to-list 'res x)))
+            with-dups)
+    res))
+
+
+;; The end.
+(provide 'nnir)
diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el
new file mode 100644
index 0000000..65bb5bd
--- /dev/null
+++ b/lisp/nnmaildir.el
@@ -0,0 +1,1636 @@
+;;; nnmaildir.el --- maildir backend for Gnus
+;; Public domain.
+
+;; Author: Paul Jarc <prj@po.cwru.edu>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
+;; and in the maildir(5) man page from qmail (available at
+;; <URL:http://www.qmail.org/man/man5/maildir.html>).  nnmaildir also stores
+;; extra information in the .nnmaildir/ directory within a maildir.
+;;
+;; Some goals of nnmaildir:
+;; * Everything Just Works, and correctly.  E.g., NOV data is automatically
+;;   regenerated when stale; no need for manually running
+;;   *-generate-nov-databases.
+;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
+;;   SIGKILL will never corrupt its data in the filesystem.
+;; * Allow concurrent operation as much as possible.  If files change out
+;;   from under us, adapt to the changes or degrade gracefully.
+;; * We use the filesystem as a database, so that, e.g., it's easy to
+;;   manipulate marks from outside Gnus.
+;; * All information about a group is stored in the maildir, for easy backup,
+;;   copying, restoring, etc.
+;;
+;; Todo:
+;; * Add a hook for when moving messages from new/ to cur/, to support
+;;   nnmail's duplicate detection.
+;; * Improve generated Xrefs, so crossposts are detectable.
+;; * Improve code readability.
+
+;;; Code:
+
+;; eval this before editing
+[(progn
+   (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
+   (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
+   (put 'nnmaildir--with-nov-buffer  'lisp-indent-function 0)
+   (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
+   )
+]
+
+(eval-and-compile
+  (require 'nnheader)
+  (require 'gnus)
+  (require 'gnus-util)
+  (require 'gnus-range)
+  (require 'gnus-start)
+  (require 'gnus-int)
+  (require 'message))
+(eval-when-compile
+  (require 'cl)
+  (require 'nnmail))
+
+(defconst nnmaildir-version "Gnus")
+
+(defvar nnmaildir-article-file-name nil
+  "*The filename of the most recently requested article.  This variable is set
+by nnmaildir-request-article.")
+
+;; The filename of the article being moved/copied:
+(defvar nnmaildir--file nil)
+
+;; Variables to generate filenames of messages being delivered:
+(defvar   nnmaildir--delivery-time "")
+(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
+(defvar   nnmaildir--delivery-count nil)
+
+;; An obarry containing symbols whose names are server names and whose values
+;; are servers:
+(defvar nnmaildir--servers (make-vector 3 0))
+;; The current server:
+(defvar nnmaildir--cur-server nil)
+
+;; A copy of nnmail-extra-headers
+(defvar nnmaildir--extra nil)
+
+;; A NOV structure looks like this (must be prin1-able, so no defstruct):
+["subject\tfrom\tdate"
+ "references\tchars\lines"
+ "To: you\tIn-Reply-To: <your.mess@ge>"
+ (12345 67890)     ;; modtime of the corresponding article file
+ (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
+(defconst nnmaildir--novlen 5)
+(defmacro nnmaildir--nov-new (beg mid end mtime extra)
+  `(vector ,beg ,mid ,end ,mtime ,extra))
+(defmacro nnmaildir--nov-get-beg   (nov) `(aref ,nov 0))
+(defmacro nnmaildir--nov-get-mid   (nov) `(aref ,nov 1))
+(defmacro nnmaildir--nov-get-end   (nov) `(aref ,nov 2))
+(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
+(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
+(defmacro nnmaildir--nov-set-beg   (nov value) `(aset ,nov 0 ,value))
+(defmacro nnmaildir--nov-set-mid   (nov value) `(aset ,nov 1 ,value))
+(defmacro nnmaildir--nov-set-end   (nov value) `(aset ,nov 2 ,value))
+(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
+(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
+
+(defstruct nnmaildir--art
+  (prefix nil :type string)  ;; "time.pid.host"
+  (suffix nil :type string)  ;; ":2,flags"
+  (num    nil :type natnum)  ;; article number
+  (msgid  nil :type string)  ;; "<mess.age@id>"
+  (nov    nil :type vector)) ;; cached nov structure, or nil
+
+(defstruct nnmaildir--grp
+  (name  nil :type string)  ;; "group.name"
+  (new   nil :type list)    ;; new/ modtime
+  (cur   nil :type list)    ;; cur/ modtime
+  (min   1   :type natnum)  ;; minimum article number
+  (count 0   :type natnum)  ;; count of articles
+  (nlist nil :type list)    ;; list of articles, ordered descending by number
+  (flist nil :type vector)  ;; obarray mapping filename prefix->article
+  (mlist nil :type vector)  ;; obarray mapping message-id->article
+  (cache nil :type vector)  ;; nov cache
+  (index nil :type natnum)  ;; index of next cache entry to replace
+  (mmth  nil :type vector)) ;; obarray mapping mark name->dir modtime
+					; ("Mark Mod Time Hash")
+
+(defstruct nnmaildir--srv
+  (address    	 nil :type string)         ;; server address string
+  (method     	 nil :type list)           ;; (nnmaildir "address" ...)
+  (prefix     	 nil :type string)         ;; "nnmaildir+address:"
+  (dir        	 nil :type string)         ;; "/expanded/path/to/server/dir/"
+  (ls         	 nil :type function)       ;; directory-files function
+  (groups     	 nil :type vector)         ;; obarray mapping group name->group
+  (curgrp     	 nil :type nnmaildir--grp) ;; current group, or nil
+  (error      	 nil :type string)         ;; last error message, or nil
+  (mtime      	 nil :type list)           ;; modtime of dir
+  (gnm        	 nil)                      ;; flag: split from mail-sources?
+  (target-prefix nil :type string))        ;; symlink target prefix
+
+(defun nnmaildir--expired-article (group article)
+  (setf (nnmaildir--art-nov article) nil)
+  (let ((flist  (nnmaildir--grp-flist group))
+	(mlist  (nnmaildir--grp-mlist group))
+	(min    (nnmaildir--grp-min   group))
+	(count  (1- (nnmaildir--grp-count group)))
+	(prefix (nnmaildir--art-prefix article))
+	(msgid  (nnmaildir--art-msgid  article))
+	(new-nlist nil)
+	(nlist-pre '(nil . nil))
+	nlist-post num)
+    (unless (zerop count)
+      (setq nlist-post (nnmaildir--grp-nlist group)
+	    num (nnmaildir--art-num article))
+      (if (eq num (caar nlist-post))
+	  (setq new-nlist (cdr nlist-post))
+	(setq new-nlist nlist-post
+	      nlist-pre nlist-post
+	      nlist-post (cdr nlist-post))
+	(while (/= num (caar nlist-post))
+	  (setq nlist-pre nlist-post
+		nlist-post (cdr nlist-post)))
+	(setq nlist-post (cdr nlist-post))
+	(if (eq num min)
+	    (setq min (caar nlist-pre)))))
+    (let ((inhibit-quit t))
+      (setf (nnmaildir--grp-min   group) min)
+      (setf (nnmaildir--grp-count group) count)
+      (setf (nnmaildir--grp-nlist group) new-nlist)
+      (setcdr nlist-pre nlist-post)
+      (unintern prefix flist)
+      (unintern msgid mlist))))
+
+(defun nnmaildir--nlist-art (group num)
+  (let ((entry (assq num (nnmaildir--grp-nlist group))))
+    (if entry
+	(cdr entry))))
+(defmacro nnmaildir--flist-art (list file)
+  `(symbol-value (intern-soft ,file ,list)))
+(defmacro nnmaildir--mlist-art (list msgid)
+  `(symbol-value (intern-soft ,msgid ,list)))
+
+(defun nnmaildir--pgname (server gname)
+  (let ((prefix (nnmaildir--srv-prefix server)))
+    (if prefix (concat prefix gname)
+      (setq gname (gnus-group-prefixed-name gname
+					    (nnmaildir--srv-method server)))
+      (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
+      gname)))
+
+(defun nnmaildir--param (pgname param)
+  (setq param (gnus-group-find-parameter pgname param 'allow-list))
+  (if (vectorp param) (setq param (aref param 0)))
+  (eval param))
+
+(defmacro nnmaildir--with-nntp-buffer (&rest body)
+  `(save-excursion
+     (set-buffer nntp-server-buffer)
+     ,@body))
+(defmacro nnmaildir--with-work-buffer (&rest body)
+  `(save-excursion
+     (set-buffer (get-buffer-create " *nnmaildir work*"))
+     ,@body))
+(defmacro nnmaildir--with-nov-buffer (&rest body)
+  `(save-excursion
+     (set-buffer (get-buffer-create " *nnmaildir nov*"))
+     ,@body))
+(defmacro nnmaildir--with-move-buffer (&rest body)
+  `(save-excursion
+     (set-buffer (get-buffer-create " *nnmaildir move*"))
+     ,@body))
+
+(defmacro nnmaildir--subdir (dir subdir)
+  `(file-name-as-directory (concat ,dir ,subdir)))
+(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
+  `(nnmaildir--subdir ,srv-dir ,gname))
+(defmacro nnmaildir--tmp       (dir) `(nnmaildir--subdir ,dir "tmp"))
+(defmacro nnmaildir--new       (dir) `(nnmaildir--subdir ,dir "new"))
+(defmacro nnmaildir--cur       (dir) `(nnmaildir--subdir ,dir "cur"))
+(defmacro nnmaildir--nndir     (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
+(defmacro nnmaildir--nov-dir   (dir) `(nnmaildir--subdir ,dir "nov"))
+(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
+(defmacro nnmaildir--num-dir   (dir) `(nnmaildir--subdir ,dir "num"))
+(defmacro nnmaildir--num-file  (dir) `(concat ,dir ":"))
+
+(defmacro nnmaildir--unlink (file-arg)
+  `(let ((file ,file-arg))
+     (if (file-attributes file) (delete-file file))))
+(defun nnmaildir--mkdir (dir)
+  (or (file-exists-p (file-name-as-directory dir))
+      (make-directory-internal (directory-file-name dir))))
+(defun nnmaildir--delete-dir-files (dir ls)
+  (when (file-attributes dir)
+    (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
+    (delete-directory dir)))
+
+(defun nnmaildir--group-maxnum (server group)
+  (if (zerop (nnmaildir--grp-count group)) 0
+    (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
+				    (nnmaildir--grp-name group))))
+      (setq x (nnmaildir--nndir x)
+	    x (nnmaildir--num-dir x)
+	    x (nnmaildir--num-file x)
+	    x (file-attributes x))
+      (if x (1- (nth 1 x)) 0))))
+
+;; Make the given server, if non-nil, be the current server.  Then make the
+;; given group, if non-nil, be the current group of the current server.  Then
+;; return the group object for the current group.
+(defun nnmaildir--prepare (server group)
+  (let (x groups)
+    (catch 'return
+      (if (null server)
+	  (unless (setq server nnmaildir--cur-server)
+	    (throw 'return nil))
+	(unless (setq server (intern-soft server nnmaildir--servers))
+	  (throw 'return nil))
+	(setq server (symbol-value server)
+	      nnmaildir--cur-server server))
+      (unless (setq groups (nnmaildir--srv-groups server))
+	(throw 'return nil))
+      (unless (nnmaildir--srv-method server)
+	(setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
+	      x (gnus-server-to-method x))
+	(unless x (throw 'return nil))
+	(setf (nnmaildir--srv-method server) x))
+      (if (null group)
+	  (unless (setq group (nnmaildir--srv-curgrp server))
+	    (throw 'return nil))
+	(unless (setq group (intern-soft group groups))
+	  (throw 'return nil))
+	(setq group (symbol-value group)))
+      group)))
+
+(defun nnmaildir--tab-to-space (string)
+  (let ((pos 0))
+    (while (string-match "\t" string pos)
+      (aset string (match-beginning 0) ? )
+      (setq pos (match-end 0))))
+  string)
+
+(defun nnmaildir--update-nov (server group article)
+  (let ((nnheader-file-coding-system 'binary)
+	(srv-dir (nnmaildir--srv-dir server))
+	(storage-version 1) ;; [version article-number msgid [...nov...]]
+	dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
+	nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
+	deactivate-mark)
+    (catch 'return
+      (setq gname (nnmaildir--grp-name group)
+	    pgname (nnmaildir--pgname server gname)
+	    dir (nnmaildir--srvgrp-dir srv-dir gname)
+	    msgdir (if (nnmaildir--param pgname 'read-only)
+		       (nnmaildir--new dir) (nnmaildir--cur dir))
+	    prefix (nnmaildir--art-prefix article)
+	    suffix (nnmaildir--art-suffix article)
+	    file (concat msgdir prefix suffix)
+	    attr (file-attributes file))
+      (unless attr
+	(nnmaildir--expired-article group article)
+	(throw 'return nil))
+      (setq mtime (nth 5 attr)
+	    attr (nth 7 attr)
+	    nov (nnmaildir--art-nov article)
+	    dir (nnmaildir--nndir dir)
+	    novdir (nnmaildir--nov-dir dir)
+	    novfile (concat novdir prefix))
+      (unless (equal nnmaildir--extra nnmail-extra-headers)
+	(setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
+      (nnmaildir--with-nov-buffer
+	;; First we'll check for already-parsed NOV data.
+	(cond ((not (file-exists-p novfile))
+	       ;; The NOV file doesn't exist; we have to parse the message.
+	       (setq nov nil))
+	      ((not nov)
+	       ;; The file exists, but the data isn't in memory; read the file.
+	       (erase-buffer)
+	       (nnheader-insert-file-contents novfile)
+	       (setq nov (read (current-buffer)))
+	       (if (not (and (vectorp nov)
+			     (/= 0 (length nov))
+			     (equal storage-version (aref nov 0))))
+		   ;; This NOV data seems to be in the wrong format.
+		   (setq nov nil)
+		 (unless (nnmaildir--art-num   article)
+		   (setf (nnmaildir--art-num   article) (aref nov 1)))
+		 (unless (nnmaildir--art-msgid article)
+		   (setf (nnmaildir--art-msgid article) (aref nov 2)))
+		 (setq nov (aref nov 3)))))
+	;; Now check whether the already-parsed data (if we have any) is
+	;; usable: if the message has been edited or if nnmail-extra-headers
+	;; has been augmented since this data was parsed from the message,
+	;; then we have to reparse.  Otherwise it's up-to-date.
+	(when (and nov (equal mtime (nnmaildir--nov-get-mtime nov)))
+	  ;; The timestamp matches.  Now check nnmail-extra-headers.
+	  (setq old-extra (nnmaildir--nov-get-extra nov))
+	  (when (equal nnmaildir--extra old-extra) ;; common case
+	    ;; Save memory; use a single copy of the list value.
+	    (nnmaildir--nov-set-extra nov nnmaildir--extra)
+	    (throw 'return nov))
+	  ;; They're not equal, but maybe the new is a subset of the old.
+	  (if (null nnmaildir--extra)
+	      ;; The empty set is a subset of every set.
+	      (throw 'return nov))
+	  (if (not (memq nil (mapcar (lambda (e) (memq e old-extra))
+				     nnmaildir--extra)))
+	      (throw 'return nov)))
+	;; Parse the NOV data out of the message.
+	(erase-buffer)
+	(nnheader-insert-file-contents file)
+	(insert "\n")
+	(goto-char (point-min))
+	(save-restriction
+	  (if (search-forward "\n\n" nil 'noerror)
+	      (progn
+		(setq nov-mid (count-lines (point) (point-max)))
+		(narrow-to-region (point-min) (1- (point))))
+	    (setq nov-mid 0))
+	  (goto-char (point-min))
+	  (delete-char 1)
+	  (setq nov (nnheader-parse-naked-head)
+		field (or (mail-header-lines nov) 0)))
+	(unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
+	  (setq nov-mid field))
+	(setq nov-mid (number-to-string nov-mid)
+	      nov-mid (concat (number-to-string attr) "\t" nov-mid))
+	(save-match-data
+	  (setq field (or (mail-header-references nov) ""))
+	  (nnmaildir--tab-to-space field)
+	  (setq nov-mid (concat field "\t" nov-mid)
+		nov-beg (mapconcat
+			  (lambda (f) (nnmaildir--tab-to-space (or f "")))
+			  (list (mail-header-subject nov)
+				(mail-header-from nov)
+				(mail-header-date nov)) "\t")
+		nov-end (mapconcat
+			  (lambda (extra)
+			    (setq field (symbol-name (car extra))
+				  val (cdr extra))
+			    (nnmaildir--tab-to-space field)
+			    (nnmaildir--tab-to-space val)
+			    (concat field ": " val))
+			  (mail-header-extra nov) "\t")))
+	(setq msgid (mail-header-id nov))
+	(if (or (null msgid) (nnheader-fake-message-id-p msgid))
+	    (setq msgid (concat "<" prefix "@nnmaildir>")))
+	(nnmaildir--tab-to-space msgid)
+	;; The data is parsed; create an nnmaildir NOV structure.
+	(setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime
+				      nnmaildir--extra)
+	      num (nnmaildir--art-num article))
+	(unless num
+	  ;; Allocate a new article number.
+	  (erase-buffer)
+	  (setq numdir (nnmaildir--num-dir dir)
+		file (nnmaildir--num-file numdir)
+		num -1)
+	  (nnmaildir--mkdir numdir)
+	  (write-region "" nil file nil 'no-message)
+	  (while file
+	    ;; Get the number of links to file.
+	    (setq attr (nth 1 (file-attributes file)))
+	    (if (= attr num)
+		;; We've already tried this number, in the previous loop
+		;; iteration, and failed.
+		(signal 'error `("Corrupt internal nnmaildir data" ,numdir)))
+	    ;; If attr is 123, try to link file to "123".  This atomically
+	    ;; increases the link count and creates the "123" link, failing
+	    ;; if that link was already created by another Gnus, just after
+	    ;; we stat()ed file.
+	    (condition-case nil
+		(progn
+		  (add-name-to-file file (concat numdir (format "%x" attr)))
+		  (setq file nil)) ;; Stop looping.
+	      (file-already-exists nil))
+	    (setq num attr))
+	  (setf (nnmaildir--art-num article) num))
+	;; Store this new NOV data in a file
+	(erase-buffer)
+	(prin1 (vector storage-version num msgid nov) (current-buffer))
+	(setq file (concat novfile ":"))
+	(nnmaildir--unlink file)
+	(write-region (point-min) (point-max) file nil 'no-message nil 'excl))
+      (rename-file file novfile 'replace)
+      (setf (nnmaildir--art-msgid article) msgid)
+      nov)))
+
+(defun nnmaildir--cache-nov (group article nov)
+  (let ((cache (nnmaildir--grp-cache group))
+	(index (nnmaildir--grp-index group))
+	goner)
+    (unless (nnmaildir--art-nov article)
+      (setq goner (aref cache index))
+      (if goner (setf (nnmaildir--art-nov goner) nil))
+      (aset cache index article)
+      (setf (nnmaildir--grp-index group) (% (1+ index) (length cache))))
+    (setf (nnmaildir--art-nov article) nov)))
+
+(defun nnmaildir--grp-add-art (server group article)
+  (let ((nov (nnmaildir--update-nov server group article))
+	count num min nlist nlist-cdr insert-nlist)
+    (when nov
+      (setq count (1+ (nnmaildir--grp-count group))
+	    num (nnmaildir--art-num article)
+	    min (if (= count 1) num
+		  (min num (nnmaildir--grp-min group)))
+	    nlist (nnmaildir--grp-nlist group))
+      (if (or (null nlist) (> num (caar nlist)))
+	  (setq nlist (cons (cons num article) nlist))
+	(setq insert-nlist t
+	      nlist-cdr (cdr nlist))
+	(while (and nlist-cdr (< num (caar nlist-cdr)))
+	  (setq nlist nlist-cdr
+		nlist-cdr (cdr nlist))))
+      (let ((inhibit-quit t))
+	(setf (nnmaildir--grp-count group) count)
+	(setf (nnmaildir--grp-min group) min)
+	(if insert-nlist
+	    (setcdr nlist (cons (cons num article) nlist-cdr))
+	  (setf (nnmaildir--grp-nlist group) nlist))
+	(set (intern (nnmaildir--art-prefix article)
+		     (nnmaildir--grp-flist group))
+	     article)
+	(set (intern (nnmaildir--art-msgid article)
+		     (nnmaildir--grp-mlist group))
+	     article)
+	(set (intern (nnmaildir--grp-name group)
+		     (nnmaildir--srv-groups server))
+	     group))
+      (nnmaildir--cache-nov group article nov)
+      t)))
+
+(defun nnmaildir--group-ls (server pgname)
+  (or (nnmaildir--param pgname 'directory-files)
+      (nnmaildir--srv-ls server)))
+
+(defun nnmaildir-article-number-to-file-name
+  (number group-name server-address-string)
+  (let ((group (nnmaildir--prepare server-address-string group-name))
+	article dir pgname)
+    (catch 'return
+      (unless group
+	;; The given group or server does not exist.
+	(throw 'return nil))
+      (setq article (nnmaildir--nlist-art group number))
+      (unless article
+	;; The given article number does not exist in this group.
+	(throw 'return nil))
+      (setq pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
+	    dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir dir group-name)
+	    dir (if (nnmaildir--param pgname 'read-only)
+		    (nnmaildir--new dir) (nnmaildir--cur dir)))
+      (concat dir (nnmaildir--art-prefix article)
+	      (nnmaildir--art-suffix article)))))
+
+(defun nnmaildir-article-number-to-base-name
+  (number group-name server-address-string)
+  (let ((x (nnmaildir--prepare server-address-string group-name)))
+    (when x
+      (setq x (nnmaildir--nlist-art x number))
+      (and x (cons (nnmaildir--art-prefix x)
+		   (nnmaildir--art-suffix x))))))
+
+(defun nnmaildir-base-name-to-article-number
+  (base-name group-name server-address-string)
+  (let ((x (nnmaildir--prepare server-address-string group-name)))
+    (when x
+      (setq x (nnmaildir--grp-flist x)
+	    x (nnmaildir--flist-art x base-name))
+      (and x (nnmaildir--art-num x)))))
+
+(defun nnmaildir--nlist-iterate (nlist ranges func)
+  (let (entry high low nlist2)
+    (if (eq ranges 'all)
+	(setq ranges `((1 . ,(caar nlist)))))
+    (while ranges
+      (setq entry (car ranges) ranges (cdr ranges))
+      (while (and ranges (eq entry (car ranges)))
+	(setq ranges (cdr ranges))) ;; skip duplicates
+      (if (numberp entry)
+	  (setq low entry
+		high entry)
+	(setq low (car entry)
+	      high (cdr entry)))
+      (setq nlist2 nlist) ;; Don't assume any sorting of ranges
+      (catch 'iterate-loop
+	(while nlist2
+	  (if (<= (caar nlist2) high) (throw 'iterate-loop nil))
+	  (setq nlist2 (cdr nlist2))))
+      (catch 'iterate-loop
+	(while nlist2
+	  (setq entry (car nlist2) nlist2 (cdr nlist2))
+	  (if (< (car entry) low) (throw 'iterate-loop nil))
+	  (funcall func (cdr entry)))))))
+
+(defun nnmaildir--up2-1 (n)
+  (if (zerop n) 1 (1- (lsh 1 (1+ (logb n))))))
+
+(defun nnmaildir--system-name ()
+  (gnus-replace-in-string
+   (gnus-replace-in-string
+    (gnus-replace-in-string
+     (system-name)
+     "\\\\" "\\134" 'literal)
+    "/" "\\057" 'literal)
+   ":" "\\072" 'literal))
+
+(defun nnmaildir-request-type (group &optional article)
+  'mail)
+
+(defun nnmaildir-status-message (&optional server)
+  (nnmaildir--prepare server nil)
+  (nnmaildir--srv-error nnmaildir--cur-server))
+
+(defun nnmaildir-server-opened (&optional server)
+  (and nnmaildir--cur-server
+       (if server
+	   (string-equal server (nnmaildir--srv-address nnmaildir--cur-server))
+	 t)
+       (nnmaildir--srv-groups nnmaildir--cur-server)
+       t))
+
+(defun nnmaildir-open-server (server &optional defs)
+  (let ((x server)
+	dir size)
+    (catch 'return
+      (setq server (intern-soft x nnmaildir--servers))
+      (if server
+	  (and (setq server (symbol-value server))
+	       (nnmaildir--srv-groups server)
+	       (setq nnmaildir--cur-server server)
+	       (throw 'return t))
+	(setq server (make-nnmaildir--srv :address x))
+	(let ((inhibit-quit t))
+	  (set (intern x nnmaildir--servers) server)))
+      (setq dir (assq 'directory defs))
+      (unless dir
+	(setf (nnmaildir--srv-error server)
+	      "You must set \"directory\" in the select method")
+	(throw 'return nil))
+      (setq dir (cadr dir)
+	    dir (eval dir)
+	    dir (expand-file-name dir)
+	    dir (file-name-as-directory dir))
+      (unless (file-exists-p dir)
+	(setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
+	(throw 'return nil))
+      (setf (nnmaildir--srv-dir server) dir)
+      (setq x (assq 'directory-files defs))
+      (if (null x)
+	  (setq x (if nnheader-directory-files-is-safe 'directory-files
+		    'nnheader-directory-files-safe))
+	(setq x (cadr x))
+	(unless (functionp x)
+	  (setf (nnmaildir--srv-error server)
+		(concat "Not a function: " (prin1-to-string x)))
+	  (throw 'return nil)))
+      (setf (nnmaildir--srv-ls server) x)
+      (setq size (length (funcall x dir nil "\\`[^.]" 'nosort))
+	    size (nnmaildir--up2-1 size))
+      (and (setq x (assq 'get-new-mail defs))
+	   (setq x (cdr x))
+	   (car x)
+	   (setf (nnmaildir--srv-gnm server) t)
+	   (require 'nnmail))
+      (setq x (assq 'target-prefix defs))
+      (if x
+	  (progn
+	    (setq x (cadr x)
+		  x (eval x))
+	    (setf (nnmaildir--srv-target-prefix server) x))
+	(setq x (assq 'create-directory defs))
+	(if x
+	    (progn
+	      (setq x (cadr x)
+		    x (eval x)
+		    x (file-name-as-directory x))
+	      (setf (nnmaildir--srv-target-prefix server) x))
+	  (setf (nnmaildir--srv-target-prefix server) "")))
+      (setf (nnmaildir--srv-groups server) (make-vector size 0))
+      (setq nnmaildir--cur-server server)
+      t)))
+
+(defun nnmaildir--parse-filename (file)
+  (let ((prefix (car file))
+	timestamp len)
+    (if (string-match "\\`\\([0-9]+\\)\\(\\..*\\)\\'" prefix)
+	(progn
+	  (setq timestamp (concat "0000" (match-string 1 prefix))
+		len (- (length timestamp) 4))
+	  (vector (string-to-number (substring timestamp 0 len))
+		  (string-to-number (substring timestamp len))
+		  (match-string 2 prefix)
+		  file))
+      file)))
+
+(defun nnmaildir--sort-files (a b)
+  (catch 'return
+    (if (consp a)
+	(throw 'return (and (consp b) (string-lessp (car a) (car b)))))
+    (if (consp b) (throw 'return t))
+    (if (< (aref a 0) (aref b 0)) (throw 'return t))
+    (if (> (aref a 0) (aref b 0)) (throw 'return nil))
+    (if (< (aref a 1) (aref b 1)) (throw 'return t))
+    (if (> (aref a 1) (aref b 1)) (throw 'return nil))
+    (string-lessp (aref a 2) (aref b 2))))
+
+(defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls)
+  (catch 'return
+    (let ((36h-ago (- (car (current-time)) 2))
+	  absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
+	  files num dir flist group x)
+      (setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
+	    nndir (nnmaildir--nndir absdir))
+      (unless (file-exists-p absdir)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such directory: " absdir))
+	(throw 'return nil))
+      (setq tdir (nnmaildir--tmp absdir)
+	    ndir (nnmaildir--new absdir)
+	    cdir (nnmaildir--cur absdir)
+	    nattr (file-attributes ndir)
+	    cattr (file-attributes cdir))
+      (unless (and (file-exists-p tdir) nattr cattr)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Not a maildir: " absdir))
+	(throw 'return nil))
+      (setq group (nnmaildir--prepare nil gname)
+	    pgname (nnmaildir--pgname nnmaildir--cur-server gname))
+      (if group
+	  (setq isnew nil)
+	(setq isnew t
+	      group (make-nnmaildir--grp :name gname :index 0))
+	(nnmaildir--mkdir nndir)
+	(nnmaildir--mkdir (nnmaildir--nov-dir   nndir))
+	(nnmaildir--mkdir (nnmaildir--marks-dir nndir))
+	(write-region "" nil (concat nndir "markfile") nil 'no-message))
+      (setq read-only (nnmaildir--param pgname 'read-only)
+	    ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
+      (unless read-only
+	(setq x (nth 11 (file-attributes tdir)))
+	(unless (and (= x (nth 11 nattr)) (= x (nth 11 cattr)))
+	  (setf (nnmaildir--srv-error nnmaildir--cur-server)
+		(concat "Maildir spans filesystems: " absdir))
+	  (throw 'return nil))
+	(mapcar
+	 (lambda (file)
+	   (setq x (file-attributes file))
+	   (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago))
+	       (delete-file file)))
+	 (funcall ls tdir 'full "\\`[^.]" 'nosort)))
+      (or scan-msgs
+	  isnew
+	  (throw 'return t))
+      (setq nattr (nth 5 nattr))
+      (if (equal nattr (nnmaildir--grp-new group))
+	  (setq nattr nil))
+      (if read-only (setq dir (and (or isnew nattr) ndir))
+	(when (or isnew nattr)
+	  (mapcar
+	   (lambda (file)
+	     (let ((path (concat ndir file)))
+	       (and (time-less-p (nth 5 (file-attributes path)) (current-time))
+		    (rename-file path (concat cdir file ":2,")))))
+	   (funcall ls ndir nil "\\`[^.]" 'nosort))
+	  (setf (nnmaildir--grp-new group) nattr))
+	(setq cattr (nth 5 (file-attributes cdir)))
+	(if (equal cattr (nnmaildir--grp-cur group))
+	    (setq cattr nil))
+	(setq dir (and (or isnew cattr) cdir)))
+      (unless dir (throw 'return t))
+      (setq files (funcall ls dir nil "\\`[^.]" 'nosort)
+	    files (save-match-data
+		    (mapcar
+		     (lambda (f)
+		       (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" f)
+		       (cons (match-string 1 f) (match-string 2 f)))
+		     files)))
+      (when isnew
+	(setq num (nnmaildir--up2-1 (length files)))
+	(setf (nnmaildir--grp-flist group) (make-vector num 0))
+	(setf (nnmaildir--grp-mlist group) (make-vector num 0))
+	(setf (nnmaildir--grp-mmth group) (make-vector 1 0))
+	(setq num (nnmaildir--param pgname 'nov-cache-size))
+	(if (numberp num) (if (< num 1) (setq num 1))
+	  (setq num 16
+		cdir (nnmaildir--marks-dir nndir)
+		ndir (nnmaildir--subdir cdir "tick")
+		cdir (nnmaildir--subdir cdir "read"))
+	  (mapcar
+	   (lambda (file)
+	     (setq file (car file))
+	     (if (or (not (file-exists-p (concat cdir file)))
+		     (file-exists-p (concat ndir file)))
+		 (setq num (1+ num))))
+	   files))
+	(setf (nnmaildir--grp-cache group) (make-vector num nil))
+        (let ((inhibit-quit t))
+          (set (intern gname groups) group))
+	(or scan-msgs (throw 'return t)))
+      (setq flist (nnmaildir--grp-flist group)
+	    files (mapcar
+		   (lambda (file)
+		     (and (null (nnmaildir--flist-art flist (car file)))
+			  file))
+		   files)
+	    files (delq nil files)
+	    files (mapcar 'nnmaildir--parse-filename files)
+	    files (sort files 'nnmaildir--sort-files))
+      (mapcar
+       (lambda (file)
+	 (setq file (if (consp file) file (aref file 3))
+	       x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
+	 (nnmaildir--grp-add-art nnmaildir--cur-server group x))
+       files)
+      (if read-only (setf (nnmaildir--grp-new group) nattr)
+	(setf (nnmaildir--grp-cur group) cattr)))
+    t))
+
+(defun nnmaildir-request-scan (&optional scan-group server)
+  (let ((coding-system-for-write nnheader-file-coding-system)
+	(output-coding-system nnheader-file-coding-system)
+	(buffer-file-coding-system nil)
+	(file-coding-system nil)
+	(file-coding-system-alist nil)
+	(nnmaildir-get-new-mail t)
+	(nnmaildir-group-alist nil)
+	(nnmaildir-active-file nil)
+	x srv-ls srv-dir method groups target-prefix group dirs grp-dir seen
+	deactivate-mark)
+    (nnmaildir--prepare server nil)
+    (setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server)
+	  srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	  method (nnmaildir--srv-method nnmaildir--cur-server)
+	  groups (nnmaildir--srv-groups nnmaildir--cur-server)
+	  target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
+    (nnmaildir--with-work-buffer
+      (save-match-data
+	(if (stringp scan-group)
+	    (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls)
+		(if (nnmaildir--srv-gnm nnmaildir--cur-server)
+		    (nnmail-get-new-mail 'nnmaildir nil nil scan-group))
+	      (unintern scan-group groups))
+	  (setq x (nth 5 (file-attributes srv-dir))
+		scan-group (null scan-group))
+	  (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server))
+	      (if scan-group
+		  (mapatoms (lambda (sym)
+			      (nnmaildir--scan (symbol-name sym) t groups
+					       method srv-dir srv-ls))
+			    groups))
+	    (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
+		  dirs (if (zerop (length target-prefix))
+			   dirs
+			 (gnus-remove-if
+			  (lambda (dir)
+			    (and (>= (length dir) (length target-prefix))
+				 (string= (substring dir 0
+						     (length target-prefix))
+					  target-prefix)))
+			  dirs))
+		  seen (nnmaildir--up2-1 (length dirs))
+		  seen (make-vector seen 0))
+	    (mapcar
+	     (lambda (grp-dir)
+	       (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
+				    srv-ls)
+		   (intern grp-dir seen)))
+	     dirs)
+	    (setq x nil)
+	    (mapatoms (lambda (group)
+			(setq group (symbol-name group))
+			(unless (intern-soft group seen)
+			  (setq x (cons group x))))
+		      groups)
+	    (mapcar (lambda (grp) (unintern grp groups)) x)
+	    (setf (nnmaildir--srv-mtime nnmaildir--cur-server)
+		  (nth 5 (file-attributes srv-dir))))
+	  (and scan-group
+	       (nnmaildir--srv-gnm nnmaildir--cur-server)
+	       (nnmail-get-new-mail 'nnmaildir nil nil))))))
+  t)
+
+(defun nnmaildir-request-list (&optional server)
+  (nnmaildir-request-scan 'find-new-groups server)
+  (let (pgname ro deactivate-mark)
+    (nnmaildir--prepare server nil)
+    (nnmaildir--with-nntp-buffer
+      (erase-buffer)
+      (mapatoms (lambda (group)
+		  (setq pgname (symbol-name group)
+			pgname (nnmaildir--pgname nnmaildir--cur-server pgname)
+			group (symbol-value group)
+			ro (nnmaildir--param pgname 'read-only))
+		  (insert (nnmaildir--grp-name group) " ")
+                  (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+			 nntp-server-buffer)
+		  (insert " ")
+                  (princ (nnmaildir--grp-min group) nntp-server-buffer)
+		  (insert " " (if ro "n" "y") "\n"))
+		(nnmaildir--srv-groups nnmaildir--cur-server))))
+  t)
+
+(defun nnmaildir-request-newgroups (date &optional server)
+  (nnmaildir-request-list server))
+
+(defun nnmaildir-retrieve-groups (groups &optional server)
+  (let (group deactivate-mark)
+    (nnmaildir--prepare server nil)
+    (nnmaildir--with-nntp-buffer
+      (erase-buffer)
+      (mapcar
+       (lambda (gname)
+	 (setq group (nnmaildir--prepare nil gname))
+	 (if (null group) (insert "411 no such news group\n")
+	   (insert "211 ")
+	   (princ (nnmaildir--grp-count group) nntp-server-buffer)
+	   (insert " ")
+	   (princ (nnmaildir--grp-min   group) nntp-server-buffer)
+	   (insert " ")
+	   (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+		  nntp-server-buffer)
+	   (insert " " gname "\n")))
+       groups)))
+  'group)
+
+(defun nnmaildir-request-update-info (gname info &optional server)
+  (let ((group (nnmaildir--prepare server gname))
+	pgname flist always-marks never-marks old-marks dotfile num dir
+	markdirs marks mark ranges markdir article read end new-marks ls
+	old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (setq gname (nnmaildir--grp-name group)
+	    pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+	    flist (nnmaildir--grp-flist group))
+      (when (zerop (nnmaildir--grp-count group))
+	(gnus-info-set-read info nil)
+	(gnus-info-set-marks info nil 'extend)
+	(throw 'return info))
+      (setq old-marks (cons 'read (gnus-info-read info))
+	    old-marks (cons old-marks (gnus-info-marks info))
+	    always-marks (nnmaildir--param pgname 'always-marks)
+	    never-marks (nnmaildir--param pgname 'never-marks)
+	    existing (nnmaildir--grp-nlist group)
+	    existing (mapcar 'car existing)
+	    existing (nreverse existing)
+	    existing (gnus-compress-sequence existing 'always-list)
+	    missing (list (cons 1 (nnmaildir--group-maxnum
+				   nnmaildir--cur-server group)))
+	    missing (gnus-range-difference missing existing)
+	    dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir dir gname)
+	    dir (nnmaildir--nndir dir)
+	    dir (nnmaildir--marks-dir dir)
+            ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+	    markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
+	    new-mmth (nnmaildir--up2-1 (length markdirs))
+	    new-mmth (make-vector new-mmth 0)
+	    old-mmth (nnmaildir--grp-mmth group))
+      (mapcar
+       (lambda (mark)
+	 (setq markdir (nnmaildir--subdir dir mark)
+	       mark-sym (intern mark)
+	       ranges nil)
+	 (catch 'got-ranges
+	   (if (memq mark-sym never-marks) (throw 'got-ranges nil))
+	   (when (memq mark-sym always-marks)
+	     (setq ranges existing)
+	     (throw 'got-ranges nil))
+	   (setq mtime (nth 5 (file-attributes markdir)))
+	   (set (intern mark new-mmth) mtime)
+	   (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
+	     (setq ranges (assq mark-sym old-marks))
+	     (if ranges (setq ranges (cdr ranges)))
+	     (throw 'got-ranges nil))
+	   (mapcar
+	    (lambda (prefix)
+	      (setq article (nnmaildir--flist-art flist prefix))
+	      (if article
+		  (setq ranges
+			(gnus-add-to-range ranges
+					   `(,(nnmaildir--art-num article))))))
+	    (funcall ls markdir nil "\\`[^.]" 'nosort)))
+	 (if (eq mark-sym 'read) (setq read ranges)
+	   (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+       markdirs)
+      (gnus-info-set-read info (gnus-range-add read missing))
+      (gnus-info-set-marks info marks 'extend)
+      (setf (nnmaildir--grp-mmth group) new-mmth)
+      info)))
+
+(defun nnmaildir-request-group (gname &optional server fast)
+  (let ((group (nnmaildir--prepare server gname))
+	deactivate-mark)
+    (catch 'return
+      (unless group
+	;; (insert "411 no such news group\n")
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group)
+      (if fast (throw 'return t))
+      (nnmaildir--with-nntp-buffer
+	(erase-buffer)
+	(insert "211 ")
+	(princ (nnmaildir--grp-count group) nntp-server-buffer)
+	(insert " ")
+	(princ (nnmaildir--grp-min   group) nntp-server-buffer)
+	(insert " ")
+	(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+	       nntp-server-buffer)
+	(insert " " gname "\n")
+	t))))
+
+(defun nnmaildir-request-create-group (gname &optional server args)
+  (nnmaildir--prepare server nil)
+  (catch 'return
+    (let ((target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
+	  srv-dir dir groups)
+      (when (zerop (length gname))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      "Invalid (empty) group name")
+	(throw 'return nil))
+      (when (eq (aref "." 0) (aref gname 0))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      "Group names may not start with \".\"")
+	(throw 'return nil))
+      (when (save-match-data (string-match "[\0/\t]" gname))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Illegal characters (null, tab, or /) in group name: "
+		      gname))
+	(throw 'return nil))
+      (setq groups (nnmaildir--srv-groups nnmaildir--cur-server))
+      (when (intern-soft gname groups)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Group already exists: " gname))
+	(throw 'return nil))
+      (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
+      (if (file-name-absolute-p target-prefix)
+	  (setq dir (expand-file-name target-prefix))
+	(setq dir srv-dir
+	      dir (file-truename dir)
+	      dir (concat dir target-prefix)))
+      (setq dir (nnmaildir--subdir dir gname))
+      (nnmaildir--mkdir dir)
+      (nnmaildir--mkdir (nnmaildir--tmp dir))
+      (nnmaildir--mkdir (nnmaildir--new dir))
+      (nnmaildir--mkdir (nnmaildir--cur dir))
+      (unless (string= target-prefix "")
+	(make-symbolic-link (concat target-prefix gname)
+			    (concat srv-dir gname)))
+      (nnmaildir-request-scan 'find-new-groups))))
+
+(defun nnmaildir-request-rename-group (gname new-name &optional server)
+  (let ((group (nnmaildir--prepare server gname))
+	(coding-system-for-write nnheader-file-coding-system)
+	(output-coding-system nnheader-file-coding-system)
+	(buffer-file-coding-system nil)
+	(file-coding-system nil)
+	(file-coding-system-alist nil)
+	srv-dir x groups)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (when (zerop (length new-name))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      "Invalid (empty) group name")
+	(throw 'return nil))
+      (when (eq (aref "." 0) (aref new-name 0))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      "Group names may not start with \".\"")
+	(throw 'return nil))
+      (when (save-match-data (string-match "[\0/\t]" new-name))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Illegal characters (null, tab, or /) in group name: "
+		      new-name))
+	(throw 'return nil))
+      (if (string-equal gname new-name) (throw 'return t))
+      (when (intern-soft new-name
+			 (nnmaildir--srv-groups nnmaildir--cur-server))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Group already exists: " new-name))
+	(throw 'return nil))
+      (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
+      (condition-case err
+	  (rename-file (concat srv-dir gname)
+		       (concat srv-dir new-name))
+	(error
+	 (setf (nnmaildir--srv-error nnmaildir--cur-server)
+	       (concat "Error renaming link: " (prin1-to-string err)))
+	 (throw 'return nil)))
+      (setq x (nnmaildir--srv-groups nnmaildir--cur-server)
+	    groups (make-vector (length x) 0))
+      (mapatoms (lambda (sym)
+		  (unless (eq (symbol-value sym) group)
+		    (set (intern (symbol-name sym) groups)
+			 (symbol-value sym))))
+		x)
+      (setq group (copy-sequence group))
+      (setf (nnmaildir--grp-name group) new-name)
+      (set (intern new-name groups) group)
+      (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups)
+      t)))
+
+(defun nnmaildir-request-delete-group (gname force &optional server)
+  (let ((group (nnmaildir--prepare server gname))
+	pgname grp-dir target dir ls deactivate-mark)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (setq gname (nnmaildir--grp-name group)
+	    pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+	    grp-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    target (car (file-attributes (concat grp-dir gname)))
+	    grp-dir (nnmaildir--srvgrp-dir grp-dir gname))
+      (unless (or force (stringp target))
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Not a symlink: " gname))
+	(throw 'return nil))
+      (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server))
+	  (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil))
+      (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server))
+      (if (not force)
+	  (progn
+	    (setq grp-dir (directory-file-name grp-dir))
+	    (nnmaildir--unlink grp-dir))
+	(setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname))
+	(if (nnmaildir--param pgname 'read-only)
+	    (progn (delete-directory  (nnmaildir--tmp grp-dir))
+		   (nnmaildir--unlink (nnmaildir--new grp-dir))
+		   (delete-directory  (nnmaildir--cur grp-dir)))
+	  (nnmaildir--delete-dir-files (nnmaildir--tmp grp-dir) ls)
+	  (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls)
+	  (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls))
+	(setq dir (nnmaildir--nndir grp-dir))
+	(mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls))
+		`(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir)
+		  ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
+			     'nosort)))
+	(setq dir (nnmaildir--nndir grp-dir))
+	(nnmaildir--unlink (concat dir "markfile"))
+	(nnmaildir--unlink (concat dir "markfile{new}"))
+	(delete-directory (nnmaildir--marks-dir dir))
+	(delete-directory dir)
+	(if (not (stringp target))
+	    (delete-directory grp-dir)
+	  (setq grp-dir (directory-file-name grp-dir)
+		dir target)
+	  (unless (eq (aref "/" 0) (aref dir 0))
+	    (setq dir (concat (file-truename
+			       (nnmaildir--srv-dir nnmaildir--cur-server))
+			      dir)))
+	  (delete-directory dir)
+	  (nnmaildir--unlink grp-dir)))
+      t)))
+
+(defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
+  (let ((group (nnmaildir--prepare server gname))
+	srv-dir dir nlist mlist article num start stop nov nlist2 insert-nov
+	deactivate-mark)
+    (setq insert-nov
+	  (lambda (article)
+	    (setq nov (nnmaildir--update-nov nnmaildir--cur-server group
+					     article))
+	    (when nov
+	      (nnmaildir--cache-nov group article nov)
+	      (setq num (nnmaildir--art-num article))
+	      (princ num nntp-server-buffer)
+	      (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
+		      (nnmaildir--art-msgid article) "\t"
+		      (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir "
+		      gname ":")
+	      (princ num nntp-server-buffer)
+	      (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (if gname (concat "No such group: " gname) "No current group"))
+	(throw 'return nil))
+      (nnmaildir--with-nntp-buffer
+	(erase-buffer)
+	(setq mlist (nnmaildir--grp-mlist group)
+	      nlist (nnmaildir--grp-nlist group)
+	      gname (nnmaildir--grp-name group)
+	      srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	      dir (nnmaildir--srvgrp-dir srv-dir gname))
+	(cond
+	 ((null nlist))
+	 ((and fetch-old (not (numberp fetch-old)))
+	  (nnmaildir--nlist-iterate nlist 'all insert-nov))
+	 ((null articles))
+	 ((stringp (car articles))
+	  (mapcar
+	   (lambda (msgid)
+	     (setq article (nnmaildir--mlist-art mlist msgid))
+	     (if article (funcall insert-nov article)))
+	   articles))
+	 (t
+	  (if fetch-old
+	      ;; Assume the article range list is sorted ascending
+	      (setq stop (car articles)
+		    start (car (last articles))
+		    stop  (if (numberp stop)  stop  (car stop))
+		    start (if (numberp start) start (cdr start))
+		    stop (- stop fetch-old)
+		    stop (if (< stop 1) 1 stop)
+		    articles (list (cons stop start))))
+	  (nnmaildir--nlist-iterate nlist articles insert-nov)))
+	(sort-numeric-fields 1 (point-min) (point-max))
+	'nov))))
+
+(defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
+  (let ((group (nnmaildir--prepare server gname))
+	(case-fold-search t)
+	list article dir pgname deactivate-mark)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (if gname (concat "No such group: " gname) "No current group"))
+	(throw 'return nil))
+      (if (numberp num-msgid)
+	  (setq article (nnmaildir--nlist-art group num-msgid))
+	(setq list (nnmaildir--grp-mlist group)
+	      article (nnmaildir--mlist-art list num-msgid))
+	(if article (setq num-msgid (nnmaildir--art-num article))
+	  (catch 'found
+	    (mapatoms
+              (lambda (group-sym)
+                (setq group (symbol-value group-sym)
+                      list (nnmaildir--grp-mlist group)
+                      article (nnmaildir--mlist-art list num-msgid))
+                (when article
+                  (setq num-msgid (nnmaildir--art-num article))
+                  (throw 'found nil)))
+              (nnmaildir--srv-groups nnmaildir--cur-server))))
+	(unless article
+	  (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
+	  (throw 'return nil)))
+      (setq gname (nnmaildir--grp-name group)
+	    pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+	    dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir dir gname)
+	    dir (if (nnmaildir--param pgname 'read-only)
+		    (nnmaildir--new dir) (nnmaildir--cur dir))
+	    nnmaildir-article-file-name
+	    (concat dir
+		    (nnmaildir--art-prefix article)
+		    (nnmaildir--art-suffix article)))
+      (unless (file-exists-p nnmaildir-article-file-name)
+	(nnmaildir--expired-article group article)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      "Article has expired")
+	(throw 'return nil))
+      (save-excursion
+	(set-buffer (or to-buffer nntp-server-buffer))
+	(erase-buffer)
+	(nnheader-insert-file-contents nnmaildir-article-file-name))
+      (cons gname num-msgid))))
+
+(defun nnmaildir-request-post (&optional server)
+  (let (message-required-mail-headers)
+    (funcall message-send-mail-function)))
+
+(defun nnmaildir-request-replace-article (number gname buffer)
+  (let ((group (nnmaildir--prepare nil gname))
+	(coding-system-for-write nnheader-file-coding-system)
+	(output-coding-system nnheader-file-coding-system)
+	(buffer-file-coding-system nil)
+	(file-coding-system nil)
+	(file-coding-system-alist nil)
+	dir file article suffix tmpfile deactivate-mark)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
+			      'read-only)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Read-only group: " group))
+	(throw 'return nil))
+      (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir dir gname)
+	    article (nnmaildir--nlist-art group number))
+      (unless article
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such article: " (number-to-string number)))
+	(throw 'return nil))
+      (setq suffix (nnmaildir--art-suffix article)
+	    file (nnmaildir--art-prefix article)
+	    tmpfile (concat (nnmaildir--tmp dir) file))
+      (when (file-exists-p tmpfile)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "File exists: " tmpfile))
+	(throw 'return nil))
+      (save-excursion
+	(set-buffer buffer)
+	(write-region (point-min) (point-max) tmpfile nil 'no-message nil
+		      'excl))
+      (unix-sync) ;; no fsync :(
+      (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace)
+      t)))
+
+(defun nnmaildir-request-move-article (article gname server accept-form
+					       &optional last)
+  (let ((group (nnmaildir--prepare server gname))
+	pgname suffix result nnmaildir--file deactivate-mark)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (setq gname (nnmaildir--grp-name group)
+	    pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+	    article (nnmaildir--nlist-art group article))
+      (unless article
+	(setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
+	(throw 'return nil))
+      (setq suffix (nnmaildir--art-suffix article)
+	    nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+	    nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
+	    nnmaildir--file (if (nnmaildir--param pgname 'read-only)
+				(nnmaildir--new nnmaildir--file)
+			      (nnmaildir--cur nnmaildir--file))
+	    nnmaildir--file (concat nnmaildir--file
+				    (nnmaildir--art-prefix article)
+				    suffix))
+      (unless (file-exists-p nnmaildir--file)
+	(nnmaildir--expired-article group article)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      "Article has expired")
+	(throw 'return nil))
+      (nnmaildir--with-move-buffer
+	(erase-buffer)
+	(nnheader-insert-file-contents nnmaildir--file)
+	(setq result (eval accept-form)))
+      (unless (or (null result) (nnmaildir--param pgname 'read-only))
+	(nnmaildir--unlink nnmaildir--file)
+	(nnmaildir--expired-article group article))
+      result)))
+
+(defun nnmaildir-request-accept-article (gname &optional server last)
+  (let ((group (nnmaildir--prepare server gname))
+	(coding-system-for-write nnheader-file-coding-system)
+	(output-coding-system nnheader-file-coding-system)
+	(buffer-file-coding-system nil)
+	(file-coding-system nil)
+	(file-coding-system-alist nil)
+	srv-dir dir file time tmpfile curfile 24h article)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(throw 'return nil))
+      (setq gname (nnmaildir--grp-name group))
+      (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
+			      'read-only)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "Read-only group: " gname))
+	(throw 'return nil))
+      (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir srv-dir gname)
+	    time (current-time)
+	    file (format-time-string "%s." time))
+      (unless (string-equal nnmaildir--delivery-time file)
+	(setq nnmaildir--delivery-time file
+	      nnmaildir--delivery-count 0))
+      (when (and (consp (cdr time))
+		 (consp (cddr time)))
+	(setq file (concat file "M" (number-to-string (caddr time)))))
+      (setq file (concat file nnmaildir--delivery-pid)
+	    file (concat file "Q" (number-to-string nnmaildir--delivery-count))
+	    file (concat file "." (nnmaildir--system-name))
+	    tmpfile (concat (nnmaildir--tmp dir) file)
+	    curfile (concat (nnmaildir--cur dir) file ":2,"))
+      (when (file-exists-p tmpfile)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "File exists: " tmpfile))
+	(throw 'return nil))
+      (when (file-exists-p curfile)
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "File exists: " curfile))
+	(throw 'return nil))
+      (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count)
+	    24h (run-with-timer 86400 nil
+				(lambda ()
+				  (nnmaildir--unlink tmpfile)
+				  (setf (nnmaildir--srv-error
+					  nnmaildir--cur-server)
+					"24-hour timer expired")
+				  (throw 'return nil))))
+      (condition-case nil
+	  (add-name-to-file nnmaildir--file tmpfile)
+	(error
+	 (write-region (point-min) (point-max) tmpfile nil 'no-message nil
+		       'excl)
+	 (unix-sync))) ;; no fsync :(
+      (cancel-timer 24h)
+      (condition-case err
+	  (add-name-to-file tmpfile curfile)
+	(error
+	 (setf (nnmaildir--srv-error nnmaildir--cur-server)
+	       (concat "Error linking: " (prin1-to-string err)))
+	 (nnmaildir--unlink tmpfile)
+	 (throw 'return nil)))
+      (nnmaildir--unlink tmpfile)
+      (setq article (make-nnmaildir--art :prefix file :suffix ":2,"))
+      (if (nnmaildir--grp-add-art nnmaildir--cur-server group article)
+	  (cons gname (nnmaildir--art-num article))))))
+
+(defun nnmaildir-save-mail (group-art)
+  (catch 'return
+    (unless group-art
+      (throw 'return nil))
+    (let (ga gname x groups nnmaildir--file deactivate-mark)
+      (save-excursion
+	(goto-char (point-min))
+	(save-match-data
+	  (while (looking-at "From ")
+	    (replace-match "X-From-Line: ")
+	    (forward-line 1))))
+      (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)
+	    ga (car group-art) group-art (cdr group-art)
+	    gname (car ga))
+      (or (intern-soft gname groups)
+	  (nnmaildir-request-create-group gname)
+	  (throw 'return nil)) ;; not that nnmail bothers to check :(
+      (unless (nnmaildir-request-accept-article gname)
+	(throw 'return nil))
+      (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+	    nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
+	    x (nnmaildir--prepare nil gname)
+	    x (nnmaildir--grp-nlist x)
+	    x (cdar x)
+	    nnmaildir--file (concat nnmaildir--file
+				    (nnmaildir--art-prefix x)
+				    (nnmaildir--art-suffix x)))
+      (delq nil
+	    (mapcar
+	     (lambda (ga)
+	       (setq gname (car ga))
+	       (and (or (intern-soft gname groups)
+			(nnmaildir-request-create-group gname))
+		    (nnmaildir-request-accept-article gname)
+		    ga))
+	     group-art)))))
+
+(defun nnmaildir-active-number (gname)
+  0)
+
+(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
+  (let ((no-force (not force))
+	(group (nnmaildir--prepare server gname))
+	pgname time boundary bound-iter high low target dir nlist nlist2
+	stop article didnt nnmaildir--file nnmaildir-article-file-name
+	deactivate-mark)
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (if gname (concat "No such group: " gname) "No current group"))
+	(throw 'return (gnus-uncompress-range ranges)))
+      (setq gname (nnmaildir--grp-name group)
+	    pgname (nnmaildir--pgname nnmaildir--cur-server gname))
+      (if (nnmaildir--param pgname 'read-only)
+	  (throw 'return (gnus-uncompress-range ranges)))
+      (setq time (nnmaildir--param pgname 'expire-age))
+      (unless time
+	(setq time (or (and nnmail-expiry-wait-function
+			    (funcall nnmail-expiry-wait-function gname))
+		       nnmail-expiry-wait))
+	(if (eq time 'immediate)
+	    (setq time 0)
+	  (if (numberp time)
+	      (setq time (* time 86400)))))
+      (when no-force
+	(unless (integerp time) ;; handle 'never
+	  (throw 'return (gnus-uncompress-range ranges)))
+	(setq boundary (current-time)
+	      high (- (car boundary) (/ time 65536))
+	      low (- (cadr boundary) (% time 65536)))
+	(if (< low 0)
+	    (setq low (+ low 65536)
+		  high (1- high)))
+	(setcar (cdr boundary) low)
+	(setcar boundary high))
+      (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir dir gname)
+	    dir (nnmaildir--cur dir)
+	    nlist (nnmaildir--grp-nlist group)
+	    ranges (reverse ranges))
+      (nnmaildir--with-move-buffer
+	(nnmaildir--nlist-iterate
+	 nlist ranges
+	 (lambda (article)
+	   (setq nnmaildir--file (nnmaildir--art-prefix article)
+		 nnmaildir--file (concat dir nnmaildir--file
+					 (nnmaildir--art-suffix article))
+		 time (file-attributes nnmaildir--file))
+	   (cond
+	    ((null time)
+	     (nnmaildir--expired-article group article))
+	    ((and no-force
+		  (progn
+		    (setq time (nth 5 time)
+			  bound-iter boundary)
+		    (while (and bound-iter time
+				(= (car bound-iter) (car time)))
+		      (setq bound-iter (cdr bound-iter)
+			    time (cdr time)))
+		    (and bound-iter time
+			 (car-less-than-car bound-iter time))))
+	     (setq didnt (cons (nnmaildir--art-num article) didnt)))
+	    (t
+	     (setq nnmaildir-article-file-name nnmaildir--file
+		   target (if force nil
+			    (save-excursion
+			      (save-restriction
+				(nnmaildir--param pgname 'expire-group)))))
+	     (when (and (stringp target)
+			(not (string-equal target pgname))) ;; Move it.
+	       (erase-buffer)
+	       (nnheader-insert-file-contents nnmaildir--file)
+	       (gnus-request-accept-article target nil nil 'no-encode))
+	     (if (equal target pgname)
+		 ;; Leave it here.
+		 (setq didnt (cons (nnmaildir--art-num article) didnt))
+	       (nnmaildir--unlink nnmaildir--file)
+	       (nnmaildir--expired-article group article))))))
+	(erase-buffer))
+      didnt)))
+
+(defun nnmaildir-request-set-mark (gname actions &optional server)
+  (let ((group (nnmaildir--prepare server gname))
+	(coding-system-for-write nnheader-file-coding-system)
+	(output-coding-system nnheader-file-coding-system)
+	(buffer-file-coding-system nil)
+	(file-coding-system nil)
+	(file-coding-system-alist nil)
+	del-mark del-action add-action set-action marksdir markfile nlist
+	ranges begin end article all-marks todo-marks did-marks mdir mfile
+	pgname ls permarkfile deactivate-mark)
+    (setq del-mark
+	  (lambda (mark)
+	    (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
+		  mfile (concat mfile (nnmaildir--art-prefix article)))
+	    (nnmaildir--unlink mfile))
+	  del-action (lambda (article) (mapcar del-mark todo-marks))
+	  add-action
+	  (lambda (article)
+	    (mapcar
+	     (lambda (mark)
+	       (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+		     permarkfile (concat mdir ":")
+		     mfile (concat mdir (nnmaildir--art-prefix article)))
+	       (unless (memq mark did-marks)
+		 (setq did-marks (cons mark did-marks))
+		 (nnmaildir--mkdir mdir)
+		 (unless (file-attributes permarkfile)
+		   (condition-case nil
+		       (add-name-to-file markfile permarkfile)
+		     (file-error
+		      ;; AFS can't make hard links in separate directories
+		      (write-region "" nil permarkfile nil 'no-message)))))
+	       (unless (file-exists-p mfile)
+		 (add-name-to-file permarkfile mfile)))
+	     todo-marks))
+	  set-action (lambda (article)
+		       (funcall add-action)
+		       (mapcar (lambda (mark)
+				 (unless (memq mark todo-marks)
+				   (funcall del-mark mark)))
+			       all-marks)))
+    (catch 'return
+      (unless group
+	(setf (nnmaildir--srv-error nnmaildir--cur-server)
+	      (concat "No such group: " gname))
+	(mapcar (lambda (action)
+		  (setq ranges (gnus-range-add ranges (car action))))
+		actions)
+	(throw 'return ranges))
+      (setq nlist (nnmaildir--grp-nlist group)
+	    marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    marksdir (nnmaildir--srvgrp-dir marksdir gname)
+	    marksdir (nnmaildir--nndir marksdir)
+	    markfile (concat marksdir "markfile")
+	    marksdir (nnmaildir--marks-dir marksdir)
+	    gname (nnmaildir--grp-name group)
+            pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+            ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+	    all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
+	    all-marks (mapcar 'intern all-marks))
+      (mapcar
+       (lambda (action)
+	 (setq ranges (car action)
+	       todo-marks (caddr action))
+	 (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks)
+	 (if (numberp (cdr ranges)) (setq ranges (list ranges)))
+	 (nnmaildir--nlist-iterate nlist ranges
+				   (cond ((eq 'del (cadr action)) del-action)
+					 ((eq 'add (cadr action)) add-action)
+					 (t set-action))))
+       actions)
+      nil)))
+
+(defun nnmaildir-close-group (gname &optional server)
+  (let ((group (nnmaildir--prepare server gname))
+	pgname ls dir msgdir files flist dirs)
+    (if (null group)
+	(progn
+	  (setf (nnmaildir--srv-error nnmaildir--cur-server)
+		(concat "No such group: " gname))
+	  nil)
+      (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+	    ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+	    dir (nnmaildir--srv-dir nnmaildir--cur-server)
+	    dir (nnmaildir--srvgrp-dir dir gname)
+	    msgdir (if (nnmaildir--param pgname 'read-only)
+		       (nnmaildir--new dir) (nnmaildir--cur dir))
+	    dir (nnmaildir--nndir dir)
+	    dirs (cons (nnmaildir--nov-dir dir)
+		       (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
+				'nosort))
+	    dirs (mapcar
+		  (lambda (dir)
+		    (cons dir (funcall ls dir nil "\\`[^.]" 'nosort)))
+		  dirs)
+	    files (funcall ls msgdir nil "\\`[^.]" 'nosort)
+	    flist (nnmaildir--up2-1 (length files))
+	    flist (make-vector flist 0))
+      (save-match-data
+	(mapcar
+	 (lambda (file)
+	   (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
+	   (intern (match-string 1 file) flist))
+	 files))
+      (mapcar
+       (lambda (dir)
+	 (setq files (cdr dir)
+	       dir (file-name-as-directory (car dir)))
+	 (mapcar
+	  (lambda (file)
+	    (unless (or (intern-soft file flist) (string= file ":"))
+	      (setq file (concat dir file))
+	      (delete-file file)))
+	  files))
+       dirs)
+      t)))
+
+(defun nnmaildir-close-server (&optional server)
+  (let (flist ls dirs dir files file x)
+    (nnmaildir--prepare server nil)
+    (when nnmaildir--cur-server
+      (setq server nnmaildir--cur-server
+	    nnmaildir--cur-server nil)
+      (unintern (nnmaildir--srv-address server) nnmaildir--servers)))
+  t)
+
+(defun nnmaildir-request-close ()
+  (let (servers buffer)
+    (mapatoms (lambda (server)
+		(setq servers (cons (symbol-name server) servers)))
+	      nnmaildir--servers)
+    (mapcar 'nnmaildir-close-server servers)
+    (setq buffer (get-buffer " *nnmaildir work*"))
+    (if buffer (kill-buffer buffer))
+    (setq buffer (get-buffer " *nnmaildir nov*"))
+    (if buffer (kill-buffer buffer))
+    (setq buffer (get-buffer " *nnmaildir move*"))
+    (if buffer (kill-buffer buffer)))
+  t)
+
+(provide 'nnmaildir)
+
+;; Local Variables:
+;; indent-tabs-mode: t
+;; fill-column: 77
+;; End:
+
+;;; nnmaildir.el ends here
diff --git a/lisp/nnnil.el b/lisp/nnnil.el
new file mode 100644
index 0000000..08a097d
--- /dev/null
+++ b/lisp/nnnil.el
@@ -0,0 +1,81 @@
+;;; nnnil.el --- empty backend for Gnus
+;; Public domain.
+
+;; Author: Paul Jarc <prj@po.cwru.edu>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; nnnil is a Gnus backend that provides no groups or articles.  It's useful
+;; as a primary select method when you want all your real select methods to
+;; be secondary or foreign.
+
+;;; Code:
+
+(eval-and-compile
+  (require 'nnheader))
+
+(defvar nnnil-status-string "")
+
+(defun nnnil-retrieve-headers (articles &optional group server fetch-old)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer))
+  'nov)
+
+(defun nnnil-open-server (server &optional definitions)
+  t)
+
+(defun nnnil-close-server (&optional server)
+  t)
+
+(defun nnnil-request-close ()
+  t)
+
+(defun nnnil-server-opened (&optional server)
+  t)
+
+(defun nnnil-status-message (&optional server)
+  nnnil-status-string)
+
+(defun nnnil-request-article (article &optional group server to-buffer)
+  (setq nnnil-status-string "No such group")
+  nil)
+
+(defun nnnil-request-group (group &optional server fast)
+  (let (deactivate-mark)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (erase-buffer)
+      (insert "411 no such news group\n")))
+  (setq nnnil-status-string "No such group")
+  nil)
+
+(defun nnnil-close-group (group &optional server)
+  t)
+
+(defun nnnil-request-list (&optional server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer))
+  t)
+
+(defun nnnil-request-post (&optional server)
+  (setq nnnil-status-string "Read-only server")
+  nil)
+
+(provide 'nnnil)
diff --git a/lisp/nnrss.el b/lisp/nnrss.el
new file mode 100644
index 0000000..6e94f09
--- /dev/null
+++ b/lisp/nnrss.el
@@ -0,0 +1,771 @@
+;;; nnrss.el --- interfacing with RSS
+;; Copyright (C) 2001, 2002, 2003  Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: RSS
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'nnoo)
+(require 'nnmail)
+(require 'message)
+(require 'mm-util)
+(require 'gnus-util)
+(require 'time-date)
+(require 'rfc2231)
+(require 'mm-url)
+(eval-when-compile
+  (ignore-errors
+    (require 'xml)))
+(eval '(require 'xml))
+
+(nnoo-declare nnrss)
+
+(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
+  "Where nnrss will save its files.")
+
+;; (group max rss-url)
+(defvoo nnrss-server-data nil)
+
+;; (num timestamp url subject author date extra)
+(defvoo nnrss-group-data nil)
+(defvoo nnrss-group-max 0)
+(defvoo nnrss-group-min 1)
+(defvoo nnrss-group nil)
+(defvoo nnrss-group-hashtb nil)
+(defvoo nnrss-status-string "")
+
+(defconst nnrss-version "nnrss 1.0")
+
+(defvar nnrss-group-alist '()
+  "List of RSS addresses.")
+
+(defvar nnrss-use-local nil)
+
+(defvar nnrss-description-field 'X-Gnus-Description
+  "Field name used for DESCRIPTION.
+To use the description in headers, put this name into `nnmail-extra-headers'.")
+
+(defvar nnrss-url-field 'X-Gnus-Url
+  "Field name used for URL.
+To use the description in headers, put this name into `nnmail-extra-headers'.")
+
+(defvar nnrss-content-function nil
+  "A function which is called in `nnrss-request-article'.
+The arguments are (ENTRY GROUP ARTICLE).
+ENTRY is the record of the current headline. GROUP is the group name.
+ARTICLE is the article number of the current headline.")
+
+(nnoo-define-basics nnrss)
+
+;;; Interface functions
+
+(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old)
+  (nnrss-possibly-change-group group server)
+  (let (e)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (erase-buffer)
+      (dolist (article articles)
+	(if (setq e (assq article nnrss-group-data))
+	    (insert (number-to-string (car e)) "\t" ;; number
+		    (if (nth 3 e)
+			(nnrss-format-string (nth 3 e)) "")
+		    "\t" ;; subject
+		    (if (nth 4 e)
+			(nnrss-format-string (nth 4 e))
+		      "(nobody)")
+		    "\t" ;;from
+		    (or (nth 5 e) "")
+		    "\t" ;; date
+		    (format "<%d@%s.nnrss>" (car e) group)
+		    "\t" ;; id
+		    "\t" ;; refs
+		    "-1" "\t" ;; chars
+		    "-1" "\t" ;; lines
+		    "" "\t" ;; Xref
+		    (if (and (nth 6 e)
+			     (memq nnrss-description-field
+				   nnmail-extra-headers))
+			(concat (symbol-name nnrss-description-field)
+				": "
+				(nnrss-format-string (nth 6 e))
+				"\t")
+		      "")
+		    (if (and (nth 2 e)
+			     (memq nnrss-url-field
+				   nnmail-extra-headers))
+			(concat (symbol-name nnrss-url-field)
+				": "
+				(nnrss-format-string (nth 2 e))
+				"\t")
+		      "")
+		    "\n")))))
+  'nov)
+
+(deffoo nnrss-request-group (group &optional server dont-check)
+  (nnrss-possibly-change-group group server)
+  (if dont-check
+      t
+    (nnrss-check-group group server)
+    (nnheader-report 'nnrss "Opened group %s" group)
+    (nnheader-insert
+     "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
+     (prin1-to-string group)
+     t)))
+
+(deffoo nnrss-close-group (group &optional server)
+  t)
+
+(deffoo nnrss-request-article (article &optional group server buffer)
+  (nnrss-possibly-change-group group server)
+  (let ((e (assq article nnrss-group-data))
+	(boundary "=-=-=-=-=-=-=-=-=-")
+	(nntp-server-buffer (or buffer nntp-server-buffer))
+	post err)
+    (when e
+      (catch 'error
+	(with-current-buffer nntp-server-buffer
+	  (erase-buffer)
+	  (goto-char (point-min))
+	  (insert "Mime-Version: 1.0\nContent-Type: multipart/alternative; boundary=\"" boundary "\"\n")
+	  (if group
+	      (insert "Newsgroups: " group "\n"))
+	  (if (nth 3 e)
+	      (insert "Subject: " (nnrss-format-string (nth 3 e)) "\n"))
+	  (if (nth 4 e)
+	      (insert "From: " (nnrss-format-string (nth 4 e)) "\n"))
+	  (if (nth 5 e)
+	      (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
+	  (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n")
+	  (insert "\n")
+	  (let ((text (if (nth 6 e)
+			  (nnrss-string-as-multibyte (nth 6 e))))
+		(link (if (nth 2 e)
+			  (nth 2 e))))
+	    (insert "\n\n--" boundary "\nContent-Type: text/plain\n\n")
+	    (let ((point (point)))
+	      (if text
+		  (progn (insert text)
+			 (goto-char point)
+			 (while (re-search-forward "\n" nil t)
+			   (replace-match " "))
+			 (goto-char (point-max))
+			 (insert "\n\n")))
+	      (if link
+		  (insert link)))
+	    (insert "\n\n--" boundary "\nContent-Type: text/html\n\n")
+	    (let ((point (point)))
+	      (if text
+		  (progn (insert "<html><head></head><body>\n" text "\n</body></html>")
+			 (goto-char point)
+			 (while (re-search-forward "\n" nil t)
+			   (replace-match " "))
+			 (goto-char (point-max))
+			 (insert "\n\n")))
+	      (if link
+		  (insert "<p><a href=\"" link "\">link</a></p>\n"))))
+	  (if nnrss-content-function
+	      (funcall nnrss-content-function e group article)))))
+    (cond
+     (err
+      (nnheader-report 'nnrss err))
+     ((not e)
+      (nnheader-report 'nnrss "no such id: %d" article))
+     (t
+      (nnheader-report 'nnrss "article %s retrieved" (car e))
+      ;; we return the article number.
+      (cons nnrss-group (car e))))))
+
+(deffoo nnrss-request-list (&optional server)
+  (nnrss-possibly-change-group nil server)
+  (nnrss-generate-active)
+  t)
+
+(deffoo nnrss-open-server (server &optional defs connectionless)
+  (nnrss-read-server-data server)
+  (nnoo-change-server 'nnrss server defs)
+  t)
+
+(deffoo nnrss-request-expire-articles
+    (articles group &optional server force)
+  (nnrss-possibly-change-group group server)
+  (let (e days not-expirable changed)
+    (dolist (art articles)
+      (if (and (setq e (assq art nnrss-group-data))
+	       (nnmail-expired-article-p
+		group
+		(if (listp (setq days (nth 1 e))) days
+		  (days-to-time (- days (time-to-days '(0 0)))))
+		force))
+	  (setq nnrss-group-data (delq e nnrss-group-data)
+		changed t)
+	(push art not-expirable)))
+    (if changed
+	(nnrss-save-group-data group server))
+    not-expirable))
+
+(deffoo nnrss-request-delete-group (group &optional force server)
+  (nnrss-possibly-change-group group server)
+  (setq nnrss-server-data
+	(delq (assoc group nnrss-server-data) nnrss-server-data))
+  (nnrss-save-server-data server)
+  (let ((file (expand-file-name
+	       (nnrss-translate-file-chars
+		(concat group (and server
+				   (not (equal server ""))
+				   "-")
+			server ".el")) nnrss-directory)))
+    (ignore-errors
+      (delete-file file)))
+  t)
+
+(deffoo nnrss-request-list-newsgroups (&optional server)
+  (nnrss-possibly-change-group nil server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (dolist (elem nnrss-group-alist)
+      (if (third elem)
+	  (insert (car elem) "\t" (third elem) "\n"))))
+  t)
+
+(nnoo-define-skeleton nnrss)
+
+;;; Internal functions
+(eval-when-compile (defun xml-rpc-method-call (&rest args)))
+(defun nnrss-fetch (url &optional local)
+  "Fetch the url and put it in a the expected lisp structure."
+  (with-temp-buffer
+  ;some CVS versions of url.el need this to close the connection quickly
+    (let* (xmlform htmlform)
+      ;; bit o' work necessary for w3 pre-cvs and post-cvs
+      (if local
+	  (let ((coding-system-for-read 'binary))
+	    (insert-file-contents url))
+	(mm-url-insert url))
+
+;; Because xml-parse-region can't deal with anything that isn't
+;; xml and w3-parse-buffer can't deal with some xml, we have to
+;; parse with xml-parse-region first and, if that fails, parse
+;; with w3-parse-buffer.  Yuck.  Eventually, someone should find out
+;; why w3-parse-buffer fails to parse some well-formed xml and
+;; fix it.
+
+    (condition-case err
+	(setq xmlform (xml-parse-region (point-min) (point-max)))
+      (error (if (fboundp 'w3-parse-buffer)
+		 (setq htmlform (caddar (w3-parse-buffer
+					 (current-buffer))))
+	       (message "nnrss: Not valid XML and w3 parse not available (%s)"
+			url))))
+    (if htmlform
+	htmlform
+      xmlform))))
+
+(defun nnrss-possibly-change-group (&optional group server)
+  (when (and server
+	     (not (nnrss-server-opened server)))
+    (nnrss-open-server server))
+  (when (and group (not (equal group nnrss-group)))
+    (nnrss-read-group-data group server)
+    (setq nnrss-group group)))
+
+(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
+
+(defun nnrss-generate-active ()
+  (if (y-or-n-p "fetch extra categories? ")
+      (dolist (func nnrss-extra-categories)
+	(funcall func)))
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (dolist (elem nnrss-group-alist)
+      (insert (prin1-to-string (car elem)) " 0 1 y\n"))
+    (dolist (elem nnrss-server-data)
+      (unless (assoc (car elem) nnrss-group-alist)
+	(insert (prin1-to-string (car elem)) " 0 1 y\n")))))
+
+;;; data functions
+
+(defun nnrss-read-server-data (server)
+  (setq nnrss-server-data nil)
+  (let ((file (expand-file-name
+	       (nnrss-translate-file-chars
+		(concat "nnrss" (and server
+				     (not (equal server ""))
+				     "-")
+			server
+			".el"))
+	       nnrss-directory)))
+    (when (file-exists-p file)
+      (with-temp-buffer
+	(let ((coding-system-for-read 'binary)
+	      (input-coding-system 'binary)
+	      emacs-lisp-mode-hook)
+	  (insert-file-contents file)
+	  (emacs-lisp-mode)
+	  (goto-char (point-min))
+	  (eval-buffer))))))
+
+(defun nnrss-save-server-data (server)
+  (gnus-make-directory nnrss-directory)
+  (let ((file (expand-file-name
+	       (nnrss-translate-file-chars
+		(concat "nnrss" (and server
+				     (not (equal server ""))
+				     "-")
+			server ".el"))
+	       nnrss-directory)))
+    (let ((coding-system-for-write 'binary)
+	  (output-coding-system 'binary)
+	  print-level print-length)
+      (with-temp-file file
+	(insert "(setq nnrss-group-alist '"
+		(prin1-to-string nnrss-group-alist)
+		")\n")
+	(insert "(setq nnrss-server-data '"
+		(prin1-to-string nnrss-server-data)
+		")\n")))))
+
+(defun nnrss-read-group-data (group server)
+  (setq nnrss-group-data nil)
+  (setq nnrss-group-hashtb (gnus-make-hashtable))
+  (let ((pair (assoc group nnrss-server-data)))
+    (setq nnrss-group-max (or (cadr pair) 0))
+    (setq nnrss-group-min (+ nnrss-group-max 1)))
+  (let ((file (expand-file-name
+	       (nnrss-translate-file-chars
+		(concat group (and server
+				   (not (equal server ""))
+				   "-")
+			server ".el"))
+	       nnrss-directory)))
+    (when (file-exists-p file)
+      (with-temp-buffer
+	(let ((coding-system-for-read 'binary)
+	      (input-coding-system 'binary)
+	      emacs-lisp-mode-hook)
+	  (insert-file-contents file)
+	  (emacs-lisp-mode)
+	  (goto-char (point-min))
+	  (eval-buffer)))
+      (dolist (e nnrss-group-data)
+	(gnus-sethash (nth 2 e) e nnrss-group-hashtb)
+	(if (and (car e) (> nnrss-group-min (car e)))
+	    (setq nnrss-group-min (car e)))
+	(if (and (car e) (< nnrss-group-max (car e)))
+	    (setq nnrss-group-max (car e)))))))
+
+(defun nnrss-save-group-data (group server)
+  (gnus-make-directory nnrss-directory)
+  (let ((file (expand-file-name
+	       (nnrss-translate-file-chars
+		(concat group (and server
+				   (not (equal server ""))
+				   "-")
+			server ".el"))
+	       nnrss-directory)))
+    (let ((coding-system-for-write 'binary)
+	  (output-coding-system 'binary)
+	  print-level print-length)
+      (with-temp-file file
+	(insert "(setq nnrss-group-data '"
+		(prin1-to-string nnrss-group-data)
+		")\n")))))
+
+;;; URL interface
+
+(defun nnrss-no-cache (url)
+  "")
+
+(defun nnrss-insert-w3 (url)
+  (mm-with-unibyte-current-buffer
+    (mm-url-insert url)))
+
+(defun nnrss-decode-entities-unibyte-string (string)
+  (if string
+      (mm-with-unibyte-buffer
+	(insert string)
+	(mm-url-decode-entities-nbsp)
+	(buffer-string))))
+
+(defalias 'nnrss-insert 'nnrss-insert-w3)
+
+(if (featurep 'xemacs)
+    (defalias 'nnrss-string-as-multibyte 'identity)
+  (defalias 'nnrss-string-as-multibyte 'string-as-multibyte))
+
+;;; Snarf functions
+
+(defun nnrss-check-group (group server)
+  (let (file xml subject url extra changed author
+	     date rss-ns rdf-ns content-ns dc-ns)
+    (if (and nnrss-use-local
+	     (file-exists-p (setq file (expand-file-name
+					(nnrss-translate-file-chars
+					 (concat group ".xml"))
+					nnrss-directory))))
+	(nnrss-fetch file t)
+      (setq url (or (nth 2 (assoc group nnrss-server-data))
+		    (second (assoc group nnrss-group-alist))))
+      (unless url
+	(setq url
+             (cdr
+              (assoc 'href
+                     (nnrss-discover-feed
+                      (read-string
+                       (format "URL to search for %s: " group) "http://")))))
+	(let ((pair (assoc group nnrss-server-data)))
+	  (if pair
+	      (setcdr (cdr pair) (list url))
+	    (push (list group nnrss-group-max url) nnrss-server-data)))
+	(setq changed t))
+      (setq xml (nnrss-fetch url)))
+    ;; See
+    ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html
+    ;; for more RSS namespaces.
+    (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/")
+	  rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
+	  rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")
+	  content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/"))
+    (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
+      (when (and (listp item)
+		 (eq (intern (concat rss-ns "item")) (car item))
+		 (setq url (nnrss-decode-entities-unibyte-string
+			    (nnrss-node-text rss-ns 'link (cddr item))))
+		 (not (gnus-gethash url nnrss-group-hashtb)))
+	(setq subject (nnrss-node-text rss-ns 'title item))
+	(setq extra (or (nnrss-node-text content-ns 'encoded item)
+			(nnrss-node-text rss-ns 'description item)))
+	(setq author (or (nnrss-node-text rss-ns 'author item)
+			 (nnrss-node-text dc-ns 'creator item)))
+	(setq date (or (nnrss-node-text dc-ns 'date item)
+		       (nnrss-node-text rss-ns 'pubDate item)
+		       (message-make-date)))
+	(push
+	 (list
+	  (incf nnrss-group-max)
+	  (current-time)
+	  url
+	  (and subject (nnrss-decode-entities-unibyte-string subject))
+	  (and author (nnrss-decode-entities-unibyte-string author))
+	  date
+	  (and extra (nnrss-decode-entities-unibyte-string extra)))
+	 nnrss-group-data)
+	(gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb)
+	(setq changed t)))
+    (when changed
+      (nnrss-save-group-data group server)
+      (let ((pair (assoc group nnrss-server-data)))
+	(if pair
+	    (setcar (cdr pair) nnrss-group-max)
+	  (push (list group nnrss-group-max) nnrss-server-data)))
+      (nnrss-save-server-data server))))
+
+(defun nnrss-generate-download-script ()
+  "Generate a download script in the current buffer.
+It is useful when `(setq nnrss-use-local t)'."
+  (interactive)
+  (insert "#!/bin/sh\n")
+  (insert "WGET=wget\n")
+  (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
+  (dolist (elem nnrss-server-data)
+    (let ((url (or (nth 2 elem)
+		   (second (assoc (car elem) nnrss-group-alist)))))
+      (insert "$WGET -q -O \"$RSSDIR\"/'"
+	      (nnrss-translate-file-chars (concat (car elem) ".xml"))
+	      "' '" url "'\n"))))
+
+(defun nnrss-translate-file-chars (name)
+  (let ((nnheader-file-name-translation-alist
+	 (append nnheader-file-name-translation-alist '((?' . ?_)))))
+    (nnheader-translate-file-chars name)))
+
+(defvar nnrss-moreover-url
+  "http://w.moreover.com/categories/category_list_rss.html"
+  "The url of moreover.com categories.")
+
+(defun nnrss-snarf-moreover-categories ()
+  "Snarf RSS links from moreover.com."
+  (interactive)
+  (let (category name url changed)
+    (with-temp-buffer
+      (nnrss-insert nnrss-moreover-url)
+      (goto-char (point-min))
+      (while (re-search-forward
+	      "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
+	(if (match-string 1)
+	    (setq category (match-string 1))
+	  (setq url (match-string 2)
+		name (mm-url-decode-entities-string
+		      (rfc2231-decode-encoded-string
+		       (match-string 3))))
+	  (if category
+	      (setq name (concat category "." name)))
+	  (unless (assoc name nnrss-server-data)
+	    (setq changed t)
+	    (push (list name 0 url) nnrss-server-data)))))
+    (if changed
+	(nnrss-save-server-data ""))))
+
+(defun nnrss-format-string (string)
+  (gnus-replace-in-string (nnrss-string-as-multibyte string) " *\n *" " "))
+
+(defun nnrss-node-text (namespace local-name element)
+  (let* ((node (assq (intern (concat namespace (symbol-name local-name)))
+		     element))
+	 (text (if (and node (listp node))
+		   (nnrss-node-just-text node)
+		 node))
+	 (cleaned-text (if text (gnus-replace-in-string
+				 text "^[\000-\037\177]+\\|^ +\\| +$" ""))))
+    (if (string-equal "" cleaned-text)
+	nil
+      cleaned-text)))
+
+(defun nnrss-node-just-text (node)
+  (if (and node (listp node))
+      (mapconcat 'nnrss-node-just-text (cddr node) " ")
+    node))
+
+(defun nnrss-find-el (tag data &optional found-list)
+  "Find the all matching elements in the data.  Careful with this on
+large documents!"
+  (if (listp data)
+      (mapcar (lambda (bit)
+		(if (car-safe bit)
+		    (progn (if (equal tag (car bit))
+			       (setq found-list
+				     (append found-list
+					     (list bit))))
+			   (if (and (listp (car-safe (caddr bit)))
+				    (not (stringp (caddr bit))))
+			       (setq found-list
+				     (append found-list
+					     (nnrss-find-el
+					      tag (caddr bit))))
+			     (setq found-list
+				   (append found-list
+					   (nnrss-find-el
+					    tag (cddr bit))))))))
+		data))
+  found-list)
+
+(defun nnrss-rsslink-p (el)
+  "Test if the element we are handed is an RSS autodiscovery link."
+  (and (eq (car-safe el) 'link)
+       (string-equal (cdr (assoc 'rel (cadr el))) "alternate")
+       (or (string-equal (cdr (assoc 'type (cadr el))) 
+			 "application/rss+xml")
+	   (string-equal (cdr (assoc 'type (cadr el))) "text/xml"))))
+
+(defun nnrss-get-rsslinks (data)
+  "Extract the <link> elements that are links to RSS from the parsed data."
+  (delq nil (mapcar 
+	     (lambda (el)
+	       (if (nnrss-rsslink-p el) el))
+	     (nnrss-find-el 'link data))))
+
+(defun nnrss-extract-hrefs (data)
+  "Recursively extract hrefs from a page's source.  DATA should be
+the output of xml-parse-region or w3-parse-buffer."
+  (mapcar (lambda (ahref)
+	    (cdr (assoc 'href (cadr ahref))))
+	  (nnrss-find-el 'a data)))
+
+(defmacro nnrss-match-macro (base-uri item 
+					   onsite-list offsite-list)
+  `(cond ((or (string-match (concat "^" ,base-uri) ,item)
+	       (not (string-match "://" ,item)))
+	   (setq ,onsite-list (append ,onsite-list (list ,item))))
+	  (t (setq ,offsite-list (append ,offsite-list (list ,item))))))
+
+(defun nnrss-order-hrefs (base-uri hrefs)
+  "Given a list of hrefs, sort them using the following priorities:
+  1. links ending in .rss
+  2. links ending in .rdf
+  3. links ending in .xml
+  4. links containing the above
+  5. offsite links
+
+BASE-URI is used to determine the location of the links and
+whether they are `offsite' or `onsite'."
+  (let (rss-onsite-end  rdf-onsite-end  xml-onsite-end
+	rss-onsite-in   rdf-onsite-in   xml-onsite-in
+	rss-offsite-end rdf-offsite-end xml-offsite-end
+	rss-offsite-in rdf-offsite-in xml-offsite-in)
+    (mapcar (lambda (href)
+	      (if (not (null href))
+	      (cond ((string-match "\\.rss$" href)
+		     (nnrss-match-macro
+		      base-uri href rss-onsite-end rss-offsite-end))
+		    ((string-match "\\.rdf$" href)
+		     (nnrss-match-macro 
+		      base-uri href rdf-onsite-end rdf-offsite-end))
+		    ((string-match "\\.xml$" href)
+		     (nnrss-match-macro
+		      base-uri href xml-onsite-end xml-offsite-end))
+		    ((string-match "rss" href)
+		     (nnrss-match-macro
+		      base-uri href rss-onsite-in rss-offsite-in))
+		    ((string-match "rdf" href)
+		     (nnrss-match-macro
+		      base-uri href rdf-onsite-in rdf-offsite-in))
+		    ((string-match "xml" href)
+		     (nnrss-match-macro
+		      base-uri href xml-onsite-in xml-offsite-in)))))
+	    hrefs)
+    (append 
+     rss-onsite-end  rdf-onsite-end  xml-onsite-end
+     rss-onsite-in   rdf-onsite-in   xml-onsite-in
+     rss-offsite-end rdf-offsite-end xml-offsite-end
+     rss-offsite-in rdf-offsite-in xml-offsite-in)))
+
+(defun nnrss-discover-feed (url)
+  "Given a page, find an RSS feed using Mark Pilgrim's
+`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)."
+
+  (let ((parsed-page (nnrss-fetch url)))
+
+;;    1. if this url is the rss, use it.
+    (if (nnrss-rss-p parsed-page)
+	(let ((rss-ns (nnrss-get-namespace-prefix parsed-page "http://purl.org/rss/1.0/")))
+	  (nnrss-rss-title-description rss-ns parsed-page url))
+
+;;    2. look for the <link rel="alternate"
+;;    type="application/rss+xml" and use that if it is there.
+      (let ((links (nnrss-get-rsslinks parsed-page)))
+	(if links
+	    (let* ((xml (nnrss-fetch
+			 (cdr (assoc 'href (cadar links)))))
+		   (rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")))
+	      (nnrss-rss-title-description rss-ns xml (cdr (assoc 'href (cadar links)))))
+
+;;    3. look for links on the site in the following order:
+;;       - onsite links ending in .rss, .rdf, or .xml
+;;       - onsite links containing any of the above
+;;       - offsite links ending in .rss, .rdf, or .xml
+;;       - offsite links containing any of the above
+	  (let* ((base-uri (progn (string-match ".*://[^/]+/?" url)
+				  (match-string 0 url)))
+		 (hrefs (nnrss-order-hrefs 
+			 base-uri (nnrss-extract-hrefs parsed-page)))
+		 (rss-link nil))
+	  (while (and (eq rss-link nil) (not (eq hrefs nil)))
+	    (let ((href-data (nnrss-fetch (car hrefs))))
+	      (if (nnrss-rss-p href-data)
+		  (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/")))
+		    (setq rss-link (nnrss-rss-title-description
+				    rss-ns href-data (car hrefs))))
+		(setq hrefs (cdr hrefs)))))
+	  (if rss-link rss-link
+
+;;    4. check syndic8
+	    (nnrss-find-rss-via-syndic8 url))))))))
+
+(defun nnrss-find-rss-via-syndic8 (url)
+  "query syndic8 for the rss feeds it has for the url."
+  (if (locate-library "xml-rpc")
+      (progn (require 'xml-rpc)
+	     (let ((feedid (xml-rpc-method-call
+			    "http://www.syndic8.com/xmlrpc.php"
+			    'syndic8.FindSites
+			    url)))
+	       (if feedid
+		   (let* ((feedinfo (xml-rpc-method-call 
+				     "http://www.syndic8.com/xmlrpc.php"
+				     'syndic8.GetFeedInfo
+				     feedid))
+			  (urllist
+			   (delq nil 
+				 (mapcar
+				  (lambda (listinfo)
+				    (if (string-equal 
+					 (cdr (assoc "status" listinfo))
+					 "Syndicated")
+					(cons
+					 (cdr (assoc "sitename" listinfo))
+					 (list
+					  (cons 'title
+						(cdr (assoc 
+						      "sitename" listinfo)))
+					  (cons 'href
+						(cdr (assoc
+						      "dataurl" listinfo)))))))
+				  feedinfo))))
+		     (if (> (length urllist) 1)
+			 (let ((completion-ignore-case t)
+			       (selection 
+				(mapcar (lambda (listinfo)
+					  (cons (cdr (assoc "sitename" listinfo)) 
+						(string-to-int 
+						 (cdr (assoc "feedid" listinfo)))))
+					feedinfo)))
+			   (cdr (assoc 
+				 (completing-read
+				  "Multiple feeds found.  Select one: "
+				  selection nil t) urllist)))
+		       (cdar urllist))))))
+    (error (message "XML-RPC is not available... not checking Syndic8."))))
+
+(defun nnrss-rss-p (data)
+  "Test if data is an RSS feed.  Simply ensures that the first
+element is rss or rdf."
+  (or (eq (caar data) 'rss)
+      (eq (caar data) 'rdf:RDF)))
+
+(defun nnrss-rss-title-description (rss-namespace data url)
+  "Return the title of an RSS feed."
+  (if (nnrss-rss-p data)
+      (let ((description (intern (concat rss-namespace "description")))
+	    (title (intern (concat rss-namespace "title")))
+	    (channel (nnrss-find-el (intern (concat rss-namespace "channel"))
+				    data)))
+	(list
+	 (cons 'description (caddr (nth 0 (nnrss-find-el description channel))))
+	 (cons 'title (caddr (nth 0 (nnrss-find-el title channel))))
+	 (cons 'href url)))))
+
+(defun nnrss-get-namespace-prefix (el uri)
+  "Given EL (containing a parsed element) and URI (containing a string
+that gives the URI for which you want to retrieve the namespace
+prefix), return the prefix."
+  (let* ((prefix (car (rassoc uri (cadar el))))
+	 (nslist (if prefix 
+		     (split-string (symbol-name prefix) ":")))
+	 (ns (cond ((eq (length nslist) 1) ; no prefix given
+		    "")
+		   ((eq (length nslist) 2) ; extract prefix
+		    (cadr nslist)))))
+    (if (and ns (not (eq ns "")))
+	(concat ns ":")
+      ns)))
+
+(provide 'nnrss)
+
+
+;;; nnrss.el ends here
+
diff --git a/lisp/sha1-el.el b/lisp/sha1-el.el
new file mode 100644
index 0000000..6bd25c6
--- /dev/null
+++ b/lisp/sha1-el.el
@@ -0,0 +1,432 @@
+;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp.
+
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: SHA1, FIPS 180-1
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program 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.
+
+;; This program 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 this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This program is implemented from the definition of SHA-1 in FIPS PUB
+;; 180-1 (Federal Information Processing Standards Publication 180-1),
+;; "Announcing the Standard for SECURE HASH STANDARD".
+;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
+;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
+;;
+;; Test cases from FIPS PUB 180-1.
+;;
+;; (sha1 "abc")
+;; => a9993e364706816aba3e25717850c26c9cd0d89d
+;;
+;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
+;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
+;;
+;; (sha1 (make-string 1000000 ?a))
+;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
+;;
+;; BUGS:
+;;  * It is assumed that length of input string is less than 2^29 bytes.
+;;  * It is caller's responsibility to make string (or region) unibyte.
+;;
+;; TODO:
+;;  * Rewrite from scratch!
+;;    This version is much faster than Keiichi Suzuki's another sha1.el,
+;;    but it is too dirty.
+
+;;; Code:
+
+(require 'hex-util)
+
+(autoload 'executable-find "executable")
+
+;;;
+;;; external SHA1 function.
+;;;
+
+(defvar sha1-maximum-internal-length 500
+  "*Maximum length of message to use lisp version of SHA1 function.
+If message is longer than this, `sha1-program' is used instead.
+
+If this variable is set to 0, use extarnal program only.
+If this variable is set to nil, use internal function only.")
+
+(defvar sha1-program '("openssl" "sha1")
+  "*Name of program to compute SHA1.
+It must be a string \(program name\) or list of strings \(name and its args\).")
+
+(defvar sha1-use-external
+  (exec-installed-p (car sha1-program))
+  "*Use external sha1 program.
+If this variable is set to nil, use internal function only.")
+
+(defun sha1-string-external (string)
+  ;; `with-temp-buffer' is new in v20, so we do not use it.
+  (save-excursion
+    (let (buffer)
+      (unwind-protect
+	  (let (prog args)
+	    (if (consp sha1-program)
+		(setq prog (car sha1-program)
+		      args (cdr sha1-program))
+	      (setq prog sha1-program
+		    args nil))
+	    (setq buffer (set-buffer
+			  (generate-new-buffer " *sha1 external*")))
+	    (insert string)
+	    (apply (function call-process-region)
+		   (point-min)(point-max)
+		   prog t t nil args)
+	    ;; SHA1 is 40 bytes long in hexadecimal form.
+	    (buffer-substring (point-min)(+ (point-min) 40)))
+	(and buffer
+	     (buffer-name buffer)
+	     (kill-buffer buffer))))))
+
+(defun sha1-region-external (beg end)
+  (sha1-string-external (buffer-substring-no-properties beg end)))
+
+;;;
+;;; internal SHA1 function.
+;;;
+
+(eval-when-compile
+  ;; optional second arg of string-to-number is new in v20.
+  (defconst sha1-K0-high 23170)		; (string-to-number "5A82" 16)
+  (defconst sha1-K0-low  31129)		; (string-to-number "7999" 16)
+  (defconst sha1-K1-high 28377)		; (string-to-number "6ED9" 16)
+  (defconst sha1-K1-low  60321)		; (string-to-number "EBA1" 16)
+  (defconst sha1-K2-high 36635)		; (string-to-number "8F1B" 16)
+  (defconst sha1-K2-low  48348)		; (string-to-number "BCDC" 16)
+  (defconst sha1-K3-high 51810)		; (string-to-number "CA62" 16)
+  (defconst sha1-K3-low  49622)		; (string-to-number "C1D6" 16)
+
+;;; original definition of sha1-F0.
+;;; (defmacro sha1-F0 (B C D)
+;;;   (` (logior (logand (, B) (, C))
+;;; 	     (logand (lognot (, B)) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
+  (defmacro sha1-F0 (B C D)
+    (` (logxor (, D) (logand (, B) (logxor (, C) (, D))))))
+  (defmacro sha1-F1 (B C D)
+    (` (logxor (, B) (, C) (, D))))
+;;; original definition of sha1-F2.
+;;; (defmacro sha1-F2 (B C D)
+;;;   (` (logior (logand (, B) (, C))
+;;; 	     (logand (, B) (, D))
+;;; 	     (logand (, C) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
+  (defmacro sha1-F2 (B C D)
+    (` (logior (logand (, B) (, C))
+	       (logand (, D) (logior (, B) (, C))))))
+  (defmacro sha1-F3 (B C D)
+    (` (logxor (, B) (, C) (, D))))
+
+  (defmacro sha1-S1  (W-high W-low)
+    (` (let ((W-high (, W-high))
+	     (W-low  (, W-low)))
+	 (setq S1W-high (+ (% (* W-high 2) 65536)
+			   (/ W-low (, (/ 65536 2)))))
+	 (setq S1W-low (+ (/ W-high (, (/ 65536 2)))
+			  (% (* W-low 2) 65536))))))
+  (defmacro sha1-S5  (A-high A-low)
+    (` (progn
+	 (setq S5A-high (+ (% (* (, A-high) 32) 65536)
+			   (/ (, A-low) (, (/ 65536 32)))))
+	 (setq S5A-low  (+ (/ (, A-high) (, (/ 65536 32)))
+			   (% (* (, A-low) 32) 65536))))))
+  (defmacro sha1-S30 (B-high B-low)
+    (` (progn
+	 (setq S30B-high (+ (/ (, B-high) 4)
+			    (* (% (, B-low) 4) (, (/ 65536 4)))))
+	 (setq S30B-low  (+ (/ (, B-low) 4)
+			    (* (% (, B-high) 4) (, (/ 65536 4))))))))
+
+  (defmacro sha1-OP (round)
+    (` (progn
+	 (sha1-S5 sha1-A-high sha1-A-low)
+	 (sha1-S30 sha1-B-high sha1-B-low)
+	 (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round)))
+			      sha1-B-low sha1-C-low sha1-D-low)
+			     sha1-E-low
+			     (, (symbol-value
+				 (intern (format "sha1-K%d-low" round))))
+			     (aref block-low idx)
+			     (progn
+			       (setq sha1-E-low sha1-D-low)
+			       (setq sha1-D-low sha1-C-low)
+			       (setq sha1-C-low S30B-low)
+			       (setq sha1-B-low sha1-A-low)
+			       S5A-low)))
+	 (setq carry (/ sha1-A-low 65536))
+	 (setq sha1-A-low (% sha1-A-low 65536))
+	 (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round)))
+				  sha1-B-high sha1-C-high sha1-D-high)
+				 sha1-E-high
+				 (, (symbol-value
+				     (intern (format "sha1-K%d-high" round))))
+				 (aref block-high idx)
+				 (progn
+				   (setq sha1-E-high sha1-D-high)
+				   (setq sha1-D-high sha1-C-high)
+				   (setq sha1-C-high S30B-high)
+				   (setq sha1-B-high sha1-A-high)
+				   S5A-high)
+				 carry)
+			      65536)))))
+
+  (defmacro sha1-add-to-H (H X)
+    (` (progn
+	 (setq (, (intern (format "sha1-%s-low" H)))
+	       (+ (, (intern (format "sha1-%s-low" H)))
+		  (, (intern (format "sha1-%s-low" X)))))
+	 (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536))
+	 (setq (, (intern (format "sha1-%s-low" H)))
+	       (% (, (intern (format "sha1-%s-low" H))) 65536))
+	 (setq (, (intern (format "sha1-%s-high" H)))
+	       (% (+ (, (intern (format "sha1-%s-high" H)))
+		     (, (intern (format "sha1-%s-high" X)))
+		     carry)
+		  65536)))))
+  )
+
+;;; buffers (H0 H1 H2 H3 H4).
+(defvar sha1-H0-high)
+(defvar sha1-H0-low)
+(defvar sha1-H1-high)
+(defvar sha1-H1-low)
+(defvar sha1-H2-high)
+(defvar sha1-H2-low)
+(defvar sha1-H3-high)
+(defvar sha1-H3-low)
+(defvar sha1-H4-high)
+(defvar sha1-H4-low)
+
+(defun sha1-block (block-high block-low)
+  (let (;; step (c) --- initialize buffers (A B C D E).
+	(sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low)
+	(sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low)
+	(sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low)
+	(sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low)
+	(sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low)
+	(idx 16))
+    ;; step (b).
+    (let (;; temporary variables used in sha1-S1 macro.
+	  S1W-high S1W-low)
+      (while (< idx 80)
+	(sha1-S1 (logxor (aref block-high (- idx 3))
+			 (aref block-high (- idx 8))
+			 (aref block-high (- idx 14))
+			 (aref block-high (- idx 16)))
+		 (logxor (aref block-low  (- idx 3))
+			 (aref block-low  (- idx 8))
+			 (aref block-low  (- idx 14))
+			 (aref block-low  (- idx 16))))
+	(aset block-high idx S1W-high)
+	(aset block-low  idx S1W-low)
+	(setq idx (1+ idx))))
+    ;; step (d).
+    (setq idx 0)
+    (let (;; temporary variables used in sha1-OP macro.
+	  S5A-high S5A-low S30B-high S30B-low carry)
+      (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx)))
+      (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx)))
+      (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx)))
+      (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx))))
+    ;; step (e).
+    (let (;; temporary variables used in sha1-add-to-H macro.
+	  carry)
+      (sha1-add-to-H H0 A)
+      (sha1-add-to-H H1 B)
+      (sha1-add-to-H H2 C)
+      (sha1-add-to-H H3 D)
+      (sha1-add-to-H H4 E))))
+
+(defun sha1-binary (string)
+  "Return the SHA1 of STRING in binary form."
+  (let (;; prepare buffers for a block. byte-length of block is 64.
+	;; input block is split into two vectors.
+	;;
+	;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ...
+	;; block-high:  +-0-+       +-1-+       +-2-+       +-3-+
+	;; block-low:         +-0-+       +-1-+       +-2-+       +-3-+
+	;;
+	;; length of each vector is 80, and elements of each vector are
+	;; 16bit integers.  elements 0x10-0x4F of each vector are
+	;; assigned later in `sha1-block'.
+	(block-high (eval-when-compile (make-vector 80 nil)))
+	(block-low  (eval-when-compile (make-vector 80 nil))))
+    (unwind-protect
+	(let* (;; byte-length of input string.
+	       (len (length string))
+	       (lim (* (/ len 64) 64))
+	       (rem (% len 4))
+	       (idx 0)(pos 0))
+	  ;; initialize buffers (H0 H1 H2 H3 H4).
+	  (setq sha1-H0-high 26437	; (string-to-number "6745" 16)
+		sha1-H0-low  8961	; (string-to-number "2301" 16)
+		sha1-H1-high 61389	; (string-to-number "EFCD" 16)
+		sha1-H1-low  43913	; (string-to-number "AB89" 16)
+		sha1-H2-high 39098	; (string-to-number "98BA" 16)
+		sha1-H2-low  56574	; (string-to-number "DCFE" 16)
+		sha1-H3-high 4146	; (string-to-number "1032" 16)
+		sha1-H3-low  21622	; (string-to-number "5476" 16)
+		sha1-H4-high 50130	; (string-to-number "C3D2" 16)
+		sha1-H4-low  57840)	; (string-to-number "E1F0" 16)
+	  ;; loop for each 64 bytes block.
+	  (while (< pos lim)
+	    ;; step (a).
+	    (setq idx 0)
+	    (while (< idx 16)
+	      (aset block-high idx (+ (* (aref string pos) 256)
+				      (aref string (1+ pos))))
+	      (setq pos (+ pos 2))
+	      (aset block-low  idx (+ (* (aref string pos) 256)
+				      (aref string (1+ pos))))
+	      (setq pos (+ pos 2))
+	      (setq idx (1+ idx)))
+	    (sha1-block block-high block-low))
+	  ;; last block.
+	  (if (prog1
+		  (< (- len lim) 56)
+		(setq lim (- len rem))
+		(setq idx 0)
+		(while (< pos lim)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (setq pos (+ pos 2))
+		  (aset block-low  idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (setq pos (+ pos 2))
+		  (setq idx (1+ idx)))
+		;; this is the last (at most) 32bit word.
+		(cond
+		 ((= rem 3)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (setq pos (+ pos 2))
+		  (aset block-low  idx (+ (* (aref string pos) 256)
+					  128)))
+		 ((= rem 2)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (aset block-low  idx 32768))
+		 ((= rem 1)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  128))
+		  (aset block-low  idx 0))
+		 (t ;; (= rem 0)
+		  (aset block-high idx 32768)
+		  (aset block-low  idx 0)))
+		(setq idx (1+ idx))
+		(while (< idx 16)
+		  (aset block-high idx 0)
+		  (aset block-low  idx 0)
+		  (setq idx (1+ idx))))
+	      ;; last block has enough room to write the length of string.
+	      (progn
+		;; write bit length of string to last 4 bytes of the block.
+		(aset block-low  15 (* (% len 8192) 8))
+		(setq len (/ len 8192))
+		(aset block-high 15 (% len 65536))
+		;; XXX: It is not practical to compute SHA1 of
+		;;      such a huge message on emacs.
+		;; (setq len (/ len 65536))	; for 64bit emacs.
+		;; (aset block-low  14 (% len 65536))
+		;; (aset block-high 14 (/ len 65536))
+		(sha1-block block-high block-low))
+	    ;; need one more block.
+	    (sha1-block block-high block-low)
+	    (fillarray block-high 0)
+	    (fillarray block-low  0)
+	    ;; write bit length of string to last 4 bytes of the block.
+	    (aset block-low  15 (* (% len 8192) 8))
+	    (setq len (/ len 8192))
+	    (aset block-high 15 (% len 65536))
+	    ;; XXX: It is not practical to compute SHA1 of
+	    ;;      such a huge message on emacs.
+	    ;; (setq len (/ len 65536))		; for 64bit emacs.
+	    ;; (aset block-low  14 (% len 65536))
+	    ;; (aset block-high 14 (/ len 65536))
+	    (sha1-block block-high block-low))
+	  ;; make output string (in binary form).
+	  (let ((result (make-string 20 0)))
+	    (aset result  0 (/ sha1-H0-high 256))
+	    (aset result  1 (% sha1-H0-high 256))
+	    (aset result  2 (/ sha1-H0-low  256))
+	    (aset result  3 (% sha1-H0-low  256))
+	    (aset result  4 (/ sha1-H1-high 256))
+	    (aset result  5 (% sha1-H1-high 256))
+	    (aset result  6 (/ sha1-H1-low  256))
+	    (aset result  7 (% sha1-H1-low  256))
+	    (aset result  8 (/ sha1-H2-high 256))
+	    (aset result  9 (% sha1-H2-high 256))
+	    (aset result 10 (/ sha1-H2-low  256))
+	    (aset result 11 (% sha1-H2-low  256))
+	    (aset result 12 (/ sha1-H3-high 256))
+	    (aset result 13 (% sha1-H3-high 256))
+	    (aset result 14 (/ sha1-H3-low  256))
+	    (aset result 15 (% sha1-H3-low  256))
+	    (aset result 16 (/ sha1-H4-high 256))
+	    (aset result 17 (% sha1-H4-high 256))
+	    (aset result 18 (/ sha1-H4-low  256))
+	    (aset result 19 (% sha1-H4-low  256))
+	    result))
+      ;; do not leave a copy of input string.
+      (fillarray block-high nil)
+      (fillarray block-low  nil))))
+
+(defun sha1-string-internal (string)
+  (encode-hex-string (sha1-binary string)))
+
+(defun sha1-region-internal (beg end)
+  (sha1-string-internal (buffer-substring-no-properties beg end)))
+
+;;;
+;;; application interface.
+;;;
+
+(defun sha1-region (beg end)
+  (if (and sha1-use-external
+	   sha1-maximum-internal-length
+	   (> (abs (- end beg)) sha1-maximum-internal-length))
+      (sha1-region-external beg end)
+    (sha1-region-internal beg end)))
+
+(defun sha1-string (string)
+  (if (and sha1-use-external
+	   sha1-maximum-internal-length
+	   (> (length string) sha1-maximum-internal-length))
+      (sha1-string-external string)
+    (sha1-string-internal string)))
+
+(defun sha1 (object &optional beg end)
+  "Return the SHA1 (Secure Hash Algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments BEG and END denote buffer positions for computing the
+hash of a portion of OBJECT."
+  (if (stringp object)
+      (sha1-string object)
+    (save-excursion
+      (set-buffer object)
+      (sha1-region (or beg (point-min)) (or end (point-max))))))
+
+(provide 'sha1-el)
+
+;;; sha1-el.el ends here
diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el
new file mode 100644
index 0000000..8897dd1
--- /dev/null
+++ b/lisp/sieve-manage.el
@@ -0,0 +1,614 @@
+;;; sieve-manage.el --- Implementation of the managesive protocol in elisp
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This library provides an elisp API for the managesieve network
+;; protocol.
+;;
+;; Currently only the CRAM-MD5 authentication mechanism is supported.
+;;
+;; The API should be fairly obvious for anyone familiar with the
+;; managesieve protocol, interface functions include:
+;;
+;; `sieve-manage-open'
+;; open connection to managesieve server, returning a buffer to be
+;; used by all other API functions.
+;;
+;; `sieve-manage-opened'
+;; check if a server is open or not
+;;
+;; `sieve-manage-close'
+;; close a server connection.
+;;
+;; `sieve-manage-authenticate'
+;; `sieve-manage-listscripts'
+;; `sieve-manage-deletescript'
+;; `sieve-manage-getscript'
+;; performs managesieve protocol actions
+;;
+;; and that's it.  Example of a managesieve session in *scratch*:
+;;
+;; (setq my-buf (sieve-manage-open "my.server.com"))
+;; " *sieve* my.server.com:2000*"
+;;
+;; (sieve-manage-authenticate "myusername" "mypassword" my-buf)
+;; 'auth
+;;
+;; (sieve-manage-listscripts my-buf)
+;; ("vacation" "testscript" ("splitmail") "badscript")
+;;
+;; References:
+;;
+;; draft-martin-managesieve-02.txt,
+;; "A Protocol for Remotely Managing Sieve Scripts",
+;; by Tim Martin.
+;;
+;; Release history:
+;;
+;; 2001-10-31 Committed to Oort Gnus.
+;; 2002-07-27 Added DELETESCRIPT.  Suggested by Ned Ludd.
+
+;;; Code:
+
+(require 'rfc2104)
+(or (fboundp 'md5)
+    (require 'md5))
+(eval-and-compile
+  (autoload 'starttls-open-stream "starttls"))
+
+;; User customizable variables:
+
+(defgroup sieve-manage nil
+  "Low-level Managesieve protocol issues."
+  :group 'mail
+  :prefix "sieve-")
+
+(defcustom sieve-manage-log "*sieve-manage-log*"
+  "Name of buffer for managesieve session trace."
+  :type 'string)
+
+(defcustom sieve-manage-default-user (user-login-name)
+  "Default username to use."
+  :type 'string)
+
+(defcustom sieve-manage-server-eol "\r\n"
+  "The EOL string sent from the server."
+  :type 'string)
+
+(defcustom sieve-manage-client-eol "\r\n"
+  "The EOL string we send to the server."
+  :type 'string)
+
+(defcustom sieve-manage-streams '(network starttls shell)
+  "Priority of streams to consider when opening connection to server.")
+
+(defcustom sieve-manage-stream-alist
+  '((network   sieve-manage-network-p          sieve-manage-network-open)
+    (shell     sieve-manage-shell-p            sieve-manage-shell-open)
+    (starttls  sieve-manage-starttls-p         sieve-manage-starttls-open))
+  "Definition of network streams.
+
+\(NAME CHECK OPEN)
+
+NAME names the stream, CHECK is a function returning non-nil if the
+server support the stream and OPEN is a function for opening the
+stream.")
+
+(defcustom sieve-manage-authenticators '(cram-md5 plain)
+  "Priority of authenticators to consider when authenticating to server.")
+
+(defcustom sieve-manage-authenticator-alist
+  '((cram-md5   sieve-manage-cram-md5-p       sieve-manage-cram-md5-auth)
+    (plain      sieve-manage-plain-p          sieve-manage-plain-auth))
+  "Definition of authenticators.
+
+\(NAME CHECK AUTHENTICATE)
+
+NAME names the authenticator.  CHECK is a function returning non-nil if
+the server support the authenticator and AUTHENTICATE is a function
+for doing the actual authentication.")
+
+(defcustom sieve-manage-default-port 2000
+  "Default port number for managesieve protocol."
+  :type 'integer)
+
+;; Internal variables:
+
+(defconst sieve-manage-local-variables '(sieve-manage-server
+					 sieve-manage-port
+					 sieve-manage-auth
+					 sieve-manage-stream
+					 sieve-manage-username
+					 sieve-manage-password
+					 sieve-manage-process
+					 sieve-manage-client-eol
+					 sieve-manage-server-eol
+					 sieve-manage-capability))
+(defconst sieve-manage-default-stream 'network)
+(defconst sieve-manage-coding-system-for-read 'binary)
+(defconst sieve-manage-coding-system-for-write 'binary)
+(defvar sieve-manage-stream nil)
+(defvar sieve-manage-auth nil)
+(defvar sieve-manage-server nil)
+(defvar sieve-manage-port nil)
+(defvar sieve-manage-username nil)
+(defvar sieve-manage-password nil)
+(defvar sieve-manage-state 'closed
+  "Managesieve state.
+Valid states are `closed', `initial', `nonauth', and `auth'.")
+(defvar sieve-manage-process nil)
+(defvar sieve-manage-capability nil)
+
+;; Internal utility functions
+
+(defsubst sieve-manage-disable-multibyte ()
+  "Enable multibyte in the current buffer."
+  (when (fboundp 'set-buffer-multibyte)
+    (set-buffer-multibyte nil)))
+
+;; Uses the dynamically bound `reason' variable.
+(defvar reason)
+(defun sieve-manage-interactive-login (buffer loginfunc)
+  "Login to server in BUFFER.
+LOGINFUNC is passed a username and a password, it should return t if
+it where sucessful authenticating itself to the server, nil otherwise.
+Returns t if login was successful, nil otherwise."
+  (with-current-buffer buffer
+    (make-variable-buffer-local 'sieve-manage-username)
+    (make-variable-buffer-local 'sieve-manage-password)
+    (let (user passwd ret reason)
+      ;;      (condition-case ()
+      (while (or (not user) (not passwd))
+	(setq user (or sieve-manage-username
+		       (read-from-minibuffer
+			(concat "Managesieve username for "
+				sieve-manage-server ": ")
+			(or user sieve-manage-default-user))))
+	(setq passwd (or sieve-manage-password
+			 (read-passwd
+			  (concat "Managesieve password for " user "@"
+				  sieve-manage-server ": "))))
+	(when (and user passwd)
+	  (if (funcall loginfunc user passwd)
+	      (progn
+		(setq ret t
+		      sieve-manage-username user)
+		(if (and (not sieve-manage-password)
+			 (y-or-n-p "Store password for this session? "))
+		    (setq sieve-manage-password passwd)))
+	    (if reason
+		(message "Login failed (reason given: %s)..." reason)
+	      (message "Login failed..."))
+	    (setq reason nil)
+	    (setq passwd nil)
+	    (sit-for 1))))
+      ;;	(quit (with-current-buffer buffer
+      ;;		(setq user nil
+      ;;		      passwd nil)))
+      ;;	(error (with-current-buffer buffer
+      ;;		 (setq user nil
+      ;;		       passwd nil))))
+      ret)))
+
+(defun sieve-manage-erase (&optional p buffer)
+  (let ((buffer (or buffer (current-buffer))))
+    (and sieve-manage-log
+	 (with-current-buffer (get-buffer-create sieve-manage-log)
+	   (sieve-manage-disable-multibyte)
+	   (buffer-disable-undo)
+	   (goto-char (point-max))
+	   (insert-buffer-substring buffer (with-current-buffer buffer
+					     (point-min))
+				    (or p (with-current-buffer buffer
+					    (point-max)))))))
+  (delete-region (point-min) (or p (point-max))))
+
+(defun sieve-manage-open-1 (buffer)
+  (with-current-buffer buffer
+    (sieve-manage-erase)
+    (setq sieve-manage-state 'initial
+	  sieve-manage-process
+	  (condition-case ()
+	      (funcall (nth 2 (assq sieve-manage-stream
+				    sieve-manage-stream-alist))
+		       "sieve" buffer sieve-manage-server sieve-manage-port)
+	    ((error quit) nil)))
+    (when sieve-manage-process
+      (while (and (eq sieve-manage-state 'initial)
+		  (memq (process-status sieve-manage-process) '(open run)))
+	(message "Waiting for response from %s..." sieve-manage-server)
+	(accept-process-output sieve-manage-process 1))
+      (message "Waiting for response from %s...done" sieve-manage-server)
+      (and (memq (process-status sieve-manage-process) '(open run))
+	   sieve-manage-process))))
+
+;; Streams
+
+(defun sieve-manage-network-p (buffer)
+  t)
+
+(defun sieve-manage-network-open (name buffer server port)
+  (let* ((port (or port sieve-manage-default-port))
+	 (coding-system-for-read sieve-manage-coding-system-for-read)
+	 (coding-system-for-write sieve-manage-coding-system-for-write)
+	 (process (open-network-stream name buffer server port)))
+    (when process
+      (while (and (memq (process-status process) '(open run))
+		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+		  (goto-char (point-min))
+		  (not (sieve-manage-parse-greeting-1)))
+	(accept-process-output process 1)
+	(sit-for 1))
+      (sieve-manage-erase nil buffer)
+      (when (memq (process-status process) '(open run))
+	process))))
+
+(defun imap-starttls-p (buffer)
+  ;;  (and (imap-capability 'STARTTLS buffer)
+  (condition-case ()
+      (progn
+	(require 'starttls)
+	(call-process "starttls"))
+    (error nil)))
+
+(defun imap-starttls-open (name buffer server port)
+  (let* ((port (or port sieve-manage-default-port))
+	 (coding-system-for-read sieve-manage-coding-system-for-read)
+	 (coding-system-for-write sieve-manage-coding-system-for-write)
+	 (process (starttls-open-stream name buffer server port))
+	 done)
+    (when process
+      (while (and (memq (process-status process) '(open run))
+		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+		  (goto-char (point-min))
+		  (not (sieve-manage-parse-greeting-1)))
+	(accept-process-output process 1)
+	(sit-for 1))
+      (sieve-manage-erase nil buffer)
+      (sieve-manage-send "STARTTLS")
+      (starttls-negotiate process))
+    (when (memq (process-status process) '(open run))
+      process)))
+
+;; Authenticators
+
+(defun sieve-manage-plain-p (buffer)
+  (sieve-manage-capability "SASL" "PLAIN" buffer))
+
+(defun sieve-manage-plain-auth (buffer)
+  "Login to managesieve server using the PLAIN SASL method."
+  (let* ((done (sieve-manage-interactive-login
+		buffer
+		(lambda (user passwd)
+		  (sieve-manage-send (concat "AUTHENTICATE \"PLAIN\" \""
+					     (base64-encode-string
+					      (concat (char-to-string 0)
+						      user
+						      (char-to-string 0)
+						      passwd))
+					     "\""))
+		  (let ((rsp (sieve-manage-parse-okno)))
+		    (if (sieve-manage-ok-p rsp)
+			t
+		      (setq reason (cdr-safe rsp))
+		      nil))))))
+    (if done
+	(message "sieve: Authenticating using PLAIN...done")
+      (message "sieve: Authenticating using PLAIN...failed"))))
+
+(defun sieve-manage-cram-md5-p (buffer)
+  (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
+
+(defun sieve-manage-cram-md5-auth (buffer)
+  "Login to managesieve server using the CRAM-MD5 SASL method."
+  (message "sieve: Authenticating using CRAM-MD5...")
+  (let* ((done (sieve-manage-interactive-login
+		buffer
+		(lambda (user passwd)
+		  (sieve-manage-send "AUTHENTICATE \"CRAM-MD5\"")
+		  (sieve-manage-send
+		   (concat
+		    "\""
+		    (base64-encode-string
+		     (concat
+		      user " "
+		      (rfc2104-hash 'md5 64 16 passwd
+				    (base64-decode-string
+				     (prog1
+					 (sieve-manage-parse-string)
+				       (sieve-manage-erase))))))
+		    "\""))
+		  (let ((rsp (sieve-manage-parse-okno)))
+		    (if (sieve-manage-ok-p rsp)
+			t
+		      (setq reason (cdr-safe rsp))
+		      nil))))))
+    (if done
+	(message "sieve: Authenticating using CRAM-MD5...done")
+      (message "sieve: Authenticating using CRAM-MD5...failed"))))
+
+;; Managesieve API
+
+(defun sieve-manage-open (server &optional port stream auth buffer)
+  "Open a network connection to a managesieve SERVER (string).
+Optional variable PORT is port number (integer) on remote server.
+Optional variable STREAM is any of `sieve-manage-streams' (a symbol).
+Optional variable AUTH indicates authenticator to use, see
+`sieve-manage-authenticators' for available authenticators.  If nil, chooses
+the best stream the server is capable of.
+Optional variable BUFFER is buffer (buffer, or string naming buffer)
+to work in."
+  (setq buffer (or buffer (format " *sieve* %s:%d" server (or port 2000))))
+  (with-current-buffer (get-buffer-create buffer)
+    (mapcar 'make-variable-buffer-local sieve-manage-local-variables)
+    (sieve-manage-disable-multibyte)
+    (buffer-disable-undo)
+    (setq sieve-manage-server (or server sieve-manage-server))
+    (setq sieve-manage-port (or port sieve-manage-port))
+    (setq sieve-manage-stream (or stream sieve-manage-stream))
+    (message "sieve: Connecting to %s..." sieve-manage-server)
+    (if (let ((sieve-manage-stream
+	       (or sieve-manage-stream sieve-manage-default-stream)))
+	  (sieve-manage-open-1 buffer))
+	;; Choose stream.
+	(let (stream-changed)
+	  (message "sieve: Connecting to %s...done" sieve-manage-server)
+	  (when (null sieve-manage-stream)
+	    (let ((streams sieve-manage-streams))
+	      (while (setq stream (pop streams))
+		(if (funcall (nth 1 (assq stream
+					  sieve-manage-stream-alist)) buffer)
+		    (setq stream-changed
+			  (not (eq (or sieve-manage-stream
+				       sieve-manage-default-stream)
+				   stream))
+			  sieve-manage-stream stream
+			  streams nil)))
+	      (unless sieve-manage-stream
+		(error "Couldn't figure out a stream for server"))))
+	  (when stream-changed
+	    (message "sieve: Reconnecting with stream `%s'..."
+		     sieve-manage-stream)
+	    (sieve-manage-close buffer)
+	    (if (sieve-manage-open-1 buffer)
+		(message "sieve: Reconnecting with stream `%s'...done"
+			 sieve-manage-stream)
+	      (message "sieve: Reconnecting with stream `%s'...failed"
+		       sieve-manage-stream))
+	    (setq sieve-manage-capability nil))
+	  (if (sieve-manage-opened buffer)
+	      ;; Choose authenticator
+	      (when (and (null sieve-manage-auth)
+			 (not (eq sieve-manage-state 'auth)))
+		(let ((auths sieve-manage-authenticators))
+		  (while (setq auth (pop auths))
+		    (if (funcall (nth 1 (assq
+					 auth
+					 sieve-manage-authenticator-alist))
+				 buffer)
+			(setq sieve-manage-auth auth
+			      auths nil)))
+		  (unless sieve-manage-auth
+		    (error "Couldn't figure out authenticator for server"))))))
+      (message "sieve: Connecting to %s...failed" sieve-manage-server))
+    (when (sieve-manage-opened buffer)
+      (sieve-manage-erase)
+      buffer)))
+
+(defun sieve-manage-opened (&optional buffer)
+  "Return non-nil if connection to managesieve server in BUFFER is open.
+If BUFFER is nil then the current buffer is used."
+  (and (setq buffer (get-buffer (or buffer (current-buffer))))
+       (buffer-live-p buffer)
+       (with-current-buffer buffer
+	 (and sieve-manage-process
+	      (memq (process-status sieve-manage-process) '(open run))))))
+
+(defun sieve-manage-close (&optional buffer)
+  "Close connection to managesieve server in BUFFER.
+If BUFFER is nil, the current buffer is used."
+  (with-current-buffer (or buffer (current-buffer))
+    (when (sieve-manage-opened)
+      (sieve-manage-send "LOGOUT")
+      (sit-for 1))
+    (when (and sieve-manage-process
+	       (memq (process-status sieve-manage-process) '(open run)))
+      (delete-process sieve-manage-process))
+    (setq sieve-manage-process nil)
+    (sieve-manage-erase)
+    t))
+
+(defun sieve-manage-authenticate (&optional user passwd buffer)
+  "Authenticate to server in BUFFER, using current buffer if nil.
+It uses the authenticator specified when opening the server.  If the
+authenticator requires username/passwords, they are queried from the
+user and optionally stored in the buffer.  If USER and/or PASSWD is
+specified, the user will not be questioned and the username and/or
+password is remembered in the buffer."
+  (with-current-buffer (or buffer (current-buffer))
+    (if (not (eq sieve-manage-state 'nonauth))
+	(eq sieve-manage-state 'auth)
+      (make-variable-buffer-local 'sieve-manage-username)
+      (make-variable-buffer-local 'sieve-manage-password)
+      (if user (setq sieve-manage-username user))
+      (if passwd (setq sieve-manage-password passwd))
+      (if (funcall (nth 2 (assq sieve-manage-auth
+				sieve-manage-authenticator-alist)) buffer)
+	  (setq sieve-manage-state 'auth)))))
+
+(defun sieve-manage-capability (&optional name value buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (if (null name)
+	sieve-manage-capability
+      (if (null value)
+	  (nth 1 (assoc name sieve-manage-capability))
+	(when (string-match value (nth 1 (assoc name sieve-manage-capability)))
+	  (nth 1 (assoc name sieve-manage-capability)))))))
+
+(defun sieve-manage-listscripts (&optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send "LISTSCRIPTS")
+    (sieve-manage-parse-listscripts)))
+
+(defun sieve-manage-havespace (name size &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
+    (sieve-manage-parse-okno)))
+
+(eval-and-compile
+  (if (fboundp 'string-bytes)
+      (defalias 'sieve-string-bytes 'string-bytes)
+    (defalias 'sieve-string-bytes 'length)))
+
+(defun sieve-manage-putscript (name content &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
+			       (sieve-string-bytes content)
+			       sieve-manage-client-eol content))
+    (sieve-manage-parse-okno)))
+
+(defun sieve-manage-deletescript (name &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "DELETESCRIPT \"%s\"" name))
+    (sieve-manage-parse-okno)))
+
+(defun sieve-manage-getscript (name output-buffer &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
+    (let ((script (sieve-manage-parse-string)))
+      (sieve-manage-parse-crlf)
+      (with-current-buffer output-buffer
+	(insert script))
+      (sieve-manage-parse-okno))))
+
+(defun sieve-manage-setactive (name &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "SETACTIVE \"%s\"" name))
+    (sieve-manage-parse-okno)))
+
+;; Protocol parsing routines
+
+(defun sieve-manage-ok-p (rsp)
+  (string= (downcase (or (car-safe rsp) "")) "ok"))
+
+(defsubst sieve-manage-forward ()
+  (or (eobp) (forward-char)))
+
+(defun sieve-manage-is-okno ()
+  (when (looking-at (concat
+		     "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
+		     sieve-manage-server-eol))
+    (let ((status (match-string 1))
+	  (resp-code (match-string 3))
+	  (response (match-string 5)))
+      (when response
+	(goto-char (match-beginning 5))
+	(setq response (sieve-manage-is-string)))
+      (list status resp-code response))))
+
+(defun sieve-manage-parse-okno ()
+  (let (rsp)
+    (while (null rsp)
+      (accept-process-output (get-buffer-process (current-buffer)) 1)
+      (goto-char (point-min))
+      (setq rsp (sieve-manage-is-okno)))
+    (sieve-manage-erase)
+    rsp))
+
+(defun sieve-manage-parse-capability-1 ()
+  "Accept a managesieve greeting."
+  (let (str)
+    (while (setq str (sieve-manage-is-string))
+      (if (eq (char-after) ? )
+	  (progn
+	    (sieve-manage-forward)
+	    (push (list str (sieve-manage-is-string))
+		  sieve-manage-capability))
+	(push (list str) sieve-manage-capability))
+      (forward-line)))
+  (when (re-search-forward (concat "^OK" sieve-manage-server-eol) nil t)
+    (setq sieve-manage-state 'nonauth)))
+
+(defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1)
+
+(defun sieve-manage-is-string ()
+  (cond ((looking-at "\"\\([^\"]+\\)\"")
+	 (prog1
+	     (match-string 1)
+	   (goto-char (match-end 0))))
+	((looking-at (concat "{\\([0-9]+\\)}" sieve-manage-server-eol))
+	 (let ((pos (match-end 0))
+	       (len (string-to-number (match-string 1))))
+	   (if (< (point-max) (+ pos len))
+	       nil
+	     (goto-char (+ pos len))
+	     (buffer-substring pos (+ pos len)))))))
+
+(defun sieve-manage-parse-string ()
+  (let (rsp)
+    (while (null rsp)
+      (accept-process-output (get-buffer-process (current-buffer)) 1)
+      (goto-char (point-min))
+      (setq rsp (sieve-manage-is-string)))
+    (sieve-manage-erase (point))
+    rsp))
+
+(defun sieve-manage-parse-crlf ()
+  (when (looking-at sieve-manage-server-eol)
+    (sieve-manage-erase (match-end 0))))
+
+(defun sieve-manage-parse-listscripts ()
+  (let (tmp rsp data)
+    (while (null rsp)
+      (while (null (or (setq rsp (sieve-manage-is-okno))
+		       (setq tmp (sieve-manage-is-string))))
+	(accept-process-output (get-buffer-process (current-buffer)) 1)
+	(goto-char (point-min)))
+      (when tmp
+	(while (not (looking-at (concat "\\( ACTIVE\\)?"
+					sieve-manage-server-eol)))
+	  (accept-process-output (get-buffer-process (current-buffer)) 1)
+	  (goto-char (point-min)))
+	(if (match-string 1)
+	    (push (cons 'active tmp) data)
+	  (push tmp data))
+	(goto-char (match-end 0))
+	(setq tmp nil)))
+    (sieve-manage-erase)
+    (if (sieve-manage-ok-p rsp)
+	data
+      rsp)))
+
+(defun sieve-manage-send (cmdstr)
+  (setq cmdstr (concat cmdstr sieve-manage-client-eol))
+  (and sieve-manage-log
+       (with-current-buffer (get-buffer-create sieve-manage-log)
+	 (sieve-manage-disable-multibyte)
+	 (buffer-disable-undo)
+	 (goto-char (point-max))
+	 (insert cmdstr)))
+  (process-send-string sieve-manage-process cmdstr))
+
+(provide 'sieve-manage)
+
+;; sieve-manage.el ends here
diff --git a/lisp/sieve-mode.el b/lisp/sieve-mode.el
new file mode 100644
index 0000000..e4945c9
--- /dev/null
+++ b/lisp/sieve-mode.el
@@ -0,0 +1,204 @@
+;;; sieve-mode.el --- Sieve code editing commands for Emacs
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file contain editing mode functions and font-lock support for
+;; editing Sieve scripts.  It sets up C-mode with support for
+;; sieve-style #-comments and a lightly hacked syntax table.  It was
+;; strongly influenced by awk-mode.el.
+;;
+;; Put something similar to the following in your .emacs to use this file:
+;;
+;; (load "~/lisp/sieve")
+;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist))
+;;
+;; References:
+;;
+;; RFC 3028,
+;; "Sieve: A Mail Filtering Language",
+;; by Tim Showalter.
+;;
+;; Release history:
+;;
+;; 2001-03-02 version 1.0 posted to gnu.emacs.sources
+;;            version 1.1 change file extension into ".siv" (official one)
+;;                        added keymap and menubar to hook into sieve-manage
+;; 2001-10-31 version 1.2 committed to Oort Gnus
+
+;;; Code:
+
+(autoload 'sieve-manage "sieve")
+(autoload 'sieve-upload "sieve")
+(autoload 'c-mode "cc-mode")
+(require 'easymenu)
+(eval-when-compile
+  (require 'font-lock))
+
+(defgroup sieve nil
+  "Sieve."
+  :group 'languages)
+
+(defcustom sieve-mode-hook nil
+  "Hook run in sieve mode buffers."
+  :group 'sieve
+  :type 'hook)
+
+;; Font-lock
+
+(defvar sieve-control-commands-face 'sieve-control-commands-face
+  "Face name used for Sieve Control Commands.")
+
+(defface sieve-control-commands-face
+  '((((type tty) (class color)) (:foreground "blue" :weight light))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (((class color) (background light)) (:foreground "Orchid"))
+    (((class color) (background dark)) (:foreground "LightSteelBlue"))
+    (t (:bold t)))
+  "Face used for Sieve Control Commands.")
+
+(defvar sieve-action-commands-face 'sieve-action-commands-face
+  "Face name used for Sieve Action Commands.")
+
+(defface sieve-action-commands-face
+  '((((type tty) (class color)) (:foreground "blue" :weight bold))
+    (((class color) (background light)) (:foreground "Blue"))
+    (((class color) (background dark)) (:foreground "LightSkyBlue"))
+    (t (:inverse-video t :bold t)))
+  "Face used for Sieve Action Commands.")
+
+(defvar sieve-test-commands-face 'sieve-test-commands-face
+  "Face name used for Sieve Test Commands.")
+
+(defface sieve-test-commands-face
+  '((((type tty) (class color)) (:foreground "magenta"))
+    (((class grayscale) (background light))
+     (:foreground "LightGray" :bold t :underline t))
+    (((class grayscale) (background dark))
+     (:foreground "Gray50" :bold t :underline t))
+    (((class color) (background light)) (:foreground "CadetBlue"))
+    (((class color) (background dark)) (:foreground "Aquamarine"))
+    (t (:bold t :underline t)))
+  "Face used for Sieve Test Commands.")
+
+(defvar sieve-tagged-arguments-face 'sieve-tagged-arguments-face
+  "Face name used for Sieve Tagged Arguments.")
+
+(defface sieve-tagged-arguments-face
+  '((((type tty) (class color)) (:foreground "cyan" :weight bold))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (((class color) (background light)) (:foreground "Purple"))
+    (((class color) (background dark)) (:foreground "Cyan"))
+    (t (:bold t)))
+  "Face used for Sieve Tagged Arguments.")
+
+
+(defconst sieve-font-lock-keywords
+  (eval-when-compile
+    (list
+     ;; control commands
+     (cons (regexp-opt '("require" "if" "else" "elsif" "stop"))
+	   'sieve-control-commands-face)
+     ;; action commands
+     (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard"))
+	   'sieve-action-commands-face)
+     ;; test commands
+     (cons (regexp-opt '("address" "allof" "anyof" "exists" "false"
+			 "true" "header" "not" "size" "envelope"))
+	   'sieve-test-commands-face)
+     (cons "\\Sw+:\\sw+"
+	   'sieve-tagged-arguments-face))))
+
+;; Syntax table
+
+(defvar sieve-mode-syntax-table nil
+  "Syntax table in use in sieve-mode buffers.")
+
+(if sieve-mode-syntax-table
+    ()
+  (setq sieve-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\ "\\" sieve-mode-syntax-table)
+  (modify-syntax-entry ?\n ">   " sieve-mode-syntax-table)
+  (modify-syntax-entry ?\f ">   " sieve-mode-syntax-table)
+  (modify-syntax-entry ?\# "<   " sieve-mode-syntax-table)
+  (modify-syntax-entry ?/ "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?* "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?+ "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?- "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?= "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?% "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?< "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?> "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?& "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?| "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?_ "_" sieve-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" sieve-mode-syntax-table))
+
+;; Key map definition
+
+(defvar sieve-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-c\C-l" 'sieve-upload)
+    (define-key map "\C-c\C-c" 'sieve-upload-and-bury)
+    (define-key map "\C-c\C-m" 'sieve-manage)
+    map)
+  "Key map used in sieve mode.")
+
+;; Menu definition
+
+(defvar sieve-mode-menu nil
+  "Menubar used in sieve mode.")
+
+;; Code for Sieve editing mode.
+
+;;;###autoload
+(define-derived-mode sieve-mode c-mode "Sieve"
+  "Major mode for editing Sieve code.
+This is much like C mode except for the syntax of comments.  Its keymap
+inherits from C mode's and it has the same variables for customizing
+indentation.  It has its own abbrev table and its own syntax table.
+
+Turning on Sieve mode runs `sieve-mode-hook'."
+  (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
+  (set (make-local-variable 'paragraph-separate) paragraph-start)
+  (set (make-local-variable 'comment-start) "#")
+  (set (make-local-variable 'comment-end) "")
+  ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *")
+  (set (make-local-variable 'comment-start-skip) "#+ *")
+  (unless (featurep 'xemacs)
+    (set (make-local-variable 'font-lock-defaults)
+	 '(sieve-font-lock-keywords nil nil ((?_ . "w")))))
+  (easy-menu-add-item nil nil sieve-mode-menu))
+
+;; Menu
+
+(easy-menu-define sieve-mode-menu sieve-mode-map
+  "Sieve Menu."
+  '("Sieve"
+    ["Upload script" sieve-upload t]
+    ["Manage scripts on server" sieve-manage t]))
+
+(provide 'sieve-mode)
+
+;; sieve-mode.el ends here
diff --git a/lisp/sieve.el b/lisp/sieve.el
new file mode 100644
index 0000000..8297f57
--- /dev/null
+++ b/lisp/sieve.el
@@ -0,0 +1,383 @@
+;;; sieve.el --- Utilities to manage sieve scripts
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file contain utilities to facilate upload, download and
+;; general management of sieve scripts.  Currently only the
+;; Managesieve protocol is supported (using sieve-manage.el), but when
+;; (useful) alternatives become available, they might be supported as
+;; well.
+;;
+;; The cursor navigation was inspired by biff-mode by Franklin Lee.
+;;
+;; Release history:
+;;
+;; 2001-10-31 Committed to Oort Gnus.
+;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode.  Fix menubar
+;;            in manage-mode.  Change some messages.  Added sieve-deactivate*,
+;;            sieve-remove.  Fixed help text in manage-mode.  Suggested by
+;;            Ned Ludd.
+;;
+;; Todo:
+;;
+;; * Namespace?  This file contains `sieve-manage' and
+;;   `sieve-manage-mode', but there is a sieve-manage.el file as well.
+;;   Can't think of a good solution though, this file need a *-mode,
+;;   and naming it `sieve-mode' would collide with sieve-mode.el.  One
+;;   solution would be to come up with some better name that this file
+;;   can use that doesn't have the managesieve specific "manage" in
+;;   it.  sieve-dired?  i dunno.  we could copy all off sieve.el into
+;;   sieve-manage.el too, but I'd like to separate the interface from
+;;   the protocol implementation since the backends are likely to
+;;   change (well).
+;;
+;; * Define servers?  We could have a customize buffer to create a server,
+;;   with authentication/stream/etc parameters, much like Gnus, and then
+;;   only use names of defined servers when interacting with M-x sieve-*.
+;;   Right now you can't use STARTTLS, which sieve-manage.el provides
+
+;;; Code:
+
+(require 'sieve-manage)
+(require 'sieve-mode)
+
+;; User customizable variables:
+
+(defgroup sieve nil
+  "Manage sieve scripts."
+  :group 'tools)
+
+(defcustom sieve-new-script "<new script>"
+  "Name of name script indicator."
+  :type 'string
+  :group 'sieve)
+
+(defcustom sieve-buffer "*sieve*"
+  "Name of sieve management buffer."
+  :type 'string
+  :group 'sieve)
+
+(defcustom sieve-template "\
+require \"fileinto\";
+
+# Example script (remove comment character '#' to make it effective!):
+#
+# if header :contains \"from\" \"coyote\" {
+#   discard;
+# } elsif header :contains [\"subject\"] [\"$$$\"] {
+#   discard;
+# } else {
+#  fileinto \"INBOX\";
+# }
+"
+  "Template sieve script."
+  :type 'string
+  :group 'sieve)
+
+;; Internal variables:
+
+(defvar sieve-manage-buffer nil)
+(defvar sieve-buffer-header-end nil)
+
+;; Sieve-manage mode:
+
+(defvar sieve-manage-mode-map nil
+  "Keymap for `sieve-manage-mode'.")
+
+(if sieve-manage-mode-map
+    ()
+  (setq sieve-manage-mode-map (make-sparse-keymap))
+  (suppress-keymap sieve-manage-mode-map)
+  ;; various
+  (define-key sieve-manage-mode-map "?" 'sieve-help)
+  (define-key sieve-manage-mode-map "h" 'sieve-help)
+  (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
+  ;; activating
+  (define-key sieve-manage-mode-map "m" 'sieve-activate)
+  (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
+  (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
+  ;; navigation keys
+  (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
+  (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
+  (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
+  (define-key sieve-manage-mode-map [down] 'sieve-next-line)
+  (define-key sieve-manage-mode-map " " 'sieve-next-line)
+  (define-key sieve-manage-mode-map "n" 'sieve-next-line)
+  (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
+  (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
+  (define-key sieve-manage-mode-map "f" 'sieve-edit-script)
+  (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
+  (define-key sieve-manage-mode-map "r" 'sieve-remove)
+  (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script)
+  (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu))
+
+(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
+  "Mode used for sieve script management."
+  (setq mode-name "SIEVE")
+  (buffer-disable-undo (current-buffer))
+  (setq truncate-lines t)
+  (easy-menu-add-item nil nil sieve-manage-mode-menu))
+
+(put 'sieve-manage-mode 'mode-class 'special)
+
+(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
+  "Sieve Menu."
+  '("Manage Sieve"
+    ["Edit script" sieve-edit-script t]
+    ["Activate script" sieve-activate t]
+    ["Deactivate script" sieve-deactivate t]))
+
+;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
+;; in substitute-command-keys.
+;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
+
+;; Commands used in sieve-manage mode:
+
+(defun sieve-activate (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)) err)
+    (when (or (null name) (string-equal name sieve-new-script))
+      (error "No sieve script at point"))
+    (message "Activating script %s..." name)
+    (setq err (sieve-manage-setactive name sieve-manage-buffer))
+    (sieve-refresh-scriptlist)
+    (if (sieve-manage-ok-p err)
+	(message "Activating script %s...done" name)
+      (message "Activating script %s...failed: %s" name (nth 2 err)))))
+
+(defun sieve-deactivate-all (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)) err)
+    (message "Deactivating scripts...")
+    (setq err (sieve-manage-setactive "" sieve-manage-buffer))
+    (sieve-refresh-scriptlist)
+    (if (sieve-manage-ok-p err)
+	(message "Deactivating scripts...done")
+      (message "Deactivating scripts...failed" (nth 2 err)))))
+
+(defalias 'sieve-deactivate 'sieve-deactivate-all)
+
+(defun sieve-remove (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)) err)
+    (when (or (null name) (string-equal name sieve-new-script))
+      (error "No sieve script at point"))
+    (message "Removing sieve script %s..." name)
+    (setq err (sieve-manage-deletescript name sieve-manage-buffer))
+    (unless (sieve-manage-ok-p err)
+      (error "Removing sieve script %s...failed: " err))
+    (sieve-refresh-scriptlist)
+    (message "Removing sieve script %s...done" name)))
+
+(defun sieve-edit-script (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)))
+    (unless name
+      (error "No sieve script at point"))
+    (if (not (string-equal name sieve-new-script))
+	(let ((newbuf (generate-new-buffer name))
+	      err)
+	  (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
+	  (switch-to-buffer newbuf)
+	  (unless (sieve-manage-ok-p err)
+	    (error "Sieve download failed: %s" err)))
+      (switch-to-buffer (get-buffer-create "template.siv"))
+      (insert sieve-template))
+    (sieve-mode)
+    (message "Press C-c C-l to upload script to server.")))
+
+(defmacro sieve-change-region (&rest body)
+  "Turns off sieve-region before executing BODY, then re-enables it after.
+Used to bracket operations which move point in the sieve-buffer."
+  `(progn
+     (sieve-highlight nil)
+     ,@body
+     (sieve-highlight t)))
+(put 'sieve-change-region 'lisp-indent-function 0)
+
+(defun sieve-next-line (&optional arg)
+  (interactive)
+  (unless arg
+    (setq arg 1))
+  (if (save-excursion
+	(forward-line arg)
+	(sieve-script-at-point))
+      (sieve-change-region
+	(forward-line arg))
+    (message "End of list")))
+
+(defun sieve-prev-line (&optional arg)
+  (interactive)
+  (unless arg
+    (setq arg -1))
+  (if (save-excursion
+	(forward-line arg)
+	(sieve-script-at-point))
+      (sieve-change-region
+	(forward-line arg))
+    (message "Beginning of list")))
+
+(defun sieve-help ()
+  "Display help for various sieve commands."
+  (interactive)
+  (if (eq last-command 'sieve-help)
+      ;; would need minor-mode for log-edit-mode
+      (describe-function 'sieve-mode)
+    (message (substitute-command-keys
+	      "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
+
+(defun sieve-bury-buffer (buf &optional mainbuf)
+  "Hide the buffer BUF that was temporarily popped up.
+BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
+  (interactive (list (current-buffer)))
+  (save-current-buffer
+    (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
+		 (get-buffer-window buf t))))
+      (when win
+	(if (window-dedicated-p win)
+	    (condition-case ()
+		(delete-window win)
+	      (error (iconify-frame (window-frame win))))
+	  (if (and mainbuf (get-buffer-window mainbuf))
+	      (delete-window win)))))
+    (with-current-buffer buf
+      (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
+				(not (window-dedicated-p (selected-window))))
+		     buf)))
+    (when mainbuf
+      (let ((mainwin (or (get-buffer-window mainbuf)
+			 (get-buffer-window mainbuf 'visible))))
+	(when mainwin (select-window mainwin))))))
+
+;; Create buffer:
+
+(defun sieve-setup-buffer (server port)
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (buffer-disable-undo)
+  (insert "\
+Server  : " server ":" (or port "2000") "
+
+")
+  (set (make-local-variable 'sieve-buffer-header-end)
+       (point-max)))
+
+(defun sieve-script-at-point (&optional pos)
+  "Return name of sieve script at point POS, or nil."
+  (interactive "d")
+  (get-char-property (or pos (point)) 'script-name))
+
+(eval-and-compile
+  (defalias 'sieve-make-overlay (if (fboundp 'make-overlay)
+				    'make-overlay
+				  'make-extent))
+  (defalias 'sieve-overlay-put (if (fboundp 'overlay-put)
+				   'overlay-put
+				 'set-extent-property))
+  (defalias 'sieve-overlays-at (if (fboundp 'overlays-at)
+				   'overlays-at
+				 'extents-at)))
+
+(defun sieve-highlight (on)
+  "Turn ON or off highlighting on the current language overlay."
+  (sieve-overlay-put (car (sieve-overlays-at (point)))
+		     'face (if on 'highlight 'default)))
+
+(defun sieve-insert-scripts (scripts)
+  "Format and insert LANGUAGE-LIST strings into current buffer at point."
+  (while scripts
+    (let ((p (point))
+	  (ext nil)
+	  (script (pop scripts)))
+      (if (consp script)
+	  (insert (format " ACTIVE %s" (cdr script)))
+	(insert (format "        %s" script)))
+      (setq ext (sieve-make-overlay p (point)))
+      (sieve-overlay-put ext 'mouse-face 'highlight)
+      (sieve-overlay-put ext 'script-name (if (consp script)
+					      (cdr script)
+					    script))
+      (insert "\n"))))
+
+(defun sieve-open-server (server &optional port)
+  ;; open server
+  (set (make-local-variable 'sieve-manage-buffer)
+       (sieve-manage-open server))
+  ;; authenticate
+  (sieve-manage-authenticate nil nil sieve-manage-buffer))
+
+(defun sieve-refresh-scriptlist ()
+  (interactive)
+  (with-current-buffer sieve-buffer
+    (setq buffer-read-only nil)
+    (delete-region (or sieve-buffer-header-end (point-max)) (point-max))
+    (goto-char (point-max))
+    ;; get list of script names and print them
+    (let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
+      (if (null scripts)
+	  (insert (format (concat "No scripts on server, press RET on %s to "
+				  "create a new script.\n") sieve-new-script))
+	(insert (format (concat "%d script%s on server, press RET on a script "
+				"name edits it, or\npress RET on %s to create "
+				"a new script.\n") (length scripts)
+				(if (eq (length scripts) 1) "" "s")
+				sieve-new-script)))
+      (save-excursion
+	(sieve-insert-scripts (list sieve-new-script))
+	(sieve-insert-scripts scripts)))
+    (sieve-highlight t)
+    (setq buffer-read-only t)))
+
+;;;###autoload
+(defun sieve-manage (server &optional port)
+  (interactive "sServer: ")
+  (switch-to-buffer (get-buffer-create sieve-buffer))
+  (sieve-manage-mode)
+  (sieve-setup-buffer server port)
+  (if (sieve-open-server server port)
+      (sieve-refresh-scriptlist)
+    (message "Could not open server %s" server)))
+
+;;;###autoload
+(defun sieve-upload (&optional name)
+  (interactive)
+  (unless name
+    (setq name (buffer-name)))
+  (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
+    (let ((script (buffer-string)) err)
+      (with-current-buffer (get-buffer sieve-buffer)
+	(setq err (sieve-manage-putscript name script sieve-manage-buffer))
+	(if (sieve-manage-ok-p err)
+	    (message (concat
+		      "Sieve upload done.  Use `C-c RET' to manage scripts."))
+	  (message "Sieve upload failed: %s" (nth 2 err)))))))
+
+;;;###autoload
+(defun sieve-upload-and-bury (&optional name)
+  (interactive)
+  (sieve-upload name)
+  (bury-buffer))
+
+(provide 'sieve)
+
+;; sieve.el ends here
diff --git a/lisp/smime.el b/lisp/smime.el
new file mode 100644
index 0000000..5701ec8
--- /dev/null
+++ b/lisp/smime.el
@@ -0,0 +1,619 @@
+;;; smime.el --- S/MIME support library
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: SMIME X.509 PEM OpenSSL
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This library perform S/MIME operations from within Emacs.
+;;
+;; Functions for fetching certificates from public repositories are
+;; provided, currently only from DNS.  LDAP support (via EUDC) is planned.
+;;
+;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
+;; encryption and decryption.
+;;
+;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is
+;; probably required to use this library in any useful way.
+;; Especially, don't expect this library to buy security for you.  If
+;; you don't understand what you are doing, you're as likely to lose
+;; security than gain any by using this library.
+;;
+;; This library is not intended to provide a "raw" API for S/MIME,
+;; PKCSx or similar, it's intended to perform common operations
+;; done on messages encoded in these formats.  The terminology chosen
+;; reflect this.
+;;
+;; The home of this file is in Gnus CVS, but also available from
+;; http://josefsson.org/smime.html.
+
+;;; Quick introduction:
+
+;; Get your S/MIME certificate from VeriSign or someplace.  I used
+;; Netscape to generate the key and certificate request and stuff, and
+;; Netscape can export the key into PKCS#12 format.
+;;
+;; Enter OpenSSL.  To be able to use this library, it need to have the
+;; SMIME key readable in PEM format.  OpenSSL is used to convert the
+;; key:
+;;
+;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem
+;; ...
+;;
+;; Now, use M-x customize-variable smime-keys and add mykey.pem as
+;; a key.
+;;
+;; Now you should be able to sign messages!  Create a buffer and write
+;; something and run M-x smime-sign-buffer RET RET and you should see
+;; your message MIME armoured and a signature.  Encryption, M-x
+;; smime-encrypt-buffer, should also work.
+;;
+;; To be able to verify messages you need to build up trust with
+;; someone.  Perhaps you trust the CA that issued your certificate, at
+;; least I did, so I export it's certificates from my PKCS#12
+;; certificate with:
+;;
+;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem
+;; ...
+;;
+;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a
+;; CA certificate.
+;;
+;; You should now be able to sign messages, and even verify messages
+;; sent by others that use the same CA as you.
+
+;; Bugs:
+;;
+;; Don't complain that this package doesn't do encrypted PEM files,
+;; submit a patch instead.  I store my keys in a safe place, so I
+;; didn't need the encryption.  Also, programming was made easier by
+;; that decision.  One might think that this even influenced were I
+;; store my keys, and one would probably be right. :-)
+;;
+;; Update: Mathias Herberts sent the patch.  However, it uses
+;; environment variables to pass the password to OpenSSL, which is
+;; slightly insecure. Hence a new todo: use a better -passin method.
+;;
+;; Cache password for e.g. 1h
+;;
+;; Suggestions and comments are appreciated, mail me at simon@josefsson.org.
+
+;; begin rant
+;;
+;; I would include pointers to introductory text on concepts used in
+;; this library here, but the material I've read are so horrible I
+;; don't want to recomend them.
+;;
+;; Why can't someone write a simple introduction to all this stuff?
+;; Until then, much of this resemble security by obscurity.
+;;
+;; Also, I'm not going to mention anything about the wonders of
+;; cryptopolitics.  Oops, I just did.
+;;
+;; end rant
+
+;;; Revision history:
+
+;; 2000-06-05  initial version, committed to Gnus CVS contrib/
+;; 2000-10-28  retrieve certificates via DNS CERT RRs
+;; 2001-10-14  posted to gnu.emacs.sources
+
+;;; Code:
+
+(require 'dig)
+(require 'comint)
+(eval-when-compile (require 'cl))
+
+(defgroup smime nil
+  "S/MIME configuration.")
+
+(defcustom smime-keys nil
+  "*Map mail addresses to a file containing Certificate (and private key).
+The file is assumed to be in PEM format. You can also associate additional
+certificates to be sent with every message to each address."
+  :type '(repeat (list (string :tag "Mail address")
+		       (file :tag "File name")
+		       (repeat :tag "Additional certificate files"
+			       (file :tag "File name"))))
+  :group 'smime)
+
+(defcustom smime-CA-directory nil
+  "*Directory containing certificates for CAs you trust.
+Directory should contain files (in PEM format) named to the X.509
+hash of the certificate.  This can be done using OpenSSL such as:
+
+$ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0
+
+where `ca.pem' is the file containing a PEM encoded X.509 CA
+certificate."
+  :type '(choice (const :tag "none" nil)
+		 directory)
+  :group 'smime)
+
+(defcustom smime-CA-file nil
+  "*Files containing certificates for CAs you trust.
+File should contain certificates in PEM format."
+  :type '(choice (const :tag "none" nil)
+		 file)
+  :group 'smime)
+
+(defcustom smime-certificate-directory "~/Mail/certs/"
+  "*Directory containing other people's certificates.
+It should contain files named to the X.509 hash of the certificate,
+and the files themself should be in PEM format."
+;The S/MIME library provide simple functionality for fetching
+;certificates into this directory, so there is no need to populate it
+;manually.
+  :type 'directory
+  :group 'smime)
+
+(defcustom smime-openssl-program
+  (and (condition-case ()
+	   (eq 0 (call-process "openssl" nil nil nil "version"))
+	 (error nil))
+       "openssl")
+  "*Name of OpenSSL binary."
+  :type 'string
+  :group 'smime)
+
+;; OpenSSL option to select the encryption cipher
+
+(defcustom smime-encrypt-cipher "-des3"
+  "*Cipher algorithm used for encryption."
+  :type '(choice (const :tag "Triple DES" "-des3")
+		 (const :tag "DES"  "-des")
+		 (const :tag "RC2 40 bits" "-rc2-40")
+		 (const :tag "RC2 64 bits" "-rc2-64")
+		 (const :tag "RC2 128 bits" "-rc2-128"))
+  :group 'smime)
+
+(defcustom smime-dns-server nil
+  "*DNS server to query certificates from.
+If nil, use system defaults."
+  :type '(choice (const :tag "System defaults")
+		 string)
+  :group 'smime)
+
+(defvar smime-details-buffer "*OpenSSL output*")
+
+(eval-and-compile
+  (defalias 'smime-make-temp-file
+    (if (fboundp 'make-temp-file)
+	'make-temp-file
+      (lambda (prefix &optional dir-flag) ;; Simple implementation
+	(expand-file-name
+	 (make-temp-name prefix)
+	 (if (fboundp 'temp-directory)
+	     (temp-directory)
+	   temporary-file-directory))))))
+
+;; Password dialog function
+
+(defun smime-ask-passphrase ()
+  "Asks the passphrase to unlock the secret key."
+  (let ((passphrase
+	 (comint-read-noecho
+	  "Passphrase for secret key (RET for no passphrase): " t)))
+    (if (string= passphrase "")
+	nil
+      passphrase)))
+
+;; OpenSSL wrappers.
+
+(defun smime-call-openssl-region (b e buf &rest args)
+  (case (apply 'call-process-region b e smime-openssl-program nil buf nil args)
+    (0 t)
+    (1 (message "OpenSSL: An error occurred parsing the command options.") nil)
+    (2 (message "OpenSSL: One of the input files could not be read.") nil)
+    (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil)
+    (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil)
+    (t (error "Unknown OpenSSL exitcode") nil)))
+
+(defun smime-make-certfiles (certfiles)
+  (if certfiles
+      (append (list "-certfile" (expand-file-name (car certfiles)))
+	      (smime-make-certfiles (cdr certfiles)))))
+
+;; Sign+encrypt region
+
+(defun smime-sign-region (b e keyfile)
+  "Sign region with certified key in KEYFILE.
+If signing fails, the buffer is not modified.  Region is assumed to
+have proper MIME tags.  KEYFILE is expected to contain a PEM encoded
+private key and certificate as its car, and a list of additional
+certificates to include in its caar.  If no additional certificates is
+included, KEYFILE may be the file containing the PEM encoded private
+key and certificate itself."
+  (smime-new-details-buffer)
+  (let ((keyfile (or (car-safe keyfile) keyfile))
+	(certfiles (and (cdr-safe keyfile) (cadr keyfile)))
+	(buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+	(passphrase (smime-ask-passphrase))
+	(tmpfile (smime-make-temp-file "smime")))
+    (if passphrase
+	(setenv "GNUS_SMIME_PASSPHRASE" passphrase))
+    (prog1
+	(when (prog1
+		  (apply 'smime-call-openssl-region b e (list buffer tmpfile)
+			 "smime" "-sign" "-signer" (expand-file-name keyfile)
+			 (append
+			  (smime-make-certfiles certfiles)
+			  (if passphrase
+			      (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))))
+		(if passphrase
+		    (setenv "GNUS_SMIME_PASSPHRASE" "" t))
+		(with-current-buffer smime-details-buffer
+		  (insert-file-contents tmpfile)
+		  (delete-file tmpfile)))
+	  (delete-region b e)
+	  (insert-buffer-substring buffer)
+	  (goto-char b)
+	  (when (looking-at "^MIME-Version: 1.0$")
+	    (delete-region (point) (progn (forward-line 1) (point))))
+	  t)
+      (with-current-buffer smime-details-buffer
+	(goto-char (point-max))
+	(insert-buffer-substring buffer))
+      (kill-buffer buffer))))
+
+(defun smime-encrypt-region (b e certfiles)
+  "Encrypt region for recipients specified in CERTFILES.
+If encryption fails, the buffer is not modified.  Region is assumed to
+have proper MIME tags.  CERTFILES is a list of filenames, each file
+is expected to contain of a PEM encoded certificate."
+  (smime-new-details-buffer)
+  (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+	(tmpfile (smime-make-temp-file "smime")))
+    (prog1
+	(when (prog1
+		  (apply 'smime-call-openssl-region b e (list buffer tmpfile)
+			 "smime" "-encrypt" smime-encrypt-cipher
+			 (mapcar 'expand-file-name certfiles))
+		(with-current-buffer smime-details-buffer
+		  (insert-file-contents tmpfile)
+		  (delete-file tmpfile)))
+	  (delete-region b e)
+	  (insert-buffer-substring buffer)
+	  (goto-char b)
+	  (when (looking-at "^MIME-Version: 1.0$")
+	    (delete-region (point) (progn (forward-line 1) (point))))
+	  t)
+      (with-current-buffer smime-details-buffer
+	(goto-char (point-max))
+	(insert-buffer-substring buffer))
+      (kill-buffer buffer))))
+
+;; Sign+encrypt buffer
+
+(defun smime-sign-buffer (&optional keyfile buffer)
+  "S/MIME sign BUFFER with key in KEYFILE.
+KEYFILE should contain a PEM encoded key and certificate."
+  (interactive)
+  (with-current-buffer (or buffer (current-buffer))
+    (smime-sign-region
+     (point-min) (point-max)
+     (if keyfile
+	 keyfile
+       (smime-get-key-with-certs-by-email
+	(completing-read
+	 (concat "Sign using which key? "
+		 (if smime-keys (concat "(default " (caar smime-keys) ") ")
+		   ""))
+	 smime-keys nil nil (car-safe (car-safe smime-keys))))))))
+
+(defun smime-encrypt-buffer (&optional certfiles buffer)
+  "S/MIME encrypt BUFFER for recipients specified in CERTFILES.
+CERTFILES is a list of filenames, each file is expected to consist of
+a PEM encoded key and certificate.  Uses current buffer if BUFFER is
+nil."
+  (interactive)
+  (with-current-buffer (or buffer (current-buffer))
+    (smime-encrypt-region
+     (point-min) (point-max)
+     (or certfiles
+	 (list (read-file-name "Recipient's S/MIME certificate: "
+			       smime-certificate-directory nil))))))
+
+;; Verify+decrypt region
+
+(defun smime-verify-region (b e)
+  "Verify S/MIME message in region between B and E.
+Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+  (smime-new-details-buffer)
+  (let ((CAs (append (if smime-CA-file
+			 (list "-CAfile"
+			       (expand-file-name smime-CA-file)))
+		     (if smime-CA-directory
+			 (list "-CApath"
+			       (expand-file-name smime-CA-directory))))))
+    (unless CAs
+      (error "No CA configured"))
+    (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
+	       "smime" "-verify" "-out" "/dev/null" CAs)
+	t
+      (insert-buffer-substring smime-details-buffer)
+      nil)))
+
+(defun smime-noverify-region (b e)
+  "Verify integrity of S/MIME message in region between B and E.
+Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+  (smime-new-details-buffer)
+  (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
+	     "smime" "-verify" "-noverify" "-out" '("/dev/null"))
+      t
+    (insert-buffer-substring smime-details-buffer)
+    nil))
+
+(eval-when-compile
+  (defvar from))
+
+(defun smime-decrypt-region (b e keyfile)
+  "Decrypt S/MIME message in region between B and E with key in KEYFILE.
+On success, replaces region with decrypted data and return non-nil.
+Any details (stderr on success, stdout and stderr on error) are left
+in the buffer specified by `smime-details-buffer'."
+  (smime-new-details-buffer)
+  (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+	CAs (passphrase (smime-ask-passphrase))
+	(tmpfile (smime-make-temp-file "smime")))
+    (if passphrase
+	(setenv "GNUS_SMIME_PASSPHRASE" passphrase))
+    (if (prog1
+	    (apply 'smime-call-openssl-region b e
+		   (list buffer tmpfile)
+		   "smime" "-decrypt" "-recip" (expand-file-name keyfile)
+		   (if passphrase
+		       (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))
+	  (if passphrase
+	      (setenv "GNUS_SMIME_PASSPHRASE" "" t))
+	  (with-current-buffer smime-details-buffer
+	    (insert-file-contents tmpfile)
+	    (delete-file tmpfile)))
+	(progn
+	  (delete-region b e)
+	  (when (boundp 'from)
+	    ;; `from' is dynamically bound in mm-dissect.
+	    (insert "From: " from "\n"))
+	  (insert-buffer-substring buffer)
+	  (kill-buffer buffer)
+	  t)
+      (with-current-buffer smime-details-buffer
+	(insert-buffer-substring buffer))
+      (kill-buffer buffer)
+      (delete-region b e)
+      (insert-buffer-substring smime-details-buffer)
+      nil)))
+
+;; Verify+Decrypt buffer
+
+(defun smime-verify-buffer (&optional buffer)
+  "Verify integrity of S/MIME message in BUFFER.
+Uses current buffer if BUFFER is nil. Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+  (interactive)
+  (with-current-buffer (or buffer (current-buffer))
+    (smime-verify-region (point-min) (point-max))))
+
+(defun smime-noverify-buffer (&optional buffer)
+  "Verify integrity of S/MIME message in BUFFER.
+Does NOT verify validity of certificate (only message integrity).
+Uses current buffer if BUFFER is nil. Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+  (interactive)
+  (with-current-buffer (or buffer (current-buffer))
+    (smime-noverify-region (point-min) (point-max))))
+
+(defun smime-decrypt-buffer (&optional buffer keyfile)
+  "Decrypt S/MIME message in BUFFER using KEYFILE.
+Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil.
+On success, replaces data in buffer and return non-nil.
+Any details (stderr on success, stdout and stderr on error) are left
+in the buffer specified by `smime-details-buffer'."
+  (interactive)
+  (with-current-buffer (or buffer (current-buffer))
+    (smime-decrypt-region
+     (point-min) (point-max)
+     (expand-file-name
+      (or keyfile
+	  (smime-get-key-by-email
+	   (completing-read
+	    (concat "Decipher using which key? "
+		    (if smime-keys (concat "(default " (caar smime-keys) ") ")
+		      ""))
+	    smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
+
+;; Various operations
+
+(defun smime-new-details-buffer ()
+  (with-current-buffer (get-buffer-create smime-details-buffer)
+    (erase-buffer)))
+
+(defun smime-pkcs7-region (b e)
+  "Convert S/MIME message between points B and E into a PKCS7 message."
+  (smime-new-details-buffer)
+  (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out")
+    (delete-region b e)
+    (insert-buffer-substring smime-details-buffer)
+    t))
+
+(defun smime-pkcs7-certificates-region (b e)
+  "Extract any certificates enclosed in PKCS7 message between points B and E."
+  (smime-new-details-buffer)
+  (when (smime-call-openssl-region
+	 b e smime-details-buffer "pkcs7" "-print_certs" "-text")
+    (delete-region b e)
+    (insert-buffer-substring smime-details-buffer)
+    t))
+
+(defun smime-pkcs7-email-region (b e)
+  "Get email addresses contained in certificate between points B and E.
+A string or a list of strings is returned."
+  (smime-new-details-buffer)
+  (when (smime-call-openssl-region
+	 b e smime-details-buffer "x509" "-email" "-noout")
+    (delete-region b e)
+    (insert-buffer-substring smime-details-buffer)
+    t))
+
+;; Utility functions
+
+(defun smime-get-certfiles (keyfile keys)
+  (if keys
+      (let ((curkey (car keys))
+	    (otherkeys (cdr keys)))
+	(if (string= keyfile (cadr curkey))
+	    (caddr curkey)
+	  (smime-get-certfiles keyfile otherkeys)))))
+
+(eval-and-compile
+  (defalias 'smime-point-at-eol
+    (if (fboundp 'point-at-eol)
+	'point-at-eol
+      'line-end-position)))
+
+(defun smime-buffer-as-string-region (b e)
+  "Return each line in region between B and E as a list of strings."
+  (save-excursion
+    (goto-char b)
+    (let (res)
+      (while (< (point) e)
+	(let ((str (buffer-substring (point) (smime-point-at-eol))))
+	  (unless (string= "" str)
+	    (push str res)))
+	(forward-line))
+      res)))
+
+;; Find certificates
+
+(defun smime-mail-to-domain (mailaddr)
+  (if (string-match "@" mailaddr)
+      (replace-match "." 'fixedcase 'literal mailaddr)
+    mailaddr))
+
+(defun smime-cert-by-dns (mail)
+  (let* ((dig-dns-server smime-dns-server)
+	 (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
+	 (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
+	 (certrr (with-current-buffer digbuf
+		   (dig-extract-rr (smime-mail-to-domain mail) "cert")))
+	 (cert (and certrr (dig-rr-get-pkix-cert certrr))))
+    (if cert
+	(with-current-buffer retbuf
+	  (insert "-----BEGIN CERTIFICATE-----\n")
+	  (let ((i 0) (len (length cert)))
+	    (while (> (- len 64) i)
+	      (insert (substring cert i (+ i 64)) "\n")
+	      (setq i (+ i 64)))
+	    (insert (substring cert i len) "\n"))
+	  (insert "-----END CERTIFICATE-----\n"))
+      (kill-buffer retbuf)
+      (setq retbuf nil))
+    (kill-buffer digbuf)
+    retbuf))
+
+;; User interface.
+
+(defvar smime-buffer "*SMIME*")
+
+(defvar smime-mode-map nil)
+(put 'smime-mode 'mode-class 'special)
+
+(unless smime-mode-map
+  (setq smime-mode-map (make-sparse-keymap))
+  (suppress-keymap smime-mode-map)
+
+  (define-key smime-mode-map "q" 'smime-exit)
+  (define-key smime-mode-map "f" 'smime-certificate-info))
+
+(defun smime-mode ()
+  "Major mode for browsing, viewing and fetching certificates.
+
+All normal editing commands are switched off.
+\\<smime-mode-map>
+
+The following commands are available:
+
+\\{smime-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'smime-mode)
+  (setq mode-name "SMIME")
+  (setq mode-line-process nil)
+  (use-local-map smime-mode-map)
+  (buffer-disable-undo)
+  (setq truncate-lines t)
+  (setq buffer-read-only t))
+
+(defun smime-certificate-info (certfile)
+  (interactive "fCertificate file: ")
+  (let ((buffer (get-buffer-create (format "*certificate %s*" certfile))))
+    (switch-to-buffer buffer)
+    (erase-buffer)
+    (call-process smime-openssl-program nil buffer 'display
+		  "x509" "-in" (expand-file-name certfile) "-text")
+    (fundamental-mode)
+    (set-buffer-modified-p nil)
+    (toggle-read-only t)
+    (goto-char (point-min))))
+
+(defun smime-draw-buffer ()
+  (with-current-buffer smime-buffer
+    (let (buffer-read-only)
+      (erase-buffer)
+      (insert "\nYour keys:\n")
+      (dolist (key smime-keys)
+	(insert
+	 (format "\t\t%s: %s\n" (car key) (cadr key))))
+      (insert "\nTrusted Certificate Authoritys:\n")
+      (insert "\nKnown Certificates:\n"))))
+
+(defun smime ()
+  "Go to the SMIME buffer."
+  (interactive)
+  (unless (get-buffer smime-buffer)
+    (save-excursion
+      (set-buffer (get-buffer-create smime-buffer))
+      (smime-mode)))
+  (smime-draw-buffer)
+  (switch-to-buffer smime-buffer))
+
+(defun smime-exit ()
+  "Quit the S/MIME buffer."
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+;; Other functions
+
+(defun smime-get-key-by-email (email)
+  (cadr (assoc email smime-keys)))
+
+(defun smime-get-key-with-certs-by-email (email)
+  (cdr (assoc email smime-keys)))
+
+(provide 'smime)
+
+;;; smime.el ends here
diff --git a/lisp/spam-report.el b/lisp/spam-report.el
new file mode 100644
index 0000000..46884c4
--- /dev/null
+++ b/lisp/spam-report.el
@@ -0,0 +1,97 @@
+;;; spam-report.el --- Reporting spam
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: network
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module addresses a few aspects of spam reporting under Gnus.  Page
+;;; breaks are used for grouping declarations and documentation relating to
+;;; each particular aspect.
+
+;;; Code:
+(require 'gnus)
+(require 'gnus-sum)
+
+(defgroup spam-report nil
+  "Spam reporting configuration.")
+
+(defcustom spam-report-gmane-regex nil
+  "String matching Gmane newsgroups if wanted, e.g. \"^nntp+.*:gmane.\"
+This is probably handled better with group/topic parameters."
+  :type 'regexp
+  :group 'spam-report)
+
+(defcustom spam-report-gmane-spam-header 
+  "^X-Report-Spam: http://\\([^/]+\\)\\(.*\\)$"
+  "String matching Gmane spam-reporting header.  Two match groups are needed."
+  :type 'regexp
+  :group 'spam-report)
+
+(defcustom spam-report-gmane-use-article-number t
+  "Whether the article number (faster!) or the header should be used."
+  :type 'boolean
+  :group 'spam-report)
+
+(defun spam-report-gmane (article)
+  "Report an article as spam through Gmane"
+  (interactive "nEnter the article number: ")
+  (when (and gnus-newsgroup-name
+	     (or (null spam-report-gmane-regex)
+		 (string-match spam-report-gmane-regex gnus-newsgroup-name)))
+    (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article)
+      (if spam-report-gmane-use-article-number
+	  (spam-report-url-ping "spam.gmane.org" 
+		    (format "/%s:%d"
+			    (gnus-group-real-name gnus-newsgroup-name)
+			    article))
+	(with-current-buffer nntp-server-buffer
+	  (gnus-request-head article gnus-newsgroup-name)
+	  (goto-char (point-min))
+	  (if (re-search-forward spam-report-gmane-spam-header nil t)
+	      (let* ((host (match-string 1))
+		     (report (match-string 2))
+		     (url (format "http://%s%s" host report)))
+		(gnus-message 10 "Reporting spam through URL %s..." url)
+		(spam-report-url-ping host report))
+	    (gnus-message 10 "Could not find X-Report-Spam in article %d..."
+			  article))))))
+
+
+(defun spam-report-url-ping (host report)
+  "Ping a host through HTTP, addressing a specific GET resource"
+  (let ((tcp-connection))
+    (with-temp-buffer
+      (or (setq tcp-connection
+		(open-network-stream 
+		 "URL ping"
+		 (buffer-name)
+		 host
+		 80))
+	  (error "Could not open connection to %s" host))
+      (set-marker (process-mark tcp-connection) (point-min))
+      (process-send-string tcp-connection
+			   (format "GET %s HTTP/1.1\nHost: %s\n\n"
+				   report host)))))
+
+(provide 'spam-report)
+
+;;; spam-report.el ends here.
diff --git a/lisp/spam-stat.el b/lisp/spam-stat.el
new file mode 100644
index 0000000..96df016
--- /dev/null
+++ b/lisp/spam-stat.el
@@ -0,0 +1,572 @@
+;;; spam-stat.el --- detecting spam based on statistics
+
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Alex Schroeder <alex@gnu.org>
+;; Keywords: network
+;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
+
+;; This file is part of GNU Emacs.
+
+;; This 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.
+
+;; This 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This implements spam analysis according to Paul Graham in "A Plan
+;; for Spam".  The basis for all this is a statistical distribution of
+;; words for your spam and non-spam mails.  We need this information
+;; in a hash-table so that the analysis can use the information when
+;; looking at your mails.  Therefore, before you begin, you need tons
+;; of mails (Graham uses 4000 non-spam and 4000 spam mails for his
+;; experiments).
+;;
+;; The main interface to using spam-stat, are the following functions:
+;;
+;; `spam-stat-buffer-is-spam' -- called in a buffer, that buffer is
+;; considered to be a new spam mail; use this for new mail that has
+;; not been processed before
+;;
+;; `spam-stat-buffer-is-non-spam' -- called in a buffer, that buffer
+;; is considered to be a new non-spam mail; use this for new mail that
+;; has not been processed before
+;;
+;; `spam-stat-buffer-change-to-spam' -- called in a buffer, that
+;; buffer is no longer considered to be normal mail but spam; use this
+;; to change the status of a mail that has already been processed as
+;; non-spam
+;;
+;; `spam-stat-buffer-change-to-non-spam' -- called in a buffer, that
+;; buffer is no longer considered to be spam but normal mail; use this
+;; to change the status of a mail that has already been processed as
+;; spam
+;;
+;; `spam-stat-save' -- save the hash table to the file; the filename
+;; used is stored in the variable `spam-stat-file'
+;;
+;; `spam-stat-load' -- load the hash table from a file; the filename
+;; used is stored in the variable `spam-stat-file'
+;;
+;; `spam-stat-score-word' -- return the spam score for a word
+;;
+;; `spam-stat-score-buffer' -- return the spam score for a buffer
+;;
+;; `spam-stat-split-fancy' -- for fancy mail splitting; add
+;; the rule (: spam-stat-split-fancy) to `nnmail-split-fancy'
+;;
+;; This requires the following in your ~/.gnus file:
+;;
+;; (require 'spam-stat)
+;; (spam-stat-load)
+
+;;; Testing:
+
+;; Typical test will involve calls to the following functions:
+;;
+;; Reset: (spam-stat-reset)
+;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+;; Save table: (spam-stat-save)
+;; File size: (nth 7 (file-attributes spam-stat-file))
+;; Number of words: (hash-table-count spam-stat)
+;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+;; Reduce table size: (spam-stat-reduce-size)
+;; Save table: (spam-stat-save)
+;; File size: (nth 7 (file-attributes spam-stat-file))
+;; Number of words: (hash-table-count spam-stat)
+;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+
+;;; Dictionary Creation:
+
+;; Typically, you will filter away mailing lists etc. using specific
+;; rules in `nnmail-split-fancy'.  Somewhere among these rules, you
+;; will filter spam.  Here is how you would create your dictionary:
+
+;; Reset: (spam-stat-reset)
+;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+;; Repeat for any other non-spam group you need...
+;; Reduce table size: (spam-stat-reduce-size)
+;; Save table: (spam-stat-save)
+
+;;; Todo:
+
+;; Speed it up.  Integrate with Gnus such that it uses spam and expiry
+;; marks to call the appropriate functions when leaving the summary
+;; buffer and saves the hash table when leaving Gnus.  More testing:
+;; More mails, disabling SpamAssassin, double checking algorithm, find
+;; improved algorithm.
+
+;;; Thanks:
+
+;; Ted Zlatanov <tzz@lifelogs.com>
+;; Jesper Harder <harder@myrealbox.com>
+;; Dan Schmidt <dfan@dfan.org>
+;; Lasse Rasinen <lrasinen@iki.fi>
+;; Milan Zamazal <pdm@zamazal.org>
+
+
+
+;;; Code:
+
+(defgroup spam-stat nil
+  "Statistical spam detection for Emacs.
+Use the functions to build a dictionary of words and their statistical
+distribution in spam and non-spam mails.  Then use a function to determine
+whether a buffer contains spam or not."
+  :group 'gnus)
+
+(defcustom spam-stat-file "~/.spam-stat.el"
+  "File used to save and load the dictionary.
+See `spam-stat-to-hash-table' for the format of the file."
+  :type 'file
+  :group 'spam-stat)
+
+(defcustom spam-stat-install-hooks t
+  "Whether spam-stat should install its hooks in Gnus.
+This is set to nil if you use spam-stat through spam.el."
+  :type 'boolean
+  :group 'spam-stat)
+
+(defcustom spam-stat-unknown-word-score 0.2
+  "The score to use for unknown words.
+Also used for words that don't appear often enough."
+  :type 'number
+  :group 'spam-stat)
+
+(defcustom spam-stat-max-word-length 15
+  "Only words shorter than this will be considered."
+  :type 'integer
+  :group 'spam-stat)
+
+(defcustom spam-stat-max-buffer-length 10240
+  "Only the beginning of buffers will be analyzed.
+This variable says how many characters this will be."
+  :type 'integer
+  :group 'spam-stat)
+
+(defcustom spam-stat-split-fancy-spam-group "mail.spam"
+  "Name of the group where spam should be stored, if
+`spam-stat-split-fancy' is used in fancy splitting rules.  Has no
+effect when spam-stat is invoked through spam.el."
+  :type 'string
+  :group 'spam-stat)
+
+(defcustom spam-stat-split-fancy-spam-threshhold 0.9
+  "Spam score threshhold in spam-stat-split-fancy."
+  :type 'number
+  :group 'spam-stat)
+
+(defvar spam-stat-syntax-table
+  (let ((table (copy-syntax-table text-mode-syntax-table)))
+    (modify-syntax-entry ?- "w" table)
+    (modify-syntax-entry ?_ "w" table)
+    (modify-syntax-entry ?. "w" table)
+    (modify-syntax-entry ?! "w" table)
+    (modify-syntax-entry ?? "w" table)
+    (modify-syntax-entry ?+ "w" table)
+    table)
+  "Syntax table used when processing mails for statistical analysis.
+The important part is which characters are word constituents.")
+
+(defvar spam-stat-buffer nil
+  "Buffer to use for scoring while splitting.
+This is set by hooking into Gnus.")
+
+(defvar spam-stat-buffer-name " *spam stat buffer*"
+  "Name of the `spam-stat-buffer'.")
+
+;; Functions missing in Emacs 20
+
+(when (memq nil (mapcar 'fboundp
+			'(gethash hash-table-count make-hash-table
+				  mapc puthash)))
+  (require 'cl)
+  (unless (fboundp 'puthash)
+    ;; alias puthash is missing from Emacs 20 cl-extra.el
+    (defalias 'puthash 'cl-puthash)))
+
+(eval-when-compile
+  (unless (fboundp 'with-syntax-table)
+    ;; Imported from Emacs 21.2
+    (defmacro with-syntax-table (table &rest body) "\
+Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+      (let ((old-table (make-symbol "table"))
+	    (old-buffer (make-symbol "buffer")))
+	`(let ((,old-table (syntax-table))
+	       (,old-buffer (current-buffer)))
+	   (unwind-protect
+	       (progn
+		 (set-syntax-table (copy-syntax-table ,table))
+		 ,@body)
+	     (save-current-buffer
+	       (set-buffer ,old-buffer)
+	       (set-syntax-table ,old-table))))))))
+
+;; Hooking into Gnus
+
+(defun spam-stat-store-current-buffer ()
+  "Store a copy of the current buffer in `spam-stat-buffer'."
+  (save-excursion
+    (let ((str (buffer-string)))
+      (set-buffer (get-buffer-create spam-stat-buffer-name))
+      (erase-buffer)
+      (insert str)
+      (setq spam-stat-buffer (current-buffer)))))
+
+(defun spam-stat-store-gnus-article-buffer ()
+  "Store a copy of the current article in `spam-stat-buffer'.
+This uses `gnus-article-buffer'."
+  (save-excursion
+    (set-buffer gnus-original-article-buffer)
+    (spam-stat-store-current-buffer)))
+
+(when spam-stat-install-hooks
+  (add-hook 'nnmail-prepare-incoming-message-hook
+	    'spam-stat-store-current-buffer)
+  (add-hook 'gnus-select-article-hook
+	    'spam-stat-store-gnus-article-buffer))
+
+;; Data -- not using defstruct in order to save space and time
+
+(defvar spam-stat (make-hash-table :test 'equal)
+  "Hash table used to store the statistics.
+Use `spam-stat-load' to load the file.
+Every word is used as a key in this table.  The value is a vector.
+Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
+`spam-stat-bad', and `spam-stat-score' to access this vector.")
+
+(defvar spam-stat-ngood 0
+  "The number of good mails in the dictionary.")
+
+(defvar spam-stat-nbad 0
+  "The number of bad mails in the dictionary.")
+
+(defsubst spam-stat-good (entry)
+  "Return the number of times this word belongs to good mails."
+  (aref entry 0))
+
+(defsubst spam-stat-bad (entry)
+  "Return the number of times this word belongs to bad mails."
+  (aref entry 1))
+
+(defsubst spam-stat-score (entry)
+  "Set the score of this word."
+  (if entry
+      (aref entry 2)
+    spam-stat-unknown-word-score))
+
+(defsubst spam-stat-set-good (entry value)
+  "Set the number of times this word belongs to good mails."
+  (aset entry 0 value))
+
+(defsubst spam-stat-set-bad (entry value)
+  "Set the number of times this word belongs to bad mails."
+  (aset entry 1 value))
+
+(defsubst spam-stat-set-score (entry value)
+  "Set the score of this word."
+  (aset entry 2 value))
+
+(defsubst spam-stat-make-entry (good bad)
+  "Return a vector with the given properties."
+  (let ((entry (vector good bad nil)))
+    (spam-stat-set-score entry (spam-stat-compute-score entry))
+    entry))
+
+;; Computing
+
+(defun spam-stat-compute-score (entry)
+  "Compute the score of this word.  1.0 means spam."
+   ;; promote all numbers to floats for the divisions
+   (let* ((g (* 2.0 (spam-stat-good entry)))
+	  (b (float (spam-stat-bad entry))))
+     (cond ((< (+ g b) 5)
+	    .2)
+	   ((= 0 spam-stat-ngood)
+	    .99)
+	   ((= 0 spam-stat-nbad)
+	    .01)
+	   (t
+	    (max .01
+		 (min .99 (/ (/ b spam-stat-nbad)
+			     (+ (/ g spam-stat-ngood)
+				(/ b spam-stat-nbad)))))))))
+
+;; Parsing
+
+(defmacro with-spam-stat-max-buffer-size (&rest body)
+  "Narrows the buffer down to the first 4k characters, then evaluates BODY."
+  `(save-restriction
+     (when (> (- (point-max)
+		 (point-min))
+	      spam-stat-max-buffer-length)
+       (narrow-to-region (point-min)
+			 (+ (point-min) spam-stat-max-buffer-length)))
+     ,@body))
+
+(defun spam-stat-buffer-words ()
+  "Return a hash table of words and number of occurences in the buffer."
+  (with-spam-stat-max-buffer-size
+   (with-syntax-table spam-stat-syntax-table
+     (goto-char (point-min))
+     (let ((result (make-hash-table :test 'equal))
+	   word count)
+       (while (re-search-forward "\\w+" nil t)
+	 (setq word (match-string-no-properties 0)
+	       count (1+ (gethash word result 0)))
+	 (when (< (length word) spam-stat-max-word-length)
+	   (puthash word count result)))
+       result))))
+
+(defun spam-stat-buffer-is-spam ()
+  "Consider current buffer to be a new spam mail."
+  (setq spam-stat-nbad (1+ spam-stat-nbad))
+  (maphash
+   (lambda (word count)
+     (let ((entry (gethash word spam-stat)))
+       (if entry
+	   (spam-stat-set-bad entry (+ count (spam-stat-bad entry)))
+	 (setq entry (spam-stat-make-entry 0 count)))
+       (spam-stat-set-score entry (spam-stat-compute-score entry))
+       (puthash word entry spam-stat)))
+   (spam-stat-buffer-words)))
+
+(defun spam-stat-buffer-is-non-spam ()
+  "Consider current buffer to be a new non-spam mail."
+  (setq spam-stat-ngood (1+ spam-stat-ngood))
+  (maphash
+   (lambda (word count)
+     (let ((entry (gethash word spam-stat)))
+       (if entry
+	   (spam-stat-set-good entry (+ count (spam-stat-good entry)))
+	 (setq entry (spam-stat-make-entry count 0)))
+       (spam-stat-set-score entry (spam-stat-compute-score entry))
+       (puthash word entry spam-stat)))
+   (spam-stat-buffer-words)))
+
+(defun spam-stat-buffer-change-to-spam ()
+  "Consider current buffer no longer normal mail but spam."
+  (setq spam-stat-nbad (1+ spam-stat-nbad)
+	spam-stat-ngood (1- spam-stat-ngood))
+  (maphash
+   (lambda (word count)
+     (let ((entry (gethash word spam-stat)))
+       (if (not entry)
+	   (error "This buffer has unknown words in it.")
+	 (spam-stat-set-good entry (- (spam-stat-good entry) count))
+	 (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
+	 (spam-stat-set-score entry (spam-stat-compute-score entry))
+	 (puthash word entry spam-stat))))
+   (spam-stat-buffer-words)))
+
+(defun spam-stat-buffer-change-to-non-spam ()
+  "Consider current buffer no longer spam but normal mail."
+  (setq spam-stat-nbad (1- spam-stat-nbad)
+	spam-stat-ngood (1+ spam-stat-ngood))
+  (maphash
+   (lambda (word count)
+     (let ((entry (gethash word spam-stat)))
+       (if (not entry)
+	   (error "This buffer has unknown words in it.")
+	 (spam-stat-set-good entry (+ (spam-stat-good entry) count))
+	 (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
+	 (spam-stat-set-score entry (spam-stat-compute-score entry))
+	 (puthash word entry spam-stat))))
+   (spam-stat-buffer-words)))
+
+;; Saving and Loading
+
+(defun spam-stat-save ()
+  "Save the `spam-stat' hash table as lisp file."
+  (interactive)
+  (with-temp-buffer
+    (let ((standard-output (current-buffer))
+	  (font-lock-maximum-size 0))
+      (insert "(setq spam-stat-ngood "
+              (number-to-string spam-stat-ngood)
+              " spam-stat-nbad "
+              (number-to-string spam-stat-nbad)
+              " spam-stat (spam-stat-to-hash-table '(")
+      (maphash (lambda (word entry)
+		 (prin1 (list word
+			      (spam-stat-good entry)
+			      (spam-stat-bad entry))))
+	       spam-stat)
+      (insert ")))")
+    (write-file spam-stat-file))))
+
+(defun spam-stat-load ()
+  "Read the `spam-stat' hash table from disk."
+  (load-file spam-stat-file))
+
+(defun spam-stat-to-hash-table (entries)
+  "Turn list ENTRIES into a hash table and store as `spam-stat'.
+Every element in ENTRIES has the form \(WORD GOOD BAD) where WORD is
+the word string, NGOOD is the number of good mails it has appeared in,
+NBAD is the number of bad mails it has appeared in, GOOD is the number
+of times it appeared in good mails, and BAD is the number of times it
+has appeared in bad mails."
+  (let ((table (make-hash-table :test 'equal)))
+    (mapc (lambda (l)
+	    (puthash (car l)
+		     (spam-stat-make-entry (nth 1 l) (nth 2 l))
+		     table))
+	  entries)
+    table))
+
+(defun spam-stat-reset ()
+  "Reset `spam-stat' to an empty hash-table.
+This deletes all the statistics."
+  (interactive)
+  (setq spam-stat (make-hash-table :test 'equal)
+	spam-stat-ngood 0
+	spam-stat-nbad 0))
+
+;; Scoring buffers
+
+(defvar spam-stat-score-data nil
+  "Raw data used in the last run of `spam-stat-score-buffer'.")
+
+(defsubst spam-stat-score-word (word)
+  "Return score for WORD.
+The default score for unknown words is stored in
+`spam-stat-unknown-word-score'."
+  (spam-stat-score (gethash word spam-stat)))
+
+(defun spam-stat-buffer-words-with-scores ()
+  "Process current buffer, return the 15 most conspicuous words.
+These are the words whose spam-stat differs the most from 0.5.
+The list returned contains elements of the form \(WORD SCORE DIFF),
+where DIFF is the difference between SCORE and 0.5."
+  (with-spam-stat-max-buffer-size
+   (with-syntax-table spam-stat-syntax-table
+     (let (result word score)
+       (maphash	(lambda (word ignore)
+		  (setq score (spam-stat-score-word word)
+			result (cons (list word score (abs (- score 0.5)))
+				     result)))
+		(spam-stat-buffer-words))
+       (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a)))))
+       (setcdr (nthcdr 14 result) nil)
+       result))))
+
+(defun spam-stat-score-buffer ()
+  "Return a score describing the spam-probability for this buffer."
+  (setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
+  (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data))
+	 (prod (apply #'* probs)))
+    (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
+				       probs))))))
+
+(defun spam-stat-split-fancy ()
+  "Return the name of the spam group if the current mail is spam.
+Use this function on `nnmail-split-fancy'.  If you are interested in
+the raw data used for the last run of `spam-stat-score-buffer',
+check the variable `spam-stat-score-data'."
+  (condition-case var
+      (progn
+	(set-buffer spam-stat-buffer)
+	(goto-char (point-min))
+	(when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshhold)
+	  (when (boundp 'nnmail-split-trace)
+	    (mapc (lambda (entry)
+		    (push entry nnmail-split-trace))
+		  spam-stat-score-data))
+	  spam-stat-split-fancy-spam-group))
+    (error (message "Error in spam-stat-split-fancy: %S" var)
+	   nil)))
+
+;; Testing
+
+(defun spam-stat-process-directory (dir func)
+  "Process all the regular files in directory DIR using function FUNC."
+  (let* ((files (directory-files dir t "^[^.]"))
+	 (max (/ (length files) 100.0))
+	 (count 0))
+    (with-temp-buffer
+      (dolist (f files)
+	(when (and (file-readable-p f)
+		   (file-regular-p f)
+                   (> (nth 7 (file-attributes f)) 0))
+	  (setq count (1+ count))
+	  (message "Reading %s: %.2f%%" dir (/ count max))
+	  (insert-file-contents f)
+	  (funcall func)
+	  (erase-buffer))))))
+
+(defun spam-stat-process-spam-directory (dir)
+  "Process all the regular files in directory DIR as spam."
+  (interactive "D")
+  (spam-stat-process-directory dir 'spam-stat-buffer-is-spam))
+
+(defun spam-stat-process-non-spam-directory (dir)
+  "Process all the regular files in directory DIR as non-spam."
+  (interactive "D")
+  (spam-stat-process-directory dir 'spam-stat-buffer-is-non-spam))
+
+(defun spam-stat-count ()
+  "Return size of `spam-stat'."
+  (interactive)
+  (hash-table-count spam-stat))
+
+(defun spam-stat-test-directory (dir)
+  "Test all the regular files in directory DIR for spam.
+If the result is 1.0, then all files are considered spam.
+If the result is 0.0, non of the files is considered spam.
+You can use this to determine error rates."
+  (interactive "D")
+  (let* ((files (directory-files dir t "^[^.]"))
+	 (total (length files))
+	 (score 0.0); float
+	 (max (/ total 100.0)); float
+	 (count 0))
+    (with-temp-buffer
+      (dolist (f files)
+	(when (and (file-readable-p f)
+		   (file-regular-p f)
+                   (> (nth 7 (file-attributes f)) 0))
+	  (setq count (1+ count))
+	  (message "Reading %.2f%%, score %.2f%%"
+		   (/ count max) (/ score count))
+	  (insert-file-contents f)
+	  (when (> (spam-stat-score-buffer) 0.9)
+	    (setq score (1+ score)))
+	  (erase-buffer))))
+    (message "Final score: %d / %d = %f" score total (/ score total))))
+
+;; Shrinking the dictionary
+
+(defun spam-stat-reduce-size (&optional count)
+  "Reduce the size of `spam-stat'.
+This removes all words that occur less than COUNT from the dictionary.
+COUNT defaults to 5"
+  (interactive)
+  (setq count (or count 5))
+  (maphash (lambda (key entry)
+	     (when (< (+ (spam-stat-good entry)
+			 (spam-stat-bad entry))
+		      count)
+	       (remhash key spam-stat)))
+	   spam-stat))
+
+(provide 'spam-stat)
+
+;;; spam-stat.el ends here
diff --git a/lisp/spam.el b/lisp/spam.el
new file mode 100644
index 0000000..4f84c11
--- /dev/null
+++ b/lisp/spam.el
@@ -0,0 +1,1065 @@
+;;; spam.el --- Identifying spam
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: network
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module addresses a few aspects of spam control under Gnus.  Page
+;;; breaks are used for grouping declarations and documentation relating to
+;;; each particular aspect.
+
+;;; The integration with Gnus is not yet complete.  See various `FIXME'
+;;; comments, below, for supplementary explanations or discussions.
+
+;;; Several TODO items are marked as such
+
+;;; Code:
+
+(require 'path-util)
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus-sum)
+
+(require 'gnus-uu)			; because of key prefix issues
+(require 'gnus)	; for the definitions of group content classification and spam processors
+(require 'message)			;for the message-fetch-field functions
+
+;; for nnimap-split-download-body-default
+(eval-when-compile (require 'nnimap))
+
+;; autoload query-dig
+(eval-and-compile
+  (autoload 'query-dig "dig"))
+
+;; autoload spam-report
+(eval-and-compile
+  (autoload 'spam-report-gmane "spam-report"))
+
+;; autoload query-dns
+(eval-and-compile
+  (autoload 'query-dns "dns"))
+
+;;; Main parameters.
+
+(defgroup spam nil
+  "Spam configuration.")
+
+(defcustom spam-directory "~/News/spam/"
+  "Directory for spam whitelists and blacklists."
+  :type 'directory
+  :group 'spam)
+
+(defcustom spam-move-spam-nonspam-groups-only t
+  "Whether spam should be moved in non-spam groups only.
+When nil, only ham and unclassified groups will have their spam moved
+to the spam-process-destination.  When t, spam will also be moved from
+spam groups."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-mark-only-unseen-as-spam t
+  "Whether only unseen articles should be marked as spam in spam
+groups.  When nil, all unread articles in a spam group are marked as
+spam.  Set this if you want to leave an article unread in a spam group
+without losing it to the automatic spam-marking process."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-mark-ham-unread-before-move-from-spam-group nil
+  "Whether ham should be marked unread before it's moved out of a spam
+group according to ham-process-destination.  This variable is an
+official entry in the international Longest Variable Name
+Competition."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
+  "The location of the whitelist.
+The file format is one regular expression per line.
+The regular expression is matched against the address."
+  :type 'file
+  :group 'spam)
+
+(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
+  "The location of the blacklist.
+The file format is one regular expression per line.
+The regular expression is matched against the address."
+  :type 'file
+  :group 'spam)
+
+(defcustom spam-use-dig t
+  "Whether query-dig should be used instead of query-dns."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-blacklist nil
+  "Whether the blacklist should be used by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-whitelist nil
+  "Whether the whitelist should be used by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-whitelist-exclusive nil
+  "Whether whitelist-exclusive should be used by spam-split.
+Exclusive whitelisting means that all messages from senders not in the whitelist
+are considered spam."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-blackholes nil
+  "Whether blackholes should be used by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-hashcash nil
+  "Whether hashcash payments should be detected by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-regex-headers nil
+  "Whether a header regular expression match should be used by spam-split.
+Also see the variable `spam-spam-regex-headers' and `spam-ham-regex-headers'."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-bogofilter-headers nil
+  "Whether bogofilter headers should be used by spam-split.
+Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-bogofilter nil
+  "Whether bogofilter should be invoked by spam-split.
+Enable this if you want Gnus to invoke Bogofilter on new messages."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-BBDB nil
+  "Whether BBDB should be used by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-BBDB-exclusive nil
+  "Whether BBDB-exclusive should be used by spam-split.
+Exclusive BBDB means that all messages from senders not in the BBDB are 
+considered spam."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-ifile nil
+  "Whether ifile should be used by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-stat nil
+  "Whether spam-stat should be used by spam-split."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-split-group "spam"
+  "Group name where incoming spam should be put by spam-split."
+  :type 'string
+  :group 'spam)
+
+(defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
+  "Mailgroups with spam contents.
+All unmarked article in such group receive the spam mark on group entry."
+  :type '(repeat (string :tag "Group"))
+  :group 'spam)
+
+(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" 
+				    "dev.null.dk" "relays.visi.com")
+  "List of blackhole servers."
+  :type '(repeat (string :tag "Server"))
+  :group 'spam)
+
+(defcustom spam-blackhole-good-server-regex nil
+  "String matching IP addresses that should not be checked in the blackholes"
+  :type 'regexp
+  :group 'spam)
+
+(defcustom spam-face 'gnus-splash-face
+  "Face for spam-marked articles"
+  :type 'face
+  :group 'spam)
+
+(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
+  "Regular expression for positive header spam matches"
+  :type '(repeat (regexp :tag "Regular expression to match spam header"))
+  :group 'spam)
+
+(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
+  "Regular expression for positive header ham matches"
+  :type '(repeat (regexp :tag "Regular expression to match ham header"))
+  :group 'spam)
+
+(defgroup spam-ifile nil
+  "Spam ifile configuration."
+  :group 'spam)
+
+(defcustom spam-ifile-path (exec-installed-p "ifile")
+  "File path of the ifile executable program."
+  :type '(choice (file :tag "Location of ifile")
+		 (const :tag "ifile is not installed"))
+  :group 'spam-ifile)
+
+(defcustom spam-ifile-database-path nil
+  "File path of the ifile database."
+  :type '(choice (file :tag "Location of the ifile database")
+		 (const :tag "Use the default"))
+  :group 'spam-ifile)
+
+(defcustom spam-ifile-spam-category "spam"
+  "Name of the spam ifile category."  
+  :type 'string
+  :group 'spam-ifile)
+
+(defcustom spam-ifile-ham-category nil
+  "Name of the ham ifile category.  If nil, the current group name will
+be used."
+  :type '(choice (string :tag "Use a fixed category")
+                (const :tag "Use the current group name"))
+  :group 'spam-ifile)
+
+(defcustom spam-ifile-all-categories nil
+  "Whether the ifile check will return all categories, or just spam.
+Set this to t if you want to use the spam-split invocation of ifile as
+your main source of newsgroup names."
+  :type 'boolean
+  :group 'spam-ifile)
+
+(defgroup spam-bogofilter nil
+  "Spam bogofilter configuration."
+  :group 'spam)
+
+(defcustom spam-bogofilter-path (exec-installed-p "bogofilter")
+  "File path of the Bogofilter executable program."
+  :type '(choice (file :tag "Location of bogofilter")
+		 (const :tag "Bogofilter is not installed"))
+  :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-header "X-Bogosity"
+  "The header that Bogofilter inserts in messages."
+  :type 'string
+  :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-spam-switch "-s"
+  "The switch that Bogofilter uses to register spam messages."
+  :type 'string
+  :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-ham-switch "-n"
+  "The switch that Bogofilter uses to register ham messages."
+  :type 'string
+  :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
+  "The regex on `spam-bogofilter-header' for positive spam identification."
+  :type 'regexp
+  :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-database-directory nil
+  "Directory path of the Bogofilter databases."
+  :type '(choice (directory :tag "Location of the Bogofilter database directory")
+		 (const :tag "Use the default"))
+  :group 'spam-ifile)
+
+;;; Key bindings for spam control.
+
+(gnus-define-keys gnus-summary-mode-map
+  "St" spam-bogofilter-score
+  "Sx" gnus-summary-mark-as-spam
+  "Mst" spam-bogofilter-score
+  "Msx" gnus-summary-mark-as-spam
+  "\M-d" gnus-summary-mark-as-spam)
+
+;;; How to highlight a spam summary line.
+
+;; TODO: How do we redo this every time spam-face is customized?
+
+(push '((eq mark gnus-spam-mark) . spam-face)
+      gnus-summary-highlight)
+
+;; convenience functions
+(defun spam-group-ham-mark-p (group mark &optional spam)
+  (when (stringp group)
+    (let* ((marks (spam-group-ham-marks group spam))
+	   (marks (if (symbolp mark) 
+		      marks 
+		    (mapcar 'symbol-value marks))))
+      (memq mark marks))))
+
+(defun spam-group-spam-mark-p (group mark)
+  (spam-group-ham-mark-p group mark t))
+
+(defun spam-group-ham-marks (group &optional spam)
+  (when (stringp group)
+    (let* ((marks (if spam
+		     (gnus-parameter-spam-marks group)
+		   (gnus-parameter-ham-marks group)))
+	   (marks (car marks))
+	   (marks (if (listp (car marks)) (car marks) marks)))
+      marks)))
+
+(defun spam-group-spam-marks (group)
+  (spam-group-ham-marks group t))
+
+(defun spam-group-spam-contents-p (group)
+  (if (stringp group)
+      (or (member group spam-junk-mailgroups)
+	  (memq 'gnus-group-spam-classification-spam 
+		(gnus-parameter-spam-contents group)))
+    nil))
+  
+(defun spam-group-ham-contents-p (group)
+  (if (stringp group)
+      (memq 'gnus-group-spam-classification-ham 
+	    (gnus-parameter-spam-contents group))
+    nil))
+
+(defun spam-group-processor-p (group processor)
+  (if (and (stringp group)
+	   (symbolp processor))
+      (member processor (car (gnus-parameter-spam-process group)))
+    nil))
+
+(defun spam-group-spam-processor-report-gmane-p (group)
+  (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
+
+(defun spam-group-spam-processor-bogofilter-p (group)
+  (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
+
+(defun spam-group-spam-processor-blacklist-p (group)
+  (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
+
+(defun spam-group-spam-processor-ifile-p (group)
+  (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
+
+(defun spam-group-ham-processor-ifile-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
+
+(defun spam-group-ham-processor-bogofilter-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
+
+(defun spam-group-spam-processor-stat-p (group)
+  (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
+
+(defun spam-group-ham-processor-stat-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
+
+(defun spam-group-ham-processor-whitelist-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
+
+(defun spam-group-ham-processor-BBDB-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
+
+(defun spam-group-ham-processor-copy-p (group)
+  (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
+
+;;; Summary entry and exit processing.
+
+(defun spam-summary-prepare ()
+  (spam-mark-junk-as-spam-routine))
+
+(add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
+
+;; The spam processors are invoked for any group, spam or ham or neither
+(defun spam-summary-prepare-exit ()
+  (unless gnus-group-is-exiting-without-update-p
+    (gnus-message 6 "Exiting summary buffer and applying spam rules")
+    (when (and spam-bogofilter-path
+	       (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
+      (gnus-message 5 "Registering spam with bogofilter")
+      (spam-bogofilter-register-spam-routine))
+  
+    (when (and spam-ifile-path
+	       (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
+      (gnus-message 5 "Registering spam with ifile")
+      (spam-ifile-register-spam-routine))
+  
+    (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering spam with spam-stat")
+      (spam-stat-register-spam-routine))
+
+    (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering spam with the blacklist")
+      (spam-blacklist-register-routine))
+
+    (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering spam with the Gmane report")
+      (spam-report-gmane-register-routine))
+
+    (if spam-move-spam-nonspam-groups-only      
+	(when (not (spam-group-spam-contents-p gnus-newsgroup-name))
+	  (spam-mark-spam-as-expired-and-move-routine
+	   (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+      (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name)
+      (spam-mark-spam-as-expired-and-move-routine 
+       (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+
+    ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
+    ;; expire spam, in case the above did not expire them
+    (gnus-message 5 "Marking spam as expired without moving it")
+    (spam-mark-spam-as-expired-and-move-routine nil)
+
+    (when (spam-group-ham-contents-p gnus-newsgroup-name)
+      (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
+	(gnus-message 5 "Registering ham with the whitelist")
+	(spam-whitelist-register-routine))
+      (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
+	(gnus-message 5 "Registering ham with ifile")
+	(spam-ifile-register-ham-routine))
+      (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
+	(gnus-message 5 "Registering ham with Bogofilter")
+	(spam-bogofilter-register-ham-routine))
+      (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
+	(gnus-message 5 "Registering ham with spam-stat")
+	(spam-stat-register-ham-routine))
+      (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
+	(gnus-message 5 "Registering ham with the BBDB")
+	(spam-BBDB-register-routine)))
+
+    (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
+      (gnus-message 5 "Copying ham")
+      (spam-ham-move-routine
+       (gnus-parameter-ham-process-destination gnus-newsgroup-name) t))
+
+    ;; now move all ham articles out of spam groups
+    (when (spam-group-spam-contents-p gnus-newsgroup-name)
+      (gnus-message 5 "Moving ham messages from spam group")
+      (spam-ham-move-routine
+       (gnus-parameter-ham-process-destination gnus-newsgroup-name)))))
+
+(add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
+
+(defun spam-mark-junk-as-spam-routine ()
+  ;; check the global list of group names spam-junk-mailgroups and the
+  ;; group parameters
+  (when (spam-group-spam-contents-p gnus-newsgroup-name)
+    (gnus-message 5 "Marking %s articles as spam"
+		  (if spam-mark-only-unseen-as-spam 
+		      "unseen"
+		    "unread"))
+    (let ((articles (if spam-mark-only-unseen-as-spam 
+			gnus-newsgroup-unseen
+		      gnus-newsgroup-unreads)))
+      (dolist (article articles)
+	(gnus-summary-mark-article article gnus-spam-mark)))))
+
+(defun spam-mark-spam-as-expired-and-move-routine (&optional group)
+  (gnus-summary-kill-process-mark)
+  (let ((articles gnus-newsgroup-articles)
+	article tomove)
+    (dolist (article articles)
+      (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
+	(gnus-summary-mark-article article gnus-expirable-mark)
+	(push article tomove)))
+
+    ;; now do the actual move
+    (when (and tomove
+	       (stringp group))
+      (dolist (article tomove)
+	(gnus-summary-set-process-mark article))
+      (when tomove (gnus-summary-move-article nil group))))
+  (gnus-summary-yank-process-mark))
+ 
+(defun spam-ham-move-routine (&optional group copy)
+  (gnus-summary-kill-process-mark)
+  (let ((articles gnus-newsgroup-articles)
+	article mark tomove)
+    (when (stringp group)		; this routine will do nothing
+					; without a valid group
+      (dolist (article articles)
+	(when (spam-group-ham-mark-p gnus-newsgroup-name
+				     (gnus-summary-article-mark article))
+	  (push article tomove)))
+
+      ;; now do the actual move
+      (when tomove
+	(dolist (article tomove)
+	  (when spam-mark-ham-unread-before-move-from-spam-group
+	    (gnus-summary-mark-article article gnus-unread-mark))	    
+	  (gnus-summary-set-process-mark article))
+	(if copy
+	    (gnus-summary-copy-article nil group)
+	  (gnus-summary-move-article nil group)))))
+  (gnus-summary-yank-process-mark))
+ 
+(defun spam-generic-register-routine (spam-func ham-func)
+  (let ((articles gnus-newsgroup-articles)
+	article mark ham-articles spam-articles)
+
+    (while articles
+      (setq article (pop articles)
+	    mark (gnus-summary-article-mark article))
+      (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark) 
+	     (push article spam-articles))
+	    ((memq article gnus-newsgroup-saved))
+	    ((spam-group-ham-mark-p gnus-newsgroup-name mark)
+	     (push article ham-articles))))
+
+    (when (and ham-articles ham-func)
+      (mapc ham-func ham-articles))	; we use mapc because unlike
+					; mapcar it discards the
+					; return values
+    (when (and spam-articles spam-func)
+      (mapc spam-func spam-articles))))	; we use mapc because unlike
+					; mapcar it discards the
+					; return values
+
+(eval-and-compile
+  (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
+				   'point-at-eol
+				 'line-end-position)))
+
+(defun spam-get-article-as-string (article)
+  (let ((article-buffer (spam-get-article-as-buffer article))
+			article-string)
+    (when article-buffer
+      (save-window-excursion
+	(set-buffer article-buffer)
+	(setq article-string (buffer-string))))
+  article-string))
+
+(defun spam-get-article-as-buffer (article)
+  (let ((article-buffer))
+    (when (numberp article)
+      (save-window-excursion
+	(gnus-summary-goto-subject article)
+	(gnus-summary-show-article t)
+	(setq article-buffer (get-buffer gnus-article-buffer))))
+    article-buffer))
+
+;; disabled for now
+;; (defun spam-get-article-as-filename (article)
+;;   (let ((article-filename))
+;;     (when (numberp article)
+;;       (nnml-possibly-change-directory (gnus-group-real-name gnus-newsgroup-name))
+;;       (setq article-filename (expand-file-name (int-to-string article) nnml-current-directory)))
+;;     (if (file-exists-p article-filename)
+;; 	article-filename
+;;       nil)))
+
+(defun spam-fetch-field-from-fast (article)
+  "Fetch the `from' field quickly, using the internal gnus-data-list function"
+  (if (and (numberp article)
+	   (assoc article (gnus-data-list nil)))
+      (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
+    nil))
+
+(defun spam-fetch-field-subject-fast (article)
+  "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+  (if (and (numberp article)
+	   (assoc article (gnus-data-list nil)))
+      (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
+    nil))
+
+
+;;;; Spam determination.
+
+(defvar spam-list-of-checks
+  '((spam-use-blacklist  		. 	spam-check-blacklist)
+    (spam-use-regex-headers  		. 	spam-check-regex-headers)
+    (spam-use-whitelist  		. 	spam-check-whitelist)
+    (spam-use-BBDB	 		. 	spam-check-BBDB)
+    (spam-use-ifile	 		. 	spam-check-ifile)
+    (spam-use-stat	 		. 	spam-check-stat)
+    (spam-use-blackholes 		. 	spam-check-blackholes)
+    (spam-use-hashcash  		. 	spam-check-hashcash)
+    (spam-use-bogofilter-headers 	. 	spam-check-bogofilter-headers)
+    (spam-use-bogofilter 		. 	spam-check-bogofilter))
+"The spam-list-of-checks list contains pairs associating a parameter
+variable with a spam checking function.  If the parameter variable is
+true, then the checking function is called, and its value decides what
+happens.  Each individual check may return nil, t, or a mailgroup
+name.  The value nil means that the check does not yield a decision,
+and so, that further checks are needed.  The value t means that the
+message is definitely not spam, and that further spam checks should be
+inhibited.  Otherwise, a mailgroup name is returned where the mail
+should go, and further checks are also inhibited.  The usual mailgroup
+name is the value of `spam-split-group', meaning that the message is
+definitely a spam.")
+
+(defvar spam-list-of-statistical-checks
+  '(spam-use-ifile spam-use-stat spam-use-bogofilter)
+"The spam-list-of-statistical-checks list contains all the mail
+splitters that need to have the full message body available.")
+
+(defun spam-split (&rest specific-checks)
+  "Split this message into the `spam' group if it is spam.
+This function can be used as an entry in `nnmail-split-fancy', for
+example like this: (: spam-split).  It can take checks as parameters.
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (dolist (check spam-list-of-statistical-checks)
+	(when (symbol-value check)
+	  (widen)
+	  (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
+			(symbol-name check))
+	  (return)))
+      ;;   (progn (widen) (debug (buffer-string)))
+      (let ((list-of-checks spam-list-of-checks)
+	    decision)
+	(while (and list-of-checks (not decision))
+	  (let ((pair (pop list-of-checks)))
+	    (when (and (symbol-value (car pair))
+		       (or (null specific-checks)
+			   (memq (car pair) specific-checks)))
+	      (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair)))
+	      (setq decision (funcall (cdr pair))))))
+	(if (eq decision t)
+	    nil
+	  decision)))))
+  
+(defun spam-setup-widening ()
+  (dolist (check spam-list-of-statistical-checks)
+    (when (symbol-value check)
+      (setq nnimap-split-download-body-default t))))
+
+(add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
+
+
+;;;; Regex headers
+
+(defun spam-check-regex-headers ()
+  (let (ret found)
+    (dolist (h-regex spam-regex-headers-ham)
+      (unless found
+	(goto-char (point-min))
+	(when (re-search-forward h-regex nil t)
+	  (message "Ham regex header search positive.")
+	  (setq found t))))
+    (dolist (s-regex spam-regex-headers-spam)
+      (unless found
+	(goto-char (point-min))
+	(when (re-search-forward s-regex nil t)
+	  (message "Spam regex header search positive." (match-string 1))
+	  (setq found t)
+	  (setq ret spam-split-group))))
+    ret))
+
+
+;;;; Blackholes.
+
+(defun spam-check-blackholes ()
+  "Check the Received headers for blackholed relays."
+  (let ((headers (message-fetch-field "received"))
+	ips matches)
+    (when headers
+      (with-temp-buffer
+	(insert headers)
+	(goto-char (point-min))
+	(gnus-message 5 "Checking headers for relay addresses")
+	(while (re-search-forward
+		"\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
+	  (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
+	  (push (mapconcat 'identity
+			   (nreverse (split-string (match-string 1) "\\."))
+			   ".")
+		ips)))
+      (dolist (server spam-blackhole-servers)
+	(dolist (ip ips)
+	  (unless (and spam-blackhole-good-server-regex
+		       (string-match spam-blackhole-good-server-regex ip))
+	    (let ((query-string (concat ip "." server)))
+	      (if spam-use-dig
+		  (let ((query-result (query-dig query-string)))
+		    (when query-result
+		      (gnus-message 5 "(DIG): positive blackhole check '%s'" 
+				    query-result)
+		      (push (list ip server query-result)
+			    matches)))
+		;; else, if not using dig.el
+		(when (query-dns query-string)
+		  (gnus-message 5 "positive blackhole check")
+		  (push (list ip server (query-dns query-string 'TXT))
+			matches))))))))
+    (when matches
+      spam-split-group)))
+
+;;;; Hashcash.
+
+(condition-case nil
+    (progn
+      (require 'hashcash)
+      
+      (defun spam-check-hashcash ()
+	"Check the headers for hashcash payments."
+	(mail-check-payment)))		;mail-check-payment returns a boolean
+
+  (file-error (progn
+		(defalias 'mail-check-payment 'ignore)
+		(defalias 'spam-check-hashcash 'ignore))))
+
+;;;; BBDB 
+
+;;; original idea for spam-check-BBDB from Alexander Kotelnikov
+;;; <sacha@giotto.sj.ru>
+
+;; all this is done inside a condition-case to trap errors
+
+(condition-case nil
+    (progn
+      (require 'bbdb)
+      (require 'bbdb-com)
+      
+  (defun spam-enter-ham-BBDB (from)
+    "Enter an address into the BBDB; implies ham (non-spam) sender"
+    (when (stringp from)
+      (let* ((parsed-address (gnus-extract-address-components from))
+	     (name (or (car parsed-address) "Ham Sender"))
+	     (net-address (car (cdr parsed-address))))
+	(gnus-message 5 "Adding address %s to BBDB" from)
+	(when (and net-address
+		   (not (bbdb-search-simple nil net-address)))
+	  (bbdb-create-internal name nil net-address nil nil 
+				"ham sender added by spam.el")))))
+
+  (defun spam-BBDB-register-routine ()
+    (spam-generic-register-routine 
+     ;; spam function
+     nil
+     ;; ham function
+     (lambda (article)
+       (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
+
+  (defun spam-check-BBDB ()
+    "Mail from people in the BBDB is classified as ham or non-spam"
+    (let ((who (message-fetch-field "from")))
+      (when who
+	(setq who (cadr (gnus-extract-address-components who)))
+	(if (bbdb-search-simple nil who)
+	    t 
+	  (if spam-use-BBDB-exclusive
+	      spam-split-group
+	    nil))))))
+
+  (file-error (progn
+		(defalias 'bbdb-search-simple 'ignore)
+		(defalias 'spam-check-BBDB 'ignore)
+		(defalias 'spam-BBDB-register-routine 'ignore)
+		(defalias 'spam-enter-ham-BBDB 'ignore)
+		(defalias 'bbdb-create-internal 'ignore)
+		(defalias 'bbdb-records 'ignore))))
+
+
+;;;; ifile
+
+;;; check the ifile backend; return nil if the mail was NOT classified
+;;; as spam
+
+(defun spam-get-ifile-database-parameter ()
+  "Get the command-line parameter for ifile's database from spam-ifile-database-path."
+  (if spam-ifile-database-path
+      (format "--db-file=%s" spam-ifile-database-path)
+    nil))
+    
+(defun spam-check-ifile ()
+  "Check the ifile backend for the classification of this message"
+  (let ((article-buffer-name (buffer-name)) 
+	category return)
+    (with-temp-buffer
+      (let ((temp-buffer-name (buffer-name))
+	    (db-param (spam-get-ifile-database-parameter)))
+	(save-excursion
+	  (set-buffer article-buffer-name)
+	  (if db-param
+	      (call-process-region (point-min) (point-max) spam-ifile-path
+				   nil temp-buffer-name nil "-q" "-c" db-param)
+	    (call-process-region (point-min) (point-max) spam-ifile-path
+				 nil temp-buffer-name nil "-q" "-c")))
+	(goto-char (point-min))
+	(if (not (eobp))
+	    (setq category (buffer-substring (point) (spam-point-at-eol))))
+	(when (not (zerop (length category))) ; we need a category here
+	  (if spam-ifile-all-categories
+	      (setq return category)
+	    ;; else, if spam-ifile-all-categories is not set...
+	    (when (string-equal spam-ifile-spam-category category)
+	      (setq return spam-split-group))))))
+    return))
+
+(defun spam-ifile-register-with-ifile (article-string category)
+  "Register an article, given as a string, with a category.
+Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
+  (when (stringp article-string)
+    (let ((category (or category gnus-newsgroup-name))
+          (db-param (spam-get-ifile-database-parameter)))
+      (with-temp-buffer
+	(insert article-string)
+	(if db-param
+            (call-process-region (point-min) (point-max) spam-ifile-path 
+                                 nil nil nil 
+                                 "-h" "-i" category db-param)
+          (call-process-region (point-min) (point-max) spam-ifile-path 
+                               nil nil nil 
+                               "-h" "-i" category))))))
+
+(defun spam-ifile-register-spam-routine ()
+  (spam-generic-register-routine 
+   (lambda (article)
+     (spam-ifile-register-with-ifile 
+      (spam-get-article-as-string article) spam-ifile-spam-category))
+   nil))
+
+(defun spam-ifile-register-ham-routine ()
+  (spam-generic-register-routine 
+   nil
+   (lambda (article)
+     (spam-ifile-register-with-ifile 
+      (spam-get-article-as-string article) spam-ifile-ham-category))))
+
+
+;;;; spam-stat
+
+(condition-case nil
+    (progn
+      (let ((spam-stat-install-hooks nil))
+	(require 'spam-stat))
+      
+      (defun spam-check-stat ()
+	"Check the spam-stat backend for the classification of this message"
+	(let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
+	      (spam-stat-buffer (buffer-name)) ; stat the current buffer
+	      category return)
+	  (spam-stat-split-fancy)))
+
+      (defun spam-stat-register-spam-routine ()
+	(spam-generic-register-routine 
+	 (lambda (article)
+	   (let ((article-string (spam-get-article-as-string article)))
+	     (with-temp-buffer
+	       (insert article-string)
+	       (spam-stat-buffer-is-spam))))
+	 nil))
+
+      (defun spam-stat-register-ham-routine ()
+	(spam-generic-register-routine 
+	 nil
+	 (lambda (article)
+	   (let ((article-string (spam-get-article-as-string article)))
+	     (with-temp-buffer
+	       (insert article-string)
+	       (spam-stat-buffer-is-non-spam))))))
+
+      (defun spam-maybe-spam-stat-load ()
+	(when spam-use-stat (spam-stat-load)))
+      
+      (defun spam-maybe-spam-stat-save ()
+	(when spam-use-stat (spam-stat-save)))
+
+      ;; Add hooks for loading and saving the spam stats
+      (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
+      (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
+      (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load))
+
+  (file-error (progn
+		(defalias 'spam-stat-register-ham-routine 'ignore)
+		(defalias 'spam-stat-register-spam-routine 'ignore)
+		(defalias 'spam-stat-buffer-is-spam 'ignore)
+		(defalias 'spam-stat-buffer-is-non-spam 'ignore)
+		(defalias 'spam-stat-split-fancy 'ignore)
+		(defalias 'spam-stat-load 'ignore)
+		(defalias 'spam-stat-save 'ignore)
+		(defalias 'spam-check-stat 'ignore))))
+
+
+
+;;;; Blacklists and whitelists.
+
+(defvar spam-whitelist-cache nil)
+(defvar spam-blacklist-cache nil)
+
+(defun spam-enter-whitelist (address)
+  "Enter ADDRESS into the whitelist."
+  (interactive "sAddress: ")
+  (spam-enter-list address spam-whitelist)
+  (setq spam-whitelist-cache nil))
+
+(defun spam-enter-blacklist (address)
+  "Enter ADDRESS into the blacklist."
+  (interactive "sAddress: ")
+  (spam-enter-list address spam-blacklist)
+  (setq spam-blacklist-cache nil))
+
+(defun spam-enter-list (address file)
+  "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
+  (unless (file-exists-p (file-name-directory file))
+    (make-directory (file-name-directory file) t))
+  (save-excursion
+    (set-buffer
+     (find-file-noselect file))
+    (goto-char (point-max))
+    (unless (bobp)
+      (insert "\n"))
+    (insert address "\n")
+    (save-buffer)))
+
+;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
+(defun spam-check-whitelist ()
+  ;; FIXME!  Should it detect when file timestamps change?
+  (unless spam-whitelist-cache
+    (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
+  (if (spam-from-listed-p spam-whitelist-cache) 
+      t
+    (if spam-use-whitelist-exclusive
+	spam-split-group
+      nil)))
+
+(defun spam-check-blacklist ()
+  ;; FIXME!  Should it detect when file timestamps change?
+  (unless spam-blacklist-cache
+    (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
+  (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
+
+(defun spam-parse-list (file)
+  (when (file-readable-p file)
+    (let (contents address)
+      (with-temp-buffer
+	(insert-file-contents file)
+	(while (not (eobp))
+	  (setq address (buffer-substring (point) (spam-point-at-eol)))
+	  (forward-line 1)
+	  (unless (zerop (length address))
+	    (setq address (regexp-quote address))
+	    (while (string-match "\\\\\\*" address)
+	      (setq address (replace-match ".*" t t address)))
+	    (push address contents))))
+      (nreverse contents))))
+
+(defun spam-from-listed-p (cache)
+  (let ((from (message-fetch-field "from"))
+	found)
+    (while cache
+      (when (string-match (pop cache) from)
+	(setq found t
+	      cache nil)))
+    found))
+
+(defun spam-blacklist-register-routine ()
+  (spam-generic-register-routine 
+   ;; the spam function
+   (lambda (article)
+     (let ((from (spam-fetch-field-from-fast article)))
+       (when (stringp from)
+	   (spam-enter-blacklist from))))
+   ;; the ham function
+   nil))
+
+(defun spam-whitelist-register-routine ()
+  (spam-generic-register-routine 
+   ;; the spam function
+   nil 
+   ;; the ham function
+   (lambda (article)
+     (let ((from (spam-fetch-field-from-fast article)))
+       (when (stringp from)
+	   (spam-enter-whitelist from))))))
+
+
+;;;; Spam-report glue
+(defun spam-report-gmane-register-routine ()
+  (spam-generic-register-routine
+   'spam-report-gmane
+   nil))
+
+
+;;;; Bogofilter
+(defun spam-check-bogofilter-headers (&optional score)
+  (let ((header (message-fetch-field spam-bogofilter-header)))
+      (when (and header
+		 (string-match spam-bogofilter-bogosity-positive-spam-header
+			       header))
+	  (if score
+	      (when (string-match "spamicity=\\([0-9.]+\\)" header)
+		(match-string 1 header))
+	    spam-split-group))))
+
+;; return something sensible if the score can't be determined
+(defun spam-bogofilter-score ()
+  "Get the Bogofilter spamicity score"
+  (interactive)
+  (save-window-excursion
+    (gnus-summary-show-article t)
+    (set-buffer gnus-article-buffer)
+    (let ((score (or (spam-check-bogofilter-headers t)
+		     (spam-check-bogofilter t))))
+      (message "Spamicity score %s" score)
+      (or score "0"))))
+
+(defun spam-check-bogofilter (&optional score)
+  "Check the Bogofilter backend for the classification of this message"
+  (let ((article-buffer-name (buffer-name)) 
+	return)
+    (with-temp-buffer
+      (let ((temp-buffer-name (buffer-name)))
+	(save-excursion
+	  (set-buffer article-buffer-name)
+	  (if spam-bogofilter-database-directory
+	      (call-process-region (point-min) (point-max) 
+				   spam-bogofilter-path
+				   nil temp-buffer-name nil "-v"
+				   "-d" spam-bogofilter-database-directory)
+	    (call-process-region (point-min) (point-max) spam-bogofilter-path
+				 nil temp-buffer-name nil "-v")))
+	(setq return (spam-check-bogofilter-headers score))))
+    return))
+
+(defun spam-bogofilter-register-with-bogofilter (article-string spam)
+  "Register an article, given as a string, as spam or non-spam."
+  (when (stringp article-string)
+    (let ((switch (if spam spam-bogofilter-spam-switch 
+		    spam-bogofilter-ham-switch)))
+      (with-temp-buffer
+	(insert article-string)
+	(if spam-bogofilter-database-directory
+	    (call-process-region (point-min) (point-max) 
+				 spam-bogofilter-path
+				 nil nil nil "-v" switch
+				 "-d" spam-bogofilter-database-directory)
+	  (call-process-region (point-min) (point-max) spam-bogofilter-path
+			       nil nil nil "-v" switch))))))
+
+(defun spam-bogofilter-register-spam-routine ()
+  (spam-generic-register-routine 
+   (lambda (article)
+     (spam-bogofilter-register-with-bogofilter
+      (spam-get-article-as-string article) t))
+   nil))
+
+(defun spam-bogofilter-register-ham-routine ()
+  (spam-generic-register-routine 
+   nil
+   (lambda (article)
+     (spam-bogofilter-register-with-bogofilter
+      (spam-get-article-as-string article) nil))))
+
+(provide 'spam)
+
+;;; spam.el ends here.
diff --git a/lisp/tls.el b/lisp/tls.el
new file mode 100644
index 0000000..a2cced9
--- /dev/null
+++ b/lisp/tls.el
@@ -0,0 +1,130 @@
+;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: comm, tls, gnutls, ssl
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package implements a simple wrapper around "gnutls-cli" to
+;; make Emacs support TLS/SSL.
+;;
+;; Usage is the same as `open-network-stream', i.e.:
+;;
+;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563))
+;; ...
+;; #<process test>
+;; (process-send-string tmp "mode reader\n")
+;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ...
+;; nil
+;; (process-send-string tmp "quit\n")
+;; 205
+;; nil
+
+;; To use this package as a replacement for ssl.el by William M. Perry
+;; <wmperry@cs.indiana.edu>, you need to evaluate the following:
+;;
+;; (defalias 'open-ssl-stream 'open-tls-stream)
+
+;;; Code:
+
+(require 'pces)
+
+(eval-and-compile
+  (autoload 'format-spec "format-spec")
+  (autoload 'format-spec-make "format-spec"))
+
+(defgroup tls nil
+  "Transport Layer Security (TLS) parameters."
+  :group 'comm)
+
+(defcustom tls-program '("gnutls-cli -p %p %h"
+			 "gnutls-cli -p %p %h --protocols ssl3")
+  "List of strings containing commands to start TLS stream to a host.
+Each entry in the list is tried until a connection is successful.
+%s is replaced with server hostname, %p with port to connect to.
+The program should read input on stdin and write output to
+stdout.  Also see `tls-success' for what the program should output
+after successful negotiation."
+  :type '(repeat string)
+  :group 'tls)
+
+(defcustom tls-process-connection-type nil
+  "*Value for `process-connection-type' to use when starting process."
+  :type 'boolean
+  :group 'tls)
+
+(defcustom tls-success "- Handshake was completed"
+  "*Regular expression indicating completed TLS handshakes.
+The default is what GNUTLS's \"gnutls-cli\" outputs."
+  :type 'regexp
+  :group 'tls)
+
+(defun open-tls-stream (name buffer host service)
+  "Open a TLS connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process.  It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+  (let ((cmds tls-program) cmd done)
+    (message "Opening TLS connection to `%s'..." host)
+    (while (and (not done) (setq cmd (pop cmds)))
+      (message "Opening TLS connection with `%s'..." cmd)
+      (let* ((process-connection-type tls-process-connection-type)
+	     (process (as-binary-process
+		       (start-process
+			name buffer shell-file-name shell-command-switch
+			(format-spec
+			 cmd
+			 (format-spec-make
+			  ?h host
+			  ?p (if (integerp service)
+				 (int-to-string service)
+			       service))))))
+	     response)
+	(while (and process
+		    (memq (process-status process) '(open run))
+		    (save-excursion
+		      (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+		      (goto-char (point-min))
+		      (not (setq done (re-search-forward tls-success nil t)))))
+	  (accept-process-output process 1)
+	  (sit-for 1))
+	(message "Opening TLS connection with `%s'...%s" cmd
+		 (if done "done" "failed"))
+	(if done
+	    (setq done process)
+	  (delete-process process))))
+    (message "Opening TLS connection to `%s'...%s"
+	     host (if done "done" "failed"))
+    done))
+
+(provide 'tls)
+
+;;; tls.el ends here
diff --git a/lisp/yenc.el b/lisp/yenc.el
new file mode 100644
index 0000000..3fea50f
--- /dev/null
+++ b/lisp/yenc.el
@@ -0,0 +1,120 @@
+;;; yenc.el --- elisp native yenc decoder
+;; Copyright (c) 2002 Free Software Foundation, Inc.
+
+;; Author: Jesper Harder <harder@ifa.au.dk>
+;; Keywords: yenc news
+
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Functions for decoding yenc encoded messages.
+;;
+;; Limitations:
+;;
+;; * Does not handle multipart messages.
+;; * No support for external decoders.
+;; * Doesn't check the crc32 checksum (if present).
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defconst yenc-begin-line
+  "^=ybegin.*$")
+
+(defconst yenc-decoding-vector
+  [214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
+       231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
+       248 249 250 251 252 253 254 255 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+       16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
+       39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
+       62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
+       85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
+       106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
+       123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
+       140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
+       157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
+       174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
+       191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+       208 209 210 211 212 213])
+
+;;;###autoload
+(defun yenc-decode-region (start end)
+  "Yenc decode region between START and END using an internal decoder."
+  (interactive "r")
+  (let (work-buffer)
+    (unwind-protect
+	(save-excursion
+	  (goto-char start)
+	  (when (re-search-forward yenc-begin-line end t)
+	    (let ((first (match-end 0))
+		  (header-alist (yenc-parse-line (match-string 0)))
+		  bytes last footer-alist char)
+	      (when (re-search-forward "^=ypart.*$" end t)
+		(setq first (match-end 0)))
+	      (when (re-search-forward "^=yend.*$" end t)
+		(setq last (match-beginning 0))
+		(setq footer-alist (yenc-parse-line (match-string 0)))
+		(let (default-enable-multibyte-characters)
+		  (setq work-buffer (generate-new-buffer " *yenc-work*")))
+		(while (< first last)
+		  (setq char (char-after first))
+		  (cond ((or (eq char ?\r)
+			     (eq char ?\n)))
+			((eq char ?=)
+			 (setq char (char-after (incf first)))
+			 (with-current-buffer work-buffer
+			   (insert-char (mod (- char 106) 256) 1)))
+			(t
+			 (with-current-buffer work-buffer
+			   ;;(insert-char (mod (- char 42) 256) 1)
+			   (insert-char (aref yenc-decoding-vector char) 1))))
+		  (incf first))
+		(setq bytes (buffer-size work-buffer))
+		(unless (and (= (cdr (assq 'size header-alist)) bytes)
+			     (= (cdr (assq 'size footer-alist)) bytes))
+		  (message "Warning: Size mismatch while decoding."))
+		(goto-char start)
+		(delete-region start end)
+		(insert-buffer-substring work-buffer))))
+	  (and work-buffer (kill-buffer work-buffer))))))
+
+;;;###autoload
+(defun yenc-extract-filename ()
+  "Extract file name from an yenc header."
+  (save-excursion
+    (when (re-search-forward yenc-begin-line nil t)
+      (cdr (assoc 'name (yenc-parse-line (match-string 0)))))))
+
+(defun yenc-parse-line (str)
+  "Extract file name and size from STR."
+  (let (result name)
+    (when (string-match "^=y.*size=\\([0-9]+\\)" str)
+      (push (cons 'size (string-to-number (match-string 1 str))) result))
+    (when (string-match "^=y.*name=\\(.*\\)$" str)
+      (setq name (match-string 1 str))
+      ;; Remove trailing white space
+      (when (string-match " +$" name)
+	(setq name (substring name 0 (match-beginning 0))))
+      (push (cons 'name name) result))
+    result))
+
+(provide 'yenc)
+
+;;; yenc.el ends here