entered into RCS

lisp/gnus-cache.el

@@ -0,0 +1,361 @@
+;;; gnus-cache.el --- cache interface for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+
+(defvar gnus-cache-directory (concat gnus-article-save-directory "cache/")
+  "*The directory where cached articles will be stored.")
+
+(defvar gnus-cache-enter-articles '(ticked dormant)
+  "*Classes of articles to enter into the cache.")
+
+(defvar gnus-cache-remove-articles '(read)
+  "*Classes of articles to remove from the cache.")
+
+
+
+(defvar gnus-cache-buffer nil)
+
+
+
+(defun gnus-cache-change-buffer (group)
+  (and gnus-cache-buffer
+       ;; see if the current group's overview cache has been loaded 
+       (or (string= group (car gnus-cache-buffer))
+	   ;; another overview cache is current, save it
+	   (gnus-cache-save-buffers)))
+  ;; if gnus-cache buffer is nil, create it
+  (or gnus-cache-buffer
+      ;; create cache buffer
+      (save-excursion
+	(setq gnus-cache-buffer
+	      (cons group
+		    (set-buffer (get-buffer-create " *gnus-cache-overview*"))))
+	(buffer-disable-undo (current-buffer))
+	;; insert the contents of this groups cache overview
+	(erase-buffer)
+	(let ((file (gnus-cache-file-name group ".overview")))
+	  (and (file-exists-p file)
+	       (insert-file-contents file)))
+	;; we have a fresh (empty/just loaded) buffer, 
+	;; mark it as unmodified to save a redundant write later.
+	(set-buffer-modified-p nil))))
+
+
+(defun gnus-cache-save-buffers ()
+  ;; save the overview buffer if it exists and has been modified
+  ;; delete empty cache subdirectories
+  (if (null gnus-cache-buffer)
+      ()
+    (let ((buffer (cdr gnus-cache-buffer))
+	  (overview-file (gnus-cache-file-name
+			  (car gnus-cache-buffer) ".overview")))
+      ;; write the overview only if it was modified
+      (if (buffer-modified-p buffer)
+	  (save-excursion
+	    (set-buffer buffer)
+	    (if (> (buffer-size) 0)
+		;; non-empty overview, write it out
+		(progn
+		  (gnus-make-directory (file-name-directory overview-file))
+		  (write-region (point-min) (point-max)
+				overview-file nil 'quietly))
+	      ;; empty overview file, remove it
+	      (and (file-exists-p overview-file)
+		   (delete-file overview-file))
+	      ;; if possible, remove group's cache subdirectory
+	      (condition-case nil
+		  ;; FIXME: we can detect the error type and warn the user
+		  ;; of any inconsistencies (articles w/o nov entries?).
+		  ;; for now, just be conservative...delete only if safe -- sj
+		  (delete-directory (file-name-directory overview-file))
+		(error nil)))))
+      ;; kill the buffer, it's either unmodified or saved
+      (gnus-kill-buffer buffer)
+      (setq gnus-cache-buffer nil))))
+
+
+;; Return whether an article is a member of a class.
+(defun gnus-cache-member-of-class (class ticked dormant unread)
+  (or (and ticked (memq 'ticked class))
+      (and dormant (memq 'dormant class))
+      (and unread (memq 'unread class))
+      (and (not unread) (memq 'read class))))
+
+(defun gnus-cache-file-name (group article)
+  (concat (file-name-as-directory gnus-cache-directory)
+	  (if (gnus-use-long-file-name 'not-cache)
+	      group 
+	    (let ((group (concat group "")))
+	      (if (string-match ":" group)
+		  (aset group (match-beginning 0) ?/))
+	      (gnus-replace-chars-in-string group ?. ?/)))
+	  "/" (if (stringp article) article (int-to-string article))))
+
+(defun gnus-cache-possibly-enter-article 
+  (group article headers ticked dormant unread)
+  (let ((number (mail-header-number headers))
+	file dir)
+    (if (or (not (vectorp headers))	; This might be a dummy article.
+	    (< number 0)		; Reffed article from other group.
+	    (not (gnus-cache-member-of-class
+		  gnus-cache-enter-articles ticked dormant unread))
+	    (file-exists-p (setq file (gnus-cache-file-name group article))))
+	()				; Do nothing.
+      ;; Possibly create the cache directory.
+      (or (file-exists-p (setq dir (file-name-directory file)))
+	  (gnus-make-directory dir))
+      ;; Save the article in the cache.
+      (if (file-exists-p file)
+	  t				; The article already is saved, so we end here.
+	(let ((gnus-use-cache nil))
+	  (gnus-summary-select-article))
+	(save-excursion
+	  (set-buffer gnus-article-buffer)
+	  (save-restriction
+	    (widen)
+	    (write-region (point-min) (point-max) file nil 'quiet))
+	  (gnus-cache-change-buffer group)
+	  (set-buffer (cdr gnus-cache-buffer))
+	  (goto-char (point-max))
+	  (forward-line -1)
+	  (while (condition-case ()
+		     (and (not (bobp))
+			  (> (read (current-buffer)) number))
+		   (error
+		    ;; The line was malformed, so we just remove it!!
+		    (gnus-delete-line)
+		    t))
+	    (forward-line -1))
+	  (if (bobp) 
+	      (if (not (eobp))
+		  (progn
+		    (beginning-of-line)
+		    (if (< (read (current-buffer)) number)
+			(forward-line 1)))
+		(beginning-of-line))
+	    (forward-line 1))
+	  (beginning-of-line)
+	  ;; [number subject from date id references chars lines xref]
+	  (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
+			  (mail-header-number headers)
+			  (mail-header-subject headers)
+			  (mail-header-from headers)
+			  (mail-header-date headers)
+			  (mail-header-id headers)
+			  (or (mail-header-references headers) "")
+			  (or (mail-header-chars headers) "")
+			  (or (mail-header-lines headers) "")
+			  (or (mail-header-xref headers) ""))))
+	t))))
+
+(defun gnus-cache-enter-remove-article (article)
+  (setq gnus-cache-removeable-articles
+	(cons article gnus-cache-removeable-articles)))
+
+(defsubst gnus-cache-possibly-remove-article 
+  (article ticked dormant unread)
+  (let ((file (gnus-cache-file-name gnus-newsgroup-name article)))
+    (if (or (not (file-exists-p file))
+	    (not (gnus-cache-member-of-class
+		  gnus-cache-remove-articles ticked dormant unread)))
+	nil
+      (save-excursion
+	(delete-file file)
+	(set-buffer (cdr gnus-cache-buffer))
+	(goto-char (point-min))
+	(if (or (looking-at (concat (int-to-string article) "\t"))
+		(search-forward (concat "\n" (int-to-string article) "\t")
+				(point-max) t))
+	    (delete-region (progn (beginning-of-line) (point))
+			   (progn (forward-line 1) (point))))))))
+
+(defun gnus-cache-possibly-remove-articles ()
+  (let ((articles gnus-cache-removeable-articles)
+	(cache-articles (gnus-cache-articles-in-group gnus-newsgroup-name))
+	article)
+    (gnus-cache-change-buffer gnus-newsgroup-name)
+    (while articles
+      (setq article (car articles)
+	    articles (cdr articles))
+      (if (memq article cache-articles)
+	  ;; The article was in the cache, so we see whether we are
+	  ;; supposed to remove it from the cache.
+	  (gnus-cache-possibly-remove-article
+	   article (memq article gnus-newsgroup-marked)
+	   (memq article gnus-newsgroup-dormant)
+	   (or (memq article gnus-newsgroup-unreads)
+	       (memq article gnus-newsgroup-unselected))))))
+  ;; the overview file might have been modified, save it
+  ;; safe because we're only called at group exit anyway
+  (gnus-cache-save-buffers))
+
+
+(defun gnus-cache-request-article (article group)
+  (let ((file (gnus-cache-file-name group article)))
+    (if (not (file-exists-p file))
+	()
+      (erase-buffer)
+      ;; There may be some overlays that we have to kill...
+      (insert "i")
+      (let ((overlays (overlays-at (point-min))))
+	(while overlays
+	  (delete-overlay (car overlays))
+	  (setq overlays (cdr overlays))))
+      (erase-buffer)	  
+      (insert-file-contents file)
+      t)))
+
+(defun gnus-cache-articles-in-group (group)
+  (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
+	articles)
+    (if (not (file-exists-p dir))
+	nil
+      (setq articles (directory-files dir nil "^[0-9]+$" t))
+      (if (not articles)
+	  nil
+	(sort (mapcar (function (lambda (name)
+				  (string-to-int name))) 
+		      articles)
+	      '<)))))
+
+(defun gnus-cache-active-articles (group)
+  (let ((articles (gnus-cache-articles-in-group group)))
+    (and articles
+	 (cons (car articles) (gnus-last-element articles)))))
+
+(defun gnus-cache-possibly-alter-active (group active)
+  (let ((cache-active (gnus-cache-active-articles group)))
+    (and cache-active (< (car cache-active) (car active))
+	 (setcar active (car cache-active)))
+    (and cache-active (> (cdr cache-active) (cdr active))
+	 (setcdr active (cdr cache-active)))))
+
+(defun gnus-cache-retrieve-headers (articles group)
+  (let* ((cached (gnus-cache-articles-in-group group))
+	 (articles (gnus-sorted-complement articles cached))
+	 (cache-file (gnus-cache-file-name group ".overview"))
+	 type)
+    (let ((gnus-use-cache nil))
+      (setq type (and articles (gnus-retrieve-headers articles group))))
+    (gnus-cache-save-buffers)
+    (save-excursion
+      (cond ((not (file-exists-p cache-file))
+	     type)
+	    ((null type)
+	     (set-buffer nntp-server-buffer)
+	     (erase-buffer)
+	     (insert-file-contents cache-file)
+	     'nov)
+	    ((eq type 'nov)
+	     (gnus-cache-braid-nov group cached)
+	     type)
+	    (t
+	     (gnus-cache-braid-heads group cached)
+	     type)))))
+
+(defun gnus-cache-braid-nov (group cached)
+  (let ((cache-buf (get-buffer-create " *gnus-cache*"))
+	beg end)
+    (gnus-cache-save-buffers)
+    (save-excursion
+      (set-buffer cache-buf)
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (insert-file-contents (gnus-cache-file-name group ".overview"))
+      (goto-char (point-min))
+      (insert "\n")
+      (goto-char (point-min)))
+    (set-buffer nntp-server-buffer)
+    (goto-char (point-min))
+    (while cached
+      (while (and (not (eobp))
+		  (< (read (current-buffer)) (car cached)))
+	(forward-line 1))
+      (beginning-of-line)
+      (save-excursion
+	(set-buffer cache-buf)
+	(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
+			    nil t)
+	    (setq beg (progn (beginning-of-line) (point))
+		  end (progn (end-of-line) (point)))
+	  (setq beg nil)))
+      (if beg (progn (insert-buffer-substring cache-buf beg end)
+		     (insert "\n")))
+      (setq cached (cdr cached)))
+    (kill-buffer cache-buf)))
+
+(defun gnus-cache-braid-heads (group cached)
+  (let ((cache-buf (get-buffer-create " *gnus-cache*")))
+    (save-excursion
+      (set-buffer cache-buf)
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer))
+    (set-buffer nntp-server-buffer)
+    (goto-char (point-min))
+    (while cached
+      (while (and (not (eobp))
+		  (looking-at "2.. +\\([0-9]+\\) ")
+		  (< (progn (goto-char (match-beginning 1))
+			    (read (current-buffer)))
+		     (car cached)))
+	(search-forward "\n.\n" nil 'move))
+      (beginning-of-line)
+      (save-excursion
+	(set-buffer cache-buf)
+	(erase-buffer)
+	(insert-file-contents (gnus-cache-file-name group (car cached)))
+	(goto-char (point-min))
+	(insert "220 " (int-to-string (car cached)) " Article retrieved.\n")
+	(search-forward "\n\n" nil 'move)
+	(delete-region (point) (point-max))
+	(forward-char -1)
+	(insert "."))
+      (insert-buffer-substring cache-buf)
+      (setq cached (cdr cached)))
+    (kill-buffer cache-buf)))
+
+(defun gnus-jog-cache ()
+  "Go through all groups and put the articles into the cache."
+  (interactive)
+  (let ((newsrc (cdr gnus-newsrc-alist))
+	(gnus-cache-enter-articles '(unread))
+	(gnus-mark-article-hook nil)
+	(gnus-expert-user t)
+	(gnus-large-newsgroup nil))
+    (while newsrc
+      (gnus-summary-read-group (car (car newsrc)))
+      (if (not (eq major-mode 'gnus-summary-mode))
+	  ()
+	(while gnus-newsgroup-unreads
+	  (gnus-summary-select-article t t nil (car gnus-newsgroup-unreads))
+	  (setq gnus-newsgroup-unreads (cdr gnus-newsgroup-unreads)))
+	(kill-buffer (current-buffer)))
+      (setq newsrc (cdr newsrc)))))
+
+(provide 'gnus-cache)
+	      
+;;; gnus-cache.el ends here

lisp/gnus-cite.el

@@ -0,0 +1,585 @@
+;;; gnus-cite.el --- parse citations in articles for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-msg)
+(require 'gnus-ems)
+
+(eval-and-compile
+  (autoload 'gnus-article-add-button "gnus-vis")
+  )
+
+;;; Customization:
+
+(defvar gnus-cite-parse-max-size 25000
+  "Maximum article size (in bytes) where parsing citations is allowed.
+Set it to nil to parse all articles.")
+
+(defvar gnus-cite-prefix-regexp 
+    "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
+  "Regexp matching the longest possible citation prefix on a line.")
+
+(defvar gnus-cite-max-prefix 20
+  "Maximal possible length for a citation prefix.")
+
+(defvar gnus-supercite-regexp 
+  (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
+	  ">>>>> +\"\\([^\"\n]+\\)\" +==")
+  "Regexp matching normal SuperCite attribution lines.
+The first regexp group should match a prefix added by another package.")
+
+(defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
+  "Regexp matching mangled SuperCite attribution lines.
+The first regexp group should match the SuperCite attribution.")
+
+(defvar gnus-cite-minimum-match-count 2
+  "Minimal number of identical prefix'es before we believe it is a citation.")
+
+;see gnus-cus.el
+;(defvar gnus-cite-face-list 
+;  (if (eq gnus-display-type 'color)
+;      (if (eq gnus-background-mode 'dark) 'light 'dark)
+;    '(italic))
+;  "Faces used for displaying different citations.
+;It is either a list of face names, or one of the following special
+;values:
+
+;dark: Create faces from `gnus-face-dark-name-list'.
+;light: Create faces from `gnus-face-light-name-list'.
+
+;The variable `gnus-make-foreground' determines whether the created
+;faces change the foreground or the background colors.")
+
+(defvar gnus-cite-attribution-prefix "in article\\|in <"
+  "Regexp matching the beginning of an attribution line.")
+
+(defvar gnus-cite-attribution-postfix
+  "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$"
+  "Regexp matching the end of an attribution line.
+The text matching the first grouping will be used as a button.")
+
+;see gnus-cus.el
+;(defvar gnus-cite-attribution-face 'underline
+;  "Face used for attribution lines.
+;It is merged with the face for the cited text belonging to the attribution.")
+
+;see gnus-cus.el
+;(defvar gnus-cite-hide-percentage 50
+;  "Only hide cited text if it is larger than this percent of the body.")
+
+;see gnus-cus.el
+;(defvar gnus-cite-hide-absolute 10
+;  "Only hide cited text if there is at least this number of cited lines.")
+
+;see gnus-cus.el
+;(defvar gnus-face-light-name-list
+;  '("light blue" "light cyan" "light yellow" "light pink"
+;    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
+;    "turquoise")
+;  "Names of light colors.")
+
+;see gnus-cus.el
+;(defvar gnus-face-dark-name-list
+;  '("dark salmon" "firebrick"
+;    "dark green" "dark orange" "dark khaki" "dark violet"
+;    "dark turquoise")
+;  "Names of dark colors.")
+
+;;; Internal Variables:
+
+(defvar gnus-article-length nil)
+;; Length of article last time we parsed it.
+;; BUG! KLUDGE! UGLY! FIX ME!
+
+(defvar gnus-cite-prefix-alist nil)
+;; Alist of citation prefixes.  
+;; The cdr is a list of lines with that prefix.
+
+(defvar gnus-cite-attribution-alist nil)
+;; Alist of attribution lines.
+;; The car is a line number.
+;; The cdr is the prefix for the citation started by that line.
+
+(defvar gnus-cite-loose-prefix-alist nil)
+;; Alist of citation prefixes that have no matching attribution.
+;; The cdr is a list of lines with that prefix.
+
+(defvar gnus-cite-loose-attribution-alist nil)
+;; Alist of attribution lines that have no matching citation.
+;; Each member has the form (WROTE IN PREFIX TAG), where
+;; WROTE: is the attribution line number
+;; IN: is the line number of the previous line if part of the same attribution,
+;; PREFIX: Is the citation prefix of the attribution line(s), and
+;; TAG: Is a SuperCite tag, if any.
+
+;;; Commands:
+
+(defun gnus-article-highlight-citation (&optional force)
+  "Highlight cited text.
+Each citation in the article will be highlighted with a different face.
+The faces are taken from `gnus-cite-face-list'.
+Attribution lines are highlighted with the same face as the
+corresponding citation merged with `gnus-cite-attribution-face'.
+
+Text is considered cited if at least `gnus-cite-minimum-match-count'
+lines matches `gnus-cite-prefix-regexp' with the same prefix.  
+
+Lines matching `gnus-cite-attribution-postfix' and perhaps
+`gnus-cite-attribution-prefix' are considered attribution lines."
+  (interactive (list 'force))
+  ;; Create dark or light faces if necessary.
+  (cond ((eq gnus-cite-face-list 'light)
+	 (setq gnus-cite-face-list
+	       (mapcar 'gnus-make-face gnus-face-light-name-list)))
+	((eq gnus-cite-face-list 'dark)
+	 (setq gnus-cite-face-list
+	       (mapcar 'gnus-make-face gnus-face-dark-name-list))))
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (gnus-cite-parse-maybe force)
+    (let ((buffer-read-only nil)
+	  (alist gnus-cite-prefix-alist)
+	  (faces gnus-cite-face-list)
+	  (inhibit-point-motion-hooks t)
+	  face entry prefix skip numbers number face-alist)
+      ;; Loop through citation prefixes.
+      (while alist
+	(setq entry (car alist)
+	      alist (cdr alist)
+	      prefix (car entry)
+	      numbers (cdr entry)
+	      face (car faces)
+	      faces (or (cdr faces) gnus-cite-face-list)
+	      face-alist (cons (cons prefix face) face-alist))
+	(while numbers
+	  (setq number (car numbers)
+		numbers (cdr numbers))
+	  (and (not (assq number gnus-cite-attribution-alist))
+	       (not (assq number gnus-cite-loose-attribution-alist))
+	       (gnus-cite-add-face number prefix face))))
+      ;; Loop through attribution lines.
+      (setq alist gnus-cite-attribution-alist)
+      (while alist
+	(setq entry (car alist)
+	      alist (cdr alist)
+	      number (car entry)
+	      prefix (cdr entry)
+	      skip (gnus-cite-find-prefix number)
+	      face (cdr (assoc prefix face-alist)))
+	;; Add attribution button.
+	(goto-line number)
+	(if (re-search-forward gnus-cite-attribution-postfix 
+			       (save-excursion (end-of-line 1) (point))
+			       t)
+	    (gnus-article-add-button (match-beginning 1) (match-end 1)
+				     'gnus-cite-toggle prefix))
+	;; Highlight attribution line.
+	(gnus-cite-add-face number skip face)
+	(gnus-cite-add-face number skip gnus-cite-attribution-face))
+      ;; Loop through attribution lines.
+      (setq alist gnus-cite-loose-attribution-alist)
+      (while alist
+	(setq entry (car alist)
+	      alist (cdr alist)
+	      number (car entry)
+	      skip (gnus-cite-find-prefix number))
+	(gnus-cite-add-face number skip gnus-cite-attribution-face)))))
+
+(defun gnus-article-hide-citation (&optional force)
+  "Hide all cited text except attribution lines.
+See the documentation for `gnus-article-highlight-citation'."
+  (interactive (list 'force))
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (gnus-cite-parse-maybe force)
+    (let ((buffer-read-only nil)
+	  (alist gnus-cite-prefix-alist)
+	  (inhibit-point-motion-hooks t)
+	  numbers number)
+      (while alist
+	(setq numbers (cdr (car alist))
+	      alist (cdr alist))
+	(while numbers
+	  (setq number (car numbers)
+		numbers (cdr numbers))
+	  (goto-line number)
+	  (or (assq number gnus-cite-attribution-alist)
+	      (add-text-properties (point) (progn (forward-line 1) (point))
+				   gnus-hidden-properties)))))))
+
+(defun gnus-article-hide-citation-maybe (&optional force)
+  "Hide cited text that has an attribution line.
+This will do nothing unless at least `gnus-cite-hide-percentage'
+percent and at least `gnus-cite-hide-absolute' lines of the body is
+cited text with attributions.  When called interactively, these two
+variables are ignored.
+See also the documentation for `gnus-article-highlight-citation'."
+  (interactive (list 'force))
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (gnus-cite-parse-maybe force)
+    (goto-char (point-min))
+    (search-forward "\n\n" nil t)
+    (let ((start (point))
+	  (atts gnus-cite-attribution-alist)
+	  (buffer-read-only nil)
+	  (inhibit-point-motion-hooks t)
+	  (hiden 0)
+	  total)
+      (goto-char (point-max))
+      (re-search-backward gnus-signature-separator nil t)
+      (setq total (count-lines start (point)))
+      (while atts
+	(setq hiden (+ hiden (length (cdr (assoc (cdr (car atts))
+						 gnus-cite-prefix-alist))))
+	      atts (cdr atts)))
+      (if (or force
+	      (and (> (* 100 hiden) (* gnus-cite-hide-percentage total))
+		   (> hiden gnus-cite-hide-absolute)))
+	  (progn
+	    (setq atts gnus-cite-attribution-alist)
+	    (while atts
+	      (setq total (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist))
+		    atts (cdr atts))
+	      (while total
+		(setq hiden (car total)
+		      total (cdr total))
+		(goto-line hiden)
+		(or (assq hiden gnus-cite-attribution-alist)
+		    (add-text-properties (point) 
+					 (progn (forward-line 1) (point))
+					 gnus-hidden-properties)))))))))
+
+;;; Internal functions:
+
+(defun gnus-cite-parse-maybe (&optional force)
+  ;; Parse if the buffer has changes since last time.
+  (if (eq gnus-article-length (- (point-max) (point-min)))
+      ()
+    ;;Reset parser information.
+    (setq gnus-cite-prefix-alist nil
+	  gnus-cite-attribution-alist nil
+	  gnus-cite-loose-prefix-alist nil
+	  gnus-cite-loose-attribution-alist nil)
+    ;; Parse if not too large.
+    (if (and (not force) 
+	     gnus-cite-parse-max-size
+	     (> (buffer-size) gnus-cite-parse-max-size))
+	()
+      (setq gnus-article-length (- (point-max) (point-min)))
+      (gnus-cite-parse))))
+
+(defun gnus-cite-parse ()
+  ;; Parse and connect citation prefixes and attribution lines.
+  
+  ;; Parse current buffer searching for citation prefixes.
+  (goto-char (point-min))
+  (or (search-forward "\n\n" nil t)
+      (goto-char (point-max)))
+  (let ((line (1+ (count-lines (point-min) (point))))
+	(case-fold-search t)
+	(max (save-excursion
+	       (goto-char (point-max))
+	       (re-search-backward gnus-signature-separator nil t)
+	       (point)))
+	alist entry start begin end numbers prefix)
+    ;; Get all potential prefixes in `alist'.
+    (while (< (point) max)
+      ;; Each line.
+      (setq begin (point)
+	    end (progn (beginning-of-line 2) (point))
+	    start end)
+      (goto-char begin)
+      ;; Ignore standard SuperCite attribution prefix.
+      (if (looking-at gnus-supercite-regexp)
+	  (if (match-end 1)
+	      (setq end (1+ (match-end 1)))
+	    (setq end (1+ begin))))
+      ;; Ignore very long prefixes.
+      (if (> end (+ (point) gnus-cite-max-prefix))
+	  (setq end (+ (point) gnus-cite-max-prefix)))
+      (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
+	;; Each prefix.
+	(setq end (match-end 0)
+	      prefix (buffer-substring begin end))
+	(set-text-properties 0 (length prefix) nil prefix)
+	(setq entry (assoc prefix alist))
+	(if entry 
+	    (setcdr entry (cons line (cdr entry)))
+	  (setq alist (cons (list prefix line) alist)))
+	(goto-char begin))
+      (goto-char start)
+      (setq line (1+ line)))
+    ;; We got all the potential prefixes.  Now create
+    ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
+    ;; line that appears at least gnus-cite-minimum-match-count
+    ;; times. First sort them by length.  Longer is older.
+    (setq alist (sort alist (lambda (a b)
+			      (> (length (car a)) (length (car b))))))
+    (while alist
+      (setq entry (car alist)
+	    prefix (car entry)
+	    numbers (cdr entry)
+	    alist (cdr alist))
+      (cond ((null numbers)
+	     ;; No lines with this prefix that wasn't also part of
+	     ;; a longer prefix.
+	     )
+	    ((< (length numbers) gnus-cite-minimum-match-count)
+	     ;; Too few lines with this prefix.  We keep it a bit
+	     ;; longer in case it is an exact match for an attribution
+	     ;; line, but we don't remove the line from other
+	     ;; prefixes. 
+	     (setq gnus-cite-prefix-alist
+		   (cons entry gnus-cite-prefix-alist)))
+	    (t
+	     (setq gnus-cite-prefix-alist (cons entry
+						gnus-cite-prefix-alist))
+	     ;; Remove articles from other prefixes.
+	     (let ((loop alist)
+		   current)
+	       (while loop
+		 (setq current (car loop)
+		       loop (cdr loop))
+		 (setcdr current 
+			 (gnus-set-difference (cdr current) numbers))))))))
+  ;; No citations have been connected to attribution lines yet.
+  (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
+
+  ;; Parse current buffer searching for attribution lines.
+  (goto-char (point-min))
+  (search-forward "\n\n" nil t)
+  (while (re-search-forward gnus-cite-attribution-postfix (point-max) t)
+    (let* ((start (match-beginning 0))
+	   (end (match-end 0))
+	   (wrote (count-lines (point-min) end))
+	   (prefix (gnus-cite-find-prefix wrote))
+	   ;; Check previous line for an attribution leader.
+	   (tag (progn
+		  (beginning-of-line 1)
+		  (and (looking-at gnus-supercite-secondary-regexp)
+		       (buffer-substring (match-beginning 1)
+					 (match-end 1)))))
+	   (in (progn
+		 (goto-char start)
+		 (and (re-search-backward gnus-cite-attribution-prefix
+					  (save-excursion
+					    (beginning-of-line 0)
+					    (point))
+					  t)
+		      (not (re-search-forward gnus-cite-attribution-postfix
+					      start t))
+		      (count-lines (point-min) (1+ (point)))))))
+      (if (eq wrote in)
+	  (setq in nil))
+      (goto-char end)
+      (setq gnus-cite-loose-attribution-alist
+	    (cons (list wrote in prefix tag)
+		  gnus-cite-loose-attribution-alist))))
+  ;; Find exact supercite citations.
+  (gnus-cite-match-attributions 'small nil
+				(lambda (prefix tag)
+				  (if tag
+				      (concat "\\`" 
+					      (regexp-quote prefix) "[ \t]*" 
+					      (regexp-quote tag) ">"))))
+  ;; Find loose supercite citations after attributions.
+  (gnus-cite-match-attributions 'small t
+				(lambda (prefix tag)
+				  (if tag (concat "\\<"
+						  (regexp-quote tag)
+						  "\\>"))))
+  ;; Find loose supercite citations anywhere.
+  (gnus-cite-match-attributions 'small nil
+				(lambda (prefix tag)
+				  (if tag (concat "\\<"
+						  (regexp-quote tag)
+						  "\\>"))))
+  ;; Find nested citations after attributions.
+  (gnus-cite-match-attributions 'small-if-unique t
+				(lambda (prefix tag)
+				  (concat "\\`" (regexp-quote prefix) ".+")))
+  ;; Find nested citations anywhere.
+  (gnus-cite-match-attributions 'small nil
+				(lambda (prefix tag)
+				  (concat "\\`" (regexp-quote prefix) ".+")))
+  ;; Remove loose prefixes with too few lines.
+  (let ((alist gnus-cite-loose-prefix-alist)
+	entry)
+    (while alist
+      (setq entry (car alist)
+	    alist (cdr alist))
+      (if (< (length (cdr entry)) gnus-cite-minimum-match-count)
+	  (setq gnus-cite-prefix-alist
+		(delq entry gnus-cite-prefix-alist)
+		gnus-cite-loose-prefix-alist
+		(delq entry gnus-cite-loose-prefix-alist)))))
+  ;; Find flat attributions.
+  (gnus-cite-match-attributions 'first t nil)
+  ;; Find any attributions (are we getting desperate yet?).
+  (gnus-cite-match-attributions 'first nil nil))
+
+(defun gnus-cite-match-attributions (sort after fun)
+  ;; Match all loose attributions and citations (SORT AFTER FUN) .
+  ;;
+  ;; If SORT is `small', the citation with the shortest prefix will be
+  ;; used, if it is `first' the first prefix will be used, if it is
+  ;; `small-if-unique' the shortest prefix will be used if the
+  ;; attribution line does not share its own prefix with other
+  ;; loose attribution lines, otherwise the first prefix will be used.
+  ;;
+  ;; If AFTER is non-nil, only citations after the attribution line
+  ;; will be concidered.
+  ;;
+  ;; If FUN is non-nil, it will be called with the arguments (WROTE
+  ;; PREFIX TAG) and expected to return a regular expression.  Only
+  ;; citations whose prefix matches the regular expression will be
+  ;; concidered. 
+  ;; 
+  ;; WROTE is the attribution line number.
+  ;; PREFIX is the attribution line prefix.
+  ;; TAG is the SuperCite tag on the attribution line.
+  (let ((atts gnus-cite-loose-attribution-alist)
+	(case-fold-search t)
+	att wrote in prefix tag regexp limit smallest best size)
+    (while atts
+      (setq att (car atts)
+	    atts (cdr atts)
+	    wrote (nth 0 att)
+	    in (nth 1 att)
+	    prefix (nth 2 att)
+	    tag (nth 3 att)
+	    regexp (if fun (funcall fun prefix tag) "")
+	    size (cond ((eq sort 'small) t)
+		       ((eq sort 'first) nil)
+		       (t (< (length (gnus-cite-find-loose prefix)) 2)))
+	    limit (if after wrote -1)
+	    smallest 1000000		       
+	    best nil)
+      (let ((cites gnus-cite-loose-prefix-alist)
+	    cite candidate numbers first compare)
+	(while cites
+	  (setq cite (car cites)
+		cites (cdr cites)
+		candidate (car cite)
+		numbers (cdr cite)
+		first (apply 'min numbers)
+		compare (if size (length candidate) first))
+	  (and (> first limit)
+	       regexp
+	       (string-match regexp candidate)
+	       (< compare smallest)
+	       (setq best cite
+		     smallest compare))))
+      (if (null best)
+	  ()
+	(setq gnus-cite-loose-attribution-alist
+	      (delq att gnus-cite-loose-attribution-alist))
+	(setq gnus-cite-attribution-alist 
+	      (cons (cons wrote (car best)) gnus-cite-attribution-alist))
+	(if in
+	    (setq gnus-cite-attribution-alist 
+		  (cons (cons in (car best)) gnus-cite-attribution-alist)))
+	(if (memq best gnus-cite-loose-prefix-alist)
+	    (let ((loop gnus-cite-prefix-alist)
+		  (numbers (cdr best))
+		  current)
+	      (setq gnus-cite-loose-prefix-alist
+		    (delq best gnus-cite-loose-prefix-alist))
+	      (while loop
+		(setq current (car loop)
+		      loop (cdr loop))
+		(if (eq current best)
+		    ()
+		  (setcdr current (gnus-set-difference (cdr current) numbers))
+		  (if (null (cdr current))
+		      (setq gnus-cite-loose-prefix-alist
+			    (delq current gnus-cite-loose-prefix-alist)
+			    atts (delq current atts)))))))))))
+
+(defun gnus-cite-find-loose (prefix)
+  ;; Return a list of loose attribution lines prefixed by PREFIX.
+  (let* ((atts gnus-cite-loose-attribution-alist)
+	 att line lines)
+    (while atts
+      (setq att (car atts)
+	    line (car att)
+	    atts (cdr atts))
+      (if (string-equal (gnus-cite-find-prefix line) prefix)
+	  (setq lines (cons line lines))))
+    lines))
+
+(defun gnus-cite-add-face (number prefix face)
+  ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
+  (if face
+      (let ((inhibit-point-motion-hooks t)
+	    from to)
+	(goto-line number)
+	(forward-char (length prefix))
+	(skip-chars-forward " \t")
+	(setq from (point))
+	(end-of-line 1)
+	(skip-chars-backward " \t")
+	(setq to (point))
+	(if (< from to)
+	    (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
+
+(defun gnus-cite-toggle (prefix)
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (let ((buffer-read-only nil)
+	  (numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
+	  (inhibit-point-motion-hooks t)
+	  number)
+      (while numbers
+	(setq number (car numbers)
+	      numbers (cdr numbers))
+	(goto-line number)
+	(cond ((get-text-property (point) 'invisible)
+	       (remove-text-properties (point) (progn (forward-line 1) (point))
+				       gnus-hidden-properties))
+	      ((assq number gnus-cite-attribution-alist))
+	      (t
+	       (add-text-properties (point) (progn (forward-line 1) (point))
+				    gnus-hidden-properties)))))))
+
+(defun gnus-cite-find-prefix (line)
+  ;; Return citation prefix for LINE.
+  (let ((alist gnus-cite-prefix-alist)
+	(prefix "")
+	entry)
+    (while alist
+      (setq entry (car alist)
+	    alist (cdr alist))
+      (if (memq line (cdr entry))
+	  (setq prefix (car entry))))
+    prefix))
+
+(gnus-ems-redefine)
+
+(provide 'gnus-cite)
+
+;;; gnus-cite.el ends here

lisp/gnus-cus.el

@@ -0,0 +1,546 @@
+;;; gnus-cus.el --- User friendly customization of Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Keywords: help, news
+;; Version: 0.1
+
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'custom)
+(require 'gnus-ems)
+
+;; The following is just helper functions and data, not ment to be set
+;; by the user.
+(defun gnus-make-face (color)
+  ;; Create entry for face with COLOR.
+  (custom-face-lookup color nil nil nil nil nil))
+
+(defvar gnus-face-light-name-list
+  '("light blue" "light cyan" "light yellow" "light pink"
+    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
+    "turquoise"))
+
+(defvar gnus-face-dark-name-list
+  '("RoyalBlue" "firebrick"
+    "dark green" "OrangeRed" "dark khaki" "dark violet"
+    "SteelBlue4"))
+; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3
+; DarkOlviveGreen4 
+
+(custom-declare '()
+  '((tag . "GNUS")
+    (doc . "\
+The coffe-brewing, all singing, all dancing, kitchen sink newsreader.")
+    (type . group)
+    (data ((tag . "Visual")
+	   (doc . "\
+GNUS can be made colorful and fun or grey and dull as you wish.")
+	   (type . group)
+	   (data ((tag . "Visual")
+		  (doc . "Enable visual features.
+If `visual' is disabled, there will be no menus and few faces.  Most of
+the visual customization options below will be ignored.  GNUS will use
+less space and be faster as a result.")
+		  (default . t)
+		  (name . gnus-visual)
+		  (type . toggle))
+		 ((tag . "WWW Browser")
+		  (doc . "\
+WWW Browser to call when clicking on an URL button in the article buffer.
+
+You can choose between one of the predefined browsers, or `Other'.")
+		  (name . gnus-button-url)
+		  (calculate . (cond ((boundp 'browse-url-browser-function)
+				      browse-url-browser-function)
+				     ((fboundp 'w3-fetch) 
+				      'w3-fetch)
+				     ((eq window-system 'x) 
+				      'gnus-netscape-open-url)))
+		  (type . choice)
+		  (data ((tag . "W3")
+			 (type . const)
+			 (default . w3-fetch))
+			((tag . "Netscape")
+			 (type . const)
+			 (default . gnus-netscape-open-url))
+			((prompt . "Other")
+			 (doc . "\
+You must specify the name of a Lisp function here.  The lisp function
+should open a WWW browser when called with an URL (a string).
+")
+			 (default . __uninitialized__)
+			 (type . symbol))))
+		 ((tag . "Mouse Face")
+		  (doc . "\
+Face used for group or summary buffer mouse highlighting.
+The line beneath the mouse pointer will be highlighted with this
+face.")
+		  (name . gnus-mouse-face)
+		  (calculate . (if (boundp 'gnus-mouse-face)
+				    gnus-mouse-face
+				  'highlight))
+		  (type . face))
+		 ((tag . "Article Display")
+		  (doc . "Controls how the article buffer will look.
+
+The list below contains various filters you can use to change the look
+of the article.  If you leave the list empty, the article will appear
+exactly as it is stored on the disk.  The list entries will hide or
+highlight various parts of the article, making it easier to find the
+information you want.")
+		  (name . gnus-article-display-hook)
+		  (type . list)
+		  (default . (gnus-article-hide-headers-if-wanted
+			      gnus-article-treat-overstrike
+			      gnus-article-maybe-highlight))
+		  (data ((type . repeat)
+			 (header . nil)
+			 (data (tag . "Filter")
+			       (type . choice)
+			       (data ((tag . "Treat Overstrike")
+				      (doc . "\
+Convert use of overstrike into bold and underline.
+
+Two identical letters separated by a backspace are displayed as a
+single bold letter, while a letter followed by a backspace and an
+underscore will be displayed as a single underlined letter.  This
+technique was developed for old line printers (think about it), and is
+still in use on some newsgroups, in particular the ClariNet
+hierearchy.
+")
+				      (type . const)
+				      (default . 
+					gnus-article-treat-overstrike))
+				     ((tag . "Word Wrap")
+				      (doc . "\
+Format too long lines.
+")
+				      (type . const)
+				      (default . gnus-article-word-wrap))
+				     ((tag . "Remove CR")
+				      (doc . "\
+Remove carriage returns from an article.
+")
+				      (type . const)
+				      (default . gnus-article-remove-cr))
+				     ((tag . "Display X-Face")
+				      (doc . "\
+Look for an X-Face header and display it if present.
+
+See also `X Face Command' for a definition of the external command
+used for decoding and displaying the face.
+")
+				      (type . const)
+				      (default . gnus-article-display-x-face))
+				     ((tag . "Unquote Printable")
+				      (doc . "\
+Tranform MIME quoted printable into 8-bit characters.
+
+Quoted printable is often seen by strings like `=EF' where you would
+expect a non-English letter.
+")
+				      (type . const)
+				      (default .
+					gnus-article-de-quoted-unreadable))
+				     ((tag . "Universal Time")
+				      (doc . "\
+Convert date header to universal time.
+")
+				      (type . const)
+				      (default . gnus-article-date-ut))
+				     ((tag . "Local Time")
+				      (doc . "\
+Convert date header to local timezone.
+")
+				      (type . const)
+				      (default . gnus-article-date-local))
+				     ((tag . "Lapsed Time")
+				      (doc . "\
+Replace date header with a header showing the articles age.
+")
+				      (type . const)
+				      (default . gnus-article-date-lapsed))
+				     ((tag . "Highlight")
+				      (doc . "\
+Highlight headers, citations, signature, and buttons.
+")
+				      (type . const)
+				      (default . gnus-article-highlight))
+				     ((tag . "Maybe Highlight")
+				      (doc . "\
+Highlight headers, signature, and buttons if `Visual' is turned on.
+")
+				      (type . const)
+				      (default . 
+					gnus-article-maybe-highlight))
+				     ((tag . "Highlight Some")
+				      (doc . "\
+Highlight headers, signature, and buttons.
+")
+				      (type . const)
+				      (default . gnus-article-highlight-some))
+				     ((tag . "Highlight Headers")
+				      (doc . "\
+Highlight headers as specified by `Article Header Highligting'.
+")
+				      (type . const)
+				      (default .
+					gnus-article-highlight-headers))
+				     ((tag . "Highlight Signature")
+				      (doc . "\
+Highlight the signature as specified by `Article Signature Face'.
+")
+				      (type . const)
+				      (default .
+					gnus-article-highlight-signature))
+				     ((tag . "Citation")
+				      (doc . "\
+Highlight the citations as specified by `Citation Faces'.
+")
+				      (type . const)
+				      (default . 
+					gnus-article-highlight-citation))
+				     ((tag . "Hide")
+				      (doc . "\
+Hide unwanted headers, excess citation, and the signature.
+")
+				      (type . const)
+				      (default . gnus-article-hide))
+				     ((tag . "Hide Headers If Wanted")
+				      (doc . "\
+Hide headers, but allow user to display them with `t' or `v'.
+")
+				      (type . const)
+				      (default . 
+					gnus-article-hide-headers-if-wanted))
+				     ((tag . "Hide Headers")
+				      (doc . "\
+Hide unwanted headers and possibly sort them as well.
+Most likely you want to use `Hide Headers If Wanted' instead.
+")
+				      (type . const)
+				      (default . gnus-article-hide-headers))
+				     ((tag . "Hide Signature")
+				      (doc . "\
+Hide the signature.
+")
+				      (type . const)
+				      (default . gnus-article-hide-signature))
+				     ((tag . "Hide Excess Citations")
+				      (doc . "\
+Hide excess citation.
+
+Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'.
+")
+				      (type . const)
+				      (default . 
+					gnus-article-hide-citation-maybe))
+				     ((tag . "Hide Citations")
+				      (doc . "\
+Hide all cited text.
+")
+				      (type . const)
+				      (default . gnus-article-hide-citation))
+				     ((tag . "Add Buttons")
+				      (doc . "\
+Make URL's into clickable buttons.
+")
+				      (type . const)
+				      (default . gnus-article-add-buttons))
+				     ((prompt . "Other")
+				      (doc . "\
+Name of Lisp function to call.
+
+Push the `Filter' button to select one of the predefined filters.
+")
+				      (type . symbol)))))))
+		 ((tag . "Article Button Face")
+		  (doc . "\
+Face used for highlighting buttons in the article buffer.
+
+An article button is a piece of text that you can activate by pressing
+`RET' or `mouse-2' above it.")
+		  (name . gnus-article-button-face)
+		  (default . bold)
+		  (type . face))
+		 ((tag . "Article Mouse Face")
+		  (doc . "\
+Face used for mouse highlighting in the article buffer.
+
+Article buttons will be displayed in this face when the cursor is
+above them.")
+		  (name . gnus-article-mouse-face)
+		  (default . highlight)
+		  (type . face))
+		 ((tag . "Article Signature Face")
+		  (doc . "\
+Face used for highlighting a signature in the article buffer.")
+		  (name . gnus-signature-face)
+		  (default . italic)
+		  (type . face))
+		 ((tag . "Article Header Highlighting")
+		  (doc . "\
+Controls highlighting of article header.
+
+Below is a list of article header names, and the faces used for
+displaying the name and content of the header.  The `Header' field
+should contain the name of the header.  The field actually contains a
+regular expression that should match the beginning of the header line,
+but if you don't know what a regular expression is, just write the
+name of the header.  The second field is the `Name' field, which
+determines how the the header name (i.e. the part of the header left
+of the `:') is displayed.  The third field is the `Content' field,
+which determines how the content (i.e. the part of the header right of
+the `:') is displayed.  
+
+If you leave the last `Header' field in the list empty, the `Name' and
+`Content' fields will determine how headers not listed above are
+displayed.  
+
+If you only want to change the display of the name part for a specific
+header, specify `None' in the `Content' field.  Similarly, specify
+`None' in the `Name' field if you only want to leave the name part
+alone.")
+		  (name . gnus-header-face-alist)
+		  (type . list)
+		  (calculate . (cond ((not (eq gnus-display-type 'color))
+				      '(("" bold italic)))
+				     ((eq gnus-background-mode 'dark)
+				      (list (list "From" nil 
+						  (custom-face-lookup 
+						   "dark blue" nil nil t t nil))
+					    (list "Subject" nil 
+						  (custom-face-lookup
+						   "pink" nil nil t t nil))
+					    (list "Newsgroups:.*," nil
+						  (custom-face-lookup
+						   "yellow" nil nil t t nil))
+					    (list "" 
+						  (custom-face-lookup
+						   "cyan" nil nil t nil nil)
+						  (custom-face-lookup
+						   "forestgreen"
+						   nil nil nil t nil))))
+				     (t
+				      (list (list "From" nil 
+						  (custom-face-lookup
+						   "RoyalBlue"
+						   nil nil t t nil))
+					    (list "Subject" nil 
+						  (custom-face-lookup
+						   "firebrick"
+						   nil nil t t nil))
+					    (list "Newsgroups:.*," nil
+						  (custom-face-lookup
+						   "indianred" nil nil t t nil))
+					    (list ""
+						  (custom-face-lookup
+						   "DarkGreen"
+						   nil nil t nil nil)
+						  (custom-face-lookup
+						   "DarkGreen"
+						   nil nil nil t nil))))))
+		  (data ((type . repeat)
+			 (header . nil)
+			 (data (type . list)
+			       (compact . t)
+			       (data ((type . string)
+				      (prompt . "Header")
+				      (tag . "Header "))
+				     "\n            "
+				     ((type . face)
+				      (prompt . "Name")
+				      (tag . "Name   "))
+				     "\n            "
+				     ((type . face)
+				      (tag . "Content"))
+				     "\n")))))
+		 ((tag . "Attribution Face")
+		  (doc . "\
+Face used for attribution lines.
+It is merged with the face for the cited text belonging to the attribution.")
+		  (name . gnus-cite-attribution-face)
+		  (default . underline)
+		  (type . face))
+		 ((tag . "Citation Faces")
+		  (doc . "\
+List of faces used for highlighting citations. 
+
+When there are citations from multiple articles in the same message,
+Gnus will try to give each citation from each article its own face.
+This should make it easier to see who wrote what.")
+		  (name . gnus-cite-face-list)
+		  (import . gnus-custom-import-cite-face-list)
+		  (type . list)
+		  (calculate . (cond ((not (eq gnus-display-type 'color))
+				      '(italic))
+				     ((eq gnus-background-mode 'dark)
+				      (mapcar 'gnus-make-face 
+					      gnus-face-light-name-list))
+				     (t 
+				      (mapcar 'gnus-make-face 
+					      gnus-face-dark-name-list))))
+		  (data ((type . repeat)
+			 (header . nil)
+			 (data (type . face)
+			       (tag . "Face")))))
+		 ((tag . "Citation Hide Percentage")
+		  (doc . "\
+Only hide excess citation if above this percentage of the body.")
+		  (name . gnus-cite-hide-percentage)
+		  (default . 50)
+		  (type . integer))
+		 ((tag . "Citation Hide Absolute")
+		  (doc . "\
+Only hide excess citation if above this number of lines in the body.")
+		  (name . gnus-cite-hide-absolute)
+		  (default . 10)
+		  (type . integer))
+		 ((tag . "Summary Selected Face")
+		  (doc . "\
+Face used for highlighting the current article in the summary buffer.")
+		  (name . gnus-summary-selected-face)
+		  (default . underline)
+		  (type . face))
+		 ((tag . "Summary Line Highlighting")
+		  (doc . "\
+Controls the higlighting of summary buffer lines. 
+
+Below is a list of `Form'/`Face' pairs.  When deciding how a a
+particular summary line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used.  You can change how those summary lines are displayed, by
+editing the face field.  
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions.  Hopefully this will
+change in a future release.  For now, you can use the following
+variables in the Lisp expression:
+
+score:   The article's score
+default: The default article score.
+below:   The score below which articles are automatically marked as read. 
+mark:    The article's mark.")
+		  (name . gnus-summary-highlight)
+		  (type . list)
+		  (calculate . (cond ((not (eq gnus-display-type 'color))
+				      '(((> score default) . bold)
+					((< score default) . italic)))
+				     ((eq gnus-background-mode 'dark)
+				      (list (cons '(= mark gnus-canceled-mark)
+						  (custom-face-lookup "yellow" "black" nil nil nil nil))
+					    (cons '(and (> score default) 
+							(or (= mark gnus-dormant-mark)
+							    (= mark gnus-ticked-mark)))
+						  (custom-face-lookup "pink" nil nil t nil nil))
+					    (cons '(and (< score default) 
+							(or (= mark gnus-dormant-mark)
+							    (= mark gnus-ticked-mark)))
+						  (custom-face-lookup "pink" nil nil nil t nil))
+					    (cons '(or (= mark gnus-dormant-mark)
+						       (= mark gnus-ticked-mark))
+						  (custom-face-lookup "pink" nil nil nil nil nil))
+
+					    (cons '(and (> score default) (= mark gnus-ancient-mark))
+						  (custom-face-lookup "dark blue" nil nil t nil nil))
+					    (cons '(and (< score default) (= mark gnus-ancient-mark))
+						  (custom-face-lookup "SkyBlue" nil nil nil t nil))
+					    (cons '(= mark gnus-ancient-mark)
+						  (custom-face-lookup "SkyBlue" nil nil nil nil nil))
+
+					    (cons '(and (> score default) (= mark gnus-unread-mark))
+						  (custom-face-lookup "white" nil nil t nil nil))
+					    (cons '(and (< score default) (= mark gnus-unread-mark))
+						  (custom-face-lookup "white" nil nil nil t nil))
+					    (cons '(= mark gnus-unread-mark)
+						  (custom-face-lookup "white" nil nil nil nil nil))
+
+					    (cons '(> score default) 'bold)
+					    (cons '(< score default) 'italic)))
+				     (t
+				      (list (cons '(= mark gnus-canceled-mark)
+						  (custom-face-lookup "yellow" "black" nil nil nil nil))
+					    (cons '(and (> score default) 
+							(or (= mark gnus-dormant-mark)
+							    (= mark gnus-ticked-mark)))
+						  (custom-face-lookup "firebrick" nil nil t nil nil))
+					    (cons '(and (< score default) 
+							(or (= mark gnus-dormant-mark)
+							    (= mark gnus-ticked-mark)))
+						  (custom-face-lookup "firebrick" nil nil nil t nil))
+					    (cons '(or (= mark gnus-dormant-mark)
+						       (= mark gnus-ticked-mark))
+						  (custom-face-lookup "firebrick" nil nil nil nil nil))
+
+					    (cons '(and (> score default) (= mark gnus-ancient-mark))
+						  (custom-face-lookup "RoyalBlue" nil nil t nil nil))
+					    (cons '(and (< score default) (= mark gnus-ancient-mark))
+						  (custom-face-lookup "RoyalBlue" nil nil nil t nil))
+					    (cons '(= mark gnus-ancient-mark)
+						  (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
+
+					    (cons '(and (> score default) (/= mark gnus-unread-mark))
+						  (custom-face-lookup "DarkGreen" nil nil t nil nil))
+					    (cons '(and (< score default) (/= mark gnus-unread-mark))
+						  (custom-face-lookup "DarkGreen" nil nil nil t nil))
+					    (cons '(/= mark gnus-unread-mark)
+						  (custom-face-lookup "DarkGreen" nil nil nil nil nil))
+
+					    (cons '(> score default) 'bold)
+					    (cons '(< score default) 'italic)))))
+		  (data ((type . repeat)
+			 (header . nil)
+			 (data (type . pair)
+			       (compact . t)
+			       (data ((type . sexp)
+				      (width . 60)
+				      (tag . "Form"))
+				     "\n            "
+				     ((type . face)
+				      (tag . "Face"))
+				     "\n")))))
+		 ;; Do not define `gnus-button-alist' before we have
+		 ;; some `complexity' attribute so we can hide it from
+		 ;; beginners. 
+		 )))))
+
+(defun gnus-custom-import-cite-face-list (custom alist)
+  ;; Backward compatible groking of light and dark.
+  (cond ((eq alist 'light)
+	 (setq alist (mapcar 'gnus-make-face gnus-face-light-name-list)))
+	((eq alist 'dark)
+	 (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list))))
+  (funcall (custom-super custom 'import) custom alist))
+
+;(defun gnus-custom-import-swap-alist (custom alist)
+;  ;; Swap key and value in CUSTOM ALIST.
+;  (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist)))
+;    (funcall (custom-super custom 'import) custom swap)))
+
+;(defun gnus-custom-export-swap-alist (custom alist)
+;  ;; Swap key and value in CUSTOM ALIST.
+;  (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist)))
+;    (funcall (custom-super custom 'export) custom swap)))
+
+(provide 'gnus-cus)
+
+;;; gnus-cus.el ends here

lisp/gnus-edit.el

@@ -0,0 +1,628 @@
+;;; gnus-edit.el --- Gnus SCORE file editing
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Keywords: news, help
+;; Version: 0.2
+
+;;; Commentary:
+;;
+;; Type `M-x gnus-score-customize RET' to invoke.
+
+;;; Code:
+
+(require 'custom)
+(require 'gnus-score)
+
+(defconst gnus-score-custom-data
+  '((tag . "Score")
+    (doc . "Customization of Gnus SCORE files.
+
+SCORE files allow you to assign a score to each article when you enter
+a group, and automatically mark the articles as read or delete them
+based on the score.  In the summary buffer you can use the score to
+sort the articles by score (`C-c C-s C-s') or to jump to the unread
+article with the highest score (`,').")
+    (type . group)
+    (data "\n"
+	  ((header . nil)
+	   (doc . "Name of SCORE file to customize.
+
+Enter the name in the `File' field, then push the [Load] button to
+load it.  When done editing, push the [Save] button to save the file.
+
+Several score files may apply to each group, and several groups may
+use the same score file.  This is controlled implicitly by the name of
+the score file and the value of the global variable
+`gnus-score-find-score-files-function', and explicitly by the the
+`Files' and `Exclude Files' entries.") 
+	   (compact . t)
+	   (type . group)
+	   (data ((tag . "Load")
+		  (type . button)
+		  (query . gnus-score-custom-load))
+		 ((tag . "Save")
+		  (type . button)
+		  (query . gnus-score-custom-save))
+		 ((name . file)
+		  (tag . "File")
+		  (directory . "~/News/")
+		  (default-file . "SCORE")
+		  (type . file))))
+	  ((name . files)
+	   (tag . "Files")
+	   (doc . "\
+List of score files to load when the the current score file is loaded.
+You can use this to share score entries between multiple score files.
+
+Push the `[INS]' button add a score file to the list, or `[DEL]' to
+delete a score file from the list.")
+	   (type . list)
+	   (data ((type . repeat)
+		  (header . nil)
+		  (data (type . file)
+			(directory . "~/News/")))))
+	  ((name . exclude-files)
+	   (tag . "Exclude Files")
+	   (doc . "\
+List of score files to exclude when the the current score file is loaded.
+You can use this if you have a score file you want to share between a
+number of newsgroups, except for the newsgroup this score file
+matches.  [ Did anyone get that? ]
+
+Push the `[INS]' button add a score file to the list, or `[DEL]' to
+delete a score file from the list.")
+	   (type . list)
+	   (data ((type . repeat)
+		  (header . nil)
+		  (data (type . file)
+			(directory . "~/News/")))))
+	  ((name . mark)
+	   (tag . "Mark")
+	   (doc . "\
+Articles below this score will be automatically marked as read.
+
+This means that when you enter the summary buffer, the articles will
+be shown but will already be marked as read.  You can then press `x'
+to get rid of them entirely.
+
+By default articles with a negative score will be marked as read.  To
+change this, push the `Mark' button, and choose `Integer'.  You can
+then enter a value in the `Mark' field.")
+	   (type . gnus-score-custom-maybe-type))
+	  ((name . expunge)
+	   (tag . "Expunge")
+	   (doc . "\
+Articles below this score will not be shown in the summary buffer.")
+	   (type . gnus-score-custom-maybe-type))
+	  ((name . mark-and-expunge)
+	   (tag . "Mark and Expunge")
+	   (doc . "\
+Articles below this score will be marked as read, but not shown.
+
+Someone should explain me the difference between this and `expunge'
+alone or combined with `mark'.")
+	   (type . gnus-score-custom-maybe-type))
+	  ((name . eval)
+	   (tag . "Eval")
+	   (doc . "\
+Evaluate this lisp expression when the entering summary buffer.")
+	   (type . sexp))
+	  ((name . read-only)
+	   (tag . "Read Only")
+	   (doc . "Read-only score files will not be updated or saved.
+Except from this buffer, of course!")
+	   (type . toggle))
+	  ((type . doc)
+	   (doc . "\
+Each news header has an associated list of score entries.  
+You can use the [INS] buttons to add new score entries anywhere in the
+list, or the [DEL] buttons to delete specific score entries.
+
+Each score entry should specify a string that should be matched with
+the content actual header in order to determine whether the entry
+applies to that header.  Enter that string in the `Match' field.
+
+If the score entry matches, the articles score will be adjusted with
+some amount.  Enter that amount in the in the `Score' field.  You
+should specify a positive amount for score entries that matches
+articles you find interesting, and a negative amount for score entries
+matching articles you would rather avoid.  The final score for the
+article will be the sum of the score of all score entries that match
+the article. 
+
+The score entry can be either permanent or expirable.  To make the
+entry permanent, push the `Date' button and choose the `Permanent'
+entry.  To make the entry expirable, choose instead the `Integer'
+entry.  After choosing the you can enter the date the score entry was
+last matched in the `Date' field.  The date will be automatically
+updated each time the score entry matches an article.  When the date
+become too old, the the score entry will be removed.
+
+For your convenience, the date is specified as the number of days
+elapsed since the (imaginary) Gregorian date Sunday, December 31, 1
+BC.
+
+Finally, you can choose what kind of match you want to perform by
+pushing the `Type' button.  For most entries you can choose between
+`Exact' which mean the header content must be exactly identical to the
+match string, or `Substring' meaning the match string should be
+somewhere in the header content, or even `Regexp' to use Emacs regular
+expression matching.  The last choice is `Fuzzy' which is like `Exact'
+except that whitespace derivations, a beginning `Re:' or a terminating
+parenthetical remark are all ignored.  Each of the four types have a
+variant which will ignore case in the comparison.  That variant is
+indicated with a `(fold)' after its name."))
+	  ((name . from)
+	   (tag . "From")
+	   (doc . "Scoring based on the authors email address.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . subject)
+	   (tag . "Subject")
+	   (doc . "Scoring based on the articles subject.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . followup)
+	   (tag . "Followup")
+	   (doc . "Scoring based on who the article is a followup to.
+
+If you want to see all followups to your own articles, add an entry
+with a positive score matching your email address here.  You can also
+put an entry with a negative score matching someone who is so annoying
+that you don't even want to see him quoted in followups.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . xref)
+	   (tag . "Xref")
+	   (doc . "Scoring based on article crossposting.
+
+If you want to score based on which newsgroups an article is posted
+to, this is the header to use.  The syntax is a little different from
+the `Newsgroups' header, but scoring in `Xref' is much faster.  As an
+example, to match all crossposted articles match on `:.*:' using the
+`Regexp' type.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . references)
+	   (tag . "References")
+	   (doc . "Scoring based on article references.
+
+The `References' header gives you an alternative way to score on
+followups.  If you for example want to see follow all discussions
+where people from `iesd.auc.dk' school participate, you can add a
+substring match on `iesd.auc.dk>' on this header.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . message-id)
+	   (tag . "Message-ID")
+	   (doc . "Scoring based on the articles message-id.
+
+This isn't very useful, but Lars like completeness.  You can use it to
+match all messaged generated by recent Gnus version with a `Substring'
+match on `.fsf@'.")
+	   (type . gnus-score-custom-string-type))
+	  ((type . doc)
+	   (doc . "\
+WARNING:  Scoring on the following three pseudo headers is very slow!
+Scoring on any of the real headers use a technique that avoids
+scanning the entire article, only the actual headers you score on are
+scanned, and this scanning has been heavily optimized.  Using just a
+single entry for one the three pseudo-headers `Head', `Body', and
+`All' will require GNUS to retrieve and scan the entire article, which
+can be very slow on large groups.  However, if you add one entry for
+any of these headers, you can just as well add several.  Each
+subsequent entry cost relatively little extra time."))
+	  ((name . head)
+	   (tag . "Head")
+	   (doc . "Scoring based on the article header.
+
+Instead of matching the content of a single header, the entire header
+section of the article is matched.  You can use this to match on
+arbitrary headers, foe example to single out TIN lusers, use a substring
+match on `Newsreader: TIN'.  That should get 'em!")
+	   (type . gnus-score-custom-string-type))
+	  ((name . body)
+	   (tag . "Body")
+	   (doc . "Scoring based on the article body.
+
+If you think any article that mentions `Kibo' is inherently
+interesting, do a substring match on His name.  You Are Allowed.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . all)
+	   (tag . "All")
+	   (doc . "Scoring based on the whole article.")
+	   (type . gnus-score-custom-string-type))
+	  ((name . date)
+	   (tag . "Date")
+	   (doc . "Scoring based on article date.
+
+You can change the score of articles that have been posted before,
+after, or at a specific date.  You should add the date in the `Match'
+field, and then select `before', `after', or `at' by pushing the
+`Type' button.  Imagine you want to lower the score of very old
+articles, or want to raise the score of articles from the future (such
+things happen!).  Then you can't use date scoring for that.  In fact,
+I can't imagine anything you would want to use this for.   
+
+For your convenience, the date is specified in Usenet date format.")
+	   (type . gnus-score-custom-date-type))
+	  ((type . doc)
+	   (doc . "\
+The Lines and Chars headers use integer based scoring.  
+
+This means that you should write an integer in the `Match' field, and
+the push the `Type' field to if the `Chars' or `Lines' header should
+be larger, equal, or smaller than the number you wrote in the match
+field."))
+	  ((name . chars)
+	   (tag . "Characters")
+	   (doc . "Scoring based on the number of characters in the article.")
+	   (type . gnus-score-custom-integer-type))
+	  ((name . lines)
+	   (tag . "Lines")
+	   (doc . "Scoring based on the number of lines in the article.")
+	   (type . gnus-score-custom-integer-type))
+	  ((name . orphan)
+	   (tag . "Orphan")
+	   (doc . "Score to add to articles with no parents.")
+	   (type . gnus-score-custom-maybe-type))
+	  ((name . adapt)
+	   (tag . "Adapt")
+	   (doc . "Adapting the score files to your newsreading habits.
+
+When you have finished reading a group GNUS can automatically create
+new score entries based on which articles you read and which you
+skipped.  This is normally controled by the two global variables
+`gnus-use-adaptive-scoring' and `gnus-default-adaptive-score-alist',
+The first determines whether adaptive scoring should be enabled or
+not, while the second determines what score entries should be created.
+
+You can overwrite the setting of `gnus-use-adaptive-scoring' by
+selecting `Enable' or `Disable' by pressing the `Adapt' button.
+Selecting `Custom' will allow you to specify the exact adaption
+rules (overwriting `gnus-default-adaptive-score-alist').")
+	   (type . choice)
+	   (data ((tag . "Default")
+		  (default . nil)
+		  (type . const))
+		 ((tag . "Enable")
+		  (default . t)
+		  (type . const))
+		 ((tag . "Disable")
+		  (default . ignore)
+		  (type . const))
+		 ((tag . "Custom")
+		  (doc . "Customization of adaptive scoring.
+
+Each time you read an article it will be marked as read.  Likewise, if
+you delete it it will be marked as deleted, and if you tick it it will
+be marked as ticked.  When you leave a group, GNUS can automatically
+create score file entries based on these marks, so next time you enter
+the group articles with subjects that you read last time have higher
+score and articles with subjects that deleted will have lower score.  
+
+Below is a list of such marks.  You can insert new marks to the list
+by pushing on one of the `[INS]' buttons in the left margin to create
+a new entry and then pushing the `Mark' button to select the mark.
+For each mark there is another list, this time of article headers,
+which determine how the mark should affect that header.  The `[INS]'
+buttons of this list are indented to indicate that the belong to the
+mark above.  Push the `Header' button to choose a header, and then
+enter a score value in the `Score' field.   
+
+For each article that are marked with `Mark' when you leave the
+group, a temporary score entry for the articles `Header' with the
+value of `Score' will be added the adapt file.  If the score entry
+already exists, `Score' will be added to its value.  If you understood
+that, you are smart.
+
+You can select the special value `Other' when pressing the `Mark' or
+`Header' buttons.  This is because Lars might add more useful values
+there.  If he does, it is up to you to figure out what they are named.")
+		  (type . list)
+		  (default . ((__uninitialized__)))
+		  (data ((type . repeat)
+			 (header . nil)
+			 (data . ((type . list)
+				  (header . nil)
+				  (compact . t)
+				  (data ((type . choice)
+					 (tag . "Mark")
+					 (data ((tag . "Unread")
+						(default . gnus-unread-mark)
+						(type . const))
+					       ((tag . "Ticked")
+						(default . gnus-ticked-mark)
+						(type . const))
+					       ((tag . "Dormant")
+						(default . gnus-dormant-mark)
+						(type . const))
+					       ((tag . "Deleted")
+						(default . gnus-del-mark)
+						(type . const))
+					       ((tag . "Read")
+						(default . gnus-read-mark)
+						(type . const))
+					       ((tag . "Expirable")
+						(default . gnus-expirable-mark)
+						(type . const))
+					       ((tag . "Killed")
+						(default . gnus-killed-mark)
+						(type . const))
+					       ((tag . "Kill-file")
+						(default . gnus-kill-file-mark)
+						(type . const))
+					       ((tag . "Low-score")
+						(default . gnus-low-score-mark)
+						(type . const))
+					       ((tag . "Catchup")
+						(default . gnus-catchup-mark)
+						(type . const))
+					       ((tag . "Ancient")
+						(default . gnus-ancient-mark)
+						(type . const))
+					       ((tag . "Canceled")
+						(default . gnus-canceled-mark)
+						(type . const))
+					       ((prompt . "Other")
+						(default . ??)
+						(type . sexp))))
+					((type . repeat)
+					 (prefix . "            ")
+					 (data . ((type . list)
+						  (compact . t)
+						  (data ((tag . "Header")
+							 (type . choice)
+							 (data ((tag . "Subject")
+								(default . subject)
+								(type . const))
+							       ((prompt . "From")
+								(tag . "From   ")
+								(default . from)
+								(type . const))
+							       ((prompt . "Other")
+								(width . 7)
+								(default . nil)
+								(type . symbol))))
+							((tag . "Score")
+							 (type . integer))))))))))))))
+	  ((name . local)
+	   (tag . "Local")
+	   (doc . "\
+List of local variables to set when this score file is loaded.
+
+Using this entry can provide a convenient way to set variables that
+will affect the summary mode for only some specific groups, i.e. those
+groups matched by the current score file.")
+	   (type . list)
+	   (data ((type . repeat)
+		  (header . nil)
+		  (data . ((type . list)
+			   (compact . t)
+			   (data ((tag . "Name")
+				  (width . 26)
+				  (type . symbol))
+				 ((tag . "Value")
+				  (width . 26)
+				  (type . sexp)))))))))))
+
+(defconst gnus-score-custom-type-properties
+  '((gnus-score-custom-maybe-type
+     (type . choice)
+     (data ((type . integer)
+	    (default . 0))
+	   ((tag . "Default")
+	    (type . const)
+	    (default . nil))))
+    (gnus-score-custom-string-type
+     (type . list)
+     (data ((type . repeat)
+	    (header . nil)
+	    (data . ((type . list)
+		     (compact . t)
+		     (data ((tag . "Match")
+			    (width . 59)
+			    (type . string))
+			   "\n            "
+			   ((tag . "Score")
+			    (type . integer))
+			   ((tag . "Date")
+			    (type . choice)
+			    (data ((type . integer)
+				   (default . 0)
+				   (width . 9))
+				  ((tag . "Permanent")
+				   (type . const)
+				   (default . nil))))
+			   ((tag . "Type")
+			    (type . choice)
+			    (data ((tag . "Exact")
+				   (default . E)
+				   (type . const))
+				  ((tag . "Substring")
+				   (default . S) 
+				   (type . const))
+				  ((tag . "Regexp")
+				   (default . R)
+				   (type . const))
+				  ((tag . "Fuzzy")
+				   (default . F)
+				   (type . const))
+				  ((tag . "Exact (fold)")
+				   (default . e)
+				   (type . const))
+				  ((tag . "Substring (fold)")
+				   (default . s) 
+				   (type . const))
+				  ((tag . "Regexp (fold)")
+				   (default . r)
+				   (type . const))
+				  ((tag . "Fuzzy  (fold)")
+				   (default . f)
+				   (type . const))))))))))
+    (gnus-score-custom-integer-type
+     (type . list)
+     (data ((type . repeat)
+	    (header . nil)
+	    (data . ((type . list)
+		     (compact . t)
+		     (data ((tag . "Match")
+			    (type . integer))
+			   ((tag . "Score")
+			    (type . integer))
+			   ((tag . "Date")
+			    (type . choice)
+			    (data ((type . integer)
+				   (default . 0)
+				   (width . 9))
+				  ((tag . "Permanent")
+				   (type . const)
+				   (default . nil))))
+			   ((tag . "Type")
+			    (type . choice)
+			    (data ((tag . "<")
+				   (default . <)
+				   (type . const))
+				  ((tag . ">")
+				   (default . >) 
+				   (type . const))
+				  ((tag . "=")
+				   (default . =)
+				   (type . const))
+				  ((tag . ">=")
+				   (default . >=)
+				   (type . const))
+				  ((tag . "<=")
+				   (default . <=)
+				   (type . const))))))))))
+    (gnus-score-custom-date-type
+     (type . list)
+     (data ((type . repeat)
+	    (header . nil)
+	    (data . ((type . list)
+		     (compact . t)
+		     (data ((tag . "Match")
+			    (width . 59)
+			    (type . string))
+			   "\n           "
+			   ((tag . "Score")
+			    (type . integer))
+			   ((tag . "Date")
+			    (type . choice)
+			    (data ((type . integer)
+				   (default . 0)
+				   (width . 9))
+				  ((tag . "Permanent")
+				   (type . const)
+				   (default . nil))))
+			   ((tag . "Type")
+			    (type . choice)
+			    (data ((tag . "Before")
+				   (default . before)
+				   (type . const))
+				  ((tag . "After")
+				   (default . after) 
+				   (type . const))
+				  ((tag . "At")
+				   (default . at)
+				   (type . const))))))))))))
+
+(defvar gnus-score-custom-file nil
+  "Name of SCORE file being customized.")
+
+(defun gnus-score-customize ()
+  "Create a buffer for editing gnus SCORE files."
+  (interactive)
+  (let (gnus-score-alist)
+    (custom-buffer-create "*Score Edit*" gnus-score-custom-data
+			  gnus-score-custom-type-properties
+			  'gnus-score-custom-set
+			  'gnus-score-custom-get
+			  'gnus-score-custom-save))
+  (make-local-variable 'gnus-score-custom-file)
+  (setq gnus-score-custom-file (expand-file-name  "SCORE" "~/News"))
+  (make-local-variable 'gnus-score-alist)
+  (setq gnus-score-alist nil)
+  (custom-reset-all))
+
+(defun gnus-score-custom-get (name)
+  (if (eq name 'file)
+      gnus-score-custom-file
+    (let ((entry (assoc (symbol-name name) gnus-score-alist)))
+      (if entry 
+	  (mapcar 'gnus-score-custom-sanify (cdr entry))
+	(setq entry (assoc name gnus-score-alist))
+	(if (or (memq name '(files exclude-files local))
+		(and (eq name 'adapt)
+		     (not (symbolp (car (cdr entry))))))
+	    (cdr entry)
+	  (car (cdr entry)))))))
+
+(defun gnus-score-custom-set (name value)
+  (cond ((eq name 'file)
+	 (setq gnus-score-custom-file value))
+	((assoc (symbol-name name) gnus-score-alist)
+	 (if value
+	     (setcdr (assoc (symbol-name name) gnus-score-alist) value)
+	   (setq gnus-score-alist (delq (assoc (symbol-name name) 
+					       gnus-score-alist) 
+					gnus-score-alist))))
+	((assoc (symbol-name name) gnus-header-index)
+	 (if value
+	     (setq gnus-score-alist 
+		   (cons (cons (symbol-name name) value) gnus-score-alist))))
+	((assoc name gnus-score-alist)
+	 (cond ((null value)
+		(setq gnus-score-alist (delq (assoc name gnus-score-alist)
+					     gnus-score-alist)))
+	       ((and (listp value) (not (eq name 'eval)))
+		(setcdr (assoc name gnus-score-alist) value))
+	       (t
+		(setcdr (assoc name gnus-score-alist) (list value)))))
+	((null value))
+	((and (listp value) (not (eq name 'eval)))
+	 (setq gnus-score-alist (cons (cons name value) gnus-score-alist)))
+	(t
+	 (setq gnus-score-alist 
+	       (cons (cons name (list value)) gnus-score-alist)))))
+
+(defun gnus-score-custom-sanify (entry)
+  (list (nth 0 entry)
+	(or (nth 1 entry) gnus-score-interactive-default-score)
+	(nth 2 entry)
+	(cond ((null (nth 3 entry))
+	       's)
+	      ((memq (nth 3 entry) '(before after at >= <=))
+	       (nth 3 entry))
+	      (t
+	       (intern (substring (symbol-name (nth 3 entry)) 0 1))))))
+
+(defvar gnus-score-cache nil)
+
+(defun gnus-score-custom-load ()
+  (interactive)
+  (let ((file (custom-name-value 'file)))
+    (if (eq file custom-nil)
+	(error "You must specify a file name"))
+    (setq file (expand-file-name file "~/News"))
+    (gnus-score-load file)
+    (setq gnus-score-custom-file file)
+    (custom-reset-all)
+    (message "Loaded")))
+
+(defun gnus-score-custom-save ()
+  (interactive)
+  (custom-apply-all)
+  (gnus-score-remove-from-cache gnus-score-custom-file)
+  (let ((file gnus-score-custom-file)
+	(score gnus-score-alist)
+	emacs-lisp-mode-hook)
+    (save-excursion
+      (set-buffer (get-buffer-create "*Score*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (pp score (current-buffer))
+      (gnus-make-directory (file-name-directory file))
+      (write-region (point-min) (point-max) file nil 'silent)
+      (kill-buffer (current-buffer))))
+  (message "Saved"))
+
+(provide 'gnus-edit)
+
+;;; gnus-edit.el end here

lisp/gnus-ems.el

@@ -0,0 +1,693 @@
+;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(defvar gnus-mouse-2 [mouse-2])
+(defvar gnus-group-mode-hook ())
+(defvar gnus-summary-mode-hook ())
+(defvar gnus-article-mode-hook ())
+
+(defalias 'gnus-make-overlay 'make-overlay)
+(defalias 'gnus-overlay-put 'overlay-put)
+(defalias 'gnus-move-overlay 'move-overlay)
+
+(or (fboundp 'mail-file-babyl-p)
+    (fset 'mail-file-babyl-p 'rmail-file-p))
+
+;; Don't warn about these undefined variables.
+					;defined in gnus.el
+(defvar gnus-active-hashtb)
+(defvar gnus-article-buffer)
+(defvar gnus-auto-center-summary)
+(defvar gnus-buffer-list)
+(defvar gnus-current-headers)
+(defvar gnus-level-killed)
+(defvar gnus-level-zombie)
+(defvar gnus-newsgroup-bookmarks)
+(defvar gnus-newsgroup-dependencies)
+(defvar gnus-newsgroup-headers-hashtb-by-number)
+(defvar gnus-newsgroup-selected-overlay)
+(defvar gnus-newsrc-hashtb)
+(defvar gnus-read-mark)
+(defvar gnus-refer-article-method)
+(defvar gnus-reffed-article-number)
+(defvar gnus-unread-mark)
+(defvar gnus-version)
+(defvar gnus-view-pseudos)
+(defvar gnus-view-pseudos-separately)
+(defvar gnus-visual)
+(defvar gnus-zombie-list)
+					;defined in gnus-msg.el
+(defvar gnus-article-copy)
+(defvar gnus-check-before-posting)
+					;defined in gnus-vis.el
+(defvar gnus-article-button-face)
+(defvar gnus-article-mouse-face)
+(defvar gnus-summary-selected-face)
+
+
+;; We do not byte-compile this file, because error messages are such a
+;; bore.  
+
+(defun gnus-set-text-properties-xemacs (start end props &optional buffer)
+  "You should NEVER use this function.  It is ideologically blasphemous.
+It is provided only to ease porting of broken FSF Emacs programs."
+  (if (and (stringp buffer) (not (setq buffer (get-buffer buffer))))
+      nil
+    (map-extents (lambda (extent ignored)
+		   (remove-text-properties 
+		    start end
+		    (list (extent-property extent 'text-prop) nil)
+		    buffer))
+		 buffer start end nil nil 'text-prop)
+    (add-text-properties start end props buffer)))
+
+(eval
+ '(progn
+    (if (string-match "XEmacs\\|Lucid" emacs-version)
+	()
+      ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+      (defvar gnus-display-type 
+	(condition-case nil
+	    (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
+	      (cond (display-resource (intern (downcase display-resource)))
+		    ((x-display-color-p) 'color)
+		    ((x-display-grayscale-p) 'grayscale)
+		    (t 'mono)))
+	  (error 'mono))
+	"A symbol indicating the display Emacs is running under.
+The symbol should be one of `color', `grayscale' or `mono'. If Emacs
+guesses this display attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.displayType' in your
+`~/.Xdefaults'. See also `gnus-background-mode'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves.")
+
+      (defvar gnus-background-mode 
+	(condition-case nil
+	    (let ((bg-resource (x-get-resource ".backgroundMode"
+					       "BackgroundMode"))
+		  (params (frame-parameters)))
+	      (cond (bg-resource (intern (downcase bg-resource)))
+		    ((and (cdr (assq 'background-color params))
+			  (< (apply '+ (x-color-values
+					(cdr (assq 'background-color params))))
+			     (/ (apply '+ (x-color-values "white")) 3)))
+		     'dark)
+		    (t 'light)))
+	  (error 'light))
+	"A symbol indicating the Emacs background brightness.
+The symbol should be one of `light' or `dark'.
+If Emacs guesses this frame attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
+`~/.Xdefaults'.
+See also `gnus-display-type'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves."))
+
+    (cond 
+     ((string-match "XEmacs\\|Lucid" emacs-version)
+      ;; XEmacs definitions.
+
+      (setq gnus-mouse-2 [button2])
+
+      (or (memq 'underline (list-faces))
+	  (and (fboundp 'make-face)
+	       (funcall (intern "make-face") 'underline)))
+      ;; Must avoid calling set-face-underline-p directly, because it
+      ;; is a defsubst in emacs19, and will make the .elc files non
+      ;; portable!
+      (or (face-differs-from-default-p 'underline)
+	  (funcall 'set-face-underline-p 'underline t))
+
+      (defalias 'gnus-make-overlay 'make-extent)
+      (defalias 'gnus-overlay-put 'set-extent-property)
+      (defun gnus-move-overlay (extent start end &optional buffer)
+	(set-extent-endpoints extent start end))
+      
+      (require 'text-props)
+      (fset 'set-text-properties 'gnus-set-text-properties-xemacs)
+
+      (or (boundp 'standard-display-table) (setq standard-display-table nil))
+      (or (boundp 'read-event) (fset 'read-event 'next-command-event))
+
+      ;; Fix by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
+      (defvar gnus-display-type (device-class)
+	"A symbol indicating the display Emacs is running under.
+The symbol should be one of `color', `grayscale' or `mono'. If Emacs
+guesses this display attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.displayType' in your
+`~/.Xdefaults'. See also `gnus-background-mode'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves.")
+
+
+      (or (fboundp 'x-color-values)
+	  (fset 'x-color-values 
+		(lambda (color)
+		  (color-instance-rgb-components
+		   (make-color-instance color)))))
+    
+      (defvar gnus-background-mode 
+	(let ((bg-resource 
+	       (condition-case ()
+		   (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
+		 (error nil)))
+	      (params (frame-parameters)))
+	  (cond (bg-resource (intern (downcase bg-resource)))
+		((and (assq 'background-color params)
+		      (< (apply '+ (x-color-values
+				    (cdr (assq 'background-color params))))
+			 (/ (apply '+ (x-color-values "white")) 3)))
+		 'dark)
+		(t 'light)))
+	"A symbol indicating the Emacs background brightness.
+The symbol should be one of `light' or `dark'.
+If Emacs guesses this frame attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
+`~/.Xdefaults'.
+See also `gnus-display-type'.
+
+This is a meta-variable that will affect what default values other
+variables get.  You would normally not change this variable, but
+pounce directly on the real variables themselves.")
+
+
+      (defun gnus-install-mouse-tracker ()
+	(require 'mode-motion)
+	(setq mode-motion-hook 'mode-motion-highlight-line)))
+
+     ((and (not (string-match "28.9" emacs-version)) 
+	   (not (string-match "29" emacs-version)))
+      ;; Remove the `intangible' prop.
+      (let ((props (and (boundp 'gnus-hidden-properties) 
+			gnus-hidden-properties)))
+	(while (and props (not (eq (car (cdr props)) 'intangible)))
+	  (setq props (cdr props)))
+	(and props (setcdr props (cdr (cdr (cdr props))))))
+      (or (fboundp 'buffer-substring-no-properties)
+	  (defun buffer-substring-no-properties (beg end)
+	    (format "%s" (buffer-substring beg end)))))
+   
+     ((boundp 'MULE)
+      (provide 'gnusutil))
+   
+     )))
+
+(eval-and-compile
+  (cond
+   ((not window-system)
+    (defun gnus-dummy-func (&rest args))
+    (let ((funcs '(mouse-set-point set-face-foreground
+				   set-face-background x-popup-menu)))
+      (while funcs
+	(or (fboundp (car funcs))
+	    (fset (car funcs) 'gnus-dummy-func))
+	(setq funcs (cdr funcs))))))
+  (or (fboundp 'file-regular-p)
+      (defun file-regular-p (file)
+	(and (not (file-directory-p file))
+	     (not (file-symlink-p file))
+	     (file-exists-p file))))
+  (or (fboundp 'face-list)
+      (defun face-list (&rest args)))
+  )
+
+(defun gnus-highlight-selected-summary-xemacs ()
+  ;; Highlight selected article in summary buffer
+  (if gnus-summary-selected-face
+      (progn
+	(if gnus-newsgroup-selected-overlay
+	    (delete-extent gnus-newsgroup-selected-overlay))
+	(setq gnus-newsgroup-selected-overlay 
+	      (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
+	(set-extent-face gnus-newsgroup-selected-overlay
+			 gnus-summary-selected-face))))
+
+(defun gnus-summary-recenter-xemacs ()
+  (let* ((top (cond ((< (window-height) 4) 0)
+		    ((< (window-height) 7) 1)
+		    (t 2)))
+	 (height (- (window-height) 2))
+	 (bottom (save-excursion (goto-char (point-max))
+				 (forward-line (- height))
+				 (point)))
+	 (window (get-buffer-window (current-buffer))))
+    (and 
+     ;; The user has to want it,
+     gnus-auto-center-summary 
+     ;; the article buffer must be displayed,
+     (get-buffer-window gnus-article-buffer)
+     ;; Set the window start to either `bottom', which is the biggest
+     ;; possible valid number, or the second line from the top,
+     ;; whichever is the least.
+     (set-window-start
+      window (min bottom (save-excursion (forward-line (- top)) 
+					 (point)))))))
+
+(defun gnus-group-insert-group-line-info-xemacs (group)
+  (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 
+	(beg (point))
+	active info)
+    (if entry
+	(progn
+	  (setq info (nth 2 entry))
+	  (gnus-group-insert-group-line 
+	   nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
+      (setq active (gnus-gethash group gnus-active-hashtb))
+	  
+      (gnus-group-insert-group-line 
+       nil group (if (member group gnus-zombie-list) gnus-level-zombie
+		   gnus-level-killed)
+       nil (if active (- (1+ (cdr active)) (car active)) 0) nil))
+    (save-excursion
+      (goto-char beg)
+      (remove-text-properties 
+       (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
+       '(gnus-group nil)))))
+
+(defun gnus-summary-refer-article-xemacs (message-id)
+  "Refer article specified by MESSAGE-ID.
+NOTE: This command only works with newsgroups that use real or simulated NNTP."
+  (interactive "sMessage-ID: ")
+  (if (or (not (stringp message-id))
+	  (zerop (length message-id)))
+      ()
+    ;; Construct the correct Message-ID if necessary.
+    ;; Suggested by tale@pawl.rpi.edu.
+    (or (string-match "^<" message-id)
+	(setq message-id (concat "<" message-id)))
+    (or (string-match ">$" message-id)
+	(setq message-id (concat message-id ">")))
+    (let ((header (car (gnus-gethash (downcase message-id)
+				     gnus-newsgroup-dependencies))))
+      (if header
+	  (or (gnus-summary-goto-article (mail-header-number header))
+	      ;; The header has been read, but the article had been
+	      ;; expunged, so we insert it again.
+	      (let ((beg (point)))
+		(gnus-summary-insert-line
+		 nil header 0 nil gnus-read-mark nil nil
+		 (mail-header-subject header))
+		(save-excursion
+		  (goto-char beg)
+		  (remove-text-properties
+		   (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
+		   '(gnus-number nil gnus-mark nil gnus-level nil)))
+		(forward-line -1)
+		(mail-header-number header)))
+	(let ((gnus-override-method gnus-refer-article-method)
+	      (gnus-ancient-mark gnus-read-mark)
+	      (tmp-point (window-start
+			  (get-buffer-window gnus-article-buffer)))
+	      number tmp-buf)
+	  (and gnus-refer-article-method
+	       (gnus-check-server gnus-refer-article-method))
+	  ;; Save the old article buffer.
+	  (save-excursion
+	    (set-buffer gnus-article-buffer)
+	    (gnus-kill-buffer " *temp Article*")
+	    (setq tmp-buf (rename-buffer " *temp Article*")))
+	  (prog1
+	      (if (gnus-article-prepare 
+		   message-id nil (gnus-read-header message-id))
+		  (progn
+		    (setq number (mail-header-number gnus-current-headers))
+		    (gnus-rebuild-thread message-id)
+		    (gnus-summary-goto-subject number)
+		    (gnus-summary-recenter)
+		    (gnus-article-set-window-start 
+		     (cdr (assq number gnus-newsgroup-bookmarks)))
+		    message-id)
+		;; We restore the old article buffer.
+		(save-excursion
+		  (kill-buffer gnus-article-buffer)
+		  (set-buffer tmp-buf)
+		  (rename-buffer gnus-article-buffer)
+		  (let ((buffer-read-only nil))
+		    (and tmp-point
+			 (set-window-start (get-buffer-window (current-buffer))
+					   tmp-point)))))))))))
+
+(defun gnus-summary-insert-pseudos-xemacs (pslist &optional not-view)
+  (let ((buffer-read-only nil)
+	(article (gnus-summary-article-number))
+	b)
+    (or (gnus-summary-goto-subject article)
+	(error (format "No such article: %d" article)))
+    (or gnus-newsgroup-headers-hashtb-by-number
+	(gnus-make-headers-hashtable-by-number))
+    (gnus-summary-position-cursor)
+    ;; If all commands are to be bunched up on one line, we collect
+    ;; them here.  
+    (if gnus-view-pseudos-separately
+	()
+      (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
+	    files action)
+	(while ps
+	  (setq action (cdr (assq 'action (car ps))))
+	  (setq files (list (cdr (assq 'name (car ps)))))
+	  (while (and ps (cdr ps)
+		      (string= (or action "1")
+			       (or (cdr (assq 'action (car (cdr ps)))) "2")))
+	    (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
+	    (setcdr ps (cdr (cdr ps))))
+	  (if (not files)
+	      ()
+	    (if (not (string-match "%s" action))
+		(setq files (cons " " files)))
+	    (setq files (cons " " files))
+	    (and (assq 'execute (car ps))
+		 (setcdr (assq 'execute (car ps))
+			 (funcall (if (string-match "%s" action)
+				      'format 'concat)
+				  action 
+				  (mapconcat (lambda (f) f) files " ")))))
+	  (setq ps (cdr ps)))))
+    (if (and gnus-view-pseudos (not not-view))
+	(while pslist
+	  (and (assq 'execute (car pslist))
+	       (gnus-execute-command (cdr (assq 'execute (car pslist)))
+				     (eq gnus-view-pseudos 'not-confirm)))
+	  (setq pslist (cdr pslist)))
+      (save-excursion
+	(while pslist
+	  (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist)))
+					 (gnus-summary-article-number)))
+	  (forward-line 1)
+	  (setq b (point))
+	  (insert "          " 
+		  (file-name-nondirectory (cdr (assq 'name (car pslist))))
+		  ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
+	  (add-text-properties 
+	   b (1+ b) (list 'gnus-number gnus-reffed-article-number
+			  'gnus-mark gnus-unread-mark 
+			  'gnus-level 0
+			  'gnus-pseudo (car pslist)))
+	  ;; Fucking XEmacs redisplay bug with truncated lines.
+	  (goto-char b)
+	  (sit-for 0)
+	  ;; Grumble.. Fucking XEmacs stickyness of text properties.
+	  (remove-text-properties
+	   (1+ b) (1+ (gnus-point-at-eol))
+	   '(gnus-number nil gnus-mark nil gnus-level nil))
+	  (forward-line -1)
+	  (gnus-sethash (int-to-string gnus-reffed-article-number)
+			(car pslist) gnus-newsgroup-headers-hashtb-by-number)
+	  (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
+	  (setq pslist (cdr pslist)))))))
+
+
+(defun gnus-copy-article-buffer-xemacs (&optional article-buffer)
+  (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
+  (buffer-disable-undo gnus-article-copy)
+  (or (memq gnus-article-copy gnus-buffer-list)
+      (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
+  (let ((article-buffer (or article-buffer gnus-article-buffer))
+	buf)
+    (if (and (get-buffer article-buffer)
+	     (buffer-name (get-buffer article-buffer)))
+	(save-excursion
+	  (set-buffer article-buffer)
+	  (widen)
+	  (setq buf (buffer-substring (point-min) (point-max)))
+	  (set-buffer gnus-article-copy)
+	  (erase-buffer)
+	  (insert (format "%s" buf))))))
+
+(defun gnus-article-push-button-xemacs (event)
+  "Check text under the mouse pointer for a callback function.
+If the text under the mouse pointer has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+  (interactive "e")
+  (set-buffer (window-buffer (event-window event)))
+  (let* ((pos (event-closest-point event))
+	 (data (get-text-property pos 'gnus-data))
+	 (fun (get-text-property pos 'gnus-callback)))
+    (if fun (funcall fun data))))
+
+;; Re-build the thread containing ID.
+(defun gnus-rebuild-thread-xemacs  (id)
+  (let ((dep gnus-newsgroup-dependencies)
+	(buffer-read-only nil)
+	parent headers refs thread art)
+    (while (and id (setq headers
+			 (car (setq art (gnus-gethash (downcase id) 
+						      dep)))))
+      (setq parent art)
+      (setq id (and (setq refs (mail-header-references headers))
+		    (string-match "\\(<[^>]+>\\) *$" refs)
+		    (substring refs (match-beginning 1) (match-end 1)))))
+    (setq thread (gnus-make-sub-thread (car parent)))
+    (gnus-rebuild-remove-articles thread)
+    (let ((beg (point)))
+      (gnus-summary-prepare-threads (list thread) 0)
+      (save-excursion
+	(while (and (>= (point) beg)
+		    (not (bobp)))
+	  (or (eobp)
+	      (remove-text-properties
+	       (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
+	       '(gnus-number nil gnus-mark nil gnus-level nil)))
+	  (forward-line -1)))
+      (gnus-summary-update-lines beg (point)))))
+
+
+;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
+(defun gnus-article-add-button-xemacs (from to fun &optional data)
+  "Create a button between FROM and TO with callback FUN and data DATA."
+  (and gnus-article-button-face
+       (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face))
+  (add-text-properties from to
+		       (append
+			(and gnus-article-mouse-face
+			     (list 'mouse-face gnus-article-mouse-face))
+			(list 'gnus-callback fun)
+			(and data (list 'gnus-data data))
+			(list 'highlight t))))
+
+(defun gnus-window-top-edge-xemacs (&optional window)
+  (nth 1 (window-pixel-edges window)))
+
+;; Select the lowest window on the frame.
+(defun gnus-appt-select-lowest-window-xemacs ()
+  (let* ((lowest-window (selected-window))
+	 (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges))))))
+         (last-window (previous-window))
+         (window-search t))
+    (while window-search
+      (let* ((this-window (next-window))
+             (next-bottom-edge (car (cdr (cdr (cdr 
+                                               (window-pixel-edges 
+						this-window)))))))
+        (if (< bottom-edge next-bottom-edge)
+            (progn
+              (setq bottom-edge next-bottom-edge)
+              (setq lowest-window this-window)))
+
+        (select-window this-window)
+        (if (eq last-window this-window)
+            (progn
+              (select-window lowest-window)
+              (setq window-search nil)))))))
+
+(defun gnus-ems-redefine ()
+  (cond 
+   ((string-match "XEmacs\\|Lucid" emacs-version)
+    ;; XEmacs definitions.
+    (fset 'gnus-mouse-face-function 'identity)
+    (fset 'gnus-summary-make-display-table (lambda () nil))
+    (fset 'gnus-visual-turn-off-edit-menu 'identity)
+    (fset 'gnus-highlight-selected-summary
+	  'gnus-highlight-selected-summary-xemacs)
+    (fset 'gnus-summary-recenter 'gnus-summary-recenter-xemacs)
+    (fset 'gnus-group-insert-group-line-info
+	  'gnus-group-insert-group-line-info-xemacs)
+    (fset 'gnus-copy-article-buffer 'gnus-copy-article-buffer-xemacs)
+    (fset 'gnus-summary-refer-article 'gnus-summary-refer-article-xemacs)
+    (fset 'gnus-summary-insert-pseudos 'gnus-summary-insert-pseudos-xemacs)
+    (fset 'gnus-article-push-button 'gnus-article-push-button-xemacs)
+    (fset 'gnus-rebuild-thread 'gnus-rebuild-thread-xemacs)
+    (fset 'gnus-article-add-button 'gnus-article-add-button-xemacs)
+    (fset 'gnus-window-top-edge 'gnus-window-top-edge-xemacs)
+    (fset 'set-text-properties 'gnus-set-text-properties-xemacs)
+
+    (or (fboundp 'appt-select-lowest-window)
+	(fset 'appt-select-lowest-window 
+	      'gnus-appt-select-lowest-window-xemacs))
+
+    (if (not gnus-visual)
+	()
+      (setq gnus-group-mode-hook
+	    (cons
+	     '(lambda ()
+		(easy-menu-add gnus-group-reading-menu)
+		(easy-menu-add gnus-group-group-menu)
+		(easy-menu-add gnus-group-misc-menu)
+		(gnus-install-mouse-tracker)) 
+	     gnus-group-mode-hook))
+      (setq gnus-summary-mode-hook
+	    (cons
+	     '(lambda ()
+		(easy-menu-add gnus-summary-article-menu)
+		(easy-menu-add gnus-summary-thread-menu)
+		(easy-menu-add gnus-summary-misc-menu)
+		(easy-menu-add gnus-summary-post-menu)
+		(easy-menu-add gnus-summary-kill-menu)
+		(gnus-install-mouse-tracker)) 
+	     gnus-summary-mode-hook))
+      (setq gnus-article-mode-hook
+	    (cons
+	     '(lambda ()
+		(easy-menu-add gnus-article-article-menu)
+		(easy-menu-add gnus-article-treatment-menu))
+	     gnus-article-mode-hook)))
+
+    (defvar gnus-logo (make-glyph (make-specifier 'image)))
+
+    (defun gnus-group-startup-xmessage (&optional x y)
+      "Insert startup message in current buffer."
+      ;; Insert the message.
+      (erase-buffer)
+      (if (featurep 'xpm)
+	  (progn
+	    (set-glyph-property gnus-logo 'image  "~/tmp/gnus.xpm")
+	    (set-glyph-image gnus-logo "~/tmp/gnus.xpm" 'global 'x)
+
+	    (insert " ")
+	    (set-extent-begin-glyph (make-extent (point) (point)) gnus-logo)
+	    (insert "
+   Gnus * A newsreader for Emacsen
+ A Praxis Release * larsi@ifi.uio.no")
+	    (goto-char (point-min))
+	    (while (not (eobp))
+	      (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
+				   ? ))
+	      (forward-line 1))
+	    (goto-char (point-min))
+	    ;; +4 is fuzzy factor.
+	    (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2)))
+
+	(insert
+	 (format "
+     %s
+           A newsreader 
+      for GNU Emacs
+
+        Based on GNUS 
+             written by 
+     Masanobu UMEDA
+
+       A Praxis Release
+      larsi@ifi.uio.no
+" 
+		 gnus-version))
+	;; And then hack it.
+	;; 18 is the longest line.
+	(indent-rigidly (point-min) (point-max) 
+			(/ (max (- (window-width) (or x 28)) 0) 2))
+	(goto-char (point-min))
+	;; +4 is fuzzy factor.
+	(insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
+
+      ;; Fontify some.
+      (goto-char (point-min))
+      (search-forward "Praxis")
+      (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
+      (goto-char (point-min)))
+
+
+
+    )
+
+   ((boundp 'MULE)
+    ;; Mule definitions
+    (if (not (fboundp 'truncate-string))
+	(defun truncate-string (str width)
+	  (let ((w (string-width str))
+		(col 0) (idx 0) (p-idx 0) chr)
+	    (if (<= w width)
+		str
+	      (while (< col width)
+		(setq chr (aref str idx)
+		      col (+ col (char-width chr))
+		      p-idx idx
+		      idx (+ idx (char-bytes chr))
+		      ))
+	      (substring str 0 (if (= col width)
+				   idx
+				 p-idx))
+	      )))
+      )
+    (defalias 'gnus-truncate-string 'truncate-string)
+
+    (defun gnus-cite-add-face (number prefix face)
+      ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
+      (if face
+	  (let ((inhibit-point-motion-hooks t)
+		from to)
+	    (goto-line number)
+	    (if (boundp 'MULE)
+		(forward-char (chars-in-string prefix))
+	      (forward-char (length prefix)))
+	    (skip-chars-forward " \t")
+	    (setq from (point))
+	    (end-of-line 1)
+	    (skip-chars-backward " \t")
+	    (setq to (point))
+	    (if (< from to)
+		(gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
+
+    (defun gnus-max-width-function (el max-width)
+      (` (let* ((val (eval (, el)))
+		(valstr (if (numberp val)
+			    (int-to-string val) val)))
+	   (if (> (length valstr) (, max-width))
+	       (truncate-string valstr (, max-width))
+	     valstr))))
+
+    (fset 'gnus-summary-make-display-table (lambda () nil))
+    
+    (if (boundp 'gnus-check-before-posting)
+	(setq gnus-check-before-posting
+	      (delq 'long-lines
+		    (delq 'control-chars gnus-check-before-posting)))
+      )
+    )
+   ))
+
+(provide 'gnus-ems)
+
+;; Local Variables:
+;; byte-compile-warnings: '(redefine callargs)
+;; End:
+
+;;; gnus-ems.el ends here

lisp/gnus-kill.el

@@ -0,0 +1,633 @@
+;;; gnus-kill.el --- kill commands for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+
+(defvar gnus-kill-file-mode-hook nil
+  "*A hook for Gnus kill file mode.")
+
+(defvar gnus-kill-expiry-days 7
+  "*Number of days before expiring unused kill file entries.")
+
+(defvar gnus-kill-save-kill-file nil
+  "*If non-nil, will save kill files after processing them.")
+
+(defvar gnus-winconf-kill-file nil)
+
+
+
+(defmacro gnus-raise (field expression level)
+  (` (gnus-kill (, field) (, expression)
+		(function (gnus-summary-raise-score (, level))) t)))
+
+(defmacro gnus-lower (field expression level)
+  (` (gnus-kill (, field) (, expression)
+		(function (gnus-summary-raise-score (- (, level)))) t)))
+
+;;;
+;;; Gnus Kill File Mode
+;;;
+
+(defvar gnus-kill-file-mode-map nil)
+
+(if gnus-kill-file-mode-map
+    nil
+  (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
+  (define-key gnus-kill-file-mode-map 
+    "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
+  (define-key gnus-kill-file-mode-map
+    "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
+  (define-key gnus-kill-file-mode-map
+    "\C-c\C-k\C-t" 'gnus-kill-file-kill-by-thread)
+  (define-key gnus-kill-file-mode-map 
+    "\C-c\C-k\C-x" 'gnus-kill-file-kill-by-xref)
+  (define-key gnus-kill-file-mode-map
+    "\C-c\C-a" 'gnus-kill-file-apply-buffer)
+  (define-key gnus-kill-file-mode-map
+    "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
+  (define-key gnus-kill-file-mode-map 
+    "\C-c\C-c" 'gnus-kill-file-exit))
+
+(defun gnus-kill-file-mode ()
+  "Major mode for editing kill files.
+
+If you are using this mode - you probably shouldn't.  Kill files
+perform badly and paint with a pretty broad brush.  Score files, on
+the other hand, are vastly faster (40x speedup) and give you more
+control over what to do.
+
+In addition to Emacs-Lisp Mode, the following commands are available:
+
+\\{gnus-kill-file-mode-map}
+
+  A kill file contains Lisp expressions to be applied to a selected
+newsgroup.  The purpose is to mark articles as read on the basis of
+some set of regexps.  A global kill file is applied to every newsgroup,
+and a local kill file is applied to a specified newsgroup.  Since a
+global kill file is applied to every newsgroup, for better performance
+use a local one.
+
+  A kill file can contain any kind of Emacs Lisp expressions expected
+to be evaluated in the Summary buffer.  Writing Lisp programs for this
+purpose is not so easy because the internal working of Gnus must be
+well-known.  For this reason, Gnus provides a general function which
+does this easily for non-Lisp programmers.
+
+  The `gnus-kill' function executes commands available in Summary Mode
+by their key sequences. `gnus-kill' should be called with FIELD,
+REGEXP and optional COMMAND and ALL.  FIELD is a string representing
+the header field or an empty string.  If FIELD is an empty string, the
+entire article body is searched for.  REGEXP is a string which is
+compared with FIELD value. COMMAND is a string representing a valid
+key sequence in Summary mode or Lisp expression. COMMAND defaults to
+'(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
+executed in the Summary buffer.  If the second optional argument ALL
+is non-nil, the COMMAND is applied to articles which are already
+marked as read or unread.  Articles which are marked are skipped over
+by default.
+
+  For example, if you want to mark articles of which subjects contain
+the string `AI' as read, a possible kill file may look like:
+
+	(gnus-kill \"Subject\" \"AI\")
+
+  If you want to mark articles with `D' instead of `X', you can use
+the following expression:
+
+	(gnus-kill \"Subject\" \"AI\" \"d\")
+
+In this example it is assumed that the command
+`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
+
+  It is possible to delete unnecessary headers which are marked with
+`X' in a kill file as follows:
+
+	(gnus-expunge \"X\")
+
+  If the Summary buffer is empty after applying kill files, Gnus will
+exit the selected newsgroup normally.  If headers which are marked
+with `D' are deleted in a kill file, it is impossible to read articles
+which are marked as read in the previous Gnus sessions.  Marks other
+than `D' should be used for articles which should really be deleted.
+
+Entry to this mode calls emacs-lisp-mode-hook and
+gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map gnus-kill-file-mode-map)
+  (set-syntax-table emacs-lisp-mode-syntax-table)
+  (setq major-mode 'gnus-kill-file-mode)
+  (setq mode-name "Kill")
+  (lisp-mode-variables nil)
+  (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
+
+(defun gnus-kill-file-edit-file (newsgroup)
+  "Begin editing a kill file for NEWSGROUP.
+If NEWSGROUP is nil, the global kill file is selected."
+  (interactive "sNewsgroup: ")
+  (let ((file (gnus-newsgroup-kill-file newsgroup)))
+    (gnus-make-directory (file-name-directory file))
+    ;; Save current window configuration if this is first invocation.
+    (or (and (get-file-buffer file)
+	     (get-buffer-window (get-file-buffer file)))
+	(setq gnus-winconf-kill-file (current-window-configuration)))
+    ;; Hack windows.
+    (let ((buffer (find-file-noselect file)))
+      (cond ((get-buffer-window buffer)
+	     (pop-to-buffer buffer))
+	    ((eq major-mode 'gnus-group-mode)
+	     (gnus-configure-windows 'group) ;Take all windows.
+	     (pop-to-buffer buffer))
+	    ((eq major-mode 'gnus-summary-mode)
+	     (gnus-configure-windows 'article)
+	     (pop-to-buffer gnus-article-buffer)
+	     (bury-buffer gnus-article-buffer)
+	     (switch-to-buffer buffer))
+	    (t				;No good rules.
+	     (find-file-other-window file))))
+    (gnus-kill-file-mode)))
+
+;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
+(defun gnus-kill-set-kill-buffer ()
+  (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
+	 (buffer (find-file-noselect file)))
+    (set-buffer buffer)
+    (gnus-kill-file-mode)
+    (bury-buffer buffer)))
+
+(defun gnus-kill-file-enter-kill (field regexp)
+  ;; Enter kill file entry.
+  ;; FIELD: String containing the name of the header field to kill.
+  ;; REGEXP: The string to kill.
+  (save-excursion
+    (let (string)
+      (or (eq major-mode 'gnus-kill-file-mode)
+	  (gnus-kill-set-kill-buffer))
+      (current-buffer)
+      (goto-char (point-max))
+      (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
+      (gnus-kill-file-apply-string string))))
+    
+(defun gnus-kill-file-kill-by-subject ()
+  "Kill by subject."
+  (interactive)
+  (gnus-kill-file-enter-kill
+   "Subject" 
+   (if (vectorp gnus-current-headers)
+       (regexp-quote 
+	(gnus-simplify-subject (mail-header-subject gnus-current-headers)))
+     "")))
+  
+(defun gnus-kill-file-kill-by-author ()
+  "Kill by author."
+  (interactive)
+  (gnus-kill-file-enter-kill
+   "From" 
+   (if (vectorp gnus-current-headers)
+       (regexp-quote (mail-header-from gnus-current-headers))
+     "")))
+ 
+(defun gnus-kill-file-kill-by-thread ()
+  "Kill by author."
+  (interactive "p")
+  (gnus-kill-file-enter-kill
+   "References" 
+   (if (vectorp gnus-current-headers)
+       (regexp-quote (mail-header-id gnus-current-headers))
+     "")))
+ 
+(defun gnus-kill-file-kill-by-xref ()
+  "Kill by Xref."
+  (interactive)
+  (let ((xref (and (vectorp gnus-current-headers) 
+		   (mail-header-xref gnus-current-headers)))
+	(start 0)
+	group)
+    (if xref
+	(while (string-match " \\([^ \t]+\\):" xref start)
+	  (setq start (match-end 0))
+	  (if (not (string= 
+		    (setq group 
+			  (substring xref (match-beginning 1) (match-end 1)))
+		    gnus-newsgroup-name))
+	      (gnus-kill-file-enter-kill 
+	       "Xref" (concat " " (regexp-quote group) ":"))))
+      (gnus-kill-file-enter-kill "Xref" ""))))
+
+(defun gnus-kill-file-raise-followups-to-author (level)
+  "Raise score for all followups to the current author."
+  (interactive "p")
+  (let ((name (mail-header-from gnus-current-headers))
+	string)
+    (save-excursion
+      (gnus-kill-set-kill-buffer)
+      (goto-char (point-min))
+      (setq name (read-string (concat "Add " level
+				      " to followup articles to: ")
+			      (regexp-quote name)))
+      (setq 
+       string
+       (format
+	"(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
+	"From" name level))
+      (insert string)
+      (gnus-kill-file-apply-string string))
+    (message "Added temporary score file entry for followups to %s." name)))
+
+(defun gnus-kill-file-apply-buffer ()
+  "Apply current buffer to current newsgroup."
+  (interactive)
+  (if (and gnus-current-kill-article
+	   (get-buffer gnus-summary-buffer))
+      ;; Assume newsgroup is selected.
+      (gnus-kill-file-apply-string (buffer-string))
+    (ding) (message "No newsgroup is selected.")))
+
+(defun gnus-kill-file-apply-string (string)
+  "Apply STRING to current newsgroup."
+  (interactive)
+  (let ((string (concat "(progn \n" string "\n)")))
+    (save-excursion
+      (save-window-excursion
+	(pop-to-buffer gnus-summary-buffer)
+	(eval (car (read-from-string string)))))))
+
+(defun gnus-kill-file-apply-last-sexp ()
+  "Apply sexp before point in current buffer to current newsgroup."
+  (interactive)
+  (if (and gnus-current-kill-article
+	   (get-buffer gnus-summary-buffer))
+      ;; Assume newsgroup is selected.
+      (let ((string
+	     (buffer-substring
+	      (save-excursion (forward-sexp -1) (point)) (point))))
+	(save-excursion
+	  (save-window-excursion
+	    (pop-to-buffer gnus-summary-buffer)
+	    (eval (car (read-from-string string))))))
+    (ding) (message "No newsgroup is selected.")))
+
+(defun gnus-kill-file-exit ()
+  "Save a kill file, then return to the previous buffer."
+  (interactive)
+  (save-buffer)
+  (let ((killbuf (current-buffer)))
+    ;; We don't want to return to article buffer.
+    (and (get-buffer gnus-article-buffer)
+	 (bury-buffer gnus-article-buffer))
+    ;; Delete the KILL file windows.
+    (delete-windows-on killbuf)
+    ;; Restore last window configuration if available.
+    (and gnus-winconf-kill-file
+	 (set-window-configuration gnus-winconf-kill-file))
+    (setq gnus-winconf-kill-file nil)
+    ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
+    (kill-buffer killbuf)))
+
+;; For kill files
+
+(defun gnus-Newsgroup-kill-file (newsgroup)
+  "Return the name of a kill file for NEWSGROUP.
+If NEWSGROUP is nil, return the global kill file instead."
+  (cond ((or (null newsgroup)
+	     (string-equal newsgroup ""))
+	 ;; The global kill file is placed at top of the directory.
+	 (expand-file-name gnus-kill-file-name
+			   (or gnus-kill-files-directory "~/News")))
+	(gnus-use-long-file-name
+	 ;; Append ".KILL" to capitalized newsgroup name.
+	 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
+				   "." gnus-kill-file-name)
+			   (or gnus-kill-files-directory "~/News")))
+	(t
+	 ;; Place "KILL" under the hierarchical directory.
+	 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+				   "/" gnus-kill-file-name)
+			   (or gnus-kill-files-directory "~/News")))))
+
+(defun gnus-expunge (marks)
+  "Remove lines marked with MARKS."
+  (save-excursion
+    (set-buffer gnus-summary-buffer)
+    (gnus-summary-remove-lines-marked-with marks)))
+
+(defun gnus-apply-kill-file-internal ()
+  "Apply a kill file to the current newsgroup.
+Returns the number of articles marked as read."
+  (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
+			   (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+	 (unreads (length gnus-newsgroup-unreads))
+	 (gnus-summary-inhibit-highlight t)
+	 beg)
+    (setq gnus-newsgroup-kill-headers nil)
+    (or gnus-newsgroup-headers-hashtb-by-number
+	(gnus-make-headers-hashtable-by-number))
+    ;; If there are any previously scored articles, we remove these
+    ;; from the `gnus-newsgroup-headers' list that the score functions
+    ;; will see. This is probably pretty wasteful when it comes to
+    ;; conses, but is, I think, faster than having to assq in every
+    ;; single score function.
+    (let ((files kill-files))
+      (while files
+	(if (file-exists-p (car files))
+	    (let ((headers gnus-newsgroup-headers))
+	      (if gnus-kill-killed
+		  (setq gnus-newsgroup-kill-headers
+			(mapcar (lambda (header) (mail-header-number header))
+				headers))
+		(while headers
+		  (or (gnus-member-of-range 
+		       (mail-header-number (car headers)) 
+		       gnus-newsgroup-killed)
+		      (setq gnus-newsgroup-kill-headers 
+			    (cons (mail-header-number (car headers))
+				  gnus-newsgroup-kill-headers)))
+		  (setq headers (cdr headers))))
+	      (setq files nil))
+ 	  (setq files (cdr files)))))
+    (if (not gnus-newsgroup-kill-headers)
+	()
+      (save-window-excursion
+	(save-excursion
+	  (while kill-files
+	    (if (not (file-exists-p (car kill-files)))
+		()
+	      (message "Processing kill file %s..." (car kill-files))
+	      (find-file (car kill-files))
+	      (gnus-add-current-to-buffer-list)
+	      (goto-char (point-min))
+
+	      (if (consp (condition-case nil (read (current-buffer)) 
+			   (error nil)))
+		  (gnus-kill-parse-gnus-kill-file)
+		(gnus-kill-parse-rn-kill-file))
+	    
+	      (message "Processing kill file %s...done" (car kill-files)))
+	    (setq kill-files (cdr kill-files)))))
+
+      (gnus-set-mode-line 'summary)
+
+      (if beg
+	  (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
+	    (or (eq nunreads 0)
+		(message "Marked %d articles as read" nunreads))
+	    nunreads)
+	0))))
+
+;; Parse a Gnus killfile.
+(defun gnus-score-insert-help (string alist idx)
+  (save-excursion
+    (pop-to-buffer "*Score Help*")
+    (buffer-disable-undo (current-buffer))
+    (erase-buffer)
+    (insert string ":\n\n")
+    (while alist
+      (insert (format " %c: %s\n" (car (car alist)) (nth idx (car alist))))
+      (setq alist (cdr alist)))))
+
+(defun gnus-kill-parse-gnus-kill-file ()
+  (goto-char (point-min))
+  (gnus-kill-file-mode)
+  (let (beg form)
+    (while (progn 
+	     (setq beg (point))
+	     (setq form (condition-case () (read (current-buffer))
+			  (error nil))))
+      (or (listp form)
+	  (error "Illegal kill entry (possibly rn kill file?): %s" form))
+      (if (or (eq (car form) 'gnus-kill)
+	      (eq (car form) 'gnus-raise)
+	      (eq (car form) 'gnus-lower))
+	  (progn
+	    (delete-region beg (point))
+	    (insert (or (eval form) "")))
+	(save-excursion
+	  (set-buffer gnus-summary-buffer)
+	  (condition-case () (eval form) (error nil)))))
+    (and (buffer-modified-p) 
+	 gnus-kill-save-kill-file
+	 (save-buffer))
+    (set-buffer-modified-p nil)))
+
+;; Parse an rn killfile.
+(defun gnus-kill-parse-rn-kill-file ()
+  (goto-char (point-min))
+  (gnus-kill-file-mode)
+  (let ((mod-to-header
+	 '((?a . "")
+	   (?h . "")
+	   (?f . "from")
+	   (?: . "subject")))
+	(com-to-com
+	 '((?m . " ")
+	   (?j . "X")))
+	pattern modifier commands)
+    (while (not (eobp))
+      (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)"))
+	  ()
+	(setq pattern (buffer-substring (match-beginning 1) (match-end 1)))
+	(setq modifier (if (match-beginning 2) (char-after (match-beginning 2))
+			 ?s))
+	(setq commands (buffer-substring (match-beginning 3) (match-end 3)))
+
+	;; The "f:+" command marks everything *but* the matches as read,
+	;; so we simply first match everything as read, and then unmark
+	;; PATTERN later. 
+	(and (string-match "\\+" commands)
+	     (progn
+	       (gnus-kill "from" ".")
+	       (setq commands "m")))
+
+	(gnus-kill 
+	 (or (cdr (assq modifier mod-to-header)) "subject")
+	 pattern 
+	 (if (string-match "m" commands) 
+	     '(gnus-summary-mark-as-unread nil " ")
+	   '(gnus-summary-mark-as-read nil "X")) 
+	 nil t))
+      (forward-line 1))))
+
+;; Kill changes and new format by suggested by JWZ and Sudish Joseph
+;; <joseph@cis.ohio-state.edu>.  
+(defun gnus-kill (field regexp &optional exe-command all silent)
+  "If FIELD of an article matches REGEXP, execute COMMAND.
+Optional 1st argument COMMAND is default to
+	(gnus-summary-mark-as-read nil \"X\").
+If optional 2nd argument ALL is non-nil, articles marked are also applied to.
+If FIELD is an empty string (or nil), entire article body is searched for.
+COMMAND must be a lisp expression or a string representing a key sequence."
+  ;; We don't want to change current point nor window configuration.
+  (let ((old-buffer (current-buffer)))
+    (save-excursion
+      (save-window-excursion
+	;; Selected window must be summary buffer to execute keyboard
+	;; macros correctly. See command_loop_1.
+	(switch-to-buffer gnus-summary-buffer 'norecord)
+	(goto-char (point-min))		;From the beginning.
+	(let ((kill-list regexp)
+	      (date (current-time-string))
+	      (command (or exe-command '(gnus-summary-mark-as-read 
+					 nil gnus-kill-file-mark)))
+	      kill kdate prev)
+	  (if (listp kill-list)
+	      ;; It is a list.
+	      (if (not (consp (cdr kill-list)))
+		  ;; It's on the form (regexp . date).
+		  (if (zerop (gnus-execute field (car kill-list) 
+					   command nil (not all)))
+		      (if (> (gnus-days-between date (cdr kill-list))
+			     gnus-kill-expiry-days)
+			  (setq regexp nil))
+		    (setcdr kill-list date))
+		(while (setq kill (car kill-list))
+		  (if (consp kill)
+		      ;; It's a temporary kill.
+		      (progn
+			(setq kdate (cdr kill))
+			(if (zerop (gnus-execute 
+				    field (car kill) command nil (not all)))
+			    (if (> (gnus-days-between date kdate)
+				   gnus-kill-expiry-days)
+				;; Time limit has been exceeded, so we
+				;; remove the match.
+				(if prev
+				    (setcdr prev (cdr kill-list))
+				  (setq regexp (cdr regexp))))
+			  ;; Successful kill. Set the date to today.
+			  (setcdr kill date)))
+		    ;; It's a permanent kill.
+		    (gnus-execute field kill command nil (not all)))
+		  (setq prev kill-list)
+		  (setq kill-list (cdr kill-list))))
+	    (gnus-execute field kill-list command nil (not all))))))
+    (switch-to-buffer old-buffer)
+    (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
+	(gnus-pp-gnus-kill
+	 (nconc (list 'gnus-kill field 
+		      (if (consp regexp) (list 'quote regexp) regexp))
+		(if (or exe-command all) (list (list 'quote exe-command)))
+		(if all (list t) nil))))))
+
+(defun gnus-pp-gnus-kill (object)
+  (if (or (not (consp (nth 2 object)))
+	  (not (consp (cdr (nth 2 object))))
+	  (and (eq 'quote (car (nth 2 object)))
+	       (not (consp (cdr (car (cdr (nth 2 object))))))))
+      (concat "\n" (prin1-to-string object))
+    (save-excursion
+      (set-buffer (get-buffer-create "*Gnus PP*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (insert (format "\n(%S %S\n  '(" (nth 0 object) (nth 1 object)))
+      (let ((klist (car (cdr (nth 2 object))))
+	    (first t))
+	(while klist
+	  (insert (if first (progn (setq first nil) "")  "\n    ")
+		  (prin1-to-string (car klist)))
+	  (setq klist (cdr klist))))
+      (insert ")")
+      (and (nth 3 object)
+	   (insert "\n  " 
+		   (if (and (consp (nth 3 object))
+			    (not (eq 'quote (car (nth 3 object))))) 
+		       "'" "")
+		   (prin1-to-string (nth 3 object))))
+      (and (nth 4 object)
+	   (insert "\n  t"))
+      (insert ")")
+      (prog1
+	  (buffer-substring (point-min) (point-max))
+	(kill-buffer (current-buffer))))))
+
+(defun gnus-execute-1 (function regexp form header)
+  (save-excursion
+    (let (did-kill)
+      (if (null header)
+	  nil				;Nothing to do.
+	(if function
+	    ;; Compare with header field.
+	    (let (value)
+	      (and header
+		   (progn
+		     (setq value (funcall function header))
+		     ;; Number (Lines:) or symbol must be converted to string.
+		     (or (stringp value)
+			 (setq value (prin1-to-string value)))
+		     (setq did-kill (string-match regexp value)))
+		   (if (stringp form)	;Keyboard macro.
+		       (execute-kbd-macro form)
+		     (funcall form))))
+	  ;; Search article body.
+	  (let ((gnus-current-article nil) ;Save article pointer.
+		(gnus-last-article nil)
+		(gnus-break-pages nil)	;No need to break pages.
+		(gnus-mark-article-hook nil)) ;Inhibit marking as read.
+	    (message "Searching for article: %d..." (mail-header-number header))
+	    (gnus-article-setup-buffer)
+	    (gnus-article-prepare (mail-header-number header) t)
+	    (if (save-excursion
+		  (set-buffer gnus-article-buffer)
+		  (goto-char (point-min))
+		  (setq did-kill (re-search-forward regexp nil t)))
+		(if (stringp form)	;Keyboard macro.
+		    (execute-kbd-macro form)
+		  (eval form))))))
+      did-kill)))
+
+(defun gnus-execute (field regexp form &optional backward ignore-marked)
+  "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
+If FIELD is an empty string (or nil), entire article body is searched for.
+If optional 1st argument BACKWARD is non-nil, do backward instead.
+If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
+marked as read or ticked are ignored."
+  (save-excursion
+    (let ((killed-no 0)
+	  function article header)
+      (if (or (null field) (string-equal field ""))
+	  (setq function nil)
+	;; Get access function of header filed.
+	(setq function (intern-soft (concat "gnus-header-" (downcase field))))
+	(if (and function (fboundp function))
+	    (setq function (symbol-function function))
+	  (error "Unknown header field: \"%s\"" field))
+	;; Make FORM funcallable.
+	(if (and (listp form) (not (eq (car form) 'lambda)))
+	    (setq form (list 'lambda nil form))))
+      ;; Starting from the current article.
+      (while (or (and (not article)
+		      (setq article (gnus-summary-article-number))
+		      t)
+		 (setq article 
+		       (gnus-summary-search-subject 
+			backward (not ignore-marked))))
+	(and (or (null gnus-newsgroup-kill-headers)
+		 (memq article gnus-newsgroup-kill-headers))
+	     (vectorp (setq header (gnus-get-header-by-number article)))
+	     (gnus-execute-1 function regexp form header)
+	     (setq killed-no (1+ killed-no))))
+      killed-no)))
+

lisp/gnus-mh.el

@@ -0,0 +1,226 @@
+;;; gnus-mh.el --- mh-e interface for Gnus
+;; Copyright (C) 1994,95 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Send mail using mh-e.
+
+;; The following mh-e interface is all cooperative works of
+;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
+;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
+;; SHINGU).
+
+;;; Code:
+
+(require 'mh-e)
+(require 'mh-comp)
+(require 'gnus)
+(require 'gnus-msg)
+
+(defun gnus-summary-save-article-folder (&optional arg)
+  "Append the current article to an mh folder.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+  (interactive "P")
+  (let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
+    (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-in-folder (&optional folder)
+  "Save this article to MH folder (using `rcvstore' in MH library).
+Optional argument FOLDER specifies folder name."
+  ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
+  (mh-find-path)
+  (let ((folder
+	 (or folder
+	     (mh-prompt-for-folder 
+	      "Save article in"
+	      (funcall gnus-folder-save-name gnus-newsgroup-name
+		       gnus-current-headers gnus-newsgroup-last-folder)
+	      t)))
+	(errbuf (get-buffer-create " *Gnus rcvstore*")))
+    (gnus-eval-in-buffer-window 
+     gnus-article-buffer
+     (save-restriction
+       (widen)
+       (unwind-protect
+	   (call-process-region (point-min) (point-max)
+				(expand-file-name "rcvstore" mh-lib)
+				nil errbuf nil folder)
+	 (set-buffer errbuf)
+	 (if (zerop (buffer-size))
+	     (message "Article saved in folder: %s" folder)
+	   (message "%s" (buffer-string)))
+	 (kill-buffer errbuf))))
+    (setq gnus-newsgroup-last-folder folder)))
+
+(defun gnus-mail-reply-using-mhe (&optional yank)
+  "Compose reply mail using mh-e.
+Optional argument YANK means yank original article.
+The command \\[mh-yank-cur-msg] yank the original message into current buffer."
+  (let (from cc subject date to reply-to to-userid orig-to
+	     references message-id
+	     (config (current-window-configuration))
+	     buffer)
+    (pop-to-buffer gnus-article-buffer)
+    (setq buffer (current-buffer))
+    (save-excursion
+      (save-restriction
+	(or gnus-user-login-name	; we need this
+	    (setq gnus-user-login-name (or (getenv "USER")
+					   (getenv "LOGNAME"))))
+
+	(gnus-article-show-all-headers);; so colors are happy
+	;; lots of junk to avoid mh-send deleting other windows
+	(setq from (or (gnus-fetch-field "from") "")
+	      subject (let ((subject (or (gnus-fetch-field "subject")
+					 "(None)")))
+			(if (and subject
+				 (not (string-match "^[Rr][Ee]:.+$" subject)))
+			    (concat "Re: " subject) subject))
+	      reply-to (gnus-fetch-field "reply-to")
+	      cc (gnus-fetch-field "cc")
+	      orig-to (or (gnus-fetch-field "to") "")
+	      date (gnus-fetch-field "date")
+	      references (gnus-fetch-field "references")
+	      message-id (gnus-fetch-field "message-id"))
+	(setq to (or reply-to from))
+	(setq to-userid (mail-strip-quoted-names orig-to))
+	(if (or (string-match "," orig-to)
+		(not (string-match (substring to-userid 0 
+					      (string-match "@" to-userid))
+				   gnus-user-login-name)))
+	    (setq cc (concat (if cc (concat cc ", ") "") orig-to)))
+        ;; mh-yank-cur-msg needs to have mh-show-buffer set in the 
+        ;; *Article* buffer
+	(setq mh-show-buffer buffer)))
+
+    (mh-find-path)
+    (mh-send-sub (or to "") (or cc "") 
+		 (or subject "(None)") config);; Erik Selberg 1/23/94
+
+    (let ((draft (current-buffer))
+	  (gnus-mail-buffer (current-buffer))
+	  mail-buf)
+      (if (not yank)
+	  (gnus-configure-windows 'reply 'force)
+	(gnus-configure-windows 'reply-yank 'force))
+      (setq mail-buf gnus-mail-buffer)
+      (pop-to-buffer mail-buf);; always in the display, so won't have window probs
+      (switch-to-buffer draft))
+
+    ;;    (mh-send to (or cc "") subject);; shouldn't use according to mhe
+    
+    ;; note - current buffer is now draft!
+    (save-excursion
+      (mh-insert-fields
+       "In-reply-to:"
+       (concat
+	(substring from 0 (string-match "  *at \\|  *@ \\| *(\\| *<" from))
+	"'s message of " date))
+      (nnheader-insert-references references message-id))
+
+    ;; need this for mh-yank-cur-msg
+    (setq mh-sent-from-folder buffer)
+    (setq mh-sent-from-msg 1)
+    (setq mh-show-buffer buffer)
+    (setq mh-previous-window-config config))
+
+  ;; Then, yank original article if requested.
+  (if yank
+      (let ((last (point)))
+	(mh-yank-cur-msg)
+	(goto-char last)))
+
+  (run-hooks 'gnus-mail-hook))
+
+
+;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh
+;; <itojun@ingram.mt.cs.keio.ac.jp>
+
+(defun gnus-mail-forward-using-mhe (&optional buffer)
+  "Forward the current message to another user using mh-e."
+  ;; First of all, prepare mhe mail buffer.
+  (let* ((to (read-string "To: "))
+	 (cc (read-string "Cc: "))
+	 (buffer (or buffer gnus-article-buffer))
+	 (config (current-window-configuration));; need to add this - erik
+	 (subject (gnus-forward-make-subject buffer)))
+    (setq mh-show-buffer buffer)
+    (mh-find-path)
+    (mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94
+    (let ((draft (current-buffer))
+	  (gnus-mail-buffer (current-buffer))
+	  mail-buf)
+      (gnus-configure-windows 'reply-yank 'force)
+      (setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer))))
+      (pop-to-buffer mail-buf);; always in the display, so won't have window probs
+      (switch-to-buffer draft)
+      )
+    (save-excursion
+      (goto-char (point-max))
+      (insert "\n------- Forwarded Message\n\n")
+      (insert-buffer buffer)
+      (goto-char (point-max))
+      (insert "\n------- End of Forwarded Message\n")
+      (setq mh-sent-from-folder buffer)
+      (setq mh-sent-from-msg 1)
+      (setq mh-previous-window-config config)
+      (run-hooks 'gnus-mail-hook)
+      )))
+
+(defun gnus-mail-other-window-using-mhe ()
+  "Compose mail other window using mh-e."
+  (let ((to (read-string "To: "))
+	(cc (read-string "Cc: "))
+	(subject (read-string "Subject: ")))
+    (gnus-article-show-all-headers)	;I don't think this is really needed.
+    (setq mh-show-buffer (current-buffer))
+    (mh-find-path)
+    (mh-send-other-window to cc subject)
+    (setq mh-sent-from-folder (current-buffer))
+    (setq mh-sent-from-msg 1)
+    (run-hooks 'gnus-mail-hook)))
+
+(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
+  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
+If variable `gnus-use-long-file-name' is nil, it is +News.group.
+Otherwise, it is like +news/group."
+  (or last-folder
+      (concat "+"
+	      (if gnus-use-long-file-name
+		  (gnus-capitalize-newsgroup newsgroup)
+		(gnus-newsgroup-directory-form newsgroup)))))
+
+(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
+  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
+If variable `gnus-use-long-file-name' is nil, it is +news.group.
+Otherwise, it is like +news/group."
+  (or last-folder
+      (concat "+"
+	      (if gnus-use-long-file-name
+		  newsgroup
+		(gnus-newsgroup-directory-form newsgroup)))))
+
+;;; gnus-mh.el ends here

lisp/gnus-vm.el

@@ -0,0 +1,261 @@
+;;; gnus-vm.el --- vm interface for Gnus
+;; Copyright (C) 1994,95 Free Software Foundation, Inc.
+
+;; Author: Per Persson <pp@solace.mh.se>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Major contributors: 
+;;	Christian Limpach <Christian.Limpach@nice.ch>
+;; Some code stolen from: 
+;;	Rick Sladkey <jrs@world.std.com>
+
+;;; Code:
+
+(require 'sendmail)
+(require 'gnus)
+(require 'gnus-msg)
+
+(eval-when-compile
+  (autoload 'vm-mode "vm")
+  (autoload 'vm-save-message "vm")
+  (autoload 'vm-forward-message "vm")
+  (autoload 'vm-reply "vm")
+  (autoload 'vm-mail "vm"))
+
+(defvar gnus-vm-inhibit-window-system nil
+  "Inhibit loading `win-vm' if using a window-system.
+Has to be set before gnus-vm is loaded.")
+
+(or gnus-vm-inhibit-window-system
+    (condition-case nil
+	(if window-system
+	    (require 'win-vm))
+      (error nil)))
+
+(if (not (featurep 'vm))
+    (load "vm"))
+
+(defun gnus-vm-make-folder (&optional buffer)
+  (let ((article (or buffer (current-buffer)))
+	(tmp-folder (generate-new-buffer " *tmp-folder*"))
+	(start (point-min))
+	(end (point-max)))
+    (set-buffer tmp-folder)
+    (insert-buffer-substring article start end)
+    (goto-char (point-min))
+    (if (looking-at "^\\(From [^ ]+ \\).*$")
+	(replace-match (concat "\\1" (current-time-string)))
+      (insert "From " gnus-newsgroup-name " "
+	      (current-time-string) "\n"))
+    (while (re-search-forward "\n\nFrom " nil t)
+      (replace-match "\n\n>From "))
+    ;; insert a newline, otherwise the last line gets lost
+    (goto-char (point-max))
+    (insert "\n")
+    (vm-mode)
+    tmp-folder))
+  
+(defun gnus-summary-save-article-vm (&optional arg)
+  "Append the current article to a vm folder.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+  (interactive "P")
+  (let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
+    (gnus-summary-save-article arg)))
+
+(defun gnus-summary-save-in-vm (&optional folder)
+  (interactive)
+  (let ((default-name
+	  (funcall gnus-mail-save-name gnus-newsgroup-name
+		   gnus-current-headers gnus-newsgroup-last-mail)))
+    (or folder
+	(setq folder
+	      (read-file-name
+	       (concat "Save article in VM folder: (default "
+		       (file-name-nondirectory default-name) ") ")
+	       (file-name-directory default-name)
+	       default-name)))
+    (setq folder
+	  (expand-file-name folder
+			    (and default-name
+				 (file-name-directory default-name))))
+    (gnus-make-directory (file-name-directory folder))
+    (set-buffer gnus-article-buffer)
+    (save-excursion
+      (save-restriction
+	(widen)
+	(let ((vm-folder (gnus-vm-make-folder)))
+	  (vm-save-message folder)
+	  (kill-buffer vm-folder))))
+    ;; Remember the directory name to save articles.
+    (setq gnus-newsgroup-last-mail folder)))
+  
+(defun gnus-mail-forward-using-vm (&optional buffer)
+  "Forward the current message to another user using vm."
+  (let* ((gnus-buffer (or buffer (current-buffer)))
+	 (subject (gnus-forward-make-subject gnus-buffer)))
+    (or (featurep 'win-vm)
+	(if gnus-use-full-window
+	    (pop-to-buffer gnus-article-buffer)
+	  (switch-to-buffer gnus-article-buffer)))
+    (gnus-copy-article-buffer)
+    (set-buffer gnus-article-copy)
+    (save-excursion
+      (save-restriction
+	(widen)
+	(let ((vm-folder (gnus-vm-make-folder))
+	      (vm-forward-message-hook
+	       (append (symbol-value 'vm-forward-message-hook)
+		       '((lambda ()
+			   (save-excursion
+			     (mail-position-on-field "Subject")
+			     (beginning-of-line)
+			     (looking-at "^\\(Subject: \\).*$")
+			     (replace-match (concat "\\1" subject))))))))
+	  (vm-forward-message)
+	  (gnus-vm-init-reply-buffer gnus-buffer)
+	  (run-hooks 'gnus-mail-hook)
+	  (kill-buffer vm-folder))))))
+
+(defun gnus-vm-init-reply-buffer (buffer)
+  (make-local-variable 'gnus-summary-buffer)
+  (setq gnus-summary-buffer buffer)
+  (set 'vm-mail-buffer nil)
+  (use-local-map (copy-keymap (current-local-map)))
+  (local-set-key "\C-c\C-y" 'gnus-yank-article))
+  
+(defun gnus-mail-reply-using-vm (&optional yank)
+  "Compose reply mail using vm.
+Optional argument YANK means yank original article.
+The command \\[vm-yank-message] yank the original message into current buffer."
+  (let ((gnus-buffer (current-buffer)))
+    (gnus-copy-article-buffer)
+    (set-buffer gnus-article-copy)
+    (save-excursion
+      (save-restriction
+	(widen)
+	(let ((vm-folder (gnus-vm-make-folder gnus-article-copy)))
+	  (vm-reply 1)
+	  (gnus-vm-init-reply-buffer gnus-buffer)
+	  (setq gnus-buffer (current-buffer))
+	  (and yank
+	       ;; nil will (magically :-)) yank the current article
+	       (gnus-yank-article nil))
+	  (kill-buffer vm-folder))))
+    (if (featurep 'win-vm) nil
+      (pop-to-buffer gnus-buffer))
+    (run-hooks 'gnus-mail-hook)))
+
+(defun gnus-mail-other-window-using-vm ()
+  "Compose mail in the other window using VM."
+  (interactive)
+  (let ((gnus-buffer (current-buffer)))
+    (vm-mail)
+    (gnus-vm-init-reply-buffer gnus-buffer))
+  (run-hooks 'gnus-mail-hook))
+
+(defun gnus-yank-article (article &optional prefix)
+  ;; Based on vm-yank-message by Kyle Jones.
+  "Yank article number N into the current buffer at point.
+When called interactively N is read from the minibuffer.
+
+This command is meant to be used in GNUS created Mail mode buffers;
+the yanked article comes from the newsgroup containing the article
+you are replying to or forwarding.
+
+All article headers are yanked along with the text.  Point is left
+before the inserted text, the mark after.  Any hook functions bound to
+`mail-citation-hook' are run, after inserting the text and setting
+point and mark.
+
+Prefix arg means to ignore `mail-citation-hook', don't set the mark,
+prepend the value of `vm-included-text-prefix' to every yanked line.
+For backwards compatibility, if `mail-citation-hook' is set to nil,
+`mail-yank-hooks' is run instead.  If that is also nil, a default
+action is taken."
+  (interactive
+   (list
+    (let ((result 0)
+	  default prompt)
+      (setq default (and gnus-summary-buffer
+			 (save-excursion
+			   (set-buffer gnus-summary-buffer)
+			   (and gnus-current-article
+				(int-to-string gnus-current-article))))
+	    prompt (if default
+		       (format "Yank article number: (default %s) " default)
+		     "Yank article number: "))
+      (while (and (not (stringp result)) (zerop result))
+	(setq result (read-string prompt))
+	(and (string= result "") default (setq result default))
+	(or (string-match "^<.*>$" result)
+	    (setq result (string-to-int result))))
+      result)
+    current-prefix-arg))
+  (if gnus-summary-buffer
+      (save-excursion
+	(let ((message (current-buffer))
+	      (start (point)) end
+	      (tmp (generate-new-buffer " *tmp-yank*")))
+	  (set-buffer gnus-summary-buffer)
+	  ;; Make sure the connection to the server is alive.
+	  (or (gnus-server-opened (gnus-find-method-for-group
+				   gnus-newsgroup-name))
+	      (progn
+		(gnus-check-server 
+		 (gnus-find-method-for-group gnus-newsgroup-name))
+		(gnus-request-group gnus-newsgroup-name t)))
+	  (and (stringp article) 
+	       (let ((gnus-override-method gnus-refer-article-method))
+		 (gnus-read-header article)))
+	  (gnus-request-article (or article
+				    gnus-current-article)
+				gnus-newsgroup-name tmp)
+	  (set-buffer tmp)
+	  (run-hooks 'gnus-article-prepare-hook)
+	  ;; Decode MIME message.
+	  (if (and gnus-show-mime
+		   (gnus-fetch-field "Mime-Version"))
+	      (funcall gnus-show-mime-method))
+	  ;; Perform the article display hooks.
+	  (let ((buffer-read-only nil))
+	    (run-hooks 'gnus-article-display-hook))
+	  (append-to-buffer message (point-min) (point-max))
+	  (kill-buffer tmp)
+	  (set-buffer message)
+	  (setq end (point))
+	  (goto-char start)
+	  (if (or prefix
+		  (not (or mail-citation-hook mail-yank-hooks)))
+	      (save-excursion
+		(while (< (point) end)
+		  (insert (symbol-value 'vm-included-text-prefix))
+		  (forward-line 1)))
+	    (push-mark end)
+	    (cond
+	     (mail-citation-hook (run-hooks 'mail-citation-hook))
+	     (mail-yank-hooks (run-hooks 'mail-yank-hooks))))))))
+
+(provide 'gnus-vm)
+
+;;; gnus-vm.el ends here.

lisp/nnbabyl.el

@@ -0,0 +1,578 @@
+;;; nnbabyl.el --- rmail mbox access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.  
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'nnmail)
+
+(defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL")
+  "The name of the rmail box file in the users home directory.")
+
+(defvar nnbabyl-active-file (expand-file-name "~/.rmail-active")
+  "The name of the active file for the rmail box.")
+
+(defvar nnbabyl-get-new-mail t
+  "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
+
+(defvar nnbabyl-prepare-save-mail-hook nil
+  "Hook run narrowed to an article before saving.")
+
+
+
+(defvar nnbabyl-mail-delimiter "\^_")
+
+(defconst nnbabyl-version "nnbabyl 1.0"
+  "nnbabyl version.")
+
+(defvar nnbabyl-mbox-buffer nil)
+(defvar nnbabyl-current-group nil)
+(defvar nnbabyl-status-string "")
+(defvar nnbabyl-group-alist nil)
+(defvar nnbabyl-active-timestamp nil)
+
+
+
+(defvar nnbabyl-current-server nil)
+(defvar nnbabyl-server-alist nil)
+(defvar nnbabyl-server-variables 
+  (list
+   (list 'nnbabyl-mbox-file nnbabyl-mbox-file)
+   (list 'nnbabyl-active-file nnbabyl-active-file)
+   (list 'nnbabyl-get-new-mail nnbabyl-get-new-mail)
+   '(nnbabyl-current-group nil)
+   '(nnbabyl-status-string "")
+   '(nnbabyl-group-alist nil)))
+
+
+
+;;; Interface functions
+
+(defun nnbabyl-retrieve-headers (sequence &optional newsgroup server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let ((number (length sequence))
+	  (count 0)
+	  article art-string start stop)
+      (nnbabyl-possibly-change-newsgroup newsgroup)
+      (if (stringp (car sequence))
+	  'headers
+	(while sequence
+	  (setq article (car sequence))
+	  (setq art-string (nnbabyl-article-string article))
+	  (set-buffer nnbabyl-mbox-buffer)
+	  (if (or (search-forward art-string nil t)
+		  (search-backward art-string nil t))
+	      (progn
+		(re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+		(while (and (not (looking-at ".+:"))
+			    (zerop (forward-line 1))))
+		(setq start (point))
+		(search-forward "\n\n" nil t)
+		(setq stop (1- (point)))
+		(set-buffer nntp-server-buffer)
+		(insert "221 " (int-to-string article) " Article retrieved.\n")
+		(insert-buffer-substring nnbabyl-mbox-buffer start stop)
+		(goto-char (point-max))
+		(insert ".\n")))
+	  (setq sequence (cdr sequence))
+	  (setq count (1+ count))
+	  (and (numberp nnmail-large-newsgroup)
+	       (> number nnmail-large-newsgroup)
+	       (zerop (% count 20))
+	       gnus-verbose-backends
+	       (message "nnbabyl: Receiving headers... %d%%"
+			(/ (* count 100) number))))
+
+	(and (numberp nnmail-large-newsgroup)
+	     (> number nnmail-large-newsgroup)
+	     gnus-verbose-backends
+	     (message "nnbabyl: Receiving headers...done"))
+
+	;; Fold continuation lines.
+	(set-buffer nntp-server-buffer)
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	'headers))))
+
+(defun nnbabyl-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nnbabyl-current-server)
+      t
+    (if nnbabyl-current-server
+	(setq nnbabyl-server-alist 
+	      (cons (list nnbabyl-current-server
+			  (nnheader-save-variables nnbabyl-server-variables))
+		    nnbabyl-server-alist)))
+    (let ((state (assoc server nnbabyl-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nnbabyl-server-alist (delq state nnbabyl-server-alist)))
+	(nnheader-set-init-variables nnbabyl-server-variables defs)))
+    (setq nnbabyl-current-server server)))
+
+(defun nnbabyl-close-server (&optional server)
+  t)
+
+(defun nnbabyl-server-opened (&optional server)
+  (and (equal server nnbabyl-current-server)
+       nnbabyl-mbox-buffer
+       (buffer-name nnbabyl-mbox-buffer)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nnbabyl-status-message (&optional server)
+  nnbabyl-status-string)
+
+(defun nnbabyl-request-article (article &optional newsgroup server buffer)
+  (nnbabyl-possibly-change-newsgroup newsgroup)
+  (if (stringp article)
+      nil
+    (save-excursion
+      (set-buffer nnbabyl-mbox-buffer)
+      (goto-char (point-min))
+      (if (search-forward (nnbabyl-article-string article) nil t)
+	  (let (start stop summary-line)
+	    (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+	    (while (and (not (looking-at ".+:"))
+			(zerop (forward-line 1))))
+	    (setq start (point))
+	    (or (and (re-search-forward 
+		      (concat "^" nnbabyl-mail-delimiter) nil t)
+		     (forward-line -1))
+		(goto-char (point-max)))
+	    (setq stop (point))
+	    (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+	      (set-buffer nntp-server-buffer)
+	      (erase-buffer)
+	      (insert-buffer-substring nnbabyl-mbox-buffer start stop)
+	      (goto-char (point-min))
+	    ;; If there is an EOOH header, then we have to remove some
+	    ;; duplicated headers. 
+	    (setq summary-line (looking-at "Summary-line:"))
+	    (if (search-forward "\n*** EOOH ***" nil t)
+		(if summary-line
+		    ;; The headers to be deleted are located before the
+		    ;; EOOH line...
+		    (delete-region (point-min) 
+				   (progn (forward-line 1) (point)))
+		  ;; ...or after.
+		  (delete-region (progn (beginning-of-line) (point))
+				 (or (search-forward "\n\n" nil t)
+				     (point)))))
+	    t))))))
+
+(defun nnbabyl-request-group (group &optional server dont-check)
+  (save-excursion
+    (if (nnbabyl-possibly-change-newsgroup group)
+	(if dont-check
+	    t
+	  (nnbabyl-get-new-mail group)
+	  (save-excursion
+	    (set-buffer nntp-server-buffer)
+	    (erase-buffer)
+	    (let ((active (assoc group nnbabyl-group-alist)))
+	      (insert (format "211 %d %d %d %s\n" 
+			      (1+ (- (cdr (car (cdr active)))
+				     (car (car (cdr active)))))
+			      (car (car (cdr active)))
+			      (cdr (car (cdr active)))
+			      (car active))))
+	    t)))))
+
+(defun nnbabyl-close-group (group &optional server)
+  t)
+
+(defun nnbabyl-request-create-group (group &optional server) 
+  (nnmail-activate 'nnbabyl)
+  (or (assoc group nnbabyl-group-alist)
+      (let (active)
+	(setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0)))
+					nnbabyl-group-alist))
+	(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))
+  t)
+
+(defun nnbabyl-request-list (&optional server)
+  (if server (nnbabyl-get-new-mail))
+  (save-excursion
+    (or (nnmail-find-file nnbabyl-active-file)
+	(progn
+	  (setq nnbabyl-group-alist (nnmail-get-active))
+	  (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+	  (nnmail-find-file nnbabyl-active-file)))))
+
+(defun nnbabyl-request-newgroups (date &optional server)
+  (nnbabyl-request-list server))
+
+(defun nnbabyl-request-list-newsgroups (&optional server)
+  (setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.")
+  nil)
+
+(defun nnbabyl-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defalias 'nnbabyl-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nnbabyl-request-expire-articles
+  (articles newsgroup &optional server force)
+  (nnbabyl-possibly-change-newsgroup newsgroup)
+  (let* ((days (or (and nnmail-expiry-wait-function
+			(funcall nnmail-expiry-wait-function newsgroup))
+		   nnmail-expiry-wait))
+	 (is-old t)
+	 rest)
+    (nnmail-activate 'nnbabyl)
+
+    (save-excursion 
+      (set-buffer nnbabyl-mbox-buffer)
+      (set-text-properties (point-min) (point-max) nil)
+      (while (and articles is-old)
+	(goto-char (point-min))
+	(if (search-forward (nnbabyl-article-string (car articles)) nil t)
+	    (if (or force
+		    (setq is-old
+			  (> (nnmail-days-between 
+			      (current-time-string)
+			      (buffer-substring 
+			       (point) (progn (end-of-line) (point))))
+			     days)))
+		(progn
+		  (and gnus-verbose-backends
+		       (message "Deleting article %s..." (car articles)))
+		  (nnbabyl-delete-mail))
+	      (setq rest (cons (car articles) rest))))
+	(setq articles (cdr articles)))
+      (save-buffer)
+      ;; Find the lowest active article in this group.
+      (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
+	(goto-char (point-min))
+	(while (and (not (search-forward
+			  (nnbabyl-article-string (car active)) nil t))
+		    (<= (car active) (cdr active)))
+	  (setcar active (1+ (car active)))
+	  (goto-char (point-min))))
+      (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+      (nconc rest articles))))
+
+(defun nnbabyl-request-move-article 
+  (article group server accept-form &optional last)
+  (nnbabyl-possibly-change-newsgroup group)
+  (let ((buf (get-buffer-create " *nnbabyl move*"))
+	result)
+    (and 
+     (nnbabyl-request-article article group server)
+     (save-excursion
+       (set-buffer buf)
+       (insert-buffer-substring nntp-server-buffer)
+       (goto-char (point-min))
+       (if (re-search-forward 
+	    "^X-Gnus-Newsgroup:" 
+	    (save-excursion (search-forward "\n\n" nil t) (point)) t)
+	   (delete-region (progn (beginning-of-line) (point))
+			  (progn (forward-line 1) (point))))
+       (setq result (eval accept-form))
+       (kill-buffer (current-buffer))
+       result)
+     (save-excursion
+       (set-buffer nnbabyl-mbox-buffer)
+       (goto-char (point-min))
+       (if (search-forward (nnbabyl-article-string article) nil t)
+	   (nnbabyl-delete-mail))
+       (and last (save-buffer))))
+    result))
+
+(defun nnbabyl-request-accept-article (group &optional last)
+  (let ((buf (current-buffer))
+	result beg)
+    (and 
+     (nnmail-activate 'nnbabyl)
+     (save-excursion
+       (goto-char (point-min))
+       (search-forward "\n\n" nil t)
+       (forward-line -1)
+       (save-excursion
+	 (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
+	   (delete-region (point) (progn (forward-line 1) (point)))))
+       (let ((nnmail-split-methods
+	      (if (stringp group) (list (list group "")) 
+		nnmail-split-methods)))
+	 (setq result (car (nnbabyl-save-mail))))
+       (set-buffer nnbabyl-mbox-buffer)
+       (goto-char (point-max))
+       (search-backward "\n\^_")
+       (goto-char (match-end 0))
+       (insert-buffer buf)
+       (and last (progn 
+		   (save-buffer)
+		   (nnmail-save-active
+		    nnbabyl-group-alist nnbabyl-active-file)))
+       result))))
+
+(defun nnbabyl-request-replace-article (article group buffer)
+  (nnbabyl-possibly-change-newsgroup group)
+  (save-excursion
+    (set-buffer nnbabyl-mbox-buffer)
+    (goto-char (point-min))
+    (if (not (search-forward (nnbabyl-article-string article) nil t))
+	nil
+      (nnbabyl-delete-mail t t)
+      (insert-buffer-substring buffer)
+      (save-buffer)
+      t)))
+
+
+;;; Low-Level Interface
+
+;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
+;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
+;; delimeter line.
+(defun nnbabyl-delete-mail (&optional force leave-delim)
+  ;; Delete the current X-Gnus-Newsgroup line.
+  (or force
+      (delete-region
+       (progn (beginning-of-line) (point))
+       (progn (forward-line 1) (point))))
+  ;; Beginning of the article.
+  (save-excursion
+    (save-restriction
+      (widen)
+      (narrow-to-region
+       (save-excursion
+	 (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+	 (if leave-delim (progn (forward-line 1) (point))
+	   (match-beginning 0)))
+       (progn
+	 (forward-line 1)
+	 (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) 
+				     nil t)
+		  (if (and (not (bobp)) leave-delim)
+		      (progn (forward-line -2) (point))
+		    (match-beginning 0)))
+	     (point-max))))
+      (goto-char (point-min))
+      ;; Only delete the article if no other groups owns it as well.
+      (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+	  (delete-region (point-min) (point-max))))))
+
+(defun nnbabyl-possibly-change-newsgroup (newsgroup)
+  (if (or (not nnbabyl-mbox-buffer)
+	  (not (buffer-name nnbabyl-mbox-buffer)))
+      (save-excursion (nnbabyl-read-mbox)))
+  (or nnbabyl-group-alist
+      (nnmail-activate 'nnbabyl))
+  (if newsgroup
+      (if (assoc newsgroup nnbabyl-group-alist)
+	  (setq nnbabyl-current-group newsgroup)
+	(setq nnbabyl-status-string "No such group in file")
+	nil)))
+
+(defun nnbabyl-article-string (article)
+  (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" 
+	  (int-to-string article) " "))
+
+(defun nnbabyl-insert-lines ()
+  "Insert how many lines and chars there are in the body of the mail."
+  (let (lines chars)
+    (save-excursion
+      (goto-char (point-min))
+      (if (search-forward "\n\n" nil t) 
+	  (progn
+	    ;; There may be an EOOH line here...
+	    (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
+		(search-forward "\n\n" nil t))
+	    (setq chars (- (point-max) (point)))
+	    (setq lines (- (count-lines (point) (point-max)) 1))
+	    ;; Move back to the end of the headers. 
+	    (goto-char (point-min))
+	    (search-forward "\n\n" nil t)
+	    (forward-char -1)
+	    (save-excursion
+	      (if (re-search-backward "^Lines: " nil t)
+		  (delete-region (point) (progn (forward-line 1) (point)))))
+	    (insert (format "Lines: %d\n" lines))
+	    chars)))))
+
+(defun nnbabyl-save-mail ()
+  ;; Called narrowed to an article.
+  (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number))))
+    (nnbabyl-insert-lines)
+    (nnmail-insert-xref group-art)
+    (nnbabyl-insert-newsgroup-line group-art)
+    (run-hooks 'nnbabyl-prepare-save-mail-hook)
+    group-art))
+
+(defun nnbabyl-insert-newsgroup-line (group-art)
+  (save-excursion
+    (goto-char (point-min))
+    (while (looking-at "From ")
+      (replace-match "Mail-from: From " t t)
+      (forward-line 1))
+    ;; If there is a C-l at the beginning of the narrowed region, this
+    ;; isn't really a "save", but rather a "scan".
+    (goto-char (point-min))
+    (or (looking-at "\^L")
+	(save-excursion
+	  (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
+	  (goto-char (point-max))
+	  (insert "\^_\n")))
+    (if (search-forward "\n\n" nil t)
+	(progn
+	  (forward-char -1)
+	  (while group-art
+	    (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
+			    (car (car group-art)) (cdr (car group-art))
+			    (current-time-string)))
+	    (setq group-art (cdr group-art)))))
+    t))
+
+(defun nnbabyl-active-number (group)
+  ;; Find the next article number in GROUP.
+  (let ((active (car (cdr (assoc group nnbabyl-group-alist)))))
+    (if active
+	(setcdr active (1+ (cdr active)))
+      ;; This group is new, so we create a new entry for it.
+      ;; This might be a bit naughty... creating groups on the drop of
+      ;; a hat, but I don't know...
+      (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1)))
+				      nnbabyl-group-alist)))
+    (cdr active)))
+
+(defun nnbabyl-read-mbox ()
+  (nnmail-activate 'nnbabyl)
+  (or (file-exists-p nnbabyl-mbox-file)
+      (save-excursion
+	(set-buffer (setq nnbabyl-mbox-buffer
+			  (create-file-buffer nnbabyl-mbox-file)))
+	(setq buffer-file-name nnbabyl-mbox-file)
+	(insert "BABYL OPTIONS:\n\n\^_")
+	(write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
+
+  (if (and nnbabyl-mbox-buffer
+	   (buffer-name nnbabyl-mbox-buffer)
+	   (save-excursion
+	     (set-buffer nnbabyl-mbox-buffer)
+	     (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file)))))
+      ()
+    (save-excursion
+      (let ((delim (concat "^" nnbabyl-mail-delimiter))
+	    start end)
+	(set-buffer (setq nnbabyl-mbox-buffer 
+			  (nnheader-find-file-noselect 
+			   nnbabyl-mbox-file nil 'raw)))
+	(buffer-disable-undo (current-buffer))
+	(widen)
+	(setq buffer-read-only nil)
+	(fundamental-mode)
+	
+	(goto-char (point-min))
+	(re-search-forward delim nil t)
+	(setq start (match-end 0))
+	(while (re-search-forward delim nil t)
+	  (setq end (match-end 0))
+	  (or (search-backward "\nX-Gnus-Newsgroup: " start t)
+	      (progn
+		(goto-char end)
+		(save-excursion
+		  (save-restriction
+		    (goto-char start)
+		    (narrow-to-region start end)
+		    (nnbabyl-save-mail)
+		    (setq end (point-max))))))
+	  (goto-char (setq start end)))
+	(and (buffer-modified-p (current-buffer)) (save-buffer))
+	(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
+
+(defun nnbabyl-remove-incoming-delims ()
+  (goto-char (point-min))
+  (while (search-forward "\^_" nil t)
+    (replace-match "?" t t)))
+
+(defun nnbabyl-get-new-mail (&optional group)
+  "Read new incoming mail."
+  (let* ((spools (nnmail-get-spool-files group))
+	 (group-in group)
+	 incoming incomings)
+    (nnbabyl-read-mbox)
+    (if (or (not nnbabyl-get-new-mail) (not nnmail-spool-file))
+	()
+      ;; We go through all the existing spool files and split the
+      ;; mail from each.
+      (while spools
+	(and
+	 (file-exists-p (car spools))
+	 (> (nth 7 (file-attributes (car spools))) 0)
+	 (progn
+	   (and gnus-verbose-backends 
+		(message "nnbabyl: Reading incoming mail..."))
+	   (if (not (setq incoming 
+			  (nnmail-move-inbox 
+			   (car spools) 
+			   (concat nnbabyl-mbox-file "-Incoming"))))
+	       ()
+	     (setq incomings (cons incoming incomings))
+	     (save-excursion
+	       (setq group (nnmail-get-split-group (car spools) group-in))
+	       (let* ((nnmail-prepare-incoming-hook
+		       (cons 'nnbabyl-remove-incoming-delims
+			     nnmail-prepare-incoming-hook))
+		      in-buf)
+		 (setq in-buf (nnmail-split-incoming 
+			       incoming 'nnbabyl-save-mail t group))
+		 (set-buffer in-buf)
+		 (goto-char (point-min))
+		 (while (search-forward "\n\^_\n" nil t)
+		   (delete-char -1))
+		 (set-buffer nnbabyl-mbox-buffer)
+		 (goto-char (point-max))
+		 (search-backward "\n\^_" nil t)
+		 (goto-char (match-end 0))
+		 (insert-buffer-substring in-buf)
+		 (kill-buffer in-buf))))))
+	(setq spools (cdr spools)))
+      ;; If we did indeed read any incoming spools, we save all info. 
+      (and (buffer-modified-p nnbabyl-mbox-buffer) 
+	   (save-excursion
+	     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
+	     (set-buffer nnbabyl-mbox-buffer)
+	     (save-buffer)))
+      (if incomings (run-hooks 'nnmail-read-incoming-hook))
+      (while incomings
+	(setq incoming (car incomings))
+	(and nnmail-delete-incoming
+	     (file-exists-p incoming) 
+	     (file-writable-p incoming) 
+	     (delete-file incoming))
+	(setq incomings (cdr incomings))))))
+
+(provide 'nnbabyl)
+
+;;; nnbabyl.el ends here

lisp/nndir.el

@@ -0,0 +1,141 @@
+;;; nndir.el --- single directory newsgroup access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmh)
+(require 'nnml)
+
+(eval-and-compile
+  (autoload 'mail-send-and-exit "sendmail"))
+
+
+
+(defconst nndir-version "nndir 1.0")
+
+(defvar nndir-current-directory nil
+  "Current news group directory.")
+
+(defvar nndir-status-string "")
+
+(defvar nndir-nov-is-evil nil
+  "*Non-nil means that nndir will never retrieve NOV headers.")
+
+
+
+;;; Interface functions.
+
+
+(defun nndir-retrieve-headers (sequence &optional newsgroup server)
+  (nndir-execute-nnml-command
+   '(nnml-retrieve-headers sequence group server) server))
+
+(defun nndir-open-server (host &optional service)
+  "Open nndir backend."
+  (setq nndir-status-string "")
+  (nnheader-init-server-buffer))
+
+(defun nndir-close-server (&optional server)
+  "Close news server."
+  t)
+
+(defun nndir-server-opened (&optional server)
+  "Return server process status, T or NIL.
+If the stream is opened, return T, otherwise return NIL."
+  (and nntp-server-buffer
+       (get-buffer nntp-server-buffer)))
+
+(defun nndir-status-message (&optional server)
+  "Return server status response as string."
+  nndir-status-string)
+
+(defun nndir-request-article (id &optional newsgroup server buffer)
+  (nndir-execute-nnmh-command
+   '(nnmh-request-article id group server buffer) server))
+
+(defun nndir-request-group (group &optional server dont-check)
+  "Select news GROUP."
+  (nndir-execute-nnmh-command
+   '(nnmh-request-group group "" dont-check) server))
+
+(defun nndir-request-list (&optional server dir)
+  "Get list of active articles in all newsgroups."
+  (nndir-execute-nnmh-command
+   '(nnmh-request-list nil dir) server))
+
+(defun nndir-request-newgroups (date &optional server)
+  (nndir-execute-nnmh-command
+   '(nnmh-request-newgroups date server) server))
+
+(defun nndir-request-post (&optional server)
+  "Post a new news in current buffer."
+  (mail-send-and-exit nil))
+
+(defalias 'nndir-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nndir-request-expire-articles (articles newsgroup &optional server force)
+  "Expire all articles in the ARTICLES list in group GROUP."
+  (setq nndir-status-string "nndir: expire not possible")
+  nil)
+
+(defun nndir-close-group (group &optional server)
+  t)
+
+(defun nndir-request-move-article (article group server accept-form)
+  (setq nndir-status-string "nndir: move not possible")
+  nil)
+
+(defun nndir-request-accept-article (group)
+  (setq nndir-status-string "nndir: accept not possible")
+  nil)
+
+
+;;; Low-Level Interface
+
+(defun nndir-execute-nnmh-command (command server)
+  (let ((dir (expand-file-name server)))
+    (and (string-match "/$" dir)
+	 (setq dir (substring dir 0 (match-beginning 0))))
+    (string-match "/[^/]+$" dir)
+    (let ((group (substring dir (1+ (match-beginning 0))))
+	  (nnmh-directory (substring dir 0 (1+ (match-beginning 0))))
+	  (nnmh-get-new-mail nil))
+      (eval command))))
+
+(defun nndir-execute-nnml-command (command server)
+  (let ((dir (expand-file-name server)))
+    (and (string-match "/$" dir)
+	 (setq dir (substring dir 0 (match-beginning 0))))
+    (string-match "/[^/]+$" dir)
+    (let ((group (substring dir (1+ (match-beginning 0))))
+	  (nnml-directory (substring dir 0 (1+ (match-beginning 0))))
+	  (nnml-nov-is-evil nndir-nov-is-evil)
+	  (nnml-get-new-mail nil))
+      (eval command))))
+
+(provide 'nndir)
+
+;;; nndir.el ends here

lisp/nndoc.el

@@ -0,0 +1,400 @@
+;;; nndoc.el --- single file access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'nnmail)
+
+(defvar nndoc-article-type 'mbox
+  "*Type of the file - one of `mbox', `babyl' or `digest'.")
+
+(defvar nndoc-digest-type 'traditional
+  "Type of the last digest.  Auto-detected from the article header.
+Possible values:
+  `traditional' -- the \"lots of dashes\" (30+) rules used;
+                   we currently also do unconditional RFC 934 unquoting.
+  `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).")
+
+(defconst nndoc-type-to-regexp
+  (list (list 'mbox 
+	      (concat "^" rmail-unix-mail-delimiter)
+	      (concat "^" rmail-unix-mail-delimiter)
+	      nil "^$" nil nil nil)
+	(list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
+	      "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
+	(list 'digest
+	      "^------------------------------*[\n \t]+"
+	      "^------------------------------*[\n \t]+"
+	      nil "^ ?$"   
+	      "^------------------------------*[\n \t]+"
+	      "^End of" nil))
+  "Regular expressions for articles of the various types.")
+
+
+
+(defvar nndoc-article-begin nil)
+(defvar nndoc-article-end nil)
+(defvar nndoc-head-begin nil)
+(defvar nndoc-head-end nil)
+(defvar nndoc-first-article nil)
+(defvar nndoc-end-of-file nil)
+(defvar nndoc-body-begin nil)
+
+(defvar nndoc-current-server nil)
+(defvar nndoc-server-alist nil)
+(defvar nndoc-server-variables
+  (list
+   (list 'nndoc-article-type nndoc-article-type)
+   '(nndoc-article-begin nil)
+   '(nndoc-article-end nil)
+   '(nndoc-head-begin nil)
+   '(nndoc-head-end nil)
+   '(nndoc-first-article nil)
+   '(nndoc-current-buffer nil)
+   '(nndoc-group-alist nil)
+   '(nndoc-end-of-file nil)
+   '(nndoc-body-begin nil)
+   '(nndoc-address nil)))
+
+(defconst nndoc-version "nndoc 1.0"
+  "nndoc version.")
+
+(defvar nndoc-current-buffer nil
+  "Current nndoc news buffer.")
+
+(defvar nndoc-address nil)
+
+
+
+(defvar nndoc-status-string "")
+
+(defvar nndoc-group-alist nil)
+
+;;; Interface functions
+
+(defun nndoc-retrieve-headers (sequence &optional newsgroup server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let ((prev 2)
+	  article p beg lines)
+      (nndoc-possibly-change-buffer newsgroup server)
+      (if (stringp (car sequence))
+	  'headers
+	(set-buffer nndoc-current-buffer)
+	(widen)
+	(goto-char (point-min))
+	(re-search-forward (or nndoc-first-article 
+			       nndoc-article-begin) nil t)
+	(or (not nndoc-head-begin)
+	    (re-search-forward nndoc-head-begin nil t))
+	(re-search-forward nndoc-head-end nil t)
+	(while sequence
+	  (setq article (car sequence))
+	  (set-buffer nndoc-current-buffer)
+	  (if (not (nndoc-forward-article (max 0 (- article prev))))
+	      ()
+	    (setq p (point))
+	    (setq beg (or (and
+			   (re-search-backward nndoc-article-begin nil t)
+			   (match-end 0))
+			  (point-min)))
+	    (goto-char p)
+	    (setq lines (count-lines 
+			 (point)
+			 (or
+			  (and (re-search-forward nndoc-article-end nil t)
+			       (goto-char (match-beginning 0)))
+			  (goto-char (point-max)))))
+
+	    (set-buffer nntp-server-buffer)
+	    (insert (format "221 %d Article retrieved.\n" article))
+	    (insert-buffer-substring nndoc-current-buffer beg p)
+	    (goto-char (point-max))
+	    (or (= (char-after (1- (point))) ?\n) (insert "\n"))
+	    (insert (format "Lines: %d\n" lines))
+	    (insert ".\n"))
+
+	  (setq prev article
+		sequence (cdr sequence)))
+
+	;; Fold continuation lines.
+	(set-buffer nntp-server-buffer)
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	'headers))))
+
+(defun nndoc-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nndoc-current-server)
+      t
+    (if nndoc-current-server
+	(setq nndoc-server-alist 
+	      (cons (list nndoc-current-server
+			  (nnheader-save-variables nndoc-server-variables))
+		    nndoc-server-alist)))
+    (let ((state (assoc server nndoc-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nndoc-server-alist (delq state nndoc-server-alist)))
+	(nnheader-set-init-variables nndoc-server-variables defs)))
+    (setq nndoc-current-server server)
+    (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
+      (setq nndoc-article-begin (nth 0 defs))
+      (setq nndoc-article-end (nth 1 defs))
+      (setq nndoc-head-begin (nth 2 defs))
+      (setq nndoc-head-end (nth 3 defs))
+      (setq nndoc-first-article (nth 4 defs))
+      (setq nndoc-end-of-file (nth 5 defs))
+      (setq nndoc-body-begin (nth 6 defs)))
+    t))
+
+(defun nndoc-close-server (&optional server)
+  t)
+
+(defun nndoc-server-opened (&optional server)
+  (and (equal server nndoc-current-server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nndoc-status-message (&optional server)
+  nndoc-status-string)
+
+(defun nndoc-request-article (article &optional newsgroup server buffer)
+  (nndoc-possibly-change-buffer newsgroup server)
+  (save-excursion
+    (let ((buffer (or buffer nntp-server-buffer)))
+      (set-buffer buffer)
+      (erase-buffer)
+      (if (stringp article)
+	  nil
+	(nndoc-insert-article article)
+	;; Unquote quoted non-separators in digests.
+	(if (and (eq nndoc-article-type 'digest)
+		 (eq nndoc-digest-type 'traditional))
+	    (progn
+	      (goto-char (point-min))
+	      (while (re-search-forward "^- -"nil t)
+		(replace-match "-" t t))))
+	;; Some assholish digests do not have a blank line after the
+	;; headers. Aargh!
+	(goto-char (point-min))
+	(if (search-forward "\n\n" nil t)
+	    ()				; We let this one pass.
+	  (if (re-search-forward "^[ \t]+$" nil t)
+	      (replace-match "" t t)	; We nix out a line of blanks.
+	    (while (and (looking-at "[^ ]+:")
+			(zerop (forward-line 1))))
+	    ;; We just insert a couple of lines. If you read digests
+	    ;; that are so badly formatted, you don't deserve any
+	    ;; better. Blphphpht!
+	    (insert "\n\n")))
+	t))))
+
+(defun nndoc-request-group (group &optional server dont-check)
+  "Select news GROUP."
+  (save-excursion
+    (if (not (nndoc-possibly-change-buffer group server))
+	(progn
+	  (setq nndoc-status-string "No such file or buffer")
+	  nil)
+      (nndoc-set-header-dependent-regexps) ; hack for MIME digests
+      (if dont-check
+	  t
+	(save-excursion
+	  (set-buffer nntp-server-buffer)
+	  (erase-buffer)
+	  (let ((number (nndoc-number-of-articles)))
+	    (if (zerop number)
+		(progn
+		  (nndoc-close-group group)
+		  nil)
+	      (insert (format "211 %d %d %d %s\n" number 1 number group))
+	      t)))))))
+
+(defun nndoc-close-group (group &optional server)
+  (nndoc-possibly-change-buffer group server)
+  (kill-buffer nndoc-current-buffer)
+  (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
+				nndoc-group-alist))
+  (setq nndoc-current-buffer nil)
+  (setq nndoc-current-server nil)
+  t)
+
+(defun nndoc-request-list (&optional server)
+  nil)
+
+(defun nndoc-request-newgroups (date &optional server)
+  nil)
+
+(defun nndoc-request-list-newsgroups (&optional server)
+  nil)
+
+(defalias 'nndoc-request-post 'nnmail-request-post)
+(defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
+
+
+;;; Internal functions.
+
+(defun nndoc-possibly-change-buffer (group source)
+  (let (buf)
+    (cond 
+     ;; The current buffer is this group's buffer.
+     ((and nndoc-current-buffer
+	   (eq nndoc-current-buffer 
+	       (setq buf (cdr (assoc group nndoc-group-alist))))))
+     ;; We change buffers by taking an old from the group alist.
+     ;; `source' is either a string (a file name) or a buffer object. 
+     (buf
+      (setq nndoc-current-buffer buf))
+     ;; It's a totally new group.    
+     ((or (and (bufferp nndoc-address)
+	       (buffer-name nndoc-address))
+	  (and (stringp nndoc-address)
+	       (file-exists-p nndoc-address)
+	       (not (file-directory-p nndoc-address))))
+      (setq nndoc-group-alist 
+	    (cons (cons group (setq nndoc-current-buffer 
+				    (get-buffer-create 
+				     (concat " *nndoc " group "*"))))
+		  nndoc-group-alist))
+      (save-excursion
+	(set-buffer nndoc-current-buffer)
+	(buffer-disable-undo (current-buffer))
+	(erase-buffer)
+	(if (stringp nndoc-address)
+	    (insert-file-contents nndoc-address)
+	  (save-excursion
+	    (set-buffer nndoc-address)
+	    (widen))
+	  (insert-buffer-substring nndoc-address))
+	t)))))
+
+;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
+(defun nndoc-set-header-dependent-regexps ()
+  (if (not (eq nndoc-article-type 'digest))
+      ()
+    (let ((case-fold-search t)		; We match a bit too much, keep it simple.
+	  (boundary-id) (b-delimiter))
+      (save-excursion
+	(set-buffer nndoc-current-buffer)
+	(goto-char (point-min))
+	(if (and
+	     (re-search-forward
+	      (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
+		      "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+	      nil t)
+	     (match-beginning 1))
+	    (setq nndoc-digest-type 'rfc1341
+		  boundary-id (format "%s"
+				      (buffer-substring
+				       (match-beginning 1) (match-end 1)))
+		  b-delimiter       (concat "\n--" boundary-id "[\n \t]+")
+		  nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
+		  nndoc-article-end (concat "\n--" boundary-id
+					    "\\(--\\)?[\n \t]+")
+		  nndoc-first-article b-delimiter ; ^eof ends article too.
+		  nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$"))
+	  (setq nndoc-digest-type 'traditional))))))
+
+(defun nndoc-forward-article (n)
+  (while (and (> n 0)
+	      (re-search-forward nndoc-article-begin nil t)
+	      (or (not nndoc-head-begin)
+		  (re-search-forward nndoc-head-begin nil t))
+	      (re-search-forward nndoc-head-end nil t))
+    (setq n (1- n)))
+  (zerop n))
+
+(defun nndoc-number-of-articles ()
+  (save-excursion
+    (set-buffer nndoc-current-buffer)
+    (widen)
+    (goto-char (point-min))
+    (let ((num 0))
+      (if (re-search-forward (or nndoc-first-article
+				 nndoc-article-begin) nil t)
+	  (progn
+	    (setq num 1)
+	    (while (and (re-search-forward nndoc-article-begin nil t)
+			(or (not nndoc-end-of-file)
+			    (not (looking-at nndoc-end-of-file)))
+			(or (not nndoc-head-begin)
+			    (re-search-forward nndoc-head-begin nil t))
+			(re-search-forward nndoc-head-end nil t))
+	      (setq num (1+ num)))))
+      num)))
+
+(defun nndoc-narrow-to-article (article)
+  (save-excursion
+    (set-buffer nndoc-current-buffer)
+    (widen)
+    (goto-char (point-min))
+    (while (and (re-search-forward nndoc-article-begin nil t)
+		(not (zerop (setq article (1- article))))))
+    (if (not (zerop article))
+	()
+      (narrow-to-region 
+       (match-end 0)
+       (or (and (re-search-forward nndoc-article-end nil t)
+		(match-beginning 0))
+	   (point-max)))
+      t)))
+
+;; Insert article ARTICLE in the current buffer.
+(defun nndoc-insert-article (article)
+  (let ((ibuf (current-buffer)))
+    (save-excursion
+      (set-buffer nndoc-current-buffer)
+      (widen)
+      (goto-char (point-min))
+      (while (and (re-search-forward nndoc-article-begin nil t)
+		  (not (zerop (setq article (1- article))))))
+      (if (not (zerop article))
+	  ()
+	(narrow-to-region 
+	 (match-end 0)
+	 (or (and (re-search-forward nndoc-article-end nil t)
+		  (match-beginning 0))
+	     (point-max)))
+	(goto-char (point-min))
+	(and nndoc-head-begin
+	     (re-search-forward nndoc-head-begin nil t)
+	     (narrow-to-region (point) (point-max)))
+	(or (re-search-forward nndoc-head-end nil t)
+	    (goto-char (point-max)))
+	(append-to-buffer ibuf (point-min) (point))
+	(and nndoc-body-begin 
+	     (re-search-forward nndoc-body-begin nil t))
+	(append-to-buffer ibuf (point) (point-max))
+	t))))
+
+(provide 'nndoc)
+
+;;; nndoc.el ends here

lisp/nneething.el

@@ -0,0 +1,334 @@
+;;; nneething.el --- random file access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.  
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+
+(defvar nneething-map-file-directory "~/.nneething/"
+  "*Map files directory.")
+
+(defvar nneething-exclude-files "~$"
+  "*Regexp saying what files to exclude from the group.")
+
+(defvar nneething-map-file ".nneething"
+  "*Name of map files.")
+
+
+
+(defconst nneething-version "nneething 1.0"
+  "nneething version.")
+
+(defvar nneething-current-directory nil
+  "Current news group directory.")
+
+(defvar nneething-status-string "")
+(defvar nneething-group-alist nil)
+
+
+
+(defvar nneething-directory nil)
+(defvar nneething-group nil)
+(defvar nneething-map nil)
+(defvar nneething-read-only nil)
+(defvar nneething-active nil)
+(defvar nneething-server-variables 
+  (list
+   (list 'nneething-directory nneething-directory)
+   '(nneething-current-directory nil)
+   '(nneething-status-string "")
+   '(nneething-group-alist)))
+
+
+
+;;; Interface functions.
+
+(defun nneething-retrieve-headers (sequence &optional newsgroup server)
+  (nneething-possibly-change-directory newsgroup)
+
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let* ((number (length sequence))
+	   (count 0)
+	   (large (and (numberp nnmail-large-newsgroup)
+		       (> number nnmail-large-newsgroup)))
+	   article file)
+
+      (if (stringp (car sequence))
+	  'headers
+
+	(while sequence
+	  (setq article (car sequence))
+	  (setq file (nneething-file-name article))
+
+	  (if (and (file-exists-p file)
+		   (not (zerop (nth 7 (file-attributes file)))))
+	      (progn
+		(insert (format "221 %d Article retrieved.\n" article))
+		(nneething-insert-head file)
+		(insert ".\n")))
+
+	  (setq sequence (cdr sequence)
+		count (1+ count))
+
+	  (and large
+	       (zerop (% count 20))
+	       (message "nneething: Receiving headers... %d%%"
+			(/ (* count 100) number))))
+
+	(and large (message "nneething: Receiving headers...done"))
+
+	;; Fold continuation lines.
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	'headers))))
+
+(defun nneething-open-server (server &optional defs)
+  (setq nneething-status-string "")
+  (nnheader-init-server-buffer))
+
+(defun nneething-close-server (&optional server)
+  t)
+
+(defun nneething-server-opened (&optional server)
+  t)
+
+(defun nneething-status-message (&optional server)
+  nneething-status-string)
+
+(defun nneething-request-article (id &optional newsgroup server buffer)
+  (nneething-possibly-change-directory newsgroup)
+  (let ((file (if (stringp id) nil (nneething-file-name id)))
+	(nntp-server-buffer (or buffer nntp-server-buffer)))
+    (and (stringp file)			; We did not request by Message-ID.
+	 (file-exists-p file)		; The file exists.
+	 (not (file-directory-p file))	; It's not a dir.
+	 (save-excursion
+	   (nnmail-find-file file)	; Insert the file in the nntp buf.
+	   (or (nnheader-article-p)	; Either it's a real article...
+	       (progn
+		 (goto-char (point-min))
+		 (nneething-make-head file) ; ... or we fake some headers.
+		 (insert "\n")))
+	   t))))
+
+(defun nneething-request-group (group &optional dir dont-check)
+  (nneething-possibly-change-directory group dir)
+  (or dont-check (nneething-create-mapping))
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (if (> (car nneething-active) (cdr nneething-active))
+	(insert (format "211 0 1 0 %s\n" group))
+      (insert (format "211 %d %d %d %s\n" 
+		      (- (1+ (cdr nneething-active)) (car nneething-active))
+		      (car nneething-active) (cdr nneething-active)
+		      group)))
+    t))
+
+(defun nneething-request-list (&optional server dir)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer))
+  nil)
+
+(defun nneething-request-newgroups (date &optional server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer))
+  nil)
+
+(defun nneething-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defalias 'nneething-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nneething-close-group (group &optional server)
+  t)
+
+
+;;; Internal functions.
+
+(defun nneething-possibly-change-directory (group &optional dir)
+  (if (not group)
+      ()
+    (if (and nneething-group
+	     (string= group nneething-group))
+	t
+      (let (entry)
+	(if (setq entry (assoc group nneething-group-alist))
+	    (progn
+	      (setq nneething-group group)
+	      (setq nneething-directory (nth 1 entry))
+	      (setq nneething-map (nth 2 entry))
+	      (setq nneething-active (nth 3 entry)))
+	  (setq nneething-group group)
+	  (setq nneething-directory dir)
+	  (setq nneething-map nil)
+	  (setq nneething-active (cons 1 0))
+	  (nneething-create-mapping)
+	  (setq nneething-group-alist
+		(cons (list group dir nneething-map nneething-active)
+		      nneething-group-alist)))))))
+
+(defun nneething-map-file ()
+  ;; We make sure that the .neething directory exists. 
+  (make-directory nneething-map-file-directory 'parents)
+  ;; We store it in a special directory under the user's home dir.
+  (concat (file-name-as-directory nneething-map-file-directory)
+	  nneething-group nneething-map-file))
+
+(defun nneething-create-mapping ()
+  ;; Read nneething-active and nneething-map
+  (let ((map-file (nneething-map-file))
+	(files (directory-files nneething-directory))
+	touched)
+    (if (file-exists-p map-file)
+	(condition-case nil
+	    (load map-file nil t t)
+	  (error nil)))
+    (or nneething-active (setq nneething-active (cons 1 0)))
+    ;; Remove files matching that regexp.
+    (let ((f files)
+	  prev)
+      (while f
+	(if (string-match nneething-exclude-files (car f))
+	    (if prev (setcdr prev (cdr f))
+	      (setq files (cdr files)))
+	  (setq prev f))
+	(setq f (cdr f))))
+    ;; Remove files that have disappeared from the map.
+    (let ((map nneething-map)
+	  prev)
+      (while map
+	(if (member (car (car map)) files)
+	    (setq prev map)
+	  (setq touched t)
+	  (if prev
+	      (setcdr prev (cdr map))
+	    (setq nneething-map (cdr nneething-map))))
+	(setq map (cdr map))))
+    ;; Find all new files and enter them into the map.
+    (while files
+      (or (assoc (car files) nneething-map) ; If already in the map, ignore.
+	  (progn
+	    (setq touched t)
+	    (setcdr nneething-active (1+ (cdr nneething-active)))
+	    (setq nneething-map
+		  (cons (cons (car files) (cdr nneething-active)) nneething-map))))
+      (setq files (cdr files)))
+    (if (or (not touched) nneething-read-only)
+	()
+      (save-excursion
+	(set-buffer (get-buffer-create " *nneething map*"))
+	(buffer-disable-undo (current-buffer))
+	(erase-buffer)
+	(insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n"
+		"(setq nneething-active '" (prin1-to-string nneething-active)
+		")\n")
+	(write-region (point-min) (point-max) map-file nil 'nomesg)
+	(kill-buffer (current-buffer))))))
+
+(defvar nneething-message-id-number 0)
+(defvar nneething-work-buffer " *nneething work*")
+
+(defun nneething-insert-head (file)
+  (and (nneething-get-head file)
+       (insert-buffer-substring nneething-work-buffer)))
+
+(defun nneething-make-head (file)
+  (let ((atts (file-attributes file)))
+    (insert "Subject: " (file-name-nondirectory file) "\n"
+	    "Message-ID: <nneething-"
+	    (int-to-string 
+	     (setq nneething-message-id-number
+		   (1+ nneething-message-id-number)))
+	    "@" (system-name) ">\n"
+	    "Date: " (current-time-string (nth 5 atts)) "\n"
+	    (nneething-from-line (nth 2 atts))
+	    "Chars: " (int-to-string (nth 7 atts)) "\n")))
+
+(defun nneething-from-line (uid)
+  (let ((login (condition-case nil 
+		   (user-login-name uid)
+		 (error 
+		  (cond ((= uid (user-uid)) (user-login-name))
+			((zerop uid) "root")
+			(t (int-to-string uid))))))
+	(name (condition-case nil 
+		  (user-full-name uid)
+		(error 
+		 (cond ((= uid (user-uid)) (user-full-name))
+		       ((zerop uid) "Ms. Root"))))))
+    (concat "From: " login "@" (system-name) 
+	    (if name (concat " (" name ")") "") "\n")))
+
+(defun nneething-get-head (file)
+  (save-excursion
+    (set-buffer (get-buffer-create nneething-work-buffer))
+    (setq case-fold-search nil)
+    (buffer-disable-undo (current-buffer))
+    (erase-buffer)
+    (cond 
+     ((not (file-exists-p file))
+      ;; The file do not exist. 
+      nil)
+     ((or (file-directory-p file)
+	  (file-symlink-p file))
+      ;; It's a dir, so we fudge a head.
+      (nneething-make-head file) t)
+     (t 
+      ;; We examine the file.
+      (nnheader-insert-head file)
+      (if (nnheader-article-p)
+	  (delete-region 
+	   (progn
+	     (goto-char (point-min))
+	     (or (and (search-forward "\n\n" nil t)
+		      (1- (point)))
+		 (point-max)))
+	   (point-max))
+	(erase-buffer)
+	(nneething-make-head file))
+      t))))
+
+(defun nneething-number-to-file (number)
+  (car (rassq number nneething-map)))
+
+(defun nneething-file-name (article)
+  (concat (file-name-as-directory nneething-directory)
+	  (if (numberp article) (nneething-number-to-file article)
+	    article)))
+
+(provide 'nneething)
+
+;;; nneething.el ends here

lisp/nnfolder.el

@@ -0,0 +1,704 @@
+;;; nnfolder.el --- mail folder access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Scott Byer <byer@mv.us.adobe.com>
+;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.  
+
+;; Various enhancements by byer@mv.us.adobe.com (Scott Byer).
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'nnmail)
+
+(defvar nnfolder-directory (expand-file-name "~/Mail/")
+  "The name of the mail box file in the users home directory.")
+
+(defvar nnfolder-active-file 
+  (concat (file-name-as-directory nnfolder-directory) "active")
+  "The name of the active file.")
+
+;; I renamed this variable to somehting more in keeping with the general GNU
+;; style. -SLB
+
+(defvar nnfolder-ignore-active-file nil
+  "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file.  
+Note that the active file is still saved, but it's values are not
+used.  This costs some extra time when scanning an mbox when opening
+it.")
+
+;; Note that this variable may not be completely implemented yet. -SLB
+
+(defvar nnfolder-always-close nil
+  "If non-nil, nnfolder attempts to only ever have one mbox open at a time.  
+This is a straight space/performance trade off, as the mboxes will have to 
+be scanned every time they are read in.  If nil (default), nnfolder will
+attempt to keep the buffers around (saving the nnfolder's buffer upon group 
+close, but not killing it), speeding some things up tremendously, especially
+such things as moving mail.  All buffers always get killed upon server close.")
+
+(defvar nnfolder-newsgroups-file 
+  (concat (file-name-as-directory  nnfolder-directory) "newsgroups")
+  "Mail newsgroups description file.")
+
+(defvar nnfolder-get-new-mail t
+  "If non-nil, nnfolder will check the incoming mail file and split the mail.")
+
+(defvar nnfolder-prepare-save-mail-hook nil
+  "Hook run narrowed to an article before saving.")
+
+
+
+(defconst nnfolder-version "nnfolder 1.0"
+  "nnfolder version.")
+
+(defconst nnfolder-article-marker "X-Gnus-Article-Number: "
+  "String used to demarcate what the article number for a message is.")
+
+(defvar nnfolder-current-group nil)
+(defvar nnfolder-current-buffer nil)
+(defvar nnfolder-status-string "")
+(defvar nnfolder-group-alist nil)
+(defvar nnfolder-buffer-alist nil)
+(defvar nnfolder-active-timestamp nil)
+
+(defmacro nnfolder-article-string (article)
+  (` (concat "\n" nnfolder-article-marker (int-to-string (, article)) " ")))
+
+
+
+(defvar nnfolder-current-server nil)
+(defvar nnfolder-server-alist nil)
+(defvar nnfolder-server-variables 
+  (list 
+   (list 'nnfolder-directory nnfolder-directory)
+   (list 'nnfolder-active-file nnfolder-active-file)
+   (list 'nnfolder-newsgroups-file nnfolder-newsgroups-file)
+   (list 'nnfolder-get-new-mail nnfolder-get-new-mail)
+   '(nnfolder-current-group nil)
+   '(nnfolder-current-buffer nil)
+   '(nnfolder-status-string "")
+   '(nnfolder-group-alist nil)
+   '(nnfolder-buffer-alist nil)
+   '(nnfolder-active-timestamp nil)))
+
+
+
+;;; Interface functions
+
+(defun nnfolder-retrieve-headers (sequence &optional newsgroup server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let ((delim-string (concat "^" rmail-unix-mail-delimiter))
+	  article art-string start stop)
+      (nnfolder-possibly-change-group newsgroup)
+      (set-buffer nnfolder-current-buffer)
+      (goto-char (point-min))
+      (if (stringp (car sequence))
+	  'headers
+	(while sequence
+	  (setq article (car sequence))
+	  (setq art-string (nnfolder-article-string article))
+	  (set-buffer nnfolder-current-buffer)
+	  (if (or (search-forward art-string nil t)
+		  ;; Don't search the whole file twice!  Also, articles
+		  ;; probably have some locality by number, so searching
+		  ;; backwards will be faster.  Especially if we're at the
+		  ;; beginning of the buffer :-). -SLB
+		  (search-backward art-string nil t))
+	      (progn
+		(setq start (or (re-search-backward delim-string nil t)
+				(point)))
+		(search-forward "\n\n" nil t)
+		(setq stop (1- (point)))
+		(set-buffer nntp-server-buffer)
+		(insert (format "221 %d Article retrieved.\n" article))
+		(insert-buffer-substring nnfolder-current-buffer start stop)
+		(goto-char (point-max))
+		(insert ".\n")))
+	  (setq sequence (cdr sequence)))
+
+	;; Fold continuation lines.
+	(set-buffer nntp-server-buffer)
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	'headers))))
+
+(defun nnfolder-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nnfolder-current-server)
+      t
+    (if nnfolder-current-server
+	(setq nnfolder-server-alist 
+	      (cons (list nnfolder-current-server
+			  (nnheader-save-variables nnfolder-server-variables))
+		    nnfolder-server-alist)))
+    (let ((state (assoc server nnfolder-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nnfolder-server-alist (delq state nnfolder-server-alist)))
+	(nnheader-set-init-variables nnfolder-server-variables defs)))
+    (setq nnfolder-current-server server)))
+
+(defun nnfolder-close-server (&optional server)
+  t)
+
+(defun nnfolder-server-opened (&optional server)
+  (and (equal server nnfolder-current-server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nnfolder-request-close ()
+  (let ((alist nnfolder-buffer-alist))
+    (while alist
+      (nnfolder-close-group (car (car alist)) nil t)
+      (setq alist (cdr alist))))
+  (setq nnfolder-buffer-alist nil
+	nnfolder-group-alist nil))
+
+(defun nnfolder-status-message (&optional server)
+  nnfolder-status-string)
+
+(defun nnfolder-request-article (article &optional newsgroup server buffer)
+  (nnfolder-possibly-change-group newsgroup)
+  (if (stringp article)
+      nil
+    (save-excursion
+      (set-buffer nnfolder-current-buffer)
+      (goto-char (point-min))
+      (if (search-forward (nnfolder-article-string article) nil t)
+	  (let (start stop)
+	    (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
+	    (setq start (point))
+	    (forward-line 1)
+	    (or (and (re-search-forward 
+		      (concat "^" rmail-unix-mail-delimiter) nil t)
+		     (forward-line -1))
+		(goto-char (point-max)))
+	    (setq stop (point))
+	    (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+	      (set-buffer nntp-server-buffer)
+	      (erase-buffer)
+	      (insert-buffer-substring nnfolder-current-buffer start stop)
+	      (goto-char (point-min))
+	      (while (looking-at "From ")
+		(delete-char 5)
+		(insert "X-From-Line: ")
+		(forward-line 1))
+	      t))))))
+
+(defun nnfolder-request-group (group &optional server dont-check)
+  (save-excursion
+    (nnmail-activate 'nnfolder)
+    (nnfolder-possibly-change-group group)
+    (and (assoc group nnfolder-group-alist)
+	 (progn
+	   (if dont-check
+	       t
+	     (nnfolder-get-new-mail group)
+	     (let* ((active (assoc group nnfolder-group-alist))
+		    (group (car active))
+		    (range (car (cdr active)))
+		    (minactive (car range))
+		    (maxactive (cdr range)))
+	       ;; I've been getting stray 211 lines in my nnfolder active
+	       ;; file.  So, let's make sure that doesn't happen. -SLB
+	       (set-buffer nntp-server-buffer)
+	       (erase-buffer)
+	       (if (not active)
+		   ()
+		 (insert (format "211 %d %d %d %s\n" 
+				 (1+ (- maxactive minactive))
+				 minactive maxactive group))
+		 t)))))))
+
+;; Don't close the buffer if we're not shutting down the server.  This way,
+;; we can keep the buffer in the group buffer cache, and not have to grovel
+;; over the buffer again unless we add new mail to it or modify it in some
+;; way.
+
+(defun nnfolder-close-group (group &optional server force)
+  ;; Make sure we _had_ the group open.
+  (if (or (assoc group nnfolder-buffer-alist)
+	  (equal group nnfolder-current-group))
+      (progn
+	(nnfolder-possibly-change-group group)
+	(save-excursion
+	  (set-buffer nnfolder-current-buffer)
+	  ;; If the buffer was modified, write the file out now.
+	  (and (buffer-modified-p) (save-buffer))
+	  (if (or force
+		  nnfolder-always-close)
+	      ;; If we're shutting the server down, we need to kill the
+	      ;; buffer and remove it from the open buffer list.  Or, of
+	      ;; course, if we're trying to minimize our space impact.
+	      (progn
+		(kill-buffer (current-buffer))
+		(setq nnfolder-buffer-alist (delq (assoc group 
+							 nnfolder-buffer-alist)
+						  nnfolder-buffer-alist)))))))
+  (setq nnfolder-current-group nil
+	nnfolder-current-buffer nil)
+  t)
+
+(defun nnfolder-request-create-group (group &optional server) 
+  (nnmail-activate 'nnfolder)
+  (or (assoc group nnfolder-group-alist)
+      (let (active)
+	(setq nnfolder-group-alist 
+	      (cons (list group (setq active (cons 1 0)))
+		    nnfolder-group-alist))
+	(nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
+  t)
+
+(defun nnfolder-request-list (&optional server)
+  (if server (nnfolder-get-new-mail))
+  (save-excursion
+    (nnmail-find-file nnfolder-active-file)
+    (setq nnfolder-group-alist (nnmail-get-active))))
+
+(defun nnfolder-request-newgroups (date &optional server)
+  (nnfolder-request-list server))
+
+(defun nnfolder-request-list-newsgroups (&optional server)
+  (save-excursion
+    (nnmail-find-file nnfolder-newsgroups-file)))
+
+(defun nnfolder-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defalias 'nnfolder-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nnfolder-request-expire-articles 
+  (articles newsgroup &optional server force)
+  (nnfolder-possibly-change-group newsgroup)
+  (let* ((days (or (and nnmail-expiry-wait-function
+			(funcall nnmail-expiry-wait-function newsgroup))
+		   nnmail-expiry-wait))
+	 (is-old t)
+	 rest)
+    (nnmail-activate 'nnfolder)
+
+    (save-excursion 
+      (set-buffer nnfolder-current-buffer)
+      (while (and articles is-old)
+	(goto-char (point-min))
+	(if (search-forward (nnfolder-article-string (car articles)) nil t)
+	    (if (or force
+		    (setq is-old
+			  (> (nnmail-days-between 
+			      (current-time-string)
+			      (buffer-substring 
+			       (point) (progn (end-of-line) (point))))
+			     days)))
+		(progn
+		  (and gnus-verbose-backends
+		       (message "Deleting article %s..." (car articles)))
+		  (nnfolder-delete-mail))
+	      (setq rest (cons (car articles) rest))))
+	(setq articles (cdr articles)))
+      (and (buffer-modified-p) (save-buffer))
+      ;; Find the lowest active article in this group.
+      (let* ((active (car (cdr (assoc newsgroup nnfolder-group-alist))))
+	     (marker (concat "\n" nnfolder-article-marker))
+	     (number "[0-9]+")
+	     (activemin (cdr active)))
+	(goto-char (point-min))
+	(while (and (search-forward marker nil t)
+		    (re-search-forward number nil t))
+	  (setq activemin (min activemin
+			       (string-to-number (buffer-substring
+						  (match-beginning 0)
+						  (match-end 0))))))
+	(setcar active activemin))
+      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+      (nconc rest articles))))
+
+(defun nnfolder-request-move-article
+  (article group server accept-form &optional last)
+  (nnfolder-possibly-change-group group)
+  (let ((buf (get-buffer-create " *nnfolder move*"))
+	result)
+    (and 
+     (nnfolder-request-article article group server)
+     (save-excursion
+       (set-buffer buf)
+       (buffer-disable-undo (current-buffer))
+       (erase-buffer)
+       (insert-buffer-substring nntp-server-buffer)
+       (goto-char (point-min))
+       (while (re-search-forward 
+	       (concat "^" nnfolder-article-marker)
+	       (save-excursion (search-forward "\n\n" nil t) (point)) t)
+	 (delete-region (progn (beginning-of-line) (point))
+			(progn (forward-line 1) (point))))
+       (setq result (eval accept-form))
+       (kill-buffer buf)
+       result)
+     (save-excursion
+       (nnfolder-possibly-change-group group)
+       (set-buffer nnfolder-current-buffer)
+       (goto-char (point-min))
+       (if (search-forward (nnfolder-article-string article) nil t)
+	   (nnfolder-delete-mail))
+       (and last 
+	    (buffer-modified-p)
+	    (save-buffer))))
+    result))
+
+(defun nnfolder-request-accept-article (group &optional last)
+  (and (stringp group) (nnfolder-possibly-change-group group))
+  (let ((buf (current-buffer))
+	result)
+    (goto-char (point-min))
+    (cond ((looking-at "X-From-Line: ")
+	   (replace-match "From "))
+	  ((not (looking-at "From "))
+	   (insert "From nobody " (current-time-string) "\n")))
+    (and 
+     (nnfolder-request-list)
+     (save-excursion
+       (set-buffer buf)
+       (goto-char (point-min))
+       (search-forward "\n\n" nil t)
+       (forward-line -1)
+       (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
+	 (delete-region (point) (progn (forward-line 1) (point))))
+       (setq result (car (nnfolder-save-mail (and (stringp group) group)))))
+     (save-excursion
+       (set-buffer nnfolder-current-buffer)
+       (and last (buffer-modified-p) (save-buffer))))
+    (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+    result))
+
+(defun nnfolder-request-replace-article (article group buffer)
+  (nnfolder-possibly-change-group group)
+  (save-excursion
+    (set-buffer nnfolder-current-buffer)
+    (goto-char (point-min))
+    (if (not (search-forward (nnfolder-article-string article) nil t))
+	nil
+      (nnfolder-delete-mail t t)
+      (insert-buffer-substring buffer)
+      (and (buffer-modified-p) (save-buffer))
+      t)))
+
+
+;;; Internal functions.
+
+(defun nnfolder-delete-mail (&optional force leave-delim)
+  ;; Beginning of the article.
+  (save-excursion
+    (save-restriction
+      (narrow-to-region
+       (save-excursion
+	 (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
+	 (if leave-delim (progn (forward-line 1) (point))
+	   (match-beginning 0)))
+       (progn
+	 (forward-line 1)
+	 (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) 
+				     nil t)
+		  (if (and (not (bobp)) leave-delim)
+		      (progn (forward-line -2) (point))
+		    (match-beginning 0)))
+	     (point-max))))
+      (delete-region (point-min) (point-max)))))
+
+(defun nnfolder-possibly-change-group (group)
+  (or (file-exists-p nnfolder-directory)
+      (make-directory (directory-file-name nnfolder-directory)))
+  (nnfolder-possibly-activate-groups nil)
+  (or (assoc group nnfolder-group-alist)
+      (not (file-exists-p (concat (file-name-as-directory nnfolder-directory)
+				  group)))
+      (progn
+	(setq nnfolder-group-alist 
+	      (cons (list group (cons 1 0)) nnfolder-group-alist))
+	(nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
+  (let (inf file)
+    (if (and (equal group nnfolder-current-group)
+	     nnfolder-current-buffer
+	     (buffer-name nnfolder-current-buffer))
+	()
+      (setq nnfolder-current-group group)
+
+      ;; If we have to change groups, see if we don't already have the mbox
+      ;; in memory.  If we do, verify the modtime and destroy the mbox if
+      ;; needed so we can rescan it.
+      (if (setq inf (assoc group nnfolder-buffer-alist))
+	  (setq nnfolder-current-buffer (nth 1 inf)))
+
+      ;; If the buffer is not live, make sure it isn't in the alist.  If it
+      ;; is live, verify that nobody else has touched the file since last
+      ;; time.
+      (if (or (not (and nnfolder-current-buffer
+			(buffer-name nnfolder-current-buffer)))
+	      (not (and (bufferp nnfolder-current-buffer)
+			(verify-visited-file-modtime 
+			 nnfolder-current-buffer))))
+	  (progn
+	    (if (and nnfolder-current-buffer
+		     (buffer-name nnfolder-current-buffer)
+		     (bufferp nnfolder-current-buffer))
+		(kill-buffer nnfolder-current-buffer))
+	    (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))
+	    (setq inf nil)))
+      
+      (if inf
+	  ()
+	(save-excursion
+	  (setq file (concat (file-name-as-directory nnfolder-directory)
+			     group))
+	  (if (file-directory-p (file-truename file))
+	      ()
+	    (if (not (file-exists-p file))
+		(write-region 1 1 file t 'nomesg))
+	    (setq nnfolder-current-buffer 
+		  (set-buffer (nnfolder-read-folder file)))
+	    (setq nnfolder-buffer-alist (cons (list group (current-buffer))
+					      nnfolder-buffer-alist)))))))
+  (setq nnfolder-current-group group))
+
+(defun nnfolder-save-mail (&optional group)
+  "Called narrowed to an article."
+  (let* ((nnmail-split-methods 
+	  (if group (list (list group "")) nnmail-split-methods))
+	 (group-art-list
+	  (nreverse (nnmail-article-group 'nnfolder-active-number)))
+	 save-list group-art)
+    (setq save-list group-art-list)
+    (nnmail-insert-lines)
+    (nnmail-insert-xref group-art-list)
+    (run-hooks 'nnfolder-prepare-save-mail-hook)
+
+    ;; Insert the mail into each of the destination groups.
+    (while group-art-list
+      (setq group-art (car group-art-list)
+	    group-art-list (cdr group-art-list))
+
+      ;; Kill the previous newsgroup markers.
+      (goto-char (point-min))
+      (search-forward "\n\n" nil t)
+      (forward-line -1)
+      (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
+	(delete-region (1+ (point)) (progn (forward-line 2) (point))))
+
+      ;; Insert the new newsgroup marker.
+      (nnfolder-possibly-change-group (car group-art))
+      (nnfolder-insert-newsgroup-line group-art)
+      (let ((beg (point-min))
+	    (end (point-max))
+	    (obuf (current-buffer)))
+	(set-buffer nnfolder-current-buffer)
+	(goto-char (point-max))
+	(insert-buffer-substring obuf beg end)
+	(set-buffer obuf)))
+
+    ;; Did we save it anywhere?
+    save-list))
+
+(defun nnfolder-insert-newsgroup-line (group-art)
+  (save-excursion
+    (goto-char (point-min))
+    (if (search-forward "\n\n" nil t)
+	(progn
+	  (forward-char -1)
+	  (insert (format (concat nnfolder-article-marker "%d   %s\n")
+			  (cdr group-art) (current-time-string)))))))
+
+(defun nnfolder-possibly-activate-groups (&optional group)
+  (save-excursion
+    ;; If we're looking for the activation of a specific group, find out
+    ;; its real name and switch to it.
+    (if group (nnfolder-possibly-change-group group))
+    ;; If the group alist isn't active, activate it now.
+    (nnmail-activate 'nnfolder)))
+
+(defun nnfolder-active-number (group)
+  (save-excursion 
+    ;; Find the next article number in GROUP.
+    (prog1
+	(let ((active (car (cdr (assoc group nnfolder-group-alist)))))
+	  (if active
+	      (setcdr active (1+ (cdr active)))
+	    ;; This group is new, so we create a new entry for it.
+	    ;; This might be a bit naughty... creating groups on the drop of
+	    ;; a hat, but I don't know...
+	    (setq nnfolder-group-alist 
+		  (cons (list group (setq active (cons 1 1)))
+			nnfolder-group-alist)))
+	  (cdr active))
+      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+      (nnfolder-possibly-activate-groups group)
+      )))
+
+
+;; This method has a problem if you've accidentally let the active list get
+;; out of sync with the files.  This could happen, say, if you've
+;; accidentally gotten new mail with something other than Gnus (but why
+;; would _that_ ever happen? :-).  In that case, we will be in the middle of
+;; processing the file, ready to add new X-Gnus article number markers, and
+;; we'll run accross a message with no ID yet - the active list _may_not_ be
+;; ready for us yet.
+
+;; To handle this, I'm modifying this routine to maintain the maximum ID seen
+;; so far, and when we hit a message with no ID, we will _manually_ scan the
+;; rest of the message looking for any more, possibly higher IDs.  We'll
+;; assume the maximum that we find is the highest active.  Note that this
+;; shouldn't cost us much extra time at all, but will be a lot less
+;; vulnerable to glitches between the mbox and the active file.
+
+(defun nnfolder-read-folder (file)
+  (save-excursion
+    (nnfolder-possibly-activate-groups nil)
+    ;; We should be paranoid here and make sure the group is in the alist,
+    ;; and add it if it isn't.
+    ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist)
+    (set-buffer (setq nnfolder-current-buffer 
+		      (nnheader-find-file-noselect file nil 'raw)))
+    (buffer-disable-undo (current-buffer))
+    (let ((delim (concat "^" rmail-unix-mail-delimiter))
+	  (marker (concat "\n" nnfolder-article-marker))
+	  (number "[0-9]+")
+	  (active (car (cdr (assoc nnfolder-current-group 
+				   nnfolder-group-alist))))
+	  activenumber activemin start end)
+      (goto-char (point-min))
+      ;;
+      ;; Anytime the active number is 1 or 0, it is supect.  In that case,
+      ;; search the file manually to find the active number.  Or, of course,
+      ;; if we're being paranoid.  (This would also be the place to build
+      ;; other lists from the header markers, such as expunge lists, etc., if
+      ;; we ever desired to abandon the active file entirely for mboxes.)
+      (setq activenumber (cdr active))
+      (if (or nnfolder-ignore-active-file
+	      (< activenumber 2))
+	  (progn
+	    (setq activemin (max (1- (lsh 1 23)) 
+				 (1- (lsh 1 24)) 
+				 (1- (lsh 1 25))))
+	    (while (and (search-forward marker nil t)
+			(re-search-forward number nil t))
+	      (let ((newnum (string-to-number (buffer-substring
+					       (match-beginning 0)
+					       (match-end 0)))))
+		(setq activenumber (max activenumber newnum))
+		(setq activemin (min activemin newnum))))
+	    (setcar active (max 1 (min activemin activenumber)))
+	    (setcdr active (max activenumber (cdr active)))
+	    (goto-char (point-min))))
+
+      ;; Keep track of the active number on our own, and insert it back into
+      ;; the active list when we're done. Also, prime the pump to cut down on
+      ;; the number of searches we do.
+      (setq end (point-marker))
+      (set-marker end (or (and (re-search-forward delim nil t)
+			       (match-beginning 0))
+			  (point-max)))
+      (while (not (= end (point-max)))
+	(setq start (marker-position end))
+	(goto-char end)
+	;; There may be more than one "From " line, so we skip past
+	;; them.  
+	(while (looking-at delim) 
+	  (forward-line 1))
+	(set-marker end (or (and (re-search-forward delim nil t)
+				 (match-beginning 0))
+			    (point-max)))
+	(goto-char start)
+	(if (not (search-forward marker end t))
+	    (progn
+	      (narrow-to-region start end)
+	      (nnmail-insert-lines)
+	      (nnfolder-insert-newsgroup-line
+	       (cons nil (nnfolder-active-number nnfolder-current-group)))
+	      (widen))))
+
+      ;; Make absolutely sure that the active list reflects reality!
+      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+      (current-buffer))))
+
+(defun nnfolder-get-new-mail (&optional group)
+  "Read new incoming mail."
+  (let* ((spools (nnmail-get-spool-files group))
+	 (group-in group)
+	 incomings incoming)
+    (if (or (not nnfolder-get-new-mail) (not nnmail-spool-file))
+	()
+      ;; We first activate all the groups.
+      (nnfolder-possibly-activate-groups nil)
+      ;; The we go through all the existing spool files and split the
+      ;; mail from each.
+      (while spools
+	(and
+	 (file-exists-p (car spools))
+	 (> (nth 7 (file-attributes (car spools))) 0)
+	 (progn
+	   (and gnus-verbose-backends 
+		(message "nnfolder: Reading incoming mail..."))
+	   (if (not (setq incoming 
+			  (nnmail-move-inbox 
+			   (car spools) 
+			   (concat (file-name-as-directory nnfolder-directory)
+				   "Incoming"))))
+	       ()
+	     (setq incomings (cons incoming incomings))
+	     (setq group (nnmail-get-split-group (car spools) group-in))
+	     (nnmail-split-incoming incoming 'nnfolder-save-mail nil group))))
+	(setq spools (cdr spools)))
+      ;; If we did indeed read any incoming spools, we save all info. 
+      (if incoming 
+	  (progn
+	    (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+	    (run-hooks 'nnmail-read-incoming-hook)
+	    (and gnus-verbose-backends
+		 (message "nnfolder: Reading incoming mail...done"))))
+      (let ((bufs nnfolder-buffer-alist))
+	(save-excursion
+	  (while bufs
+	    (if (not (buffer-name (nth 1 (car bufs))))
+		(setq nnfolder-buffer-alist 
+		      (delq (car bufs) nnfolder-buffer-alist))
+	      (set-buffer (nth 1 (car bufs)))
+	      (and (buffer-modified-p) (save-buffer)))
+	    (setq bufs (cdr bufs)))))
+      (while incomings
+	(setq incoming (car incomings))
+	(and 
+	 nnmail-delete-incoming
+	 (file-writable-p incoming)
+	 (file-exists-p incoming)
+	 (delete-file incoming))
+	(setq incomings (cdr incomings))))))
+
+(provide 'nnfolder)
+
+;;; nnfolder.el ends here

lisp/nnheader.el

@@ -0,0 +1,358 @@
+;;; nnheader.el --- header access macros for Gnus and its backends
+;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; These macros may look very much like the ones in GNUS 4.1. They
+;; are, in a way, but you should note that the indices they use have
+;; been changed from the internal GNUS format to the NOV format. Makes
+;; it possible to read headers from XOVER much faster.
+;;
+;; The format of a header is now:
+;; [number subject from date id references chars lines xref]
+;;
+;; (That last entry is defined as "misc" in the NOV format, but Gnus
+;; uses it for xrefs.)
+
+;;; Code:
+
+(defalias 'nntp-header-number 'mail-header-number)
+(defmacro mail-header-number (header)
+  "Return article number in HEADER."
+  (` (aref (, header) 0)))
+
+(defalias 'nntp-set-header-number 'mail-header-set-number)
+(defmacro mail-header-set-number (header number)
+  "Set article number of HEADER to NUMBER."
+  (` (aset (, header) 0 (, number))))
+
+(defalias 'nntp-header-subject 'mail-header-subject)
+(defmacro mail-header-subject (header)
+  "Return subject string in HEADER."
+  (` (aref (, header) 1)))
+
+(defalias 'nntp-set-header-subject 'mail-header-set-subject)
+(defmacro mail-header-set-subject (header subject)
+  "Set article subject of HEADER to SUBJECT."
+  (` (aset (, header) 1 (, subject))))
+
+(defalias 'nntp-header-from 'mail-header-from)
+(defmacro mail-header-from (header)
+  "Return author string in HEADER."
+  (` (aref (, header) 2)))
+
+(defalias 'nntp-set-header-from 'mail-header-set-from)
+(defmacro mail-header-set-from (header from)
+  "Set article author of HEADER to FROM."
+  (` (aset (, header) 2 (, from))))
+
+(defalias 'nntp-header-date 'mail-header-date)
+(defmacro mail-header-date (header)
+  "Return date in HEADER."
+  (` (aref (, header) 3)))
+
+(defalias 'nntp-set-header-date 'mail-header-set-date)
+(defmacro mail-header-set-date (header date)
+  "Set article date of HEADER to DATE."
+  (` (aset (, header) 3 (, date))))
+
+(defalias 'nntp-header-id 'mail-header-id)
+(defmacro mail-header-id (header)
+  "Return Id in HEADER."
+  (` (aref (, header) 4)))
+
+(defalias 'nntp-set-header-id 'mail-header-set-id)
+(defmacro mail-header-set-id (header id)
+  "Set article Id of HEADER to ID."
+  (` (aset (, header) 4 (, id))))
+
+(defalias 'nntp-header-references 'mail-header-references)
+(defmacro mail-header-references (header)
+  "Return references in HEADER."
+  (` (aref (, header) 5)))
+
+(defalias 'nntp-set-header-references 'mail-header-set-references)
+(defmacro mail-header-set-references (header ref)
+  "Set article references of HEADER to REF."
+  (` (aset (, header) 5 (, ref))))
+
+(defalias 'nntp-header-chars 'mail-header-chars)
+(defmacro mail-header-chars (header)
+  "Return number of chars of article in HEADER."
+  (` (aref (, header) 6)))
+
+(defalias 'nntp-set-header-chars 'mail-header-set-chars)
+(defmacro mail-header-set-chars (header chars)
+  "Set number of chars in article of HEADER to CHARS."
+  (` (aset (, header) 6 (, chars))))
+
+(defalias 'nntp-header-lines 'mail-header-lines)
+(defmacro mail-header-lines (header)
+  "Return lines in HEADER."
+  (` (aref (, header) 7)))
+
+(defalias 'nntp-set-header-lines 'mail-header-set-lines)
+(defmacro mail-header-set-lines (header lines)
+  "Set article lines of HEADER to LINES."
+  (` (aset (, header) 7 (, lines))))
+
+(defalias 'nntp-header-xref 'mail-header-xref)
+(defmacro mail-header-xref (header)
+  "Return xref string in HEADER."
+  (` (aref (, header) 8)))
+
+(defalias 'nntp-set-header-xref 'mail-header-set-xref)
+(defmacro mail-header-set-xref (header xref)
+  "Set article xref of HEADER to xref."
+  (` (aset (, header) 8 (, xref))))
+
+
+;; Various cruft the backends and Gnus need to communicate.
+
+(defvar nntp-server-buffer nil)
+(defvar gnus-verbose-backends t
+  "*If non-nil, Gnus backends will generate lots of comments.")
+(defvar gnus-nov-is-evil nil
+  "If non-nil, Gnus backends will never output headers in the NOV format.")
+(defvar news-reply-yank-from nil)
+(defvar news-reply-yank-message-id nil)
+
+;; All backends use this function, so I moved it to this file.
+
+(defun nnheader-init-server-buffer ()
+  (save-excursion
+    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
+    (set-buffer nntp-server-buffer)
+    (buffer-disable-undo (current-buffer))
+    (erase-buffer)
+    (kill-all-local-variables)
+    (setq case-fold-search t)		;Should ignore case.
+    t))
+
+(defun nnheader-set-init-variables (server defs)
+  (let ((s server)
+	val)
+    ;; First we set the server variables in the sequence required.  We
+    ;; use the definitions from the `defs' list where that is
+    ;; possible. 
+    (while s
+      (set (car (car s)) 
+	   (if (setq val (assq (car (car s)) defs))
+	       (nth 1 val)
+	     (nth 1 (car s))))
+      (setq s (cdr s)))
+    ;; The we go through the defs list and set any variables that were
+    ;; not set in the first sweep.
+    (while defs
+      (if (not (assq (car (car defs)) server))
+	  (set (car (car defs)) 
+	       (if (and (symbolp (nth 1 (car defs)))
+			(not (boundp (nth 1 (car defs)))))
+		   (nth 1 (car defs))
+		 (eval (nth 1 (car defs))))))
+      (setq defs (cdr defs)))))
+
+(defun nnheader-save-variables (server)
+  (let (out)
+    (while server
+      (setq out (cons (list (car (car server)) 
+			    (symbol-value (car (car server))))
+		      out))
+      (setq server (cdr server)))
+    (nreverse out)))
+
+(defun nnheader-restore-variables (state)
+  (while state
+    (set (car (car state)) (nth 1 (car state)))
+    (setq state (cdr state))))
+
+;; Read the head of an article.
+(defun nnheader-insert-head (file)
+  (let ((beg 0)
+	(chop 1024))
+    (while (and (eq chop (nth 1 (nnheader-insert-file-contents-literally
+				 file nil beg (setq beg (+ chop beg)))))
+		(prog1 (not (search-backward "\n\n" nil t)) 
+		  (goto-char (point-max)))))))
+
+(defun nnheader-article-p ()
+  (goto-char (point-min))
+  (if (not (search-forward "\n\n" nil t))
+      nil
+    (narrow-to-region (point-min) (1- (point)))
+    (goto-char (point-min))
+    (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
+      (goto-char (match-end 0)))
+    (prog1
+	(eobp)
+      (widen))))    
+
+;; Written by Erik Naggum <erik@naggum.no>.
+(defun nnheader-insert-file-contents-literally (filename &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+  This function ensures that none of these modifications will take place."
+  (let (				; (file-name-handler-alist nil)
+	(format-alist nil)
+	(after-insert-file-functions nil)
+	(find-buffer-file-type-function 
+	 (if (fboundp 'find-buffer-file-type)
+	     (symbol-function 'find-buffer-file-type)
+	   nil)))
+    (unwind-protect
+	(progn
+	  (fset 'find-buffer-file-type (lambda (filename) t))
+	  (insert-file-contents filename visit beg end replace))
+      (if find-buffer-file-type-function
+	  (fset 'find-buffer-file-type find-buffer-file-type-function)
+	(fmakunbound 'find-buffer-file-type)))))
+
+(defun nnheader-find-file-noselect (filename &optional nowarn rawfile)
+  "Read file FILENAME into a buffer and return the buffer.
+If a buffer exists visiting FILENAME, return that one, but
+verify that the file has not changed since visited or saved.
+The buffer is not selected, just returned to the caller."
+  (setq filename
+	(abbreviate-file-name
+	 (expand-file-name filename)))
+  (if (file-directory-p filename)
+      (if find-file-run-dired
+	  (dired-noselect filename)
+	(error "%s is a directory." filename))
+    (let* ((buf (get-file-buffer filename))
+	   (truename (abbreviate-file-name (file-truename filename)))
+	   (number (nthcdr 10 (file-attributes truename)))
+	   ;; Find any buffer for a file which has same truename.
+	   (other (and (not buf) 
+		       (if (fboundp 'find-buffer-visiting)
+			   (find-buffer-visiting filename)
+			 (get-file-buffer filename))))
+	   error)
+      ;; Let user know if there is a buffer with the same truename.
+      (if other
+	  (progn
+	    (or nowarn
+		(string-equal filename (buffer-file-name other))
+		(message "%s and %s are the same file"
+			 filename (buffer-file-name other)))
+	    ;; Optionally also find that buffer.
+	    (if (or (and (boundp 'find-file-existing-other-name)
+			 find-file-existing-other-name)
+		    find-file-visit-truename)
+		(setq buf other))))
+      (if buf
+	  (or nowarn
+	      (verify-visited-file-modtime buf)
+	      (cond ((not (file-exists-p filename))
+		     (error "File %s no longer exists!" filename))
+		    ((yes-or-no-p
+		      (if (string= (file-name-nondirectory filename)
+				   (buffer-name buf))
+			  (format
+			   (if (buffer-modified-p buf)
+			       "File %s changed on disk.  Discard your edits? "
+			     "File %s changed on disk.  Reread from disk? ")
+			   (file-name-nondirectory filename))
+			(format
+			 (if (buffer-modified-p buf)
+			     "File %s changed on disk.  Discard your edits in %s? "
+			   "File %s changed on disk.  Reread from disk into %s? ")
+			 (file-name-nondirectory filename)
+			 (buffer-name buf))))
+		     (save-excursion
+		       (set-buffer buf)
+		       (revert-buffer t t)))))
+	(save-excursion
+;;; The truename stuff makes this obsolete.
+;;;	  (let* ((link-name (car (file-attributes filename)))
+;;;		 (linked-buf (and (stringp link-name)
+;;;				  (get-file-buffer link-name))))
+;;;	    (if (bufferp linked-buf)
+;;;		(message "Symbolic link to file in buffer %s"
+;;;			 (buffer-name linked-buf))))
+	  (setq buf (create-file-buffer filename))
+	  ;;	  (set-buffer-major-mode buf)
+	  (set-buffer buf)
+	  (erase-buffer)
+	  (if rawfile
+	      (condition-case ()
+		  (nnheader-insert-file-contents-literally filename t)
+		(file-error
+		 ;; Unconditionally set error
+		 (setq error t)))
+	    (condition-case ()
+		(insert-file-contents filename t)
+	      (file-error
+	       ;; Run find-file-not-found-hooks until one returns non-nil.
+	       (or t			; (run-hook-with-args-until-success 'find-file-not-found-hooks)
+		   ;; If they fail too, set error.
+		   (setq error t)))))
+	  ;; Find the file's truename, and maybe use that as visited name.
+	  (setq buffer-file-truename truename)
+	  (setq buffer-file-number number)
+	  ;; On VMS, we may want to remember which directory in a search list
+	  ;; the file was found in.
+	  (and (eq system-type 'vax-vms)
+	       (let (logical)
+		 (if (string-match ":" (file-name-directory filename))
+		     (setq logical (substring (file-name-directory filename)
+					      0 (match-beginning 0))))
+		 (not (member logical find-file-not-true-dirname-list)))
+	       (setq buffer-file-name buffer-file-truename))
+	  (if find-file-visit-truename
+	      (setq buffer-file-name
+		    (setq filename
+			  (expand-file-name buffer-file-truename))))
+	  ;; Set buffer's default directory to that of the file.
+	  (setq default-directory (file-name-directory filename))
+	  ;; Turn off backup files for certain file names.  Since
+	  ;; this is a permanent local, the major mode won't eliminate it.
+	  (and (not (funcall backup-enable-predicate buffer-file-name))
+	       (progn
+		 (make-local-variable 'backup-inhibited)
+		 (setq backup-inhibited t)))
+	  (if rawfile
+	      nil
+	    (after-find-file error (not nowarn)))))
+      buf)))
+
+(defun nnheader-insert-references (references message-id)
+  (if (and (not references) (not message-id)) 
+      () ; This is illegal, but not all articles have Message-IDs.
+    (mail-position-on-field "References")
+    ;; Fold long references line to follow RFC1036.
+    (let ((begin (gnus-point-at-bol))
+	  (fill-column 78)
+	  (fill-prefix "\t"))
+      (if references (insert references))
+      (if (and references message-id) (insert " "))
+      (if message-id (insert message-id))
+      ;; The region must end with a newline to fill the region
+      ;; without inserting extra newline.
+      (fill-region-as-paragraph begin (1+ (point))))))
+
+(provide 'nnheader)
+
+;;; nnheader.el ends here

lisp/nnkiboze.el

@@ -0,0 +1,345 @@
+;;; nnkiboze.el --- select virtual news access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; The other access methods (nntp, nnspool, etc) are general news
+;; access methods. This module relies on Gnus and can not be used
+;; separately.
+
+;;; Code:
+
+(require 'nntp)
+(require 'nnheader)
+(require 'gnus)
+(require 'gnus-score)
+
+(defvar nnkiboze-directory 
+  (expand-file-name (or gnus-article-save-directory "~/News/"))
+  "nnkiboze will put its files in this directory.")
+
+
+
+(defconst nnkiboze-version "nnkiboze 1.0"
+  "Version numbers of this version of nnkiboze.")
+
+(defvar nnkiboze-current-group nil)
+(defvar nnkiboze-current-score-group "")
+(defvar nnkiboze-status-string "")
+
+
+
+;;; Interface functions.
+
+(defun nnkiboze-retrieve-headers (articles &optional group server)
+  (nnkiboze-possibly-change-newsgroups group)
+  (if gnus-nov-is-evil
+      nil
+    (if (stringp (car articles))
+	'headers
+      (let ((first (car articles))
+	    (last (progn (while (cdr articles) (setq articles (cdr articles)))
+			 (car articles)))
+	    (nov (nnkiboze-nov-file-name)))
+	(if (file-exists-p nov)
+	    (save-excursion
+	      (set-buffer nntp-server-buffer)
+	      (erase-buffer)
+	      (insert-file-contents nov)
+	      (goto-char (point-min))
+	      (while (and (not (eobp)) (< first (read (current-buffer))))
+		(forward-line 1))
+	      (beginning-of-line)
+	      (if (not (eobp)) (delete-region 1 (point)))
+	      (while (and (not (eobp)) (>= last (read (current-buffer))))
+		(forward-line 1))
+	      (beginning-of-line)
+	      (if (not (eobp)) (delete-region (point) (point-max)))
+	      'nov))))))
+
+(defun nnkiboze-open-server (newsgroups &optional something)
+  "Open a virtual newsgroup that contains NEWSGROUPS."
+  (gnus-make-directory nnkiboze-directory)
+  (nnheader-init-server-buffer))
+
+(defun nnkiboze-close-server (&rest dum)
+  "Close news server."
+  t)
+
+(defalias 'nnkiboze-request-quit (symbol-function 'nnkiboze-close-server))
+
+(defun nnkiboze-server-opened (&optional server)
+  "Return server process status, T or NIL.
+If the stream is opened, return T, otherwise return NIL."
+  (and nntp-server-buffer
+       (get-buffer nntp-server-buffer)))
+
+(defun nnkiboze-status-message (&optional server)
+  "Return server status response as string."
+  nnkiboze-status-string)
+
+(defun nnkiboze-request-article (article &optional newsgroup server buffer)
+  "Select article by message number."
+  (nnkiboze-possibly-change-newsgroups newsgroup)
+  (if (not (numberp article))
+      ;; This is a real cludge. It might not work at times, but it
+      ;; does no harm I think. The only alternative is to offer no
+      ;; article fetching by message-id at all.
+      (nntp-request-article article newsgroup gnus-nntp-server buffer)
+    (let* ((header (gnus-get-header-by-number article))
+	   (xref (mail-header-xref header))
+	   igroup iarticle)
+      (or xref (error "nnkiboze: No xref"))
+      (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
+	  (error "nnkiboze: Malformed xref"))
+      (setq igroup (substring xref (match-beginning 1) (match-end 1)))
+      (setq iarticle (string-to-int 
+		      (substring xref (match-beginning 2) (match-end 2))))
+      (and (gnus-request-group igroup t)
+	   (gnus-request-article iarticle igroup buffer)))))
+
+(defun nnkiboze-request-group (group &optional server dont-check)
+  "Make GROUP the current newsgroup."
+  (nnkiboze-possibly-change-newsgroups group)
+  (if dont-check
+      ()
+    (let ((nov-file (nnkiboze-nov-file-name))
+	  beg end total)
+      (save-excursion
+	(set-buffer nntp-server-buffer)
+	(erase-buffer)
+	(if (not (file-exists-p nov-file))
+	    (insert (format "211 0 0 0 %s\n" group))
+	  (insert-file-contents nov-file)
+	  (if (zerop (buffer-size))
+	      (insert (format "211 0 0 0 %s\n" group))
+	    (goto-char (point-min))
+	    (and (looking-at "[0-9]+") (setq beg (read (current-buffer))))
+	    (goto-char (point-max))
+	    (and (re-search-backward "^[0-9]" nil t)
+		 (setq end (read (current-buffer))))
+	    (setq total (count-lines (point-min) (point-max)))
+	    (erase-buffer)
+	    (insert (format "211 %d %d %d %s\n" total beg end group)))))))
+  t)
+
+(defun nnkiboze-close-group (group &optional server)
+  (nnkiboze-possibly-change-newsgroups group)
+  ;; Remove NOV lines of articles that are marked as read.
+  (if (not (file-exists-p (nnkiboze-nov-file-name)))
+      ()
+    (save-excursion
+      (let ((unreads gnus-newsgroup-unreads)
+	    (unselected gnus-newsgroup-unselected))
+	(set-buffer (get-buffer-create "*nnkiboze work*"))
+	(buffer-disable-undo (current-buffer))
+	(erase-buffer)
+	(let ((cur (current-buffer))
+	      article)
+	  (insert-file-contents (nnkiboze-nov-file-name))
+	  (goto-char (point-min))
+	  (while (looking-at "[0-9]+")
+	    (if (or (memq (setq article (read cur)) unreads)
+		    (memq article unselected))
+		(forward-line 1)
+	      (delete-region (progn (beginning-of-line) (point))
+			     (progn (forward-line 1) (point)))))
+	  (write-file (nnkiboze-nov-file-name))
+	  (kill-buffer (current-buffer)))))
+    (setq nnkiboze-current-group nil)))
+
+(defun nnkiboze-request-list (&optional server) 
+  (setq nnkiboze-status-string "nnkiboze: LIST is not implemented.")
+  nil)
+
+(defun nnkiboze-request-newgroups (date &optional server)
+  "List new groups."
+  (setq nnkiboze-status-string "NEWGROUPS is not supported.")
+  nil)
+
+(defun nnkiboze-request-list-newsgroups (&optional server)
+  (setq nnkiboze-status-string "nnkiboze: LIST NEWSGROUPS is not implemented.")
+  nil)
+
+(defalias 'nnkiboze-request-post 'nntp-request-post)
+
+(defalias 'nnkiboze-request-post-buffer 'nntp-request-post-buffer)
+
+
+;;; Internal functions.
+
+(defun nnkiboze-possibly-change-newsgroups (group)
+  (setq nnkiboze-current-group group))
+
+(defun nnkiboze-prefixed-name (group)
+  (gnus-group-prefixed-name group '(nnkiboze "")))
+
+;;;###autoload
+(defun nnkiboze-generate-groups ()
+  "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups
+Finds out what articles are to be part of the nnkiboze groups."
+  (interactive)
+  (let ((nnmail-spool-file nil)
+	(gnus-use-dribble-file nil)
+	(gnus-read-active-file t)
+	(gnus-expert-user t))
+    (gnus))
+  (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
+	 (newsrc gnus-newsrc-alist))
+    (while newsrc
+      (if (string-match "nnkiboze" (car (car newsrc)))
+	  (nnkiboze-generate-group (car (car newsrc))))
+      (setq newsrc (cdr newsrc)))))
+
+(defun nnkiboze-score-file (group)
+  (list (expand-file-name
+	 (concat gnus-kill-files-directory nnkiboze-current-score-group 
+		 "." gnus-score-file-suffix))))
+
+(defun nnkiboze-generate-group (group) 
+  (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
+	 (newsrc-file (concat nnkiboze-directory group ".newsrc"))
+	 (nov-file (concat nnkiboze-directory group ".nov"))
+	 (regexp (nth 1 (nth 4 info)))
+	 (gnus-expert-user t)
+	 (gnus-large-newsgroup nil)
+	 (gnus-score-find-score-files-function 'nnkiboze-score-file)
+ 	 gnus-select-group-hook gnus-summary-prepare-hook 
+	 gnus-thread-sort-functions gnus-show-threads 
+	 gnus-visual
+	 method nnkiboze-newsrc nov-buffer gname newsrc active
+	 ginfo lowest)
+    (setq nnkiboze-current-score-group group)
+    (or info (error "No such group: %s" group))
+    (and (file-exists-p newsrc-file) (load newsrc-file))
+    (save-excursion
+      (set-buffer (setq nov-buffer (find-file-noselect nov-file)))
+      (buffer-disable-undo (current-buffer)))
+    ;; Go through the active hashtb and add new all groups that match the 
+    ;; kiboze regexp.
+    (mapatoms
+     (lambda (group)
+       (if (and (string-match regexp (setq gname (symbol-name group))) ; Match
+		(not (assoc gname nnkiboze-newsrc)) ; It isn't registered
+		(numberp (car (symbol-value group))) ; It is active
+		(not (string-match "^nnkiboze:" gname))) ; Exclude kibozes
+	   (setq nnkiboze-newsrc 
+		 (cons (cons gname (1- (car (symbol-value group))))
+		       nnkiboze-newsrc))))
+     gnus-active-hashtb)
+    (setq newsrc nnkiboze-newsrc)
+    (while newsrc
+      (if (not (setq active (gnus-gethash 
+			     (car (car newsrc)) gnus-active-hashtb)))
+	  (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
+	(switch-to-buffer gnus-group-buffer)
+	(gnus-group-jump-to-group (car (car newsrc)))
+	(if (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) 
+						  gnus-newsrc-hashtb)))
+		 (nth 3 ginfo))
+	    (setcar (nthcdr 3 ginfo) nil))
+	(if (not (and (or (not ginfo)
+			  (> (length (gnus-list-of-unread-articles 
+				      (car ginfo))) 0))
+		      (progn
+			(gnus-group-select-group nil)
+			(eq major-mode 'gnus-summary-mode))))
+	    ()
+	  (setq lowest (cdr (car newsrc)))
+	  (setq method (gnus-find-method-for-group gnus-newsgroup-name))
+	  (and (eq method gnus-select-method) (setq method nil))
+	  (while gnus-newsgroup-scored
+	    (if (> (car (car gnus-newsgroup-scored)) lowest)
+		(nnkiboze-enter-nov 
+		 nov-buffer
+		 (gnus-get-header-by-number (car (car gnus-newsgroup-scored)))
+		 (if method
+		     (gnus-group-prefixed-name gnus-newsgroup-name method)
+		   gnus-newsgroup-name)))
+	    (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
+	  (gnus-summary-quit)))
+      (setcdr (car newsrc) (car active))
+      (setq newsrc (cdr newsrc)))
+    (set-buffer nov-buffer)
+    (save-buffer)
+    (kill-buffer (current-buffer))
+    (set-buffer (get-buffer-create "*nnkiboze work*"))
+    (buffer-disable-undo (current-buffer))
+    (erase-buffer)
+    (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc)
+	    ")\n")
+    (write-file newsrc-file)
+    (kill-buffer (current-buffer))
+    (switch-to-buffer gnus-group-buffer)
+    (gnus-group-list-groups 5 nil)))
+    
+(defun nnkiboze-enter-nov (buffer header group)
+  (save-excursion
+    (set-buffer buffer)
+    (goto-char (point-max))
+    (let ((xref (mail-header-xref header))
+	  (prefix (gnus-group-real-prefix group))
+	  (first t)
+	  article)
+      (if (zerop (forward-line -1))
+	  (progn
+	    (setq article (1+ (read (current-buffer))))
+	    (forward-line 1))
+	(setq article 1))
+      (insert (int-to-string article) "\t"
+	      (or (mail-header-subject header) "") "\t"
+	      (or (mail-header-from header) "") "\t"
+	      (or (mail-header-date header) "") "\t"
+	      (or (mail-header-id header) "") "\t"
+	      (or (mail-header-references header) "") "\t"
+	      (int-to-string (or (mail-header-chars header) 0)) "\t"
+	      (int-to-string (or (mail-header-lines header) 0)) "\t")
+      (if (or (not xref) (equal "" xref))
+	  (insert "Xref: " (system-name) " " group ":" 
+		  (int-to-string (mail-header-number header))
+		  "\t\n")
+	(insert (mail-header-xref header) "\t\n")
+	(search-backward "\t" nil t)
+	(search-backward "\t" nil t)
+	(while (re-search-forward 
+		"[^ ]+:[0-9]+"
+		(save-excursion (end-of-line) (point)) t)
+	  (if first
+	      ;; The first xref has to be the group this article
+	      ;; really came for - this is the article nnkiboze
+	      ;; will request when it is asked for the article.
+	      (save-excursion
+		(goto-char (match-beginning 0))
+		(insert prefix group ":" 
+			(int-to-string (mail-header-number header)) " ")
+		(setq first nil)))
+	  (save-excursion
+	    (goto-char (match-beginning 0))
+	    (insert prefix)))))))
+
+(defun nnkiboze-nov-file-name ()
+  (concat nnkiboze-directory
+	  (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))
+
+(provide 'nnkiboze)
+
+;;; nnkiboze.el ends here

lisp/nnmail.el

@@ -0,0 +1,877 @@
+;;; nnmail.el --- mail support functions for the Gnus mail backends
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'timezone)
+(require 'sendmail)
+
+(defvar nnmail-split-methods
+  '(("mail.misc" ""))
+  "*Incoming mail will be split according to this variable.
+
+If you'd like, for instance, one mail group for mail from the
+\"4ad-l\" mailing list, one group for junk mail and one for everything
+else, you could do something like this:
+
+ (setq nnmail-split-methods
+       '((\"mail.4ad\" \"From:.*4ad\")
+         (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
+         (\"mail.misc\" \"\")))
+
+As you can see, this variable is a list of lists, where the first
+element in each \"rule\" is the name of the group (which, by the way,
+does not have to be called anything beginning with \"mail\",
+\"yonka.zow\" is a fine, fine name), and the second is a regexp that
+nnmail will try to match on the header to find a fit.
+
+The second element can also be a function.  In that case, it will be
+called narrowed to the headers with the first element of the rule as
+the argument.  It should return a non-nil value if it thinks that the
+mail belongs in that group.
+
+The last element should always have \"\" as the regexp.
+
+This variable can also have a function as its value.")
+
+;; Suggested by Erik Selberg <speed@cs.washington.edu>.
+(defvar nnmail-crosspost t
+  "*If non-nil, do crossposting if several split methods match the mail.
+If nil, the first match found will be used.")
+
+;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
+(defvar nnmail-keep-last-article nil
+  "*If non-nil, nnmail will never delete the last expired article in a
+directory.  You may need to set this variable if other programs are putting
+new mail into folder numbers that Gnus has marked as expired.")
+
+(defvar nnmail-expiry-wait 7
+  "*Articles that are older than `nnmail-expiry-wait' days will be expired.")
+
+(defvar nnmail-expiry-wait-function nil
+  "*Variable that holds function to specify how old articles should be before they are expired.
+  The function will be called with the name of the group that the
+expiry is to be performed in, and it should return an integer that
+says how many days an article can be stored before it is considered
+'old'. 
+
+Eg.:
+
+(setq nnmail-expiry-wait-function
+      (lambda (newsgroup)
+        (cond ((string-match \"private\" newsgroup) 31)
+              ((string-match \"junk\" newsgroup) 1)
+	      (t 7))))")
+
+(defvar nnmail-spool-file 
+  (or (getenv "MAIL")
+      (concat "/usr/spool/mail/" (user-login-name)))
+  "Where the mail backends will look for incoming mail.
+This variable is \"/usr/spool/mail/$user\" by default.
+If this variable is nil, no mail backends will read incoming mail.
+If this variable is a list, all files mentioned in this list will be
+used as incoming mailboxes.")
+
+(defvar nnmail-use-procmail nil
+  "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
+The file(s) in `nnmail-spool-file' will also be read.")
+
+(defvar nnmail-procmail-directory "~/incoming/"
+  "*When using procmail (and the like), incoming mail is put in this directory.
+The Gnus mail backends will read the mail from this directory.")
+
+(defvar nnmail-procmail-suffix ".spool"
+  "*Suffix of files created by procmail (and the like).
+This variable might be a suffix-regexp to match the suffixes of
+several files - eg. \".spool[0-9]*\".")
+
+(defvar nnmail-resplit-incoming nil
+  "*If non-nil, re-split incoming procmail sorted mail.")
+
+(defvar nnmail-movemail-program "movemail"
+  "*A command to be executed to move mail from the inbox.
+The default is \"movemail\".")
+
+(defvar nnmail-read-incoming-hook nil
+  "*Hook that will be run after the incoming mail has been transferred.
+The incoming mail is moved from `nnmail-spool-file' (which normally is
+something like \"/usr/spool/mail/$user\") to the user's home
+directory. This hook is called after the incoming mail box has been
+emptied, and can be used to call any mail box programs you have
+running (\"xwatch\", etc.)
+
+Eg.
+
+(add-hook 'nnmail-read-incoming-hook 
+	   (lambda () 
+	     (start-process \"mailsend\" nil 
+			    \"/local/bin/mailsend\" \"read\" \"mbox\")))")
+
+;; Suggested by Erik Selberg <speed@cs.washington.edu>.
+(defvar nnmail-prepare-incoming-hook nil
+  "*Hook called before treating incoming mail.
+The hook is run in a buffer with all the new, incoming mail.")
+
+;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
+(defvar nnmail-tmp-directory nil
+  "*If non-nil, use this directory for temporary storage when reading incoming mail.")
+
+(defvar nnmail-large-newsgroup 50
+  "*The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+(defvar nnmail-split-fancy "mail.misc"
+  "*Incoming mail can be split according to this fancy variable.
+To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
+
+The format is this variable is SPLIT, where SPLIT can be one of
+the following:
+
+GROUP: Mail will be stored in GROUP (a string).
+
+\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
+  VALUE (a regexp), store the messages as specified by SPLIT.
+
+\(| SPLIT...): Process each SPLIT expression until one of them matches.
+  A SPLIT expression is said to match if it will cause the mail
+  message to be stored in one or more groups.  
+
+\(& SPLIT...): Process each SPLIT expression.
+
+FIELD must match a complete field name.  VALUE must match a complete
+word according to the fundamental mode syntax table.  You can use .*
+in the regexps to match partial field names or words.
+
+FIELD and VALUE can also be lisp symbols, in that case they are expanded
+as specified in `nnmail-split-abbrev-alist'.
+
+Example:
+
+\(setq nnmail-split-methods 'nnmail-split-fancy
+      nnmail-split-fancy
+      ;; Messages from the mailer deamon are not crossposted to any of
+      ;; the ordinary groups.  Warnings are put in a separate group
+      ;; from real errors.
+      '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
+			  \"mail.misc\"))
+	  ;; Non-error messages are crossposted to all relevant
+	  ;; groups, but we don't crosspost between the group for the
+	  ;; (ding) list and the group for other (ding) related mail.
+	  (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
+		(\"subject\" \"ding\" \"ding.misc\"))
+	     ;; Other mailing lists...
+	     (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
+	     (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
+	     ;; People...
+	     (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
+	  ;; Unmatched mail goes to the catch all group.
+	  \"misc.misc\"))")
+
+(defvar nnmail-split-abbrev-alist
+  '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
+    (mail . "mailer-daemon\\|postmaster"))
+  "*Alist of abbreviations allowed in `nnmail-split-fancy'.")
+
+(defvar nnmail-delete-incoming t
+  "*If non-nil, the mail backends will delete incoming files after splitting.")
+
+(defvar nnmail-message-id-cache-length 1000
+  "*The approximate number of Message-IDs nnmail will keep in its cache.
+If this variable is nil, no checking on duplicate messages will be
+perfomed.")
+
+(defvar nnmail-message-id-cache-file "~/.nnmail-cache"
+  "*The file name of the nnmail Message-ID cache.")
+
+(defvar nnmail-delete-duplicates nil
+  "*If non-nil, nnmail will delete any duplicate mails it sees.")
+
+
+
+(defconst nnmail-version "nnmail 1.0"
+  "nnmail version.")
+
+
+
+(defun nnmail-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defun nnmail-request-post-buffer (post group subject header article-buffer
+					info follow-to respect-poster)
+  (let ((method-address (cdr (assq 'to-address (nth 5 info))))
+	from date to reply-to message-of
+	references message-id cc new-cc sendto elt)
+    (setq method-address
+	  (if (and (stringp method-address) 
+		   (string= method-address ""))
+	      nil method-address))
+    (save-excursion
+      (set-buffer (get-buffer-create "*mail*"))
+      (mail-mode)
+      (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+      (if (and (buffer-modified-p)
+	       (> (buffer-size) 0)
+	       (not (y-or-n-p "Unsent mail being composed; erase it? ")))
+	  ()
+	(erase-buffer)
+	(if post
+	    (progn
+	      (mail-setup method-address subject nil nil nil nil)
+	      (auto-save-mode auto-save-default))
+	  (save-excursion
+	    (set-buffer article-buffer)
+	    (goto-char (point-min))
+	    (narrow-to-region (point-min)
+			      (progn (search-forward "\n\n") (point)))
+	    (let ((buffer-read-only nil))
+	      (set-text-properties (point-min) (point-max) nil))
+	    (setq from (mail-header-from header))
+	    (setq date (mail-header-date header))
+	    (and from
+		 (let ((stop-pos 
+			(string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+		   (setq message-of
+			 (concat (if stop-pos (substring from 0 stop-pos) from)
+				 "'s message of " date))))
+	    (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") "")))
+	    (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") "")))
+	    (setq new-cc (rmail-dont-reply-to 
+			  (concat (or to "")
+				  (if cc (concat (if to ", " "") cc) ""))))
+	    (let ((rmail-dont-reply-to-names 
+		   (regexp-quote (mail-strip-quoted-names
+				  (or method-address reply-to from "")))))
+	      (setq new-cc (rmail-dont-reply-to new-cc)))
+	    (setq subject (mail-header-subject header))
+	    (or (string-match "^[Rr][Ee]:" subject)
+		(setq subject (concat "Re: " subject)))
+	    (setq reply-to (mail-fetch-field "reply-to"))
+	    (setq references (mail-header-references header))
+	    (setq message-id (mail-header-id header))
+	    (widen))
+	  (setq news-reply-yank-from from)
+	  (setq news-reply-yank-message-id message-id)
+	  
+	  ;; Gather the "to" addresses out of the follow-to list and remove
+	  ;; them as we go.
+	  (if (and follow-to (listp follow-to))
+	      (while (setq elt (assoc "To" follow-to))
+		(setq sendto (concat sendto (and sendto ", ") (cdr elt)))
+		(setq follow-to (delq elt follow-to))))
+	  (mail-setup (if (and follow-to (listp follow-to)) 
+			  sendto
+			(or method-address reply-to from ""))
+		      subject message-of 
+		      (if (zerop (length new-cc)) nil new-cc)
+		      article-buffer nil)
+	  (auto-save-mode auto-save-default)
+	  ;; Note that "To" elements should already be in the message.
+	  (if (and follow-to (listp follow-to))
+	      (progn
+		(goto-char (point-min))
+		(re-search-forward "^To:" nil t)
+		(beginning-of-line)
+		(forward-line 1)
+		(while follow-to
+		  (insert 
+		   (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
+		  (setq follow-to (cdr follow-to)))))
+	  (nnheader-insert-references references message-id)))
+      (current-buffer))))
+
+(defun nnmail-find-file (file)
+  "Insert FILE in server buffer safely."
+  (set-buffer nntp-server-buffer)
+  (erase-buffer)
+  (condition-case ()
+      (progn (insert-file-contents file) t)
+    (file-error nil)))
+
+(defun nnmail-article-pathname (group mail-dir)
+  "Make pathname for GROUP."
+  (concat (file-name-as-directory (expand-file-name mail-dir))
+	  (nnmail-replace-chars-in-string group ?. ?/) "/"))
+
+(defun nnmail-replace-chars-in-string (string from to)
+  "Replace characters in STRING from FROM to TO."
+  (let ((string (substring string 0))	;Copy string.
+	(len (length string))
+	(idx 0))
+    ;; Replace all occurrences of FROM with TO.
+    (while (< idx len)
+      (if (= (aref string idx) from)
+	  (aset string idx to))
+      (setq idx (1+ idx)))
+    string))
+
+(defun nnmail-days-between (date1 date2)
+  ;; Return the number of days between date1 and date2.
+  (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) )
+		    (timezone-parse-date date1)))
+	(d2 (mapcar (lambda (s) (and s (string-to-int s)) )
+		    (timezone-parse-date date2))))
+    (- (timezone-absolute-from-gregorian 
+	(nth 1 d1) (nth 2 d1) (car d1))
+       (timezone-absolute-from-gregorian 
+	(nth 1 d2) (nth 2 d2) (car d2)))))
+
+;; Function taken from rmail.el.
+(defun nnmail-move-inbox (inbox tofile)
+  (let ((inbox (file-truename
+		(expand-file-name (substitute-in-file-name inbox))))
+	movemail popmail errors)
+    ;; Check whether the inbox is to be moved to the special tmp dir. 
+    (if nnmail-tmp-directory
+	(setq tofile (concat (file-name-as-directory nnmail-tmp-directory)
+			     (file-name-nondirectory tofile))))
+    ;; Make the filename unique.
+    (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile)))
+    ;; We create the directory the tofile is to reside in if it
+    ;; doesn't exist.
+    (or (file-exists-p (file-name-directory tofile))
+	(make-directory tofile 'parents))
+    ;; If getting from mail spool directory,
+    ;; use movemail to move rather than just renaming,
+    ;; so as to interlock with the mailer.
+    (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
+	(setq movemail t))
+    (if popmail (setq inbox (file-name-nondirectory inbox)))
+    (if movemail
+	;; On some systems, /usr/spool/mail/foo is a directory
+	;; and the actual inbox is /usr/spool/mail/foo/foo.
+	(if (file-directory-p inbox)
+	    (setq inbox (expand-file-name (user-login-name) inbox))))
+    (if popmail
+	(message "Getting mail from post office ...")
+      (if (or (and (file-exists-p tofile)
+		   (/= 0 (nth 7 (file-attributes tofile))))
+	      (and (file-exists-p inbox)
+		   (/= 0 (nth 7 (file-attributes inbox)))))
+	  (message "Getting mail from %s..." inbox)))
+    ;; Set TOFILE if have not already done so, and
+    ;; rename or copy the file INBOX to TOFILE if and as appropriate.
+    (cond ((or (file-exists-p tofile) (and (not popmail)
+					   (not (file-exists-p inbox))))
+	   nil)
+	  ((and (not movemail) (not popmail))
+	   ;; Try copying.  If that fails (perhaps no space),
+	   ;; rename instead.
+	   (condition-case nil
+	       (copy-file inbox tofile nil)
+	     (error
+	      ;; Third arg is t so we can replace existing file TOFILE.
+	      (rename-file inbox tofile t)))
+	   ;; Make the real inbox file empty.
+	   ;; Leaving it deleted could cause lossage
+	   ;; because mailers often won't create the file.
+	   (condition-case ()
+	       (write-region (point) (point) inbox)
+	     (file-error nil)))
+	  (t
+	   (unwind-protect
+	       (save-excursion
+		 (setq errors (generate-new-buffer " *nnmail loss*"))
+		 (buffer-disable-undo errors)
+		 (call-process
+		  (expand-file-name nnmail-movemail-program exec-directory)
+		  nil errors nil inbox tofile)
+		 (if (not (buffer-modified-p errors))
+		     ;; No output => movemail won
+		     nil
+		   (set-buffer errors)
+		   (subst-char-in-region (point-min) (point-max) ?\n ?\  )
+		   (goto-char (point-max))
+		   (skip-chars-backward " \t")
+		   (delete-region (point) (point-max))
+		   (goto-char (point-min))
+		   (if (looking-at "movemail: ")
+		       (delete-region (point-min) (match-end 0)))
+		   (beep t)
+		   (message (concat "movemail: "
+				    (buffer-substring (point-min)
+						      (point-max))))
+		   (sit-for 3)
+		   nil)))))
+    (and errors
+	 (buffer-name errors)
+	 (kill-buffer errors))
+    tofile))
+
+
+(defun nnmail-get-active ()
+  "Returns an assoc of group names and active ranges.
+nn*-request-list should have been called before calling this function."
+  (let (group-assoc)
+    ;; Go through all groups from the active list.
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (goto-char (point-min))
+      (while (re-search-forward 
+	      "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
+	(setq group-assoc
+	      (cons (list (buffer-substring (match-beginning 1) 
+					    (match-end 1))
+			  (cons (string-to-int 
+				 (buffer-substring (match-beginning 3)
+						   (match-end 3)))
+				(string-to-int 
+				 (buffer-substring (match-beginning 2)
+						   (match-end 2)))))
+		    group-assoc))))
+
+    ;;    ;; In addition, add all groups mentioned in `nnmail-split-methods'.
+    ;;    (let ((methods (and (not (symbolp nnmail-split-methods))
+    ;;			nnmail-split-methods)))
+    ;;      (while methods
+    ;;	(if (not (assoc (car (car methods)) group-assoc))
+    ;;	    (setq group-assoc
+    ;;		  (cons (list (car (car methods)) (cons 1 0)) 
+    ;;			group-assoc)))
+    ;;	(setq methods (cdr methods)))
+    
+    group-assoc))
+
+(defun nnmail-save-active (group-assoc file-name)
+  (let (group)
+    (save-excursion
+      (set-buffer (get-buffer-create " *nnmail active*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (while group-assoc
+	(setq group (car group-assoc))
+	(insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
+			(car (car (cdr group)))))
+	(setq group-assoc (cdr group-assoc)))
+      (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
+      (kill-buffer (current-buffer)))))
+
+(defun nnmail-get-split-group (file group)
+  (if (or (eq nnmail-spool-file 'procmail)
+	  nnmail-use-procmail)
+      (cond (group group)
+	    ((string-match (concat "^" (expand-file-name
+					(file-name-as-directory
+					 nnmail-procmail-directory))
+				   "\\(.*\\)" nnmail-procmail-suffix "$")
+			   (expand-file-name file))
+	     (substring (expand-file-name file)
+			(match-beginning 1) (match-end 1)))
+	    (t
+	     group))
+    group))
+
+(defun nnmail-split-incoming (incoming func &optional dont-kill group)
+  "Go through the entire INCOMING file and pick out each individual mail.
+FUNC will be called with the buffer narrowed to each mail."
+  (let ((delim (concat "^" rmail-unix-mail-delimiter))
+	;; If this is a group-specific split, we bind the split
+	;; methods to just this group.
+	(nnmail-split-methods (if (and group
+				       (or (eq nnmail-spool-file 'procmail)
+					   nnmail-use-procmail)
+				       (not nnmail-resplit-incoming))
+				  (list (list group ""))
+				nnmail-split-methods))
+	start end content-length do-search message-id)
+    (save-excursion
+      ;; Open the message-id cache.
+      (nnmail-cache-open)
+      ;; Insert the incoming file.
+      (set-buffer (get-buffer-create " *nnmail incoming*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (insert-file-contents incoming)
+      (goto-char (point-min))
+      (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
+      ;; Go to the beginning of the first mail...
+      (if (and (re-search-forward delim nil t)
+	       (goto-char (match-beginning 0)))
+	  ;; and then carry on until the bitter end.
+	  (while (not (eobp))
+	    (setq start (point))
+	    ;; Skip all the headers in case there are more "From "s...
+	    (if (not (search-forward "\n\n" nil t))
+		(forward-line 1))
+	    ;; Find the Message-ID header.
+	    (save-excursion
+	      (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
+		  (setq message-id (buffer-substring (match-beginning 1)
+						     (match-end 1)))
+		;; There is no Message-ID here, so we create one.
+		(forward-line -1)
+		(insert "Message-ID: " (setq message-id (nnmail-message-id))
+			"\n")))
+	    ;; Look for a Content-Length header.
+	    (if (not (save-excursion
+		       (and (re-search-backward 
+			     "^Content-Length: \\([0-9]+\\)" start t)
+			    (setq content-length (string-to-int
+						  (buffer-substring 
+						   (match-beginning 1)
+						   (match-end 1))))
+			    ;; We destroy the header, since none of
+			    ;; the backends ever use it, and we do not
+			    ;; want to confuse other mailers by having
+			    ;; a (possibly) faulty header.
+			    (progn (insert "X-") t))))
+		(setq do-search t)
+	      (if (or (= (+ (point) content-length) (point-max))
+		      (save-excursion
+			(goto-char (+ (point) content-length))
+			(looking-at delim)))
+		  (progn
+		    (goto-char (+ (point) content-length))
+		    (setq do-search nil))
+		(setq do-search t)))
+	    ;; Go to the beginning of the next article - or to the end
+	    ;; of the buffer.  
+	    (if do-search
+		(if (re-search-forward delim nil t)
+		    (goto-char (match-beginning 0))
+		  (goto-char (point-max))))
+	    (save-excursion
+	      (save-restriction
+		(narrow-to-region start (point))
+		(goto-char (point-min))
+		;; If this is a duplicate message, then we do not save it.
+		(if (nnmail-cache-id-exists-p message-id)
+		    (delete-region (point-min) (point-max))
+		  (nnmail-cache-insert message-id)
+		  (funcall func))
+		(setq end (point-max))))
+	    (goto-char end)))
+      ;; Close the message-id cache.
+      (nnmail-cache-close)
+      (if dont-kill
+	  (current-buffer)
+	(kill-buffer (current-buffer))))))
+
+;; Mail crossposts syggested by Brian Edmonds <edmonds@cs.ubc.ca>. 
+(defun nnmail-article-group (func)
+  "Look at the headers and return an alist of groups that match.
+FUNC will be called with the group name to determine the article number."
+  (let ((methods nnmail-split-methods)
+	(obuf (current-buffer))
+	(beg (point-min))
+	end group-art)
+    (if (and (sequencep methods) (= (length methods) 1))
+	;; If there is only just one group to put everything in, we
+	;; just return a list with just this one method in.
+	(setq group-art
+	      (list (cons (car (car methods))
+			  (funcall func (car (car methods))))))
+      ;; We do actual comparison.
+      (save-excursion
+	;; Find headers.
+	(goto-char beg)
+	(setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
+	(set-buffer (get-buffer-create " *nnmail work*"))
+	(buffer-disable-undo (current-buffer))
+	(erase-buffer)
+	;; Copy the headers into the work buffer.
+	(insert-buffer-substring obuf beg end)
+	;; Fold continuation lines.
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	(if (and (symbolp nnmail-split-methods)
+		 (fboundp nnmail-split-methods))
+	    (setq group-art
+		  (mapcar
+		   (lambda (group) (cons group (funcall func group)))
+		   (condition-case nil
+		       (funcall nnmail-split-methods)
+		     (error
+		      (message "\
+Problems with `nnmail-split-methods', using `bogus' mail group")
+		      (sit-for 1)
+		      '("bogus")))))
+	  ;; Go throught the split methods to find a match.
+	  (while (and methods (or nnmail-crosspost (not group-art)))
+	    (goto-char (point-max))
+	    (if (or (cdr methods)
+		    (not (equal "" (nth 1 (car methods)))))
+		(if (and (condition-case () 
+			     (if (stringp (nth 1 (car methods)))
+				 (re-search-backward
+				  (car (cdr (car methods))) nil t)
+			       ;; Suggested by Brian Edmonds 
+			       ;; <edmonds@cs.ubc.ca>.
+			       (funcall (nth 1 (car methods)) 
+					(car (car methods))))
+			   (error nil))
+			 ;; Don't enter the article into the same group twice.
+			 (not (assoc (car (car methods)) group-art)))
+		    (setq group-art
+			  (cons (cons (car (car methods))
+				      (funcall func (car (car methods)))) 
+				group-art)))
+	      (or group-art
+		  (setq group-art 
+			(list (cons (car (car methods)) 
+				    (funcall func (car (car methods))))))))
+	    (setq methods (cdr methods))))
+	(kill-buffer (current-buffer))
+	group-art))))
+
+(defun nnmail-insert-lines ()
+  "Insert how many lines and chars there are in the body of the mail."
+  (let (lines chars)
+    (save-excursion
+      (goto-char (point-min))
+      (if (search-forward "\n\n" nil t) 
+	  (progn
+	    (setq chars (- (point-max) (point)))
+	    (setq lines (- (count-lines (point) (point-max)) 1))
+	    (forward-char -1)
+	    (save-excursion
+	      (if (re-search-backward "^Lines: " nil t)
+		  (delete-region (point) (progn (forward-line 1) (point)))))
+	    (insert (format "Lines: %d\n" lines))
+	    chars)))))
+
+(defun nnmail-insert-xref (group-alist)
+  "Insert an Xref line based on the (group . article) alist."
+  (save-excursion
+    (goto-char (point-min))
+    (if (search-forward "\n\n" nil t) 
+	(progn
+	  (forward-char -1)
+	  (if (re-search-backward "^Xref: " nil t)
+	      (delete-region (match-beginning 0) 
+			     (progn (forward-line 1) (point))))
+	  (insert (format "Xref: %s" (system-name)))
+	  (while group-alist
+	    (insert (format " %s:%d" (car (car group-alist)) 
+			    (cdr (car group-alist))))
+	    (setq group-alist (cdr group-alist)))
+	  (insert "\n")))))
+
+;; Written by byer@mv.us.adobe.com (Scott Byer).
+(defun nnmail-make-complex-temp-name (prefix)
+  (let ((newname (make-temp-name prefix))
+	(newprefix prefix))
+    (while (file-exists-p newname)
+      (setq newprefix (concat newprefix "x"))
+      (setq newname (make-temp-name newprefix)))
+    newname))
+
+;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
+
+(defun nnmail-split-fancy ()
+  "Fancy splitting method.
+See the documentation for the variable `nnmail-split-fancy' for documentation."
+  (nnmail-split-it nnmail-split-fancy))
+
+(defvar nnmail-split-cache nil)
+;; Alist of split expresions their equivalent regexps.
+
+(defun nnmail-split-it (split)
+  ;; Return a list of groups matching SPLIT.
+  (cond ((stringp split)
+	 ;; A group.
+	 (list split))
+	((eq (car split) '&)
+	 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
+	((eq (car split) '|)
+	 (let (done)
+	   (while (and (not done) (cdr split))
+	     (setq split (cdr split)
+		   done (nnmail-split-it (car split))))
+	   done))	((assq split nnmail-split-cache)
+			 ;; A compiled match expression.
+	 (goto-char (point-max))
+	 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
+	     (nnmail-split-it (nth 2 split))))
+	(t
+	 ;; An uncompiled match.
+	 (let* ((field (nth 0 split))
+		(value (nth 1 split))
+		(regexp (concat "^\\(" 
+				(if (symbolp field)
+				    (cdr (assq field 
+					       nnmail-split-abbrev-alist))
+				  field)
+				"\\):.*\\<\\("
+				(if (symbolp value)
+				    (cdr (assq value
+					       nnmail-split-abbrev-alist))
+				  value)
+				"\\>\\)")))
+	   (setq nnmail-split-cache 
+		 (cons (cons split regexp) nnmail-split-cache))
+	   (goto-char (point-max))
+	   (if (re-search-backward regexp nil t)
+	       (nnmail-split-it (nth 2 split)))))))
+
+;; Get a list of spool files to read.
+(defun nnmail-get-spool-files (&optional group)
+  (if (null nnmail-spool-file)
+      ;; No spool file whatsoever.
+      nil)
+  (let* ((procmails 
+	  ;; If procmail is used to get incoming mail, the files
+	  ;; are stored in this directory.
+	  (and (file-exists-p nnmail-procmail-directory)
+	       (directory-files 
+		nnmail-procmail-directory 
+		t (concat (if group group "")
+			  nnmail-procmail-suffix "$") t)))
+	 (p procmails))
+    ;; Remove any directories that inadvertantly match the procmail
+    ;; suffix, which might happen if the suffix is "".
+    (while p
+      (and (or (file-directory-p (car p))
+	       (file-symlink-p (car p)))
+	   (setq procmails (delete (car p) procmails)))
+      (setq p (cdr p)))
+    (cond ((listp nnmail-spool-file)
+	   (append nnmail-spool-file procmails))
+	  ((stringp nnmail-spool-file)
+	   (cons nnmail-spool-file procmails))
+	  (t
+	   procmails))))
+
+;; Activate a backend only if it isn't already activated. 
+;; If FORCE, re-read the active file even if the backend is 
+;; already activated.
+(defun nnmail-activate (backend &optional force)
+  (let (file timestamp file-time)
+    (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
+	    force
+	    (and (setq file (condition-case ()
+				(symbol-value (intern (format "%s-active-file" 
+							      backend)))
+			      (error nil)))
+		 (setq file-time (nth 5 (file-attributes file)))
+		 (or (not
+		      (setq timestamp
+			    (condition-case ()
+				(symbol-value (intern
+					       (format "%s-active-timestamp" 
+						       backend)))
+			      (error 'none))))
+		     (not (consp timestamp))
+		     (equal timestamp '(0 0))
+		     (> (nth 0 file-time) (nth 0 timestamp))
+		     (and (= (nth 0 file-time) (nth 0 timestamp))
+			  (> (nth 1 file-time) (nth 1 timestamp))))))
+	(save-excursion
+	  (or (eq timestamp 'none)
+	      (set (intern (format "%s-active-timestamp" backend)) 
+		   (current-time)))
+	  (funcall (intern (format "%s-request-list" backend)))
+	  (set (intern (format "%s-group-alist" backend)) 
+	       (nnmail-get-active))))
+    t))
+
+(defun nnmail-message-id ()
+  (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
+
+(defvar nnmail-unique-id-char nil)
+
+(defun nnmail-number-base36 (num len)
+  (if (if (< len 0) (<= num 0) (= len 0))
+      ""
+    (concat (nnmail-number-base36 (/ num 36) (1- len))
+	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+				  (% num 36))))))
+
+(defun nnmail-unique-id ()
+  (setq nnmail-unique-id-char
+	(% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+	   ;; (current-time) returns 16-bit ints,
+	   ;; and 2^16*25 just fits into 4 digits i base 36.
+	   (* 25 25)))
+  (let ((tm (if (fboundp 'current-time)
+		(current-time) '(12191 46742 287898))))
+    (concat
+     (nnmail-number-base36 (+ (car   tm) 
+			      (lsh (% nnmail-unique-id-char 25) 16)) 4)
+     (nnmail-number-base36 (+ (nth 1 tm) 
+			      (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
+
+;;;
+;;; nnmail duplicate handling
+;;;
+
+(defvar nnmail-cache-buffer nil)
+
+(defun nnmail-cache-open ()
+  (if (or (not nnmail-delete-duplicates)
+	  (and nnmail-cache-buffer
+	       (buffer-name nnmail-cache-buffer)))
+      ()				; The buffer is open.
+    (save-excursion
+      (set-buffer 
+       (setq nnmail-cache-buffer 
+	     (get-buffer-create " *nnmail message-id cache*")))
+      (buffer-disable-undo (current-buffer))
+      (and (file-exists-p nnmail-message-id-cache-file)
+	   (insert-file-contents nnmail-message-id-cache-file))
+      (current-buffer))))
+
+(defun nnmail-cache-close ()
+  (if (or (not nnmail-cache-buffer)
+	  (not nnmail-delete-duplicates)
+	  (not (buffer-name nnmail-cache-buffer))
+	  (not (buffer-modified-p nnmail-cache-buffer)))
+      ()				; The buffer is closed.
+    (save-excursion
+      (set-buffer nnmail-cache-buffer)
+      ;; Weed out the excess number of Message-IDs.
+      (goto-char (point-max))
+      (and (search-backward "\n" nil t nnmail-message-id-cache-length)
+	   (progn
+	     (beginning-of-line)
+	     (delete-region (point-min) (point))))
+      ;; Save the buffer.
+      (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
+	  (make-directory (file-name-directory nnmail-message-id-cache-file)
+			  t))
+      (write-region (point-min) (point-max)
+		    nnmail-message-id-cache-file nil 'silent)
+      (set-buffer-modified-p nil))))
+
+(defun nnmail-cache-insert (id)
+  (and nnmail-delete-duplicates
+       (save-excursion
+	 (set-buffer nnmail-cache-buffer)
+	 (goto-char (point-max))
+	 (insert id "\n"))))
+
+(defun nnmail-cache-id-exists-p (id)
+  (and nnmail-delete-duplicates
+       (save-excursion
+	 (set-buffer nnmail-cache-buffer)
+	 (goto-char (point-max))
+	 (search-backward id nil t))))
+
+
+(provide 'nnmail)
+
+;;; nnmail.el ends here

lisp/nnmbox.el

@@ -0,0 +1,508 @@
+;;; nnmbox.el --- mail mbox access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.  
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'nnmail)
+
+(defvar nnmbox-mbox-file (expand-file-name "~/mbox")
+  "The name of the mail box file in the user's home directory.")
+
+(defvar nnmbox-active-file (expand-file-name "~/.mbox-active")
+  "The name of the active file for the mail box.")
+
+(defvar nnmbox-get-new-mail t
+  "If non-nil, nnmbox will check the incoming mail file and split the mail.")
+
+(defvar nnmbox-prepare-save-mail-hook nil
+  "Hook run narrowed to an article before saving.")
+
+
+
+(defconst nnmbox-version "nnmbox 1.0"
+  "nnmbox version.")
+
+(defvar nnmbox-current-group nil
+  "Current nnmbox news group directory.")
+
+(defconst nnmbox-mbox-buffer nil)
+
+(defvar nnmbox-status-string "")
+
+(defvar nnmbox-group-alist nil)
+(defvar nnmbox-active-timestamp nil)
+
+
+
+(defvar nnmbox-current-server nil)
+(defvar nnmbox-server-alist nil)
+(defvar nnmbox-server-variables 
+  (list
+   (list 'nnmbox-mbox-file nnmbox-mbox-file)
+   (list 'nnmbox-active-file nnmbox-active-file)
+   (list 'nnmbox-get-new-mail nnmbox-get-new-mail)
+   '(nnmbox-current-group nil)
+   '(nnmbox-status-string "")
+   '(nnmbox-group-alist nil)))
+
+
+
+;;; Interface functions
+
+(defun nnmbox-retrieve-headers (sequence &optional newsgroup server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let ((number (length sequence))
+	  (count 0)
+	  article art-string start stop)
+      (nnmbox-possibly-change-newsgroup newsgroup)
+      (if (stringp (car sequence))
+	  'headers
+	(while sequence
+	  (setq article (car sequence))
+	  (setq art-string (nnmbox-article-string article))
+	  (set-buffer nnmbox-mbox-buffer)
+	  (if (or (search-forward art-string nil t)
+		  (progn (goto-char (point-min))
+			 (search-forward art-string nil t)))
+	      (progn
+		(setq start 
+		      (save-excursion
+			(re-search-backward 
+			 (concat "^" rmail-unix-mail-delimiter) nil t)
+			(point)))
+		(search-forward "\n\n" nil t)
+		(setq stop (1- (point)))
+		(set-buffer nntp-server-buffer)
+		(insert (format "221 %d Article retrieved.\n" article))
+		(insert-buffer-substring nnmbox-mbox-buffer start stop)
+		(goto-char (point-max))
+		(insert ".\n")))
+	  (setq sequence (cdr sequence))
+	  (setq count (1+ count))
+	  (and (numberp nnmail-large-newsgroup)
+	       (> number nnmail-large-newsgroup)
+	       (zerop (% count 20))
+	       gnus-verbose-backends
+	       (message "nnmbox: Receiving headers... %d%%"
+			(/ (* count 100) number))))
+
+	(and (numberp nnmail-large-newsgroup)
+	     (> number nnmail-large-newsgroup)
+	     gnus-verbose-backends
+	     (message "nnmbox: Receiving headers...done"))
+
+	;; Fold continuation lines.
+	(set-buffer nntp-server-buffer)
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	'headers))))
+
+(defun nnmbox-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nnmbox-current-server)
+      t
+    (if nnmbox-current-server
+	(setq nnmbox-server-alist 
+	      (cons (list nnmbox-current-server
+			  (nnheader-save-variables nnmbox-server-variables))
+		    nnmbox-server-alist)))
+    (let ((state (assoc server nnmbox-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nnmbox-server-alist (delq state nnmbox-server-alist)))
+	(nnheader-set-init-variables nnmbox-server-variables defs)))
+    (setq nnmbox-current-server server)))
+
+(defun nnmbox-close-server (&optional server)
+  t)
+
+(defun nnmbox-server-opened (&optional server)
+  (and (equal server nnmbox-current-server)
+       nnmbox-mbox-buffer
+       (buffer-name nnmbox-mbox-buffer)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nnmbox-status-message (&optional server)
+  nnmbox-status-string)
+
+(defun nnmbox-request-article (article &optional newsgroup server buffer)
+  (nnmbox-possibly-change-newsgroup newsgroup)
+  (if (stringp article)
+      nil
+    (save-excursion
+      (set-buffer nnmbox-mbox-buffer)
+      (goto-char (point-min))
+      (if (search-forward (nnmbox-article-string article) nil t)
+	  (let (start stop)
+	    (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
+	    (setq start (point))
+	    (forward-line 1)
+	    (or (and (re-search-forward 
+		      (concat "^" rmail-unix-mail-delimiter) nil t)
+		     (forward-line -1))
+		(goto-char (point-max)))
+	    (setq stop (point))
+	    (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+	      (set-buffer nntp-server-buffer)
+	      (erase-buffer)
+	      (insert-buffer-substring nnmbox-mbox-buffer start stop)
+	      (goto-char (point-min))
+	      (while (looking-at "From ")
+		(delete-char 5)
+		(insert "X-From-Line: ")
+		(forward-line 1))
+	      t))))))
+
+(defun nnmbox-request-group (group &optional server dont-check)
+  (save-excursion
+    (if (nnmbox-possibly-change-newsgroup group)
+	(if dont-check
+	    t
+	  (nnmbox-get-new-mail group)
+	  (save-excursion
+	    (set-buffer nntp-server-buffer)
+	    (erase-buffer)
+	    (let ((active (assoc group nnmbox-group-alist)))
+	      (insert (format "211 %d %d %d %s\n" 
+			      (1+ (- (cdr (car (cdr active)))
+				     (car (car (cdr active)))))
+			      (car (car (cdr active)))
+			      (cdr (car (cdr active)))
+			      (car active))))
+	    t)))))
+
+(defun nnmbox-close-group (group &optional server)
+  t)
+
+(defun nnmbox-request-list (&optional server)
+  (if server (nnmbox-get-new-mail))
+  (save-excursion
+    (or (nnmail-find-file nnmbox-active-file)
+	(progn
+	  (setq nnmbox-group-alist (nnmail-get-active))
+	  (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+	  (nnmail-find-file nnmbox-active-file)))))
+
+(defun nnmbox-request-newgroups (date &optional server)
+  (nnmbox-request-list server))
+
+(defun nnmbox-request-list-newsgroups (&optional server)
+  (setq nnmbox-status-string "nnmbox: LIST NEWSGROUPS is not implemented.")
+  nil)
+
+(defun nnmbox-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defalias 'nnmbox-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nnmbox-request-expire-articles 
+  (articles newsgroup &optional server force)
+  (nnmbox-possibly-change-newsgroup newsgroup)
+  (let* ((days (or (and nnmail-expiry-wait-function
+			(funcall nnmail-expiry-wait-function newsgroup))
+		   nnmail-expiry-wait))
+	 (is-old t)
+	 rest)
+    (nnmail-activate 'nnmbox)
+
+    (save-excursion 
+      (set-buffer nnmbox-mbox-buffer)
+      (while (and articles is-old)
+	(goto-char (point-min))
+	(if (search-forward (nnmbox-article-string (car articles)) nil t)
+	    (if (or force
+		    (setq is-old
+			  (> (nnmail-days-between 
+			      (current-time-string)
+			      (buffer-substring 
+			       (point) (progn (end-of-line) (point))))
+			     days)))
+		(progn
+		  (and gnus-verbose-backends
+		       (message "Deleting article %s..." (car articles)))
+		  (nnmbox-delete-mail))
+	      (setq rest (cons (car articles) rest))))
+	(setq articles (cdr articles)))
+      (save-buffer)
+      ;; Find the lowest active article in this group.
+      (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
+	(goto-char (point-min))
+	(while (and (not (search-forward
+			  (nnmbox-article-string (car active)) nil t))
+		    (<= (car active) (cdr active)))
+	  (setcar active (1+ (car active)))
+	  (goto-char (point-min))))
+      (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+      (nconc rest articles))))
+
+(defun nnmbox-request-move-article
+  (article group server accept-form &optional last)
+  (nnmbox-possibly-change-newsgroup group)
+  (let ((buf (get-buffer-create " *nnmbox move*"))
+	result)
+    (and 
+     (nnmbox-request-article article group server)
+     (save-excursion
+       (set-buffer buf)
+       (buffer-disable-undo (current-buffer))
+       (erase-buffer)
+       (insert-buffer-substring nntp-server-buffer)
+       (goto-char (point-min))
+       (while (re-search-forward 
+	       "^X-Gnus-Newsgroup:" 
+	       (save-excursion (search-forward "\n\n" nil t) (point)) t)
+	 (delete-region (progn (beginning-of-line) (point))
+			(progn (forward-line 1) (point))))
+       (setq result (eval accept-form))
+       (kill-buffer buf)
+       result)
+     (save-excursion
+       (set-buffer nnmbox-mbox-buffer)
+       (goto-char (point-min))
+       (if (search-forward (nnmbox-article-string article) nil t)
+	   (nnmbox-delete-mail))
+       (and last (save-buffer))))
+    result))
+
+(defun nnmbox-request-accept-article (group &optional last)
+  (let ((buf (current-buffer))
+	result)
+    (goto-char (point-min))
+    (if (looking-at "X-From-Line: ")
+	(replace-match "From ")
+      (insert "From nobody " (current-time-string) "\n"))
+    (and 
+     (nnmail-activate 'nnmbox)
+     (progn
+       (set-buffer buf)
+       (goto-char (point-min))
+       (search-forward "\n\n" nil t)
+       (forward-line -1)
+       (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
+	 (delete-region (point) (progn (forward-line 1) (point))))
+       (setq result (nnmbox-save-mail (and (stringp group) group))))
+     (save-excursion
+       (set-buffer nnmbox-mbox-buffer)
+       (insert-buffer-substring buf)
+       (and last (save-buffer))
+       result)
+     (nnmail-save-active nnmbox-group-alist nnmbox-active-file))
+    (car result)))
+
+(defun nnmbox-request-replace-article (article group buffer)
+  (nnmbox-possibly-change-newsgroup group)
+  (save-excursion
+    (set-buffer nnmbox-mbox-buffer)
+    (goto-char (point-min))
+    (if (not (search-forward (nnmbox-article-string article) nil t))
+	nil
+      (nnmbox-delete-mail t t)
+      (insert-buffer-substring buffer)
+      (save-buffer)
+      t)))
+
+
+;;; Internal functions.
+
+;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
+;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
+;; delimeter line.
+(defun nnmbox-delete-mail (&optional force leave-delim)
+  ;; Delete the current X-Gnus-Newsgroup line.
+  (or force
+      (delete-region
+       (progn (beginning-of-line) (point))
+       (progn (forward-line 1) (point))))
+  ;; Beginning of the article.
+  (save-excursion
+    (save-restriction
+      (narrow-to-region
+       (save-excursion
+	 (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
+	 (if leave-delim (progn (forward-line 1) (point))
+	   (match-beginning 0)))
+       (progn
+	 (forward-line 1)
+	 (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) 
+				     nil t)
+		  (if (and (not (bobp)) leave-delim)
+		      (progn (forward-line -2) (point))
+		    (match-beginning 0)))
+	     (point-max))))
+      (goto-char (point-min))
+      ;; Only delete the article if no other groups owns it as well.
+      (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+	  (delete-region (point-min) (point-max))))))
+
+(defun nnmbox-possibly-change-newsgroup (newsgroup)
+  (if (or (not nnmbox-mbox-buffer)
+	  (not (buffer-name nnmbox-mbox-buffer)))
+      (save-excursion
+	(set-buffer (setq nnmbox-mbox-buffer 
+			  (nnheader-find-file-noselect
+			   nnmbox-mbox-file nil 'raw)))
+	(buffer-disable-undo (current-buffer))))
+  (if (not nnmbox-group-alist)
+      (nnmail-activate 'nnmbox))
+  (if newsgroup
+      (if (assoc newsgroup nnmbox-group-alist)
+	  (setq nnmbox-current-group newsgroup))))
+
+(defun nnmbox-article-string (article)
+  (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" 
+	  (int-to-string article) " "))
+
+(defun nnmbox-save-mail (&optional group)
+  "Called narrowed to an article."
+  (let* ((nnmail-split-methods 
+	  (if group (list (list group "")) nnmail-split-methods))
+	 (group-art (nreverse (nnmail-article-group 'nnmbox-active-number))))
+    (nnmail-insert-lines)
+    (nnmail-insert-xref group-art)
+    (nnmbox-insert-newsgroup-line group-art)
+    (run-hooks 'nnml-prepare-save-mail-hook)
+    group-art))
+
+(defun nnmbox-insert-newsgroup-line (group-art)
+  (save-excursion
+    (goto-char (point-min))
+    (if (search-forward "\n\n" nil t)
+	(progn
+	  (forward-char -1)
+	  (while group-art
+	    (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
+			    (car (car group-art)) (cdr (car group-art))
+			    (current-time-string)))
+	    (setq group-art (cdr group-art)))))
+    t))
+
+(defun nnmbox-active-number (group)
+  ;; Find the next article number in GROUP.
+  (let ((active (car (cdr (assoc group nnmbox-group-alist)))))
+    (if active
+	(setcdr active (1+ (cdr active)))
+      ;; This group is new, so we create a new entry for it.
+      ;; This might be a bit naughty... creating groups on the drop of
+      ;; a hat, but I don't know...
+      (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1)))
+				     nnmbox-group-alist)))
+    (cdr active)))
+
+(defun nnmbox-read-mbox ()
+  (nnmail-activate 'nnmbox)
+  (if (not (file-exists-p nnmbox-mbox-file))
+      (write-region 1 1 nnmbox-mbox-file t 'nomesg))
+  (if (and nnmbox-mbox-buffer
+	   (buffer-name nnmbox-mbox-buffer)
+	   (save-excursion
+	     (set-buffer nnmbox-mbox-buffer)
+	     (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file)))))
+      ()
+    (save-excursion
+      (let ((delim (concat "^" rmail-unix-mail-delimiter))
+	    start end)
+	(set-buffer (setq nnmbox-mbox-buffer 
+			  (nnheader-find-file-noselect 
+			   nnmbox-mbox-file nil 'raw)))
+	(buffer-disable-undo (current-buffer))
+	(goto-char (point-min))
+	(while (re-search-forward delim nil t)
+	  (setq start (match-beginning 0))
+	  (if (not (search-forward "\nX-Gnus-Newsgroup: " 
+				   (save-excursion 
+				     (setq end
+					   (or
+					    (and
+					     (re-search-forward delim nil t)
+					     (match-beginning 0))
+					    (point-max))))
+				   t))
+	      (save-excursion
+		(save-restriction
+		  (narrow-to-region start end)
+		  (nnmbox-save-mail))))
+	  (goto-char end))))))
+
+(defun nnmbox-get-new-mail (&optional group)
+  "Read new incoming mail."
+  (let* ((spools (nnmail-get-spool-files group))
+	 (group-in group)
+	 incoming incomings)
+    (nnmbox-read-mbox)
+    (if (or (not nnmbox-get-new-mail) (not nnmail-spool-file))
+	()
+      ;; We go through all the existing spool files and split the
+      ;; mail from each.
+      (while spools
+	(and
+	 (file-exists-p (car spools))
+	 (> (nth 7 (file-attributes (car spools))) 0)
+	 (progn
+	   (and gnus-verbose-backends 
+		(message "nnmbox: Reading incoming mail..."))
+	   (if (not (setq incoming 
+			  (nnmail-move-inbox 
+			   (car spools) 
+			   (concat nnmbox-mbox-file "-Incoming"))))
+	       ()
+	     (setq incomings (cons incoming incomings))
+	     (save-excursion
+	       (setq group (nnmail-get-split-group (car spools) group-in))
+	       (let ((in-buf (nnmail-split-incoming 
+			      incoming 'nnmbox-save-mail t group)))
+		 (set-buffer nnmbox-mbox-buffer)
+		 (goto-char (point-max))
+		 (insert-buffer-substring in-buf)
+		 (kill-buffer in-buf))))))
+	(setq spools (cdr spools)))
+      ;; If we did indeed read any incoming spools, we save all info. 
+      (and (buffer-modified-p nnmbox-mbox-buffer) 
+	   (save-excursion
+	     (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
+	     (set-buffer nnmbox-mbox-buffer)
+	     (save-buffer)))
+      (if incomings (run-hooks 'nnmail-read-incoming-hook))
+      (while incomings
+	(setq incoming (car incomings))
+	(and nnmail-delete-incoming
+	     (file-exists-p incoming) 
+	     (file-writable-p incoming) 
+	     (delete-file incoming))
+	(setq incomings (cdr incomings))))))
+
+
+(provide 'nnmbox)
+
+;;; nnmbox.el ends here

lisp/nnmh.el

@@ -0,0 +1,516 @@
+;;; nnmh.el --- mhspool access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.  
+
+;;; Code:
+
+(require 'nnheader)
+(require 'rmail)
+(require 'nnmail)
+(require 'gnus)
+
+(defvar nnmh-directory "~/Mail/"
+  "*Mail spool directory.")
+
+(defvar nnmh-get-new-mail t
+  "*If non-nil, nnmh will check the incoming mail file and split the mail.")
+
+(defvar nnmh-prepare-save-mail-hook nil
+  "*Hook run narrowed to an article before saving.")
+
+(defvar nnmh-be-safe nil
+  "*If non-nil, nnmh will check all articles to make sure whether they are new or not.")
+
+
+
+(defconst nnmh-version "nnmh 1.0"
+  "nnmh version.")
+
+(defvar nnmh-current-directory nil
+  "Current news group directory.")
+
+(defvar nnmh-status-string "")
+(defvar nnmh-group-alist nil)
+
+
+
+(defvar nnmh-current-server nil)
+(defvar nnmh-server-alist nil)
+(defvar nnmh-server-variables 
+  (list
+   (list 'nnmh-directory nnmh-directory)
+   (list 'nnmh-get-new-mail nnmh-get-new-mail)
+   '(nnmh-current-directory nil)
+   '(nnmh-status-string "")
+   '(nnmh-group-alist)))
+
+
+
+;;; Interface functions.
+
+(defun nnmh-retrieve-headers (sequence &optional newsgroup server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let* ((file nil)
+	   (number (length sequence))
+	   (large (and (numberp nnmail-large-newsgroup)
+		       (> number nnmail-large-newsgroup)))
+	   (count 0)
+	   beg article)
+      (nnmh-possibly-change-directory newsgroup)
+      (if (stringp (car sequence))
+	  'headers
+	(while sequence
+	  (setq article (car sequence))
+	  (setq file
+		(concat nnmh-current-directory (int-to-string article)))
+	  (if (and (file-exists-p file)
+		   (not (file-directory-p file)))
+	      (progn
+		(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 large
+	       (zerop (% count 20))
+	       (message "nnmh: Receiving headers... %d%%"
+			(/ (* count 100) number))))
+
+	(and large (message "nnmh: Receiving headers...done"))
+
+	;; Fold continuation lines.
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	'headers))))
+
+(defun nnmh-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nnmh-current-server)
+      t
+    (if nnmh-current-server
+	(setq nnmh-server-alist 
+	      (cons (list nnmh-current-server
+			  (nnheader-save-variables nnmh-server-variables))
+		    nnmh-server-alist)))
+    (let ((state (assoc server nnmh-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nnmh-server-alist (delq state nnmh-server-alist)))
+	(nnheader-set-init-variables nnmh-server-variables defs)))
+    (setq nnmh-current-server server)))
+
+(defun nnmh-close-server (&optional server)
+  t)
+
+(defun nnmh-server-opened (&optional server)
+  (and (equal server nnmh-current-server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nnmh-status-message (&optional server)
+  nnmh-status-string)
+
+(defun nnmh-request-article (id &optional newsgroup server buffer)
+  (nnmh-possibly-change-directory newsgroup)
+  (let ((file (if (stringp id)
+		  nil
+		(concat nnmh-current-directory (int-to-string id))))
+	(nntp-server-buffer (or buffer nntp-server-buffer)))
+    (and (stringp file)
+	 (file-exists-p file)
+	 (not (file-directory-p file))
+	 (save-excursion (nnmail-find-file file)))))
+
+(defun nnmh-request-group (group &optional server dont-check)
+  (and nnmh-get-new-mail (or dont-check (nnmh-get-new-mail group)))
+  (let ((pathname (nnmh-article-pathname group nnmh-directory))
+	dir)
+    (if (file-directory-p pathname)
+	(progn
+	  (setq nnmh-current-directory pathname)
+	  (and nnmh-get-new-mail 
+	       nnmh-be-safe
+	       (nnmh-update-gnus-unreads group))
+	  (or dont-check
+	      (progn
+		(setq dir 
+		      (sort
+		       (mapcar
+			(function
+			 (lambda (name)
+			   (string-to-int name)))
+			(directory-files pathname nil "^[0-9]+$" t))
+		       '<))
+		(save-excursion
+		  (set-buffer nntp-server-buffer)
+		  (erase-buffer)
+		  (if dir
+		      (insert (format "211 %d %d %d %s\n" (length dir) 
+				      (car dir)
+				      (progn (while (cdr dir)
+					       (setq dir (cdr dir)))
+					     (car dir))
+				      group))
+		    (insert (format "211 0 1 0 %s\n" group))))))
+	  t)
+      (setq nnmh-status-string "No such group")
+      nil)))
+
+(defun nnmh-request-list (&optional server dir)
+  (or dir
+      (save-excursion
+	(set-buffer nntp-server-buffer)
+	(erase-buffer)
+	(setq dir (file-truename (file-name-as-directory nnmh-directory)))))
+  (setq dir (expand-file-name dir))
+  ;; Recurse down all directories.
+  (let ((dirs (and (file-readable-p dir)
+		   (> (nth 1 (file-attributes (file-chase-links dir))) 2)
+		   (directory-files dir t nil t))))
+    (while dirs 
+      (if (and (not (string-match "/\\.\\.?$" (car dirs)))
+	       (file-directory-p (car dirs))
+	       (file-readable-p (car dirs)))
+	  (nnmh-request-list nil (car dirs)))
+      (setq dirs (cdr dirs))))
+  ;; For each directory, generate an active file line.
+  (if (not (string= (expand-file-name nnmh-directory) dir))
+      (let ((files (mapcar
+		    (lambda (name) (string-to-int name))
+		    (directory-files dir nil "^[0-9]+$" t))))
+	(if (null files)
+	    ()
+	  (save-excursion
+	    (set-buffer nntp-server-buffer)
+	    (goto-char (point-max))
+	    (insert 
+	     (format 
+	      "%s %d %d y\n" 
+	      (progn
+		(string-match 
+		 (file-truename (file-name-as-directory 
+				 (expand-file-name nnmh-directory))) dir)
+		(nnmail-replace-chars-in-string
+		 (substring dir (match-end 0)) ?/ ?.))
+	      (apply (function max) files) 
+	      (apply (function min) files)))))))
+  (setq nnmh-group-alist (nnmail-get-active))
+  (and server nnmh-get-new-mail (nnmh-get-new-mail))
+  t)
+
+(defun nnmh-request-newgroups (date &optional server)
+  (nnmh-request-list server))
+
+(defun nnmh-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defalias 'nnmh-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nnmh-request-expire-articles (articles newsgroup &optional server force)
+  (nnmh-possibly-change-directory newsgroup)
+  (let* ((days (or (and nnmail-expiry-wait-function
+			(funcall nnmail-expiry-wait-function newsgroup))
+		   nnmail-expiry-wait))
+	 (active-articles 
+	  (mapcar
+	   (function
+	    (lambda (name)
+	      (string-to-int name)))
+	   (directory-files nnmh-current-directory nil "^[0-9]+$" t)))
+	 (max-article (and active-articles (apply 'max active-articles)))
+	 (is-old t)
+	 article rest mod-time)
+    (nnmail-activate 'nnmh)
+
+    (while (and articles is-old)
+      (setq article (concat nnmh-current-directory 
+			    (int-to-string (car articles))))
+      (if (setq mod-time (nth 5 (file-attributes article)))
+	  (if (and (or (not nnmail-keep-last-article)
+		       (not max-article)
+		       (not (= (car articles) max-article)))
+		   (not (equal mod-time '(0 0)))
+		   (or force
+		       (setq is-old
+			     (> (nnmail-days-between
+				 (current-time-string)
+				 (current-time-string mod-time))
+				days))))
+	      (progn
+		(and gnus-verbose-backends 
+		     (message "Deleting article %s..." article))
+		(condition-case ()
+		    (delete-file article)
+		  (file-error
+		   (setq rest (cons (car articles) rest)))))
+	    (setq rest (cons (car articles) rest))))
+      (setq articles (cdr articles)))
+    (message "")
+    (nconc rest articles)))
+
+(defun nnmh-close-group (group &optional server)
+  t)
+
+(defun nnmh-request-move-article 
+  (article group server accept-form &optional last)
+  (let ((buf (get-buffer-create " *nnmh move*"))
+	result)
+    (and 
+     (nnmh-request-article article group server)
+     (save-excursion
+       (set-buffer buf)
+       (insert-buffer-substring nntp-server-buffer)
+       (setq result (eval accept-form))
+       (kill-buffer (current-buffer))
+       result)
+     (condition-case ()
+	 (delete-file (concat nnmh-current-directory 
+			      (int-to-string article)))
+       (file-error nil)))
+    result))
+
+(defun nnmh-request-accept-article (group &optional last)
+  (if (stringp group)
+      (and 
+       (nnmail-activate 'nnmh)
+       ;; We trick the choosing function into believing that only one
+       ;; group is availiable.  
+       (let ((nnmail-split-methods (list (list group ""))))
+	 (car (nnmh-save-mail))))
+    (and
+     (nnmail-activate 'nnmh)
+     (car (nnmh-save-mail)))))
+
+(defun nnmh-request-replace-article (article group buffer)
+  (nnmh-possibly-change-directory group)
+  (save-excursion
+    (set-buffer buffer)
+    (nnmh-possibly-create-directory group)
+    (condition-case ()
+	(progn
+	  (write-region (point-min) (point-max)
+			(concat nnmh-current-directory (int-to-string article))
+			nil (if gnus-verbose-backends nil 'nomesg))
+	  t)
+      (error nil))))
+
+
+;;; Internal functions.
+
+(defun nnmh-possibly-change-directory (newsgroup)
+  (if newsgroup
+      (let ((pathname (nnmh-article-pathname newsgroup nnmh-directory)))
+	(if (file-directory-p pathname)
+	    (setq nnmh-current-directory pathname)
+	  (error "No such newsgroup: %s" newsgroup)))))
+
+(defun nnmh-possibly-create-directory (group)
+  (let (dir dirs)
+    (setq dir (nnmh-article-pathname group nnmh-directory))
+    (while (not (file-directory-p dir))
+      (setq dirs (cons dir dirs))
+      (setq dir (file-name-directory (directory-file-name dir))))
+    (while dirs
+      (if (make-directory (directory-file-name (car dirs)))
+	  (error "Could not create directory %s" (car dirs)))
+      (and gnus-verbose-backends 
+	   (message "Creating mail directory %s" (car dirs)))
+      (setq dirs (cdr dirs)))))
+	     
+(defun nnmh-save-mail ()
+  "Called narrowed to an article."
+  (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number))))
+    (nnmail-insert-lines)
+    (nnmail-insert-xref group-art)
+    (run-hooks 'nnmh-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 newsgroups it belongs in.
+    (let ((ga group-art)
+	  first)
+      (while ga
+	(nnmh-possibly-create-directory (car (car ga)))
+	(let ((file (concat (nnmh-article-pathname 
+			     (car (car ga)) nnmh-directory) 
+			    (int-to-string (cdr (car ga))))))
+	  (if first
+	      ;; It was already saved, so we just make a hard link.
+	      (add-name-to-file first file t)
+	    ;; Save the article.
+	    (write-region (point-min) (point-max) file nil nil)
+	    (setq first file)))
+	(setq ga (cdr ga))))
+    group-art))
+
+(defun nnmh-active-number (group)
+  "Compute the next article number in GROUP."
+  (let ((active (car (cdr (assoc group nnmh-group-alist)))))
+    ;; The group wasn't known to nnmh, so we just create an active
+    ;; entry for it.   
+    (or active
+	(progn
+	  (setq active (cons 1 0))
+	  (setq nnmh-group-alist (cons (list group active) nnmh-group-alist))))
+    (setcdr active (1+ (cdr active)))
+    (while (file-exists-p
+	    (concat (nnmh-article-pathname group nnmh-directory)
+		    (int-to-string (cdr active))))
+      (setcdr active (1+ (cdr active))))
+    (cdr active)))
+
+(defun nnmh-article-pathname (group mail-dir)
+  "Make pathname for GROUP."
+  (let ((mail-dir (file-name-as-directory (expand-file-name mail-dir))))
+    (if (file-directory-p (concat mail-dir group))
+	(concat mail-dir group "/")
+      (concat mail-dir (nnmail-replace-chars-in-string group ?. ?/) "/"))))
+
+(defun nnmh-get-new-mail (&optional group)
+  "Read new incoming mail."
+  (let* ((spools (nnmail-get-spool-files group))
+	 (group-in group)
+	 incoming incomings)
+    (if (or (not nnmh-get-new-mail) (not nnmail-spool-file))
+	()
+      ;; We first activate all the groups.
+      (or nnmh-group-alist
+	  (nnmh-request-list))
+      ;; The we go through all the existing spool files and split the
+      ;; mail from each.
+      (while spools
+	(and
+	 (file-exists-p (car spools))
+	 (> (nth 7 (file-attributes (car spools))) 0)
+	 (progn
+	   (and gnus-verbose-backends 
+		(message "nnmh: Reading incoming mail..."))
+	   (if (not (setq incoming 
+			  (nnmail-move-inbox 
+			   (car spools) 
+			   (concat (file-name-as-directory nnmh-directory)
+				   "Incoming"))))
+	       ()
+	     (setq incomings (cons incoming incomings))
+	     (setq group (nnmail-get-split-group (car spools) group-in))
+	     (nnmail-split-incoming incoming 'nnmh-save-mail nil group))))
+	(setq spools (cdr spools)))
+      ;; If we did indeed read any incoming spools, we save all info. 
+      (if incoming 
+	  (message "nnmh: Reading incoming mail...done"))
+      (while incomings
+	(setq incoming (car incomings))
+	(and nnmail-delete-incoming
+	     (file-exists-p incoming)
+	     (file-writable-p incoming)
+	     (delete-file incoming))
+	(setq incomings (cdr incomings))))))
+      
+
+(defun nnmh-update-gnus-unreads (group)
+  ;; Go through the .nnmh-articles file and compare with the actual
+  ;; articles in this folder. The articles that are "new" will be
+  ;; marked as unread by Gnus.
+  (let* ((dir nnmh-current-directory)
+	 (files (sort (mapcar (function (lambda (name) (string-to-int name)))
+			      (directory-files nnmh-current-directory 
+					       nil "^[0-9]+$" t)) '<))
+	 (nnmh-file (concat dir ".nnmh-articles"))
+	 new articles)
+    ;; Load the .nnmh-articles file.
+    (if (file-exists-p nnmh-file)
+	(setq articles 
+	      (let (nnmh-newsgroup-articles)
+		(condition-case nil (load nnmh-file nil t t) (error nil))
+		nnmh-newsgroup-articles)))
+    ;; Add all new articles to the `new' list.
+    (let ((art files))
+      (while art
+	(if (not (assq (car art) articles)) (setq new (cons (car art) new)))
+	(setq art (cdr art))))
+    ;; Remove all deleted articles.
+    (let ((art articles))
+      (while art
+	(if (not (memq (car (car art)) files))
+	    (setq articles (delq (car art) articles)))
+	(setq art (cdr art))))
+    ;; Check whether the highest-numbered articles really are the ones
+    ;; that Gnus thinks they are by looking at the time-stamps.
+    (let ((art articles))
+      (while (and art 
+		  (not (equal 
+			(nth 5 (file-attributes 
+				(concat dir (int-to-string (car (car art))))))
+			(cdr (car art)))))
+	(setq articles (delq (car art) articles))
+	(setq new (cons (car (car art)) new))
+	(setq art (cdr art))))
+    ;; Go through all the new articles and add them, and their
+    ;; time-stamps to the list.
+    (let ((n new))
+      (while n
+	(setq articles 
+	      (cons (cons 
+		     (car n)
+		     (nth 5 (file-attributes 
+			     (concat dir (int-to-string (car n))))))
+		    articles))
+	(setq n (cdr n))))
+    ;; Make Gnus mark all new articles as unread.
+    (or (zerop (length new))
+	(gnus-make-articles-unread 
+	 (gnus-group-prefixed-name group (list 'nnmh ""))
+	 (setq new (sort new '<))))
+    ;; Sort the article list with highest numbers first.
+    (setq articles (sort articles (lambda (art1 art2) 
+				    (> (car art1) (car art2)))))
+    ;; Finally write this list back to the .nnmh-articles file.
+    (save-excursion
+      (set-buffer (get-buffer-create "*nnmh out*"))
+      (insert ";; Gnus article active file for " group "\n\n")
+      (insert "(setq nnmh-newsgroup-articles '")
+      (insert (prin1-to-string articles) ")\n")
+      (write-region (point-min) (point-max) nnmh-file nil 'nomesg)
+      (kill-buffer (current-buffer)))))
+
+(provide 'nnmh)
+
+;;; nnmh.el ends here

lisp/nnml.el

@@ -0,0 +1,701 @@
+;;; nnml.el --- mail spool access for Gnus
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
+;; For an overview of what the interface functions do, please see the
+;; Gnus sources.  
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+
+(defvar nnml-directory "~/Mail/"
+  "Mail spool directory.")
+
+(defvar nnml-active-file (concat nnml-directory "active")
+  "Mail active file.")
+
+(defvar nnml-newsgroups-file (concat nnml-directory "newsgroups")
+  "Mail newsgroups description file.")
+
+(defvar nnml-get-new-mail t
+  "If non-nil, nnml will check the incoming mail file and split the mail.")
+
+(defvar nnml-nov-is-evil nil
+  "If non-nil, Gnus will never generate and use nov databases for mail 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 `nnml-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.")
+
+(defvar nnml-prepare-save-mail-hook nil
+  "Hook run narrowed to an article before saving.")
+
+
+
+(defconst nnml-version "nnml 1.0"
+  "nnml version.")
+
+(defvar nnml-nov-file-name ".overview")
+
+(defvar nnml-current-directory nil)
+(defvar nnml-status-string "")
+(defvar nnml-nov-buffer-alist nil)
+(defvar nnml-group-alist nil)
+(defvar nnml-active-timestamp nil)
+
+
+
+;; Server variables.
+
+(defvar nnml-current-server nil)
+(defvar nnml-server-alist nil)
+(defvar nnml-server-variables 
+  (list 
+   (list 'nnml-directory nnml-directory)
+   (list 'nnml-active-file nnml-active-file)
+   (list 'nnml-newsgroups-file nnml-newsgroups-file)
+   (list 'nnml-get-new-mail nnml-get-new-mail)
+   (list 'nnml-nov-is-evil nnml-nov-is-evil)
+   (list 'nnml-nov-file-name nnml-nov-file-name)
+   '(nnml-current-directory nil)
+   '(nnml-status-string "")
+   '(nnml-nov-buffer-alist nil)
+   '(nnml-group-alist nil)
+   '(nnml-active-timestamp nil)))
+
+
+
+;;; Interface functions.
+
+(defun nnml-retrieve-headers (sequence &optional newsgroup server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let ((file nil)
+	  (number (length sequence))
+	  (count 0)
+	  beg article)
+      (if (stringp (car sequence))
+	  'headers
+	(nnml-possibly-change-directory newsgroup)
+	(if (nnml-retrieve-headers-with-nov sequence)
+	    'nov
+	  (while sequence
+	    (setq article (car sequence))
+	    (setq file
+		  (concat nnml-current-directory (int-to-string article)))
+	    (if (and (file-exists-p file)
+		     (not (file-directory-p file)))
+		(progn
+		  (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))
+		 gnus-verbose-backends
+		 (message "nnml: Receiving headers... %d%%"
+			  (/ (* count 100) number))))
+
+	  (and (numberp nnmail-large-newsgroup)
+	       (> number nnmail-large-newsgroup)
+	       gnus-verbose-backends
+	       (message "nnml: Receiving headers...done"))
+
+	  ;; Fold continuation lines.
+	  (goto-char (point-min))
+	  (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	    (replace-match " " t t))
+	  'headers)))))
+
+(defun nnml-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nnml-current-server)
+      t
+    (if nnml-current-server
+	(setq nnml-server-alist 
+	      (cons (list nnml-current-server
+			  (nnheader-save-variables nnml-server-variables))
+		    nnml-server-alist)))
+    (let ((state (assoc server nnml-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nnml-server-alist (delq state nnml-server-alist)))
+	(nnheader-set-init-variables nnml-server-variables defs)))
+    (setq nnml-current-server server)))
+
+(defun nnml-close-server (&optional server)
+  t)
+
+(defun nnml-server-opened (&optional server)
+  (and (equal server nnml-current-server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nnml-status-message (&optional server)
+  nnml-status-string)
+
+(defun nnml-request-article (id &optional newsgroup server buffer)
+  (nnml-possibly-change-directory newsgroup)
+  (let ((file (if (stringp id)
+		  nil
+		(concat nnml-current-directory (int-to-string id))))
+	(nntp-server-buffer (or buffer nntp-server-buffer)))
+    (if (and (stringp file)
+	     (file-exists-p file)
+	     (not (file-directory-p file)))
+	(save-excursion
+	  (nnmail-find-file file)))))
+
+(defun nnml-request-group (group &optional server dont-check)
+  (if (not (nnml-possibly-change-directory group))
+      (progn
+	(setq nnml-status-string "Invalid group (no such directory)")
+	nil)
+    (if dont-check 
+	t
+      (nnml-get-new-mail group)
+      (nnmail-activate 'nnml)
+      (let ((active (nth 1 (assoc group nnml-group-alist))))
+	(save-excursion
+	  (set-buffer nntp-server-buffer)
+	  (erase-buffer)
+	  (if (not active)
+	      ()
+	    (insert (format "211 %d %d %d %s\n" 
+			    (max (1+ (- (cdr active) (car active))) 0)
+			    (car active) (cdr active) group))
+	    t))))))
+
+(defun nnml-close-group (group &optional server)
+  t)
+
+(defun nnml-request-close ()
+  (setq nnml-current-server nil)
+  (setq nnml-server-alist nil)
+  t)
+
+(defun nnml-request-create-group (group &optional server) 
+  (nnmail-activate 'nnml)
+  (or (assoc group nnml-group-alist)
+      (let (active)
+	(setq nnml-group-alist (cons (list group (setq active (cons 1 0)))
+				     nnml-group-alist))
+	(nnml-possibly-create-directory group)
+	(nnml-possibly-change-directory group)
+	(let ((articles (mapcar
+			 (lambda (file)
+			   (string-to-int file))
+			 (directory-files 
+			  nnml-current-directory nil "^[0-9]+$"))))
+	  (and articles
+	       (progn
+		 (setcar active (apply 'min articles))
+		 (setcdr active (apply 'max articles)))))
+	(nnmail-save-active nnml-group-alist nnml-active-file)))
+  t)
+
+(defun nnml-request-list (&optional server)
+  (if server (nnml-get-new-mail))
+  (save-excursion
+    (nnmail-find-file nnml-active-file)
+    (setq nnml-group-alist (nnmail-get-active))))
+
+(defun nnml-request-newgroups (date &optional server)
+  (nnml-request-list server))
+
+(defun nnml-request-list-newsgroups (&optional server)
+  (save-excursion
+    (nnmail-find-file nnml-newsgroups-file)))
+
+(defun nnml-request-post (&optional server)
+  (mail-send-and-exit nil))
+
+(defalias 'nnml-request-post-buffer 'nnmail-request-post-buffer)
+
+(defun nnml-request-expire-articles (articles newsgroup &optional server force)
+  (nnml-possibly-change-directory newsgroup)
+  (let* ((days (or (and nnmail-expiry-wait-function
+			(funcall nnmail-expiry-wait-function newsgroup))
+		   nnmail-expiry-wait))
+	 (active-articles 
+	  (mapcar
+	   (function
+	    (lambda (name)
+	      (string-to-int name)))
+	   (directory-files nnml-current-directory nil "^[0-9]+$" t)))
+	 (max-article (and active-articles (apply 'max active-articles)))
+	 (is-old t)
+	 article rest mod-time)
+    (nnmail-activate 'nnml)
+
+    (while (and articles is-old)
+      (setq article (concat nnml-current-directory 
+			    (int-to-string (car articles))))
+      (if (setq mod-time (nth 5 (file-attributes article)))
+	  (if (and (or (not nnmail-keep-last-article)
+		       (not max-article)
+		       (not (= (car articles) max-article)))
+		   (or force
+		       (and (not (equal mod-time '(0 0)))
+			    (setq is-old
+				  (> (nnmail-days-between
+				      (current-time-string)
+				      (current-time-string mod-time))
+				     days)))))
+	      (progn
+		(and gnus-verbose-backends 
+		     (message "Deleting article %s..." article))
+		(condition-case ()
+		    (delete-file article)
+		  (file-error
+		   (setq rest (cons (car articles) rest))))
+		(setq active-articles (delq (car articles) active-articles))
+		(nnml-nov-delete-article newsgroup (car articles)))
+	    (setq rest (cons (car articles) rest))))
+      (setq articles (cdr articles)))
+    (let ((active (nth 1 (assoc newsgroup nnml-group-alist))))
+      (and active
+	   (setcar active (or (and active-articles
+				   (apply 'min active-articles))
+			      0)))
+      (nnmail-save-active nnml-group-alist nnml-active-file))
+    (nnml-save-nov)
+    (message "")
+    (nconc rest articles)))
+
+(defun nnml-request-move-article 
+  (article group server accept-form &optional last)
+  (let ((buf (get-buffer-create " *nnml move*"))
+	result)
+    (and 
+     (nnml-request-article article group server)
+     (save-excursion
+       (set-buffer buf)
+       (insert-buffer-substring nntp-server-buffer)
+       (setq result (eval accept-form))
+       (kill-buffer (current-buffer))
+       result)
+     (progn
+       (condition-case ()
+	   (delete-file (concat nnml-current-directory 
+				(int-to-string article)))
+	 (file-error nil))
+       (nnml-nov-delete-article group article)
+       (and last (nnml-save-nov))))
+    result))
+
+(defun nnml-request-accept-article (group &optional last)
+  (let (result)
+    (if (stringp group)
+	(and 
+	 (nnmail-activate 'nnml)
+	 ;; We trick the choosing function into believing that only one
+	 ;; group is availiable.  
+	 (let ((nnmail-split-methods (list (list group ""))))
+	   (setq result (car (nnml-save-mail))))
+	 (progn
+	   (nnmail-save-active nnml-group-alist nnml-active-file)
+	   (and last (nnml-save-nov))))
+      (and
+       (nnmail-activate 'nnml)
+       (setq result (car (nnml-save-mail)))
+       (progn
+	 (nnmail-save-active nnml-group-alist nnml-active-file)
+	 (and last (nnml-save-nov)))))
+    result))
+
+(defun nnml-request-replace-article (article group buffer)
+  (nnml-possibly-change-directory group)
+  (save-excursion
+    (set-buffer buffer)
+    (nnml-possibly-create-directory group)
+    (if (not (condition-case ()
+		 (progn
+		   (write-region (point-min) (point-max)
+				 (concat nnml-current-directory 
+					 (int-to-string article))
+				 nil (if gnus-verbose-backends nil 'nomesg))
+		   t)
+	       (error nil)))
+	()
+      (let ((chars (nnmail-insert-lines))
+	    (art (concat (int-to-string article) "\t"))
+	    nov-line)
+	(setq nov-line (nnml-make-nov-line chars))
+	;; Replace the NOV line in the NOV file.
+	(save-excursion 
+	  (set-buffer (nnml-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)
+	  (insert (int-to-string article) nov-line)
+	  (nnml-save-nov)
+	  t)))))
+
+
+
+;;; Internal functions
+
+(defun nnml-retrieve-headers-with-nov (articles)
+  (if (or gnus-nov-is-evil nnml-nov-is-evil)
+      nil
+    (let ((first (car articles))
+	  (last (progn (while (cdr articles) (setq articles (cdr articles)))
+		       (car articles)))
+	  (nov (concat nnml-current-directory nnml-nov-file-name)))
+      (if (file-exists-p nov)
+	  (save-excursion
+	    (set-buffer nntp-server-buffer)
+	    (erase-buffer)
+	    (insert-file-contents nov)
+	    (goto-char (point-min))
+	    (while (and (not (eobp)) (< first (read (current-buffer))))
+	      (forward-line 1))
+	    (beginning-of-line)
+	    (if (not (eobp)) (delete-region 1 (point)))
+	    (while (and (not (eobp)) (>= last (read (current-buffer))))
+	      (forward-line 1))
+	    (beginning-of-line)
+	    (if (not (eobp)) (delete-region (point) (point-max)))
+	    t)))))
+
+(defun nnml-possibly-change-directory (newsgroup &optional force)
+  (if newsgroup
+      (let ((pathname (nnmail-article-pathname newsgroup nnml-directory)))
+	(and (or force (file-directory-p pathname))
+	     (setq nnml-current-directory pathname)))
+    t))
+
+(defun nnml-possibly-create-directory (group)
+  (let (dir dirs)
+    (setq dir (nnmail-article-pathname group nnml-directory))
+    (while (not (file-directory-p dir))
+      (setq dirs (cons dir dirs))
+      (setq dir (file-name-directory (directory-file-name dir))))
+    (while dirs
+      (make-directory (directory-file-name (car dirs)))
+      (and gnus-verbose-backends 
+	   (message "Creating mail directory %s" (car dirs)))
+      (setq dirs (cdr dirs)))))
+	     
+(defun nnml-save-mail ()
+  "Called narrowed to an article."
+  (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number)))
+	chars nov-line)
+    (setq chars (nnmail-insert-lines))
+    (nnmail-insert-xref group-art)
+    (run-hooks 'nnml-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 newsgroups it belongs in.
+    (let ((ga group-art)
+	  first)
+      (while ga
+	(nnml-possibly-create-directory (car (car ga)))
+	(let ((file (concat (nnmail-article-pathname 
+			     (car (car ga)) nnml-directory)
+			    (int-to-string (cdr (car ga))))))
+	  (if first
+	      ;; It was already saved, so we just make a hard link.
+	      (add-name-to-file first file t)
+	    ;; Save the article.
+	    (write-region (point-min) (point-max) file nil 
+			  (if gnus-verbose-backends 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 nov-line (nnml-make-nov-line chars))
+    ;; Output the nov line to all nov databases that should have it.
+    (let ((ga group-art))
+      (while ga
+	(nnml-add-nov (car (car ga)) (cdr (car ga)) nov-line)
+	(setq ga (cdr ga))))
+    group-art))
+
+(defun nnml-active-number (group)
+  "Compute the next article number in GROUP."
+  (let ((active (car (cdr (assoc group nnml-group-alist)))))
+    ;; The group wasn't known to nnml, so we just create an active
+    ;; entry for it.   
+    (or active
+	(progn
+	  (setq active (cons 1 0))
+	  (setq nnml-group-alist (cons (list group active) nnml-group-alist))))
+    (setcdr active (1+ (cdr active)))
+    (while (file-exists-p
+	    (concat (nnmail-article-pathname group nnml-directory)
+		    (int-to-string (cdr active))))
+      (setcdr active (1+ (cdr active))))
+    (cdr active)))
+
+(defun nnml-get-new-mail (&optional group)
+  "Read new incoming mail."
+  (let* ((spools (nnmail-get-spool-files group))
+	 (group-in group)
+	 incoming incomings)
+    (if (or (not nnml-get-new-mail) (not nnmail-spool-file))
+	()
+      ;; We first activate all the groups.
+      (nnmail-activate 'nnml)
+      ;; The we go through all the existing spool files and split the
+      ;; mail from each.
+      (while spools
+	(and
+	 (file-exists-p (car spools))
+	 (> (nth 7 (file-attributes (car spools))) 0)
+	 (progn
+	   (and gnus-verbose-backends 
+		(message "nnml: Reading incoming mail..."))
+	   (if (not (setq incoming 
+			  (nnmail-move-inbox 
+			   (car spools) (concat nnml-directory "Incoming"))))
+	       ()
+	     (setq group (nnmail-get-split-group (car spools) group-in))
+	     (nnmail-split-incoming incoming 'nnml-save-mail nil group)
+	     (setq incomings (cons incoming incomings)))))
+	(setq spools (cdr spools)))
+      ;; If we did indeed read any incoming spools, we save all info. 
+      (if incoming 
+	  (progn
+	    (nnmail-save-active nnml-group-alist nnml-active-file)
+	    (nnml-save-nov)
+	    (run-hooks 'nnmail-read-incoming-hook)
+	    (and gnus-verbose-backends
+		 (message "nnml: Reading incoming mail...done"))))
+      (while incomings
+	(setq incoming (car incomings))
+	(and nnmail-delete-incoming
+	     (file-exists-p incoming)
+	     (file-writable-p incoming)
+	     (delete-file incoming))
+	(setq incomings (cdr incomings))))))
+
+
+(defun nnml-add-nov (group article line)
+  "Add a nov line for the GROUP base."
+  (save-excursion 
+    (set-buffer (nnml-open-nov group))
+    (goto-char (point-max))
+    (insert (int-to-string article) line)))
+
+(defsubst nnml-header-value ()
+  (buffer-substring (match-end 0) (save-excursion (end-of-line) (point))))
+
+(defun nnml-make-nov-line (chars)
+  "Create a nov from the current headers."
+  (let ((case-fold-search t)
+	subject from date id references lines xref in-reply-to char)
+    (save-excursion
+      (save-restriction
+	(goto-char (point-min))
+	(narrow-to-region 
+	 (point)
+	 (1- (or (search-forward "\n\n" nil t) (point-max))))
+	;; Fold continuation lines.
+	(goto-char (point-min))
+	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	  (replace-match " " t t))
+	(subst-char-in-region (point-min) (point-max) ?\t ? )
+	;; [number subject from date id references chars lines xref]
+	(save-excursion
+	  (goto-char (point-min))
+	  (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): "
+				    nil t)
+	    (beginning-of-line)
+	    (setq char (downcase (following-char))) 
+	    (cond
+	     ((eq char ?s)
+	      (setq subject (nnml-header-value)))
+	     ((eq char ?f)
+	      (setq from (nnml-header-value)))
+	     ((eq char ?x)
+	      (setq xref (nnml-header-value)))
+	     ((eq char ?l)
+	      (setq lines (nnml-header-value)))
+	     ((eq char ?d)
+	      (setq date (nnml-header-value)))
+	     ((eq char ?m)
+	      (setq id (setq id (nnml-header-value))))
+	     ((eq char ?r)
+	      (setq references (nnml-header-value)))
+	     ((eq char ?i)
+	      (setq in-reply-to (nnml-header-value))))
+	    (forward-line 1))
+      
+	  (and (not references)
+	       in-reply-to
+	       (string-match "<[^>]+>" in-reply-to)
+	       (setq references
+		     (substring in-reply-to (match-beginning 0)
+				(match-end 0)))))
+	;; [number subject from date id references chars lines xref]
+	(format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n"
+		(or subject "(none)")
+		(or from "(nobody)") (or date "")
+		(or id (concat "nnml-dummy-id-" 
+			       (mapconcat 
+				(lambda (time) (int-to-string time))
+				(current-time) "-")))
+		(or references "")
+		(or chars 0) (or lines "0") (or xref ""))))))
+
+(defun nnml-open-nov (group)
+  (or (cdr (assoc group nnml-nov-buffer-alist))
+      (let ((buffer (find-file-noselect 
+		     (concat (nnmail-article-pathname 
+			      group nnml-directory) nnml-nov-file-name))))
+	(save-excursion
+	  (set-buffer buffer)
+	  (buffer-disable-undo (current-buffer)))
+	(setq nnml-nov-buffer-alist 
+	      (cons (cons group buffer) nnml-nov-buffer-alist))
+	buffer)))
+
+(defun nnml-save-nov ()
+  (save-excursion
+    (while nnml-nov-buffer-alist
+      (if (buffer-name (cdr (car nnml-nov-buffer-alist)))
+	  (progn
+	    (set-buffer (cdr (car nnml-nov-buffer-alist)))
+	    (and (buffer-modified-p)
+		 (write-region 
+		  1 (point-max) (buffer-file-name) nil 'nomesg))
+	    (set-buffer-modified-p nil)
+	    (kill-buffer (current-buffer))))
+      (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
+
+;;;###autoload
+(defun nnml-generate-nov-databases (dir)
+  "Generate nov databases in all nnml mail newsgroups."
+  (interactive 
+   (progn   
+     (setq nnml-group-alist nil)
+     (list nnml-directory)))
+  (nnml-open-server (or nnml-current-server ""))
+  (let ((dirs (directory-files dir t nil t)))
+    (while dirs 
+      (if (and (not (string-match "/\\.\\.$" (car dirs)))
+	       (not (string-match "/\\.$" (car dirs)))
+	       (file-directory-p (car dirs)))
+	  (nnml-generate-nov-databases (car dirs)))
+      (setq dirs (cdr dirs))))
+  (let ((files (sort
+		(mapcar
+		 (function
+		  (lambda (name)
+		    (string-to-int name)))
+		 (directory-files dir nil "^[0-9]+$" t))
+		(function <)))
+	(nov (concat dir "/" nnml-nov-file-name))
+	(nov-buffer (get-buffer-create "*nov*"))
+	nov-line chars)
+    (if files
+	(setq nnml-group-alist 
+	      (cons (list (nnmail-replace-chars-in-string 
+			   (substring (expand-file-name dir)
+				      (length (expand-file-name 
+					       nnml-directory)))
+			   ?/ ?.)
+			  (cons (car files)
+				(let ((f files))
+				  (while (cdr f) (setq f (cdr f)))
+				  (car f))))
+		    nnml-group-alist)))
+    (if files
+	(save-excursion
+	  (set-buffer nntp-server-buffer)
+	  (if (file-exists-p nov)
+	      (delete-file nov))
+	  (save-excursion
+	    (set-buffer nov-buffer)
+	    (buffer-disable-undo (current-buffer))
+	    (erase-buffer))
+	  (while files
+	    (erase-buffer)
+	    (insert-file-contents (concat dir "/" (int-to-string (car files))))
+	    (goto-char (point-min))
+	    (narrow-to-region 1 (save-excursion (search-forward "\n\n" nil t)
+						(setq chars (- (point-max) 
+							       (point)))
+						(point)))
+ 	    (if (not (= 0 chars))	; none of them empty files...
+ 		(progn
+		  (setq nov-line (nnml-make-nov-line chars))
+		  (save-excursion
+		    (set-buffer nov-buffer)
+		    (goto-char (point-max))
+		    (insert (int-to-string (car files)) nov-line))))
+	    (widen)
+	    (setq files (cdr files)))
+	  (save-excursion
+	    (set-buffer nov-buffer)
+	    (write-region 1 (point-max) (expand-file-name nov) nil
+			  'nomesg)
+	    (kill-buffer (current-buffer)))))
+    (nnmail-save-active nnml-group-alist nnml-active-file)))
+
+(defun nnml-nov-delete-article (group article)
+  (save-excursion
+    (set-buffer (nnml-open-nov group))
+    (goto-char (point-min))
+    (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t)
+	(delete-region (match-beginning 0) (progn (forward-line 1) (point))))
+    t))
+
+(provide 'nnml)
+
+;;; nnml.el ends here

lisp/nnspool.el

@@ -1,8 +1,8 @@
-;;; nnspool.el --- spool access using NNTP for GNU Emacs
-
-;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc.
+;;; nnspool.el --- spool access for GNU Emacs
+;; Copyright (C) 1988,89,90,93,94,95 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -21,362 +21,409 @@
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
+;;; Commentary:
+
 ;;; Code:
 
+(require 'nnheader)
 (require 'nntp)
+(require 'timezone)
 
 (defvar nnspool-inews-program news-inews-program
-  "*Program to post news.")
+  "Program to post news.
+This is most commonly `inews' or `injnews'.")
 
 (defvar nnspool-inews-switches '("-h")
-  "*Switches for nnspool-request-post to pass to `inews' for posting news.")
+  "Switches for nnspool-request-post to pass to `inews' for posting news.
+If you are using Cnews, you probably should set this variable to nil.")
 
 (defvar nnspool-spool-directory news-path
-  "*Local news spool directory.")
+  "Local news spool directory.")
 
-(defvar nnspool-active-file "/usr/lib/news/active"
-  "*Local news active file.")
+(defvar nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
+  "Local news nov directory.")
 
-(defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups"
-  "*Local news newsgroups file.")
+(defvar nnspool-lib-dir "/usr/lib/news/"
+  "Where the local news library files are stored.")
 
-(defvar nnspool-distributions-file "/usr/lib/news/distributions"
-  "*Local news distributions file.")
+(defvar nnspool-active-file (concat nnspool-lib-dir "active")
+  "Local news active file.")
 
-(defvar nnspool-history-file "/usr/lib/news/history"
-  "*Local news history file.")
+(defvar nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups")
+  "Local news newsgroups file.")
+
+(defvar nnspool-distributions-file (concat nnspool-lib-dir "distributions")
+  "Local news distributions file.")
+
+(defvar nnspool-history-file (concat nnspool-lib-dir "history")
+  "Local news history file.")
+
+(defvar nnspool-active-times-file (concat nnspool-lib-dir "active.times")
+  "Local news active date file.")
+
+(defvar nnspool-large-newsgroup 50
+  "The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+(defvar nnspool-nov-is-evil nil
+  "Non-nil means that nnspool will never return NOV lines instead of headers.")
+
+(defconst nnspool-sift-nov-with-sed nil
+  "If non-nil, use sed to get the relevant portion from the overview file.
+If nil, nnspool will load the entire file into a buffer and process it
+there.")
 
 
 
-(defconst nnspool-version "NNSPOOL 1.12"
+(defconst nnspool-version "nnspool 2.0"
   "Version numbers of this version of NNSPOOL.")
 
 (defvar nnspool-current-directory nil
   "Current news group directory.")
 
-;;;
-;;; Replacement of Extended Command for retrieving many headers.
-;;;
-
-(defun nnspool-retrieve-headers (sequence)
-  "Return list of article headers specified by SEQUENCE of article id.
-The format of list is
- `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
-If there is no References: field, In-Reply-To: field is used instead.
-Reader macros for the vector are defined as `nntp-header-FIELD'.
-Writer macros for the vector are defined as `nntp-set-header-FIELD'.
-Newsgroup must be selected before calling this."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    ;;(erase-buffer)
-    (let ((file nil)
-	  (number (length sequence))
-	  (count 0)
-	  (headers nil)			;Result list.
-	  (article 0)
-	  (subject nil)
-	  (message-id nil)
-	  (from nil)
-	  (xref nil)
-	  (lines 0)
-	  (date nil)
-	  (references nil))
-      (while sequence
-	;;(nntp-send-strings-to-server "HEAD" (car sequence))
-	(setq article (car sequence))
-	(setq file
-	      (concat nnspool-current-directory (prin1-to-string article)))
-	(if (and (file-exists-p file)
-		 (not (file-directory-p file)))
-	    (progn
-	      (erase-buffer)
-	      (insert-file-contents file)
-	      ;; Make message body invisible.
-	      (goto-char (point-min))
-	      (search-forward "\n\n" nil 'move)
-	      (narrow-to-region (point-min) (point))
-	      ;; Fold continuation lines.
-	      (goto-char (point-min))
-	      (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-		(replace-match " " t t))
-	      ;; Make it possible to search for `\nFIELD'.
-	      (goto-char (point-min))
-	      (insert "\n")
-	      ;; Extract From:
-	      (goto-char (point-min))
-	      (if (search-forward "\nFrom: " nil t)
-		  (setq from (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq from "(Unknown User)"))
-	      ;; Extract Subject:
-	      (goto-char (point-min))
-	      (if (search-forward "\nSubject: " nil t)
-		  (setq subject (buffer-substring
-				 (point)
-				 (save-excursion (end-of-line) (point))))
-		(setq subject "(None)"))
-	      ;; Extract Message-ID:
-	      (goto-char (point-min))
-	      (if (search-forward "\nMessage-ID: " nil t)
-		  (setq message-id (buffer-substring
-				    (point)
-				    (save-excursion (end-of-line) (point))))
-		(setq message-id nil))
-	      ;; Extract Date:
-	      (goto-char (point-min))
-	      (if (search-forward "\nDate: " nil t)
-		  (setq date (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq date nil))
-	      ;; Extract Lines:
-	      (goto-char (point-min))
-	      (if (search-forward "\nLines: " nil t)
-		  (setq lines (string-to-int
-			       (buffer-substring
-				(point)
-				(save-excursion (end-of-line) (point)))))
-		(setq lines 0))
-	      ;; Extract Xref:
-	      (goto-char (point-min))
-	      (if (search-forward "\nXref: " nil t)
-		  (setq xref (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq xref nil))
-	      ;; Extract References:
-	      ;; If no References: field, use In-Reply-To: field instead.
-	      (goto-char (point-min))
-	      (if (or (search-forward "\nReferences: " nil t)
-		      (search-forward "\nIn-Reply-To: " nil t))
-		  (setq references (buffer-substring
-				    (point)
-				    (save-excursion (end-of-line) (point))))
-		(setq references nil))
-	      ;; Collect valid article only.
-	      (and article
-		   message-id
-		   (setq headers
-			 (cons (vector article subject from
-				       xref lines date
-				       message-id references) headers)))
-	      ))
-	(setq sequence (cdr sequence))
-	(setq count (1+ count))
-	(and (numberp nntp-large-newsgroup)
-	     (> number nntp-large-newsgroup)
-	     (zerop (% count 20))
-	     (message "NNSPOOL: Receiving headers... %d%%"
-		      (/ (* count 100) number)))
-	)
-      (and (numberp nntp-large-newsgroup)
-	   (> number nntp-large-newsgroup)
-	   (message "NNSPOOL: Receiving headers... done"))
-      (nreverse headers)
-      )))
+(defvar nnspool-current-group nil)
+(defvar nnspool-status-string "")
 
 
-;;;
-;;; Replacement of NNTP Raw Interface.
-;;;
 
-(defun nnspool-open-server (host &optional service)
-  "Open news server on HOST.
-If HOST is nil, use value of environment variable `NNTPSERVER'.
-If optional argument SERVICE is non-nil, open by the service name."
-  (let ((host (or host (getenv "NNTPSERVER")))
-	(status nil))
-    (setq nntp-status-string "")
-    (cond ((and (file-directory-p nnspool-spool-directory)
-		(file-exists-p nnspool-active-file)
-		(string-equal host (system-name)))
-	   (setq status (nnspool-open-server-internal host service)))
-	  ((string-equal host (system-name))
-	   (setq nntp-status-string
-		 (format "%s has no news spool.  Goodbye." host)))
-	  ((null host)
-	   (setq nntp-status-string "NNTP server is not specified."))
-	  (t
-	   (setq nntp-status-string
-		 (format "NNSPOOL: cannot talk to %s." host)))
-	  )
-    status
-    ))
+(defvar nnspool-current-server nil)
+(defvar nnspool-server-alist nil)
+(defvar nnspool-server-variables 
+  (list
+   (list 'nnspool-inews-program nnspool-inews-program)
+   (list 'nnspool-inews-switches nnspool-inews-switches)
+   (list 'nnspool-spool-directory nnspool-spool-directory)
+   (list 'nnspool-nov-directory nnspool-nov-directory)
+   (list 'nnspool-lib-dir nnspool-lib-dir)
+   (list 'nnspool-active-file nnspool-active-file)
+   (list 'nnspool-newsgroups-file nnspool-newsgroups-file)
+   (list 'nnspool-distributions-file nnspool-distributions-file)
+   (list 'nnspool-history-file nnspool-history-file)
+   (list 'nnspool-active-times-file nnspool-active-times-file)
+   (list 'nnspool-large-newsgroup nnspool-large-newsgroup)
+   (list 'nnspool-nov-is-evil nnspool-nov-is-evil)
+   (list 'nnspool-sift-nov-with-sed nnspool-sift-nov-with-sed)
+   '(nnspool-current-directory nil)
+   '(nnspool-current-group nil)
+   '(nnspool-status-string "")))
 
-(defun nnspool-close-server ()
-  "Close news server."
-  (nnspool-close-server-internal))
+
+;;; Interface functions.
 
-(fset 'nnspool-request-quit (symbol-function 'nnspool-close-server))
+(defun nnspool-retrieve-headers (sequence &optional newsgroup server)
+  "Retrieve the headers for the articles in SEQUENCE.
+Newsgroup must be selected before calling this function."
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let* ((number (length sequence))
+	   (count 0)
+	   (do-message (and (numberp nnspool-large-newsgroup)
+			    (> number nnspool-large-newsgroup)))
+	   file beg article)
+      (if (not (nnspool-possibly-change-directory newsgroup))
+	  ()
+	(if (and (numberp (car sequence))
+		 (nnspool-retrieve-headers-with-nov sequence))
+	    'nov
+	  (while sequence
+	    (setq article (car sequence))
+	    (if (stringp article)
+		(progn
+		  (setq file (nnspool-find-article-by-message-id article))
+		  (setq article 0))
+	      (setq file (concat nnspool-current-directory 
+				 (int-to-string article))))
+	    (and file (file-exists-p file)
+		 (progn
+		   (insert (format "221 %d Article retrieved.\n" article))
+		   (setq beg (point))
+		   (nnheader-insert-head file)
+		   (goto-char beg)
+		   (search-forward "\n\n" nil t)
+		   (forward-char -1)
+		   (insert ".\n")
+		   (delete-region (point) (point-max))))
+	    (setq sequence (cdr sequence))
+	    
+	    (and do-message
+		 (zerop (% (setq count (1+ count)) 20))
+		 (message "NNSPOOL: Receiving headers... %d%%"
+			  (/ (* count 100) number))))
+	  
+	  (and do-message (message "NNSPOOL: Receiving headers...done"))
+	  
+	  ;; Fold continuation lines.
+	  (goto-char (point-min))
+	  (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+	    (replace-match " " t t))
+	  'headers)))))
 
-(defun nnspool-server-opened ()
-  "Return server process status, T or NIL.
-If the stream is opened, return T, otherwise return NIL."
-  (and nntp-server-buffer
-       (get-buffer nntp-server-buffer)))
+(defun nnspool-open-server (server &optional defs)
+  (nnheader-init-server-buffer)
+  (if (equal server nnspool-current-server)
+      t
+    (if nnspool-current-server
+	(setq nnspool-server-alist 
+	      (cons (list nnspool-current-server
+			  (nnheader-save-variables nnspool-server-variables))
+		    nnspool-server-alist)))
+    (let ((state (assoc server nnspool-server-alist)))
+      (if state 
+	  (progn
+	    (nnheader-restore-variables (nth 1 state))
+	    (setq nnspool-server-alist (delq state nnspool-server-alist)))
+	(nnheader-set-init-variables nnspool-server-variables defs)))
+    (setq nnspool-current-server server)))
 
-(defun nnspool-status-message ()
+(defun nnspool-close-server (&optional server)
+  t)
+
+(defun nnspool-server-opened (&optional server)
+  (and (equal server nnspool-current-server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defun nnspool-status-message (&optional server)
   "Return server status response as string."
-  nntp-status-string
-  )
+  nnspool-status-string)
 
-(defun nnspool-request-article (id)
+(defun nnspool-request-article (id &optional newsgroup server buffer)
   "Select article by message ID (or number)."
+  (nnspool-possibly-change-directory newsgroup)
   (let ((file (if (stringp id)
 		  (nnspool-find-article-by-message-id id)
-		(concat nnspool-current-directory (prin1-to-string id)))))
+		(concat nnspool-current-directory (prin1-to-string id))))
+	(nntp-server-buffer (or buffer nntp-server-buffer)))
     (if (and (stringp file)
 	     (file-exists-p file)
 	     (not (file-directory-p file)))
 	(save-excursion
-	  (nnspool-find-file file)))
-    ))
+	  (nnspool-find-file file)))))
 
-(defun nnspool-request-body (id)
+(defun nnspool-request-body (id &optional newsgroup server)
   "Select article body by message ID (or number)."
+  (nnspool-possibly-change-directory newsgroup)
   (if (nnspool-request-article id)
       (save-excursion
 	(set-buffer nntp-server-buffer)
 	(goto-char (point-min))
 	(if (search-forward "\n\n" nil t)
 	    (delete-region (point-min) (point)))
-	t
-	)
-    ))
+	t)))
 
-(defun nnspool-request-head (id)
+(defun nnspool-request-head (id &optional newsgroup server)
   "Select article head by message ID (or number)."
+  (nnspool-possibly-change-directory newsgroup)
   (if (nnspool-request-article id)
       (save-excursion
 	(set-buffer nntp-server-buffer)
 	(goto-char (point-min))
 	(if (search-forward "\n\n" nil t)
 	    (delete-region (1- (point)) (point-max)))
-	t
-	)
-    ))
+	t)))
 
-(defun nnspool-request-stat (id)
-  "Select article by message ID (or number)."
-  (setq nntp-status-string "NNSPOOL: STAT is not implemented.")
-  nil
-  )
-
-(defun nnspool-request-group (group)
+(defun nnspool-request-group (group &optional server dont-check)
   "Select news GROUP."
   (let ((pathname (nnspool-article-pathname
-		   (nnspool-replace-chars-in-string group ?. ?/))))
-    (if (file-directory-p pathname)
-	(setq nnspool-current-directory pathname))
-    ))
+		   (nnspool-replace-chars-in-string group ?. ?/)))
+	dir)
+    (if (not (file-directory-p pathname))
+	(progn
+	  (setq nnspool-status-string
+		"Invalid group name (no such directory)")
+	  nil)
+      (setq nnspool-current-directory pathname)
+      (setq nnspool-status-string "")
+      (if (not dont-check)
+	  (progn
+	    (setq dir (directory-files pathname nil "^[0-9]+$" t))
+	    ;; yes, completely empty spool directories *are* possible
+	    ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
+	    (and dir
+		 (setq dir
+		       (sort 
+			(mapcar
+			 (function
+			  (lambda (name)
+			    (string-to-int name)))
+			 dir)
+			'<)))
+	    (save-excursion
+	      (set-buffer nntp-server-buffer)
+	      (erase-buffer)
+	      (if dir
+		  (insert
+		   (format "211 %d %d %d %s\n" (length dir) (car dir)
+			   (progn (while (cdr dir) (setq dir (cdr dir)))
+				  (car dir))
+			   group))
+		(insert (format "211 0 0 0 %s\n" group))))))
+      t)))
 
-(defun nnspool-request-list ()
-  "List active newsgoups."
+(defun nnspool-close-group (group &optional server)
+  t)
+
+(defun nnspool-request-list (&optional server)
+  "List active newsgroups."
   (save-excursion
     (nnspool-find-file nnspool-active-file)))
 
-(defun nnspool-request-list-newsgroups ()
+(defun nnspool-request-list-newsgroups (&optional server)
   "List newsgroups (defined in NNTP2)."
   (save-excursion
     (nnspool-find-file nnspool-newsgroups-file)))
 
-(defun nnspool-request-list-distributions ()
+(defun nnspool-request-list-distributions (&optional server)
   "List distributions (defined in NNTP2)."
   (save-excursion
     (nnspool-find-file nnspool-distributions-file)))
 
-(defun nnspool-request-last ()
-  "Set current article pointer to the previous article
-in the current news group."
-  (setq nntp-status-string "NNSPOOL: LAST is not implemented.")
-  nil
-  )
+;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+(defun nnspool-request-newgroups (date &optional server)
+  "List groups created after DATE."
+  (if (nnspool-find-file nnspool-active-times-file)
+      (save-excursion
+	;; Find the last valid line.
+	(goto-char (point-max))
+	(while (and (not (looking-at 
+			  "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
+		    (zerop (forward-line -1))))
+	(let ((seconds (nnspool-seconds-since-epoch date))
+	      groups)
+	  ;; Go through lines and add the latest groups to a list.
+	  (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ")
+		      (progn
+			;; We insert a .0 to make the list reader
+			;; interpret the number as a float. It is far
+			;; too big to be stored in a lisp integer. 
+			(goto-char (1- (match-end 0)))
+			(insert ".0")
+			(> (progn
+			     (goto-char (match-end 1))
+			     (read (current-buffer)))
+			   seconds))
+		      (setq groups (cons (buffer-substring
+					  (match-beginning 1) (match-end 1))
+					 groups))
+		      (zerop (forward-line -1))))
+	  (erase-buffer)
+	  (while groups
+	    (insert (car groups) " 0 0 y\n")
+	    (setq groups (cdr groups))))
+	t)
+    nil))
 
-(defun nnspool-request-next ()
-  "Advance current article pointer."
-  (setq nntp-status-string "NNSPOOL: NEXT is not implemented.")
-  nil
-  )
-
-(defun nnspool-request-post ()
+(defun nnspool-request-post (&optional server)
   "Post a new news in current buffer."
   (save-excursion
-    ;; We have to work in the server buffer because of NEmacs hack.
-    (copy-to-buffer nntp-server-buffer (point-min) (point-max))
-    (set-buffer nntp-server-buffer)
-    (apply (function call-process-region)
-	   (point-min) (point-max)
-	   nnspool-inews-program 'delete t nil nnspool-inews-switches)
-    (prog1
-	(or (zerop (buffer-size))
-	    ;; If inews returns strings, it must be error message 
-	    ;;  unless SPOOLNEWS is defined.  
-	    ;; This condition is very weak, but there is no good rule 
-	    ;;  identifying errors when SPOOLNEWS is defined.  
-	    ;; Suggested by ohm@kaba.junet.
-	    (string-match "spooled" (buffer-string)))
+    (let* ((process-connection-type nil) ; t bugs out on Solaris
+	   (inews-buffer (generate-new-buffer " *nnspool post*"))
+	   (proc (apply 'start-process "*nnspool inews*" inews-buffer
+			nnspool-inews-program nnspool-inews-switches)))
+      (set-process-sentinel proc 'nnspool-inews-sentinel)
+      (process-send-region proc (point-min) (point-max))
+      ;; We slap a condition-case around this, because the process may
+      ;; have exited already...
+      (condition-case nil
+	  (process-send-eof proc)
+	(error nil))
+      t)))
+
+(defun nnspool-inews-sentinel (proc status)
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    (goto-char (point-min))
+    (if (or (zerop (buffer-size))
+	    (search-forward "spooled" nil t))
+	(kill-buffer (current-buffer))
       ;; Make status message by unfolding lines.
       (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
-      (setq nntp-status-string (buffer-string))
-      (erase-buffer))
-    ))
+      (setq nnspool-status-string (buffer-string))
+      (message "nnspool: %s" nnspool-status-string)
+					;(kill-buffer (current-buffer))
+      )))
+
+(defalias 'nnspool-request-post-buffer 'nntp-request-post-buffer)
 
 
-;;;
-;;; Replacement of Low-Level Interface to NNTP Server.
-;;; 
+;;; Internal functions.
 
-(defun nnspool-open-server-internal (host &optional service)
-  "Open connection to news server on HOST by SERVICE (default is nntp)."
-  (save-excursion
-    (if (not (string-equal host (system-name)))
-	(error "NNSPOOL: cannot talk to %s." host))
-    ;; Initialize communication buffer.
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
-    (set-buffer nntp-server-buffer)
-    (buffer-flush-undo (current-buffer))
-    (erase-buffer)
-    (kill-all-local-variables)
-    (setq case-fold-search t)		;Should ignore case.
-    (setq nntp-server-process nil)
-    (setq nntp-server-name host)
-    ;; It is possible to change kanji-fileio-code in this hook.
-    (run-hooks 'nntp-server-hook)
-    t
-    ))
+(defun nnspool-retrieve-headers-with-nov (articles)
+  (if (or gnus-nov-is-evil nnspool-nov-is-evil)
+      nil
+    (let ((nov (concat (file-name-as-directory nnspool-nov-directory)
+		       (nnspool-replace-chars-in-string
+			nnspool-current-group ?. ?/)
+		       "/.overview"))
+	  article)
+      (if (file-exists-p nov)
+	  (save-excursion
+	    (set-buffer nntp-server-buffer)
+	    (erase-buffer)
+	    (if nnspool-sift-nov-with-sed
+		(nnspool-sift-nov-with-sed articles nov)
+	      (insert-file-contents nov)
+	      ;; First we find the first wanted line. We issue a number
+	      ;; of search-forwards - the first article we are lookign
+	      ;; for may be expired, so we have to go on searching until
+	      ;; we find one of the articles we want.
+	      (while (and articles
+			  (setq article (concat (int-to-string 
+						 (car articles)) "\t"))
+			  (not (or (looking-at article)
+				   (search-forward (concat "\n" article) 
+						   nil t))))
+		(setq articles (cdr articles)))
+	      (if (not articles)
+		  ()
+		(beginning-of-line)
+		(delete-region (point-min) (point))
+		;; Then we find the last wanted line. We go to the end
+		;; of the buffer and search backward much the same way
+		;; we did to find the first article.
+		;; !!! Perhaps it would be better just to do a (last articles), 
+		;; and go forward successively over each line and
+		;; compare to avoid this (reverse), like this:
+		;; (while (and (>= last (read nntp-server-buffer)))
+		;;             (zerop (forward-line 1))))
+		(setq articles (reverse articles))
+		(goto-char (point-max))
+		(while (and articles
+			    (not (search-backward 
+				  (concat "\n" (int-to-string (car articles))
+					  "\t") nil t)))
+		  (setq articles (cdr articles)))
+		(if articles
+		    (progn
+		      (forward-line 2)
+		      (delete-region (point) (point-max)))))
+	      (or articles (progn (erase-buffer) nil))))))))
 
-(defun nnspool-close-server-internal ()
-  "Close connection to news server."
-  (if (get-file-buffer nnspool-history-file)
-      (kill-buffer (get-file-buffer nnspool-history-file)))
-  (if nntp-server-buffer
-      (kill-buffer nntp-server-buffer))
-  (setq nntp-server-buffer nil)
-  (setq nntp-server-process nil))
+(defun nnspool-sift-nov-with-sed (articles file)
+  (let ((first (car articles))
+	(last (progn (while (cdr articles) (setq articles (cdr articles)))
+		     (car articles))))
+    (call-process "awk" nil t nil 
+		  (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
+			  (1- first) (1+ last))
+		  file)))
 
+;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). 
 (defun nnspool-find-article-by-message-id (id)
   "Return full pathname of an article identified by message-ID."
   (save-excursion
-    (let ((buffer (get-file-buffer nnspool-history-file)))
-      (if buffer
-	  (set-buffer buffer)
-	;; Finding history file may take lots of time.
-	(message "Reading history file...")
-	(set-buffer (find-file-noselect nnspool-history-file))
-	(message "Reading history file... done")))
-    ;; Search from end of the file. I think this is much faster than
-    ;; do from the beginning of the file.
-    (goto-char (point-max))
-    (if (re-search-backward
-	 (concat "^" (regexp-quote id)
-		 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
-	(let ((group (buffer-substring (match-beginning 1) (match-end 1)))
-	      (number (buffer-substring (match-beginning 2) (match-end 2))))
-	  (concat (nnspool-article-pathname
-		   (nnspool-replace-chars-in-string group ?. ?/))
-		  number))
-      )))
+    (let ((buf (get-buffer-create " *nnspool work*")))
+      (set-buffer buf)
+      (erase-buffer)
+      (call-process "grep" nil t nil id nnspool-history-file)
+      (goto-char (point-min))
+      (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ \t\n]*\\)")
+	  (concat nnspool-spool-directory
+		  (nnspool-replace-chars-in-string 
+		   (buffer-substring (match-beginning 1) (match-end 1)) 
+		   ?. ?/))))))
 
 (defun nnspool-find-file (file)
   "Insert FILE in server buffer safely."
@@ -384,8 +431,20 @@ in the current news group."
   (erase-buffer)
   (condition-case ()
       (progn (insert-file-contents file) t)
-    (file-error nil)
-    ))
+    (file-error nil)))
+
+(defun nnspool-possibly-change-directory (newsgroup)
+  (if newsgroup
+      (let ((pathname (nnspool-article-pathname
+		       (nnspool-replace-chars-in-string newsgroup ?. ?/))))
+	(if (file-directory-p pathname)
+	    (progn
+	      (setq nnspool-current-directory pathname)
+	      (setq nnspool-current-group newsgroup))
+	  (setq nnspool-status-string 
+		(format "No such newsgroup: %s" newsgroup))
+	  nil))
+    t))
 
 (defun nnspool-article-pathname (group)
   "Make pathname for GROUP."
@@ -401,8 +460,32 @@ in the current news group."
       (if (= (aref string idx) from)
 	  (aset string idx to))
       (setq idx (1+ idx)))
-    string
-    ))
+    string))
+
+(defun nnspool-number-base-10 (num pos)
+  (if (<= pos 0) ""
+    (setcdr num (+ (* (% (car num) 10) 65536) (cdr num)))
+    (apply
+     'concat
+     (reverse
+      (list
+       (char-to-string
+	(aref "0123456789" (% (cdr num) 10)))
+       (progn
+	 (setcdr num (/ (cdr num) 10))
+	 (setcar num (/ (car num) 10))
+	 (nnspool-number-base-10 num (1- pos))))))))
+
+(defun nnspool-seconds-since-epoch (date)
+  (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
+			(timezone-parse-date date)))
+	 (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
+			(timezone-parse-time
+			 (aref (timezone-parse-date date) 3))))
+	 (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime)
+			    (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) (nth 4 tdate))))
+    (+ (* (car unix) 65536.0)
+       (car (cdr unix)))))
 
 (provide 'nnspool)
 

lisp/nnvirtual.el

@@ -0,0 +1,476 @@
+;;; nnvirtual.el --- virtual newsgroups access for Gnus
+;; Copyright (C) 1994,95 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; The other access methods (nntp, nnspool, etc) are general news
+;; access methods. This module relies on Gnus and can not be used
+;; separately.
+
+;;; Code:
+
+(require 'nntp)
+(require 'nnheader)
+(require 'gnus)
+
+
+
+(defconst nnvirtual-version "nnvirtual 1.0"
+  "Version number of this version of nnvirtual.")
+
+(defvar nnvirtual-group-alist nil)
+(defvar nnvirtual-current-group nil)
+(defvar nnvirtual-current-groups nil)
+(defvar nnvirtual-current-mapping nil)
+
+(defvar nnvirtual-do-not-open nil)
+
+(defvar nnvirtual-status-string "")
+
+
+
+;;; Interface functions.
+
+(defun nnvirtual-retrieve-headers (sequence &optional newsgroup server)
+  "Retrieve the headers for the articles in SEQUENCE."
+  (nnvirtual-possibly-change-newsgroups newsgroup server t)
+  (save-excursion
+    (set-buffer (get-buffer-create "*virtual headers*"))
+    (buffer-disable-undo (current-buffer))
+    (erase-buffer)
+    (if (stringp (car sequence))
+	'headers
+      (let ((map nnvirtual-current-mapping)
+	    (offset 0)
+	    articles beg group active top article result prefix
+	    fetched-articles group-method)
+	(while sequence
+	  (while (< (car (car map)) (car sequence))
+	    (setq offset (car (car map)))
+	    (setq map (cdr map)))
+	  (setq top (car (car map)))
+	  (setq group (nth 1 (car map)))
+	  (setq prefix (gnus-group-real-prefix group))
+	  (setq active (nth 2 (car map)))
+	  (setq articles nil)
+	  (while (and sequence (<= (car sequence) top))
+	    (setq articles (cons (- (+ active (car sequence)) offset) 
+				 articles))
+	    (setq sequence (cdr sequence)))
+	  (setq articles (nreverse articles))
+	  (if (and articles
+		   (setq result 
+			 (progn
+			   (setq group-method 
+				 (gnus-find-method-for-group group))
+			   (and (or (gnus-server-opened group-method)
+				    (gnus-open-server group-method))
+				(gnus-request-group group t)
+				(gnus-retrieve-headers articles group)))))
+	      (save-excursion
+		(set-buffer nntp-server-buffer)
+		;; If we got HEAD headers, we convert them into NOV
+		;; headers. This is slow, inefficient and, come to think
+		;; of it, downright evil. So sue me. I couldn't be
+		;; bothered to write a header parse routine that could
+		;; parse a mixed HEAD/NOV buffer.
+		(and (eq result 'headers) (nnvirtual-convert-headers))
+		(goto-char (point-min))
+		(setq fetched-articles nil)
+		(while (not (eobp))
+		  (setq beg (point)
+			article (read nntp-server-buffer)
+			fetched-articles (cons article fetched-articles))
+		  (delete-region beg (point))
+		  (insert (int-to-string (+ (- article active) offset)))
+		  (beginning-of-line)
+		  (looking-at 
+		   "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
+		  (goto-char (match-end 0))
+		  (or (search-forward 
+		       "\t" (save-excursion (end-of-line) (point)) t)
+		      (end-of-line))
+		  (while (= (char-after (1- (point))) ? )
+		    (forward-char -1)
+		    (delete-char 1))
+		  (if (eolp)
+		      (progn
+			(end-of-line)
+			(or (= (char-after (1- (point))) ?\t)
+			    (insert ?\t))
+			(insert (format "Xref: %s %s:%d\t" (system-name) 
+					group article)))
+		    (if (not (string= "" prefix))
+			(while (re-search-forward 
+				"[^ ]+:[0-9]+"
+				(save-excursion (end-of-line) (point)) t)
+			  (save-excursion
+			    (goto-char (match-beginning 0))
+			    (insert prefix))))
+		    (end-of-line)
+		    (or (= (char-after (1- (point))) ?\t)
+			(insert ?\t)))
+		  (forward-line 1))))
+	  (goto-char (point-max))
+	  (insert-buffer-substring nntp-server-buffer)
+	  ;; We have now massaged and inserted the headers from one
+	  ;; group. In case some of the articles have expired or been
+	  ;; cancelled, we have to mark them as read in the component
+	  ;; group. 
+	  (let ((unfetched (gnus-sorted-complement 
+			    articles (nreverse fetched-articles))))
+	    (and unfetched
+		 (gnus-group-make-articles-read group unfetched nil))))
+	;; The headers are ready for reading, so they are inserted into
+	;; the nntp-server-buffer, which is where Gnus expects to find
+	;; them.
+	(prog1
+	    (save-excursion
+	      (set-buffer nntp-server-buffer)
+	      (erase-buffer)
+	      (insert-buffer-substring "*virtual headers*")
+	      'nov)
+	  (kill-buffer (current-buffer)))))))
+
+(defun nnvirtual-open-server (newsgroups &optional something)
+  "Open a virtual newsgroup that contains NEWSGROUPS."
+  (nnheader-init-server-buffer))
+
+(defun nnvirtual-close-server (&rest dum)
+  "Close news server."
+  t)
+
+(defun nnvirtual-request-close ()
+  (setq nnvirtual-current-group nil
+	nnvirtual-current-groups nil
+	nnvirtual-current-mapping nil
+	nnvirtual-group-alist nil)
+  t)
+
+(defun nnvirtual-server-opened (&optional server)
+  "Return server process status, T or NIL.
+If the stream is opened, return T, otherwise return NIL."
+  (and nntp-server-buffer
+       (get-buffer nntp-server-buffer)))
+
+(defun nnvirtual-status-message (&optional server)
+  "Return server status response as string."
+  nnvirtual-status-string)
+
+(defun nnvirtual-request-article (article &optional newsgroup server buffer)
+  "Select article by message number."
+  (nnvirtual-possibly-change-newsgroups newsgroup server t)
+  (and (numberp article)
+       (let ((map nnvirtual-current-mapping)
+	     (offset 0)
+	     group-method)
+	 (while (< (car (car map)) article)
+	   (setq offset (car (car map)))
+	   (setq map (cdr map)))
+	 (setq group-method (gnus-find-method-for-group (nth 1 (car map))))
+	 (or (gnus-server-opened group-method)
+	     (gnus-open-server group-method))
+	 (gnus-request-group (nth 1 (car map)) t)
+	 (gnus-request-article (- (+ (nth 2 (car map)) article) offset)
+			       (nth 1 (car map)) buffer))))
+
+(defun nnvirtual-request-group (group &optional server dont-check)
+  "Make GROUP the current newsgroup."
+  (nnvirtual-possibly-change-newsgroups group server dont-check)
+  (let ((map nnvirtual-current-mapping))
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      (erase-buffer)
+      (if map
+	  (progn
+	    (while (cdr map)
+	      (setq map (cdr map)))
+	    (insert (format "211 %d 1 %d %s\n" (car (car map)) 
+			    (car (car map)) group))
+	    t)
+	(setq nnvirtual-status-string "No component groups")
+	(setq nnvirtual-current-group nil)
+	nil))))
+    
+(defun nnvirtual-close-group (group &optional server)
+  (if (not nnvirtual-current-group)
+      ()
+    (nnvirtual-possibly-change-newsgroups group server t)
+    (nnvirtual-update-marked)
+    (setq nnvirtual-current-group nil
+	  nnvirtual-current-groups nil
+	  nnvirtual-current-mapping nil)
+    (setq nnvirtual-group-alist 
+	  (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist))))
+
+(defun nnvirtual-request-list (&optional server) 
+  (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.")
+  nil)
+
+(defun nnvirtual-request-newgroups (date &optional server)
+  "List new groups."
+  (setq nnvirtual-status-string "NEWGROUPS is not supported.")
+  nil)
+
+(defun nnvirtual-request-list-newsgroups (&optional server)
+  (setq nnvirtual-status-string
+	"nnvirtual: LIST NEWSGROUPS is not implemented.")
+  nil)
+
+(defalias 'nnvirtual-request-post 'nntp-request-post)
+
+(defun nnvirtual-request-post-buffer 
+  (post group subject header article-buffer info follow-to respect-poster)
+  (nntp-request-post-buffer post "" subject header article-buffer
+			    info follow-to respect-poster))
+
+
+;;; Internal functions.
+
+;; Convert HEAD headers into NOV headers.
+(defun nnvirtual-convert-headers ()
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (let* ((gnus-newsgroup-dependencies (make-vector 100 0))
+	   (headers (gnus-get-newsgroup-headers))
+	   header)
+      (erase-buffer)
+      (while headers
+	(setq header (car headers)
+	      headers (cdr headers))
+	(insert (int-to-string (mail-header-number header)) "\t"
+		(or (mail-header-subject header) "") "\t"
+		(or (mail-header-from header) "") "\t"
+		(or (mail-header-date header) "") "\t"
+		(or (mail-header-id header) "") "\t"
+		(or (mail-header-references header) "") "\t"
+		(int-to-string (or (mail-header-chars header) 0)) "\t"
+		(int-to-string (or (mail-header-lines header) 0)) "\t"
+		(if (mail-header-xref header) 
+		    (concat "Xref: " (mail-header-xref header) "\t")
+		  "") "\n")))))
+
+(defun nnvirtual-possibly-change-newsgroups (group regexp &optional check)
+  (let ((inf t))
+    (or (not group)
+	(and nnvirtual-current-group
+	     (string= group nnvirtual-current-group))
+	(and (setq inf (assoc group nnvirtual-group-alist))
+	     (string= (nth 3 inf) regexp)
+	     (progn
+	       (setq nnvirtual-current-group (car inf))
+	       (setq nnvirtual-current-groups (nth 1 inf))
+	       (setq nnvirtual-current-mapping (nth 2 inf)))))
+    (if (or (not check) (not inf))
+	(progn
+	  (and inf (setq nnvirtual-group-alist 
+			 (delq inf nnvirtual-group-alist)))
+	  (setq nnvirtual-current-mapping nil)
+	  (setq nnvirtual-current-group group)
+	  (let ((newsrc gnus-newsrc-alist)
+		(virt-group (gnus-group-prefixed-name 
+			     nnvirtual-current-group '(nnvirtual ""))))
+	    (setq nnvirtual-current-groups nil)
+	    (while newsrc
+	      (and (string-match regexp (car (car newsrc)))
+		   (not (string= (car (car newsrc)) virt-group))
+		   (setq nnvirtual-current-groups
+			 (cons (car (car newsrc)) nnvirtual-current-groups)))
+	      (setq newsrc (cdr newsrc))))
+	  (if nnvirtual-current-groups
+	      (progn
+		(nnvirtual-create-mapping group)
+		(setq nnvirtual-group-alist
+		      (cons (list group nnvirtual-current-groups 
+				  nnvirtual-current-mapping regexp)
+			    nnvirtual-group-alist)))
+	    (setq nnvirtual-status-string 
+		  (format 
+		   "nnvirtual: No newsgroups for this virtual newsgroup"))))))
+  nnvirtual-current-groups)
+
+(defun nnvirtual-create-mapping (group)
+  (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual "")))
+	 (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
+	 (groups nnvirtual-current-groups)
+	 (offset 0)
+	 reads unread igroup itotal ireads)
+    ;; The virtual group doesn't exist. (?)
+    (or info (error "No such group: %s" group))
+    (setq nnvirtual-current-mapping nil)
+    (while groups
+      ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
+      (setq igroup (car groups))
+      (let ((info (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb)))
+	    (active (gnus-gethash igroup gnus-active-hashtb)))
+	;; See if the group has had its active list read this session
+	;; if not, we do it now.
+	(if (null active)
+	    (if (gnus-activate-group igroup)
+		(progn
+		  (gnus-get-unread-articles-in-group
+		   info (gnus-gethash igroup gnus-active-hashtb))
+		  (setq active (gnus-gethash igroup gnus-active-hashtb)))
+	      (message "Couldn't open component group %s" igroup)))
+	(if (null active)
+	    ()
+	  ;; And then we do the mapping for this component group. If
+	  ;; you feel tempted to cast your eyes to the soup below -
+	  ;; don't. It'll hurt your soul. Suffice to say that it
+	  ;; assigns ranges of nnvirtual article numbers to the
+	  ;; different component groups. To get the article number
+	  ;; from the nnvirtual number, one does something like
+	  ;; (+ (- number offset) (car active)), where `offset' is the
+	  ;; slice the mess below assigns, and active is the lowest
+	  ;; active article in the component group. 
+	  (setq itotal (1+ (- (cdr active) (car active))))
+ 	  (if (setq ireads (nth 2 info))
+	      (let ((itreads
+		     (if (not (listp (cdr ireads)))
+			 (setq ireads (list (cons (car ireads) (cdr ireads))))
+		       (setq ireads (copy-alist ireads)))))
+		(if (< (or (and (numberp (car ireads)) (car ireads))
+			   (cdr (car ireads))) (car active))
+		    (setq ireads (setq itreads (cdr ireads))))
+		(if (and ireads (< (or (and (numberp (car ireads))
+					    (car ireads))
+				       (car (car ireads))) (car active)))
+		    (setcar (or (and (numberp (car ireads)) ireads)
+				(car ireads)) (1+ (car active))))
+		(while itreads
+		  (setcar (or (and (numberp (car itreads)) itreads)
+			      (car itreads))
+			  (+ (max 
+			      1 (- (if (numberp (car itreads)) 
+				       (car itreads)
+				     (car (car itreads)))
+				   (car active)))
+			     offset))
+		  (if (not (numberp (car itreads)))
+		      (setcdr (car itreads)
+			      (+ (- (cdr (car itreads)) (car active)) offset)))
+		  (setq itreads (cdr itreads)))
+		(setq reads (nconc reads ireads))))
+	  (setq offset (+ offset (1- itotal)))
+	  (setq nnvirtual-current-mapping
+		(cons (list offset igroup (car active)) 
+		      nnvirtual-current-mapping)))
+	(setq groups (cdr groups))))
+    (setq nnvirtual-current-mapping
+	  (nreverse nnvirtual-current-mapping))
+    ;; Set Gnus active info.
+    (gnus-sethash group (cons 1 (1- offset)) gnus-active-hashtb)
+    ;; Set Gnus read info.
+    (setcar (nthcdr 2 info) reads)
+
+    ;; Then we deal with the marks.
+    (let ((map nnvirtual-current-mapping)
+	  (marks '(tick dormant reply expire score))
+	  (offset 0)
+	  tick dormant reply expire score marked active)
+      (while map
+	(setq igroup (nth 1 (car map)))
+	(setq active (nth 2 (car map)))
+	(setq marked (nth 3 (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb))))
+	(let ((m marks))
+	  (while m
+	    (and (assq (car m) marked)
+		 (set (car m) 
+		      (nconc (mapcar 
+			      (lambda (art) 
+				(if (numberp art)
+				    (if (< art active)
+					0 (+ (- art active) offset))
+				  (cons (+ (- (car art) active) offset)
+					(cdr art))))
+			      (cdr (assq (car m) marked)))
+			     (symbol-value (car m)))))
+	    (setq m (cdr m))))
+	(setq offset (car (car map)))
+	(setq map (cdr map)))
+      ;; Put the list of marked articles in the info of the virtual group.
+      (let ((m marks)
+	    marked)
+	(while m
+	  (and (symbol-value (car m))
+	       (setq marked (cons (cons (car m) (symbol-value (car m)))
+				  marked)))
+	  (setq m (cdr m)))
+	(if (nthcdr 3 info)
+	    (setcar (nthcdr 3 info) marked)
+	  (setcdr (nthcdr 2 info) (list marked)))))))
+
+(defun nnvirtual-update-marked ()
+  (let ((mark-lists '((gnus-newsgroup-marked . tick)
+		      (gnus-newsgroup-dormant . dormant)
+		      (gnus-newsgroup-expirable . expire)
+		      (gnus-newsgroup-replied . reply)))
+	marks art-group group-alist g)
+    (while mark-lists
+      (setq marks (symbol-value (car (car mark-lists))))
+      ;; Find out what groups the mark belong to.
+      (while marks
+	(setq art-group (nnvirtual-art-group (car marks)))
+	(if (setq g (assoc (car art-group) group-alist))
+	    (nconc g (list (cdr art-group)))
+	  (setq group-alist (cons (list (car art-group) (cdr art-group)) 
+				  group-alist)))
+	(setq marks (cdr marks)))
+      ;; The groups that don't have marks must have no marks. (Yup.)
+      (let ((groups nnvirtual-current-groups))
+	(while groups
+	  (or (assoc (car groups) group-alist)
+	      (setq group-alist (cons (list (car groups)) group-alist)))
+	  (setq groups (cdr groups))))
+      ;; The we update the list of marks.
+      (while group-alist
+	(gnus-add-marked-articles 
+	 (car (car group-alist)) (cdr (car mark-lists)) 
+	 (cdr (car group-alist)) nil t)
+	(gnus-group-update-group (car (car group-alist)) t)
+	(setq group-alist (cdr group-alist)))
+      (setq mark-lists (cdr mark-lists)))))
+
+(defun nnvirtual-art-group (article) 
+  (let ((map nnvirtual-current-mapping)
+	(offset 0))
+    (while (< (car (car map)) (if (numberp article) article (car article)))
+      (setq offset (car (car map))
+	    map (cdr map)))
+    (cons (nth 1 (car map))
+	  (if (numberp article)
+	      (- (+ article (nth 2 (car map))) offset)
+	    (cons (- (+ (car article) (nth 2 (car map))) offset)
+		  (cdr article))))))
+
+(defun nnvirtual-catchup-group (group &optional server all)
+  (nnvirtual-possibly-change-newsgroups group server)
+  (let ((gnus-group-marked nnvirtual-current-groups)
+	(gnus-expert-user t))
+    (save-excursion
+      (set-buffer gnus-group-buffer)
+      (gnus-group-catchup-current nil all))))
+
+(provide 'nnvirtual)
+
+;;; nnvirtual.el ends here