Initial revision

15 files changed, 9249 insertions, 0 deletions

diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el
new file mode 100644
index 00000000000..431eb3220ca
--- /dev/null
+++ b/lisp/gnus-demon.el
@@ -0,0 +1,222 @@
+;;; gnus-demon.el --- daemonic Gnus behaviour
+;; Copyright (C) 1995,96 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+
+(eval-when-compile (require 'cl))
+
+(defvar gnus-demon-handlers nil
+  "Alist of daemonic handlers to be run at intervals.
+Each handler is a list on the form
+
+\(FUNCTION TIME IDLE)
+
+FUNCTION is the function to be called. 
+TIME is the number of `gnus-demon-timestep's between each call.  
+If nil, never call.  If t, call each `gnus-demon-timestep'.
+If IDLE is t, only call if Emacs has been idle for a while.  If IDLE
+is a number, only call when Emacs has been idle more than this number
+of `gnus-demon-timestep's.  If IDLE is nil, don't care about
+idleness.  If IDLE is a number and TIME is nil, then call once each
+time Emacs has been idle for IDLE `gnus-demon-timestep's.")
+
+(defvar gnus-demon-timestep 60
+  "*Number of seconds in each demon timestep.")
+
+;;; Internal variables.
+
+(defvar gnus-demon-timer nil)
+(defvar gnus-demon-idle-has-been-called nil)
+(defvar gnus-demon-idle-time 0)
+(defvar gnus-demon-handler-state nil)
+(defvar gnus-demon-is-idle nil)
+(defvar gnus-demon-last-keys nil) 
+
+(eval-and-compile
+  (autoload 'timezone-parse-date "timezone")
+  (autoload 'timezone-make-arpa-date "timezone"))
+
+;;; Functions.
+
+(defun gnus-demon-add-handler (function time idle)
+  "Add the handler FUNCTION to be run at TIME and IDLE."
+  ;; First remove any old handlers that use this function.
+  (gnus-demon-remove-handler function)
+  ;; Then add the new one.
+  (push (list function time idle) gnus-demon-handlers)
+  (gnus-demon-init))
+
+(defun gnus-demon-remove-handler (function &optional no-init)
+  "Remove the handler FUNCTION from the list of handlers."
+  (setq gnus-demon-handlers 
+	(delq (assq function gnus-demon-handlers)
+	      gnus-demon-handlers))
+  (or no-init (gnus-demon-init)))
+
+(defun gnus-demon-init ()
+  "Initialize the Gnus daemon."
+  (interactive)
+  (gnus-demon-cancel)
+  (if (null gnus-demon-handlers)
+      () ; Nothing to do.
+    ;; Set up timer.
+    (setq gnus-demon-timer 
+	  (nnheader-run-at-time 
+	   gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
+    ;; Reset control variables.
+    (setq gnus-demon-handler-state
+	  (mapcar 
+	   (lambda (handler)
+	     (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
+		   (nth 2 handler)))
+	   gnus-demon-handlers))
+    (setq gnus-demon-idle-time 0)
+    (setq gnus-demon-idle-has-been-called nil)
+    (setq gnus-use-demon t)))
+
+(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
+
+(defun gnus-demon-cancel ()
+  "Cancel any Gnus daemons."
+  (interactive)
+  (and gnus-demon-timer
+       (nnheader-cancel-timer gnus-demon-timer))
+  (setq gnus-demon-timer nil
+	gnus-use-demon nil))
+
+(defun gnus-demon-is-idle-p ()
+  "Whether Emacs is idle or not."
+  ;; We do this simply by comparing the 100 most recent keystrokes
+  ;; with the ones we had last time.  If they are the same, one might
+  ;; guess that Emacs is indeed idle.  This only makes sense if one
+  ;; calls this function seldom -- like once a minute, which is what
+  ;; we do here.
+  (let ((keys (recent-keys)))
+    (or (equal keys gnus-demon-last-keys)
+	(progn
+	  (setq gnus-demon-last-keys keys)
+	  nil))))
+
+(defun gnus-demon-time-to-step (time)
+  "Find out how many seconds to TIME, which is on the form \"17:43\"."
+  (if (not (stringp time))
+      time
+    (let* ((date (current-time-string))
+	   (dv (timezone-parse-date date))
+	   (tdate (timezone-make-arpa-date 
+		   (string-to-number (aref dv 0))
+		   (string-to-number (aref dv 1))
+		   (string-to-number (aref dv 2)) time
+		   (or (aref dv 4) "UT")))
+	   (nseconds (gnus-time-minus
+		      (gnus-encode-date tdate) (gnus-encode-date date))))
+      (round
+       (/ (if (< nseconds 0)
+	      (+ nseconds (* 60 60 24))
+	    nseconds) gnus-demon-timestep)))))
+
+(defun gnus-demon ()
+  "The Gnus daemon that takes care of running all Gnus handlers."
+  ;; Increase or reset the time Emacs has been idle.
+  (if (gnus-demon-is-idle-p)
+      (incf gnus-demon-idle-time)
+    (setq gnus-demon-idle-time 0)
+    (setq gnus-demon-idle-has-been-called nil))
+  ;; Then we go through all the handler and call those that are
+  ;; sufficiently ripe.
+  (let ((handlers gnus-demon-handler-state)
+	handler time idle)
+    (while handlers
+      (setq handler (pop handlers))
+      (cond 
+       ((numberp (setq time (nth 1 handler)))
+	;; These handlers use a regular timeout mechanism.  We decrease
+	;; the timer if it hasn't reached zero yet.
+	(or (zerop time)
+	    (setcar (nthcdr 1 handler) (decf time)))
+	(and (zerop time)		; If the timer now is zero...
+	     (or (not (setq idle (nth 2 handler))) ; Don't care about idle.
+		 (and (numberp idle)	; Numerical idle...
+		      (< idle gnus-demon-idle-time)) ; Idle timed out.
+		 gnus-demon-is-idle)	; Or just need to be idle.
+	     ;; So we call the handler.
+	     (progn
+	       (funcall (car handler))
+	       ;; And reset the timer.
+	       (setcar (nthcdr 1 handler)
+		       (gnus-demon-time-to-step
+			(nth 1 (assq (car handler) gnus-demon-handlers)))))))
+       ;; These are only supposed to be called when Emacs is idle. 
+       ((null (setq idle (nth 2 handler)))
+	;; We do nothing.
+	)
+       ((not (numberp idle))
+	;; We want to call this handler each and every time that
+	;; Emacs is idle. 
+	(funcall (car handler)))
+       (t
+	;; We want to call this handler only if Emacs has been idle
+	;; for a specified number of timesteps.
+	(and (not (memq (car handler) gnus-demon-idle-has-been-called))
+	     (< idle gnus-demon-idle-time)
+	     (progn
+	       (funcall (car handler))
+	       ;; Make sure the handler won't be called once more in
+	       ;; this idle-cycle.
+	       (push (car handler) gnus-demon-idle-has-been-called))))))))
+
+(defun gnus-demon-add-nocem ()
+  "Add daemonic NoCeM handling to Gnus."
+  (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t))
+
+(defun gnus-demon-scan-nocem ()
+  "Scan NoCeM groups for NoCeM messages."
+  (gnus-nocem-scan-groups))
+
+(defun gnus-demon-add-disconnection ()
+  "Add daemonic server disconnection to Gnus."
+  (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
+
+(defun gnus-demon-close-connections ()
+  (gnus-close-backends))
+
+(defun gnus-demon-add-scanmail ()
+  "Add daemonic scanning of mail from the mail backends."
+  (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
+
+(defun gnus-demon-scan-mail ()
+  (let ((servers gnus-opened-servers)
+	server)
+    (while (setq server (car (pop servers)))
+      (and (gnus-check-backend-function 'request-scan (car server))
+	   (or (gnus-server-opened server)
+	       (gnus-open-server server))
+	   (gnus-request-scan nil server)))))
+
+(provide 'gnus-demon)
+
+;;; gnus-demon.el ends here
diff --git a/lisp/gnus-gl.el b/lisp/gnus-gl.el
new file mode 100644
index 00000000000..54997d2c9a9
--- /dev/null
+++ b/lisp/gnus-gl.el
@@ -0,0 +1,872 @@
+;;; gnus-gl.el --- an interface to GroupLens for Gnus
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+;; Author: Brad Miller <bmiller@cs.umn.edu>
+;; Keywords: news, score
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GroupLens software and documentation is copyright (c) 1995 by Paul
+;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
+;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
+;; and David Maltz (Carnegie-Mellon University).
+;;
+;; Permission to use, copy, modify, and distribute this documentation
+;; for non-commercial and commercial purposes without fee is hereby
+;; granted provided that this copyright notice and permission notice
+;; appears in all copies and that the names of the individuals and
+;; institutions holding this copyright are not used in advertising or
+;; publicity pertaining to this software without specific, written
+;; prior permission.  The copyright holders make no representations
+;; about the suitability of this software and documentation for any
+;; purpose.  It is provided ``as is'' without express or implied
+;; warranty.
+;;
+;; The copyright holders request that they be notified of
+;; modifications of this code.  Please send electronic mail to
+;; grouplens@cs.umn.edu for more information or to announce derived
+;; works.  
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Author: Brad Miller
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; User Documentation:
+;; To use GroupLens you must load this file.
+;; You must also register a pseudonym with the Better Bit Bureau.
+;; http://www.cs.umn.edu/Research/GroupLens
+;;
+;;    ---------------- For your .emacs or .gnus file ----------------
+;;
+;; As of version 2.5, grouplens now works as a minor mode of 
+;; gnus-summary-mode.  To get make that work you just need a couple of
+;; hooks.
+;; (setq gnus-use-grouplens t)
+;; (setq grouplens-pseudonym "")
+;; (setq grouplens-bbb-host "grouplens.cs.umn.edu")
+;;
+;; (setq gnus-summary-default-score 0)
+;;
+;;                              USING GROUPLENS
+;; How do I Rate an article??
+;;   Before you type n to go to the next article, hit a number from 1-5
+;;   Type r in the summary buffer and you will be prompted.
+;;   Note that when you're in grouplens-minor-mode 'r' maskes the
+;;   usual reply binding for 'r'
+;;
+;; What if, Gasp, I find a bug???
+;; Please type M-x gnus-gl-submit-bug-report.  This will set up a
+;; mail buffer with the  state of variables and buffers that will help
+;; me debug the problem.  A short description up front would help too!
+;; 
+;; How do I display the prediction for an aritcle:
+;;  If you set the gnus-summary-line-format as shown above, the score
+;;  (prediction) will be shown automatically.
+;;
+;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Programmer  Notes 
+;; 10/9/95
+;; gnus-scores-articles contains the articles
+;; When scoring is done, the call tree looks something like:
+;; gnus-possibly-score-headers
+;;  ==> gnus-score-headers
+;;      ==> gnus-score-load-file
+;;          ==> get-all-mids  (from the eval form)
+;;
+;; it would be nice to have one that gets called after all the other
+;; headers have been scored.
+;; we may want a variable gnus-grouplens-scale-factor
+;; and gnus-grouplens-offset  this would probably be either -3 or 0
+;; to make the scores centered around zero or not.
+;; Notes 10/12/95
+;; According to Lars, Norse god of gnus, the simple way to insert a
+;; call to an external function is to have a function added to the
+;; variable gnus-score-find-files-function  This new function
+;; gnus-grouplens-score-alist will return a core alist that
+;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
+;; This seems like it would be pretty inefficient, though workable.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  TODO
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 3. Add some more ways to rate messages
+;; 4. Better error handling for token timeouts.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bugs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+
+;;; Code:
+
+(require 'gnus-score)
+(require 'cl)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; User variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar gnus-summary-grouplens-line-format
+  "%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n"
+  "*The line format spec in summary GroupLens mode buffers.")
+
+(defvar grouplens-pseudonym ""
+  "User's pseudonym.  This pseudonym is obtained during the registration process")
+
+(defvar grouplens-bbb-host "grouplens.cs.umn.edu"
+  "Host where the bbbd is running" )
+
+(defvar grouplens-bbb-port 9000 
+  "Port where the bbbd is listening" )
+
+(defvar grouplens-newsgroups 
+  '("comp.lang.c++" "rec.humor" "rec.food.recipes" "comp.groupware"
+    "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
+    "comp.lang.java" "comp.os.linux.announce" "comp.os.linux.misc"
+    "comp.os.linux.development.apps" "comp.os.linux.development.system")
+  "*Groups that are part of the GroupLens experiment.")
+
+(defvar grouplens-prediction-display 'prediction-spot
+  "valid values are: 
+      prediction-spot -- an * corresponding to the prediction between 1 and 5, 
+      confidence-interval -- a numeric confidence interval
+      prediction-bar --  |#####     | the longer the bar, the better the article,
+      confidence-bar --  |  -----   } the prediction is in the middle of the bar,
+      confidence-spot -- )  *       | the spot gets bigger with more confidence,
+      prediction-num  --   plain-old numeric value,
+      confidence-plus-minus  -- prediction +/i confidence")
+
+(defvar grouplens-score-offset 0
+  "Offset the prediction by this value.  
+Setting this variable to -2 would have the following effect on
+GroupLens scores:
+
+   1   -->   -2
+   2   -->   -1
+   3   -->    0
+   4   -->    1
+   5   -->    2
+   
+The reason is that a user might want to do this is to combine
+GroupLens predictions with scores calculated by other score methods.")
+
+(defvar grouplens-score-scale-factor 1
+  "This variable allows the user to magnify the effect of GroupLens scores. 
+The scale factor is applied after the offset.")
+
+(defvar gnus-grouplens-override-scoring 'override
+  "Tell Grouplens to override the normal Gnus scoring mechanism.  
+GroupLens scores can be combined with gnus scores in one of three ways.
+'override -- just use grouplens predictions for grouplens groups
+'combine  -- combine grouplens scores with gnus scores
+'separate -- treat grouplens scores completely separate from gnus")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Program global variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar grouplens-bbb-token "0"
+  "Current session token number")
+
+(defvar grouplens-bbb-process nil
+  "Process Id of current bbbd network stream process")
+
+(defvar grouplens-bbb-buffer nil
+  "Buffer associated with the BBBD process")
+
+(defvar grouplens-rating-alist nil
+  "Current set of  message-id rating pairs")
+
+(defvar grouplens-current-hashtable (make-hash-table :test 'equal :size 100))
+;; this seems like a pretty ugly way to get around the problem, but If 
+;; I don't do this, then the compiler complains when I call gethash
+;;
+(eval-when-compile (setq grouplens-current-hashtable 
+			 (make-hash-table :test 'equal :size 100)))
+
+(defvar grouplens-current-group nil)
+
+(defvar bbb-mid-list nil)
+
+(defvar bbb-alist nil)
+
+(defvar bbb-timeout-secs 10
+  "Number of seconds to wait for some response from the BBB.
+If this times out we give up and assume that something has died..." )
+
+(defvar grouplens-previous-article nil
+  "Message-ID of the last article read.")
+
+(defvar bbb-read-point)
+(defvar bbb-response-point)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;  Utility Functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun bbb-connect-to-bbbd (host port)
+  (unless grouplens-bbb-buffer 
+    (setq grouplens-bbb-buffer 
+	  (get-buffer-create (format " *BBBD trace: %s*" host)))
+    (save-excursion
+      (set-buffer grouplens-bbb-buffer)
+      (make-local-variable 'bbb-read-point)
+      (setq bbb-read-point (point-min))))
+  ;; clear the trace buffer of old output
+  (save-excursion
+    (set-buffer grouplens-bbb-buffer)
+    (erase-buffer))
+  ;; open the connection to the server
+  (setq grouplens-bbb-process nil)
+  (catch 'done
+    (condition-case error
+	(setq grouplens-bbb-process 
+	      (open-network-stream "BBBD" grouplens-bbb-buffer host port))
+      (error (gnus-message 3 "Error: Failed to connect to BBB")
+	     nil))
+    (and (null grouplens-bbb-process) 
+	 (throw 'done nil))
+    ;; (set-process-filter grouplens-bbb-process 'bbb-process-filter)
+    (save-excursion
+      (set-buffer grouplens-bbb-buffer)
+      (setq bbb-read-point (point-min))
+      (or (bbb-read-response grouplens-bbb-process)
+	  (throw 'done nil))))
+  grouplens-bbb-process)
+
+;; (defun bbb-process-filter (process output)
+;;   (save-excursion
+;;     (set-buffer (bbb-process-buffer process))
+;;     (goto-char (point-max))
+;;     (insert output)))
+
+(defun bbb-send-command (process command)
+  (goto-char (point-max))
+  (insert command) 
+  (insert "\r\n")
+  (setq bbb-read-point (point))
+  (setq bbb-response-point (point))
+  (set-marker (process-mark process) (point)) ; process output also comes here
+  (process-send-string process command)
+  (process-send-string process "\r\n"))
+
+(defun bbb-read-response (process) ; &optional return-response-string)
+  "This function eats the initial response of OK or ERROR from the BBB."
+  (let ((case-fold-search nil)
+	 match-end)
+    (goto-char bbb-read-point)
+    (while (and (not (search-forward "\r\n" nil t))
+		(accept-process-output process bbb-timeout-secs))
+      (goto-char bbb-read-point))
+    (setq match-end (point))
+    (goto-char bbb-read-point)
+    (setq bbb-read-point match-end)
+    (looking-at "OK")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;       Login Functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun bbb-login ()
+  "return the token number if login is successful, otherwise return nil"
+  (interactive)
+  (setq grouplens-bbb-token nil)
+  (if (not (equal grouplens-pseudonym ""))
+      (let ((bbb-process 
+	     (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
+	(if bbb-process
+	    (save-excursion 
+	      (set-buffer (process-buffer bbb-process))
+	      (bbb-send-command bbb-process 
+				(concat "login " grouplens-pseudonym))
+	      (if (bbb-read-response bbb-process)
+		  (setq grouplens-bbb-token (bbb-extract-token-number))
+		(gnus-message 3 "Error: Grouplens login failed")))))
+    (gnus-message 3 "Error: you must set a pseudonym"))
+  grouplens-bbb-token)
+
+(defun bbb-extract-token-number ()
+  (let ((token-pos (search-forward "token=" nil t) ))
+    (if (looking-at "[0-9]+")
+	(buffer-substring token-pos (match-end 0)))))
+
+(gnus-add-shutdown 'bbb-logout 'gnus)
+
+(defun bbb-logout ()
+  "logout of bbb session"
+  (let ((bbb-process 
+	 (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
+    (if bbb-process
+	(save-excursion 
+	  (set-buffer (process-buffer bbb-process))
+	  (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token))
+	  (bbb-read-response bbb-process))
+      nil)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;       Get Predictions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun bbb-build-mid-scores-alist (groupname)
+  "this function can be called as part of the function to return the 
+list of score files to use. See the gnus variable 
+gnus-score-find-score-files-function.  
+
+*Note:*  If you want to use grouplens scores along with calculated scores, 
+you should see the offset and scale variables.  At this point, I don't 
+recommend using both scores and grouplens predictions together."
+  (setq grouplens-current-group groupname)
+  (if (member groupname grouplens-newsgroups)
+      (let* ((mid-list (bbb-get-all-mids))
+	     (predict-list (bbb-get-predictions mid-list groupname)))
+	(setq grouplens-previous-article nil)
+	;; scores-alist should be a list of lists:
+	;;  ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s))))
+	;;`((("message-id" . ,predict-list))) ; Yes, this is the return value
+	(list (list (list (append (list "message-id") predict-list)))))
+    nil))
+
+(defun bbb-get-predictions (midlist groupname)
+  "Ask the bbb for predictions, and build up the score alist."
+  (if (or (null grouplens-bbb-token)
+	  (equal grouplens-bbb-token "0"))
+      (progn 
+	(gnus-message 3 "Error: You are not logged in to a BBB")
+	nil)
+    (gnus-message 5 "Fetching Predictions...")
+    (let (predict-list
+	  (predict-command (bbb-build-predict-command midlist groupname 
+						      grouplens-bbb-token))
+	  (bbb-process (bbb-connect-to-bbbd grouplens-bbb-host 
+					    grouplens-bbb-port)))
+      (if bbb-process
+	  (save-excursion 
+	    (set-buffer (process-buffer bbb-process))
+	    (bbb-send-command bbb-process predict-command)
+	    (if (bbb-read-response bbb-process)
+		(setq predict-list (bbb-get-prediction-response bbb-process))
+	      (gnus-message 1 "Invalid Token, login and try again")
+	      (ding))))
+      (setq bbb-alist predict-list))))
+
+(defun bbb-get-all-mids ()
+  (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
+	(articles gnus-newsgroup-headers)
+	art this)
+    (setq bbb-mid-list nil)
+    (while articles
+      (progn (setq art (car articles)
+		   this (aref art index)
+		   articles (cdr articles))
+	     (setq bbb-mid-list (cons this bbb-mid-list))))
+    bbb-mid-list))
+
+(defun bbb-build-predict-command (mlist grpname token)
+  (let ((cmd (concat "getpredictions " token " " grpname "\r\n"))
+	art)
+    (while mlist
+      (setq art (car mlist)
+	    cmd (concat cmd art "\r\n")
+	    mlist (cdr mlist)))
+    (setq cmd (concat cmd ".\r\n"))
+  cmd))
+
+(defun bbb-get-prediction-response (process)
+  (let ((case-fold-search nil)
+	match-end)
+    (goto-char bbb-read-point)
+    (while (and (not (search-forward ".\r\n" nil t))
+		(accept-process-output process bbb-timeout-secs))
+      (goto-char bbb-read-point))
+    (setq match-end (point))
+    (goto-char (+ bbb-response-point 4))  ;; we ought to be right before OK
+    (bbb-build-response-alist)))
+
+;; build-response-alist assumes that the cursor has been positioned at
+;; the first line of the list of mid/rating pairs.  For now we will
+;; use a prediction of 99 to signify no prediction.  Ultimately, we
+;; should just ignore messages with no predictions.
+(defun bbb-build-response-alist ()
+  (let ((resp nil)
+	(match-end (point)))
+    (setq grouplens-current-hashtable (make-hash-table :test 'equal :size 100))
+    (while
+	(cond ((looking-at "\\(<.*>\\) :nopred=")
+	       (push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp)
+	       (forward-line 1)
+	       t)
+	      ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
+	       (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp)
+	       (cl-puthash (bbb-get-mid)
+			   (list (bbb-get-pred) (bbb-get-confl) (bbb-get-confh))
+			   grouplens-current-hashtable)
+	       (forward-line 1)
+	       t)
+	      ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
+	       (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp)
+	       (cl-puthash (bbb-get-mid)
+			   (list (bbb-get-pred) 0 0)
+			   grouplens-current-hashtable)
+	       (forward-line 1)
+	       t)
+	      (t nil)))
+    resp))
+
+;; these two functions assume that there is an active match lying
+;; around.  Where the first parenthesized expression is the
+;; message-id, and the second is the prediction.  Since gnus assumes
+;; that scores are integer values?? we round the prediction.
+(defun bbb-get-mid ()
+  (buffer-substring (match-beginning 1) (match-end 1)))
+
+(defun bbb-get-pred ()
+  (let ((tpred (string-to-number (buffer-substring  
+				      (match-beginning 2) 
+				      (match-end 2)))))
+    (if (> tpred 0)
+	(round (* grouplens-score-scale-factor (+ grouplens-score-offset  tpred)))
+      1)))
+
+(defun bbb-get-confl ()
+  (string-to-number (buffer-substring (match-beginning 3) (match-end 3))))
+
+(defun bbb-get-confh ()
+  (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;      Prediction Display
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defconst grplens-rating-range 4.0)
+(defconst grplens-maxrating 5)
+(defconst grplens-minrating 1)
+(defconst grplens-predstringsize 12)
+
+(defvar gnus-tmp-score)
+(defun bbb-grouplens-score (header)
+  (if (eq gnus-grouplens-override-scoring 'separate)
+      (bbb-grouplens-other-score header)
+    (let* ((rate-string (make-string 12 ? ))
+	   (mid (aref header (nth 1 (assoc "message-id" gnus-header-index))))
+	   (hashent (gethash mid grouplens-current-hashtable))
+	   (iscore gnus-tmp-score)
+	   (low (car (cdr hashent)))
+	   (high (car (cdr (cdr hashent)))))
+      (aset rate-string 0 ?|) 
+      (aset rate-string 11 ?|)
+      (unless (member grouplens-current-group grouplens-newsgroups)
+	(unless (equal grouplens-prediction-display 'prediction-num)
+	  (cond ((< iscore 0)
+		 (setq iscore 1))
+		((> iscore 5)
+		 (setq iscore 5))))
+	(setq low 0) 
+	(setq high 0))
+      (if (and (bbb-valid-score iscore) 
+	       (not (null mid)))
+	  (cond 
+	   ;; prediction-spot
+	   ((equal grouplens-prediction-display 'prediction-spot)
+	    (setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
+	   ;; confidence-interval
+	   ((equal grouplens-prediction-display 'confidence-interval)
+	    (setq rate-string (bbb-fmt-confidence-interval iscore low high)))
+	   ;; prediction-bar
+	   ((equal grouplens-prediction-display 'prediction-bar)
+	    (setq rate-string (bbb-fmt-prediction-bar rate-string iscore)))
+	   ;; confidence-bar
+	   ((equal grouplens-prediction-display 'confidence-bar)
+	    (setq rate-string (format "|   %4.2f   |" iscore)))
+	   ;; confidence-spot
+	   ((equal grouplens-prediction-display 'confidence-spot)
+	    (setq rate-string (format "|   %4.2f   |" iscore)))
+	   ;; prediction-num
+	   ((equal grouplens-prediction-display 'prediction-num)
+	    (setq rate-string (bbb-fmt-prediction-num iscore)))
+	   ;; confidence-plus-minus
+	   ((equal grouplens-prediction-display 'confidence-plus-minus)
+	    (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high))
+	    )
+	   (t (gnus-message 3 "Invalid prediction display type")))
+	(aset rate-string 5 ?N) (aset rate-string 6 ?A))
+      rate-string)))
+
+;;
+;; Gnus user format function that doesn't depend on
+;; bbb-build-mid-scores-alist being used as the score function, but is
+;; instead called from gnus-select-group-hook. -- LAB
+(defun bbb-grouplens-other-score (header)
+  (if (not (member grouplens-current-group grouplens-newsgroups))
+      ;; Return an empty string
+      ""
+    (let* ((rate-string (make-string 12 ? ))
+           (mid (aref header (nth 1 (assoc "message-id" gnus-header-index))))
+           (hashent (gethash mid grouplens-current-hashtable))
+           (pred (or (nth 0 hashent) 0))
+           (low (nth 1 hashent))
+           (high (nth 2 hashent)))
+      ;; Init rate-string
+      (aset rate-string 0 ?|) 
+      (aset rate-string 11 ?|)
+      (unless (equal grouplens-prediction-display 'prediction-num)
+	(cond ((< pred 0)
+	       (setq pred 1))
+	      ((> pred 5)
+	       (setq pred 5))))
+      ;; If no entry in BBB hash mark rate string as NA and return
+      (cond 
+       ((null hashent) 
+	(aset rate-string 5 ?N) 
+	(aset rate-string 6 ?A)
+	rate-string)
+
+       ((equal grouplens-prediction-display 'prediction-spot)
+	(bbb-fmt-prediction-spot rate-string pred))
+       
+       ((equal grouplens-prediction-display 'confidence-interval)
+	(bbb-fmt-confidence-interval pred low high))
+       
+       ((equal grouplens-prediction-display 'prediction-bar)
+	(bbb-fmt-prediction-bar rate-string pred))
+
+       ((equal grouplens-prediction-display 'confidence-bar)
+	(format "|   %4.2f   |" pred))
+
+       ((equal grouplens-prediction-display 'confidence-spot)
+	(format "|   %4.2f   |" pred))
+       
+       ((equal grouplens-prediction-display 'prediction-num)
+	(bbb-fmt-prediction-num pred))
+       
+       ((equal grouplens-prediction-display 'confidence-plus-minus)
+	(bbb-fmt-confidence-plus-minus pred low high))
+       
+       (t 
+	(gnus-message 3 "Invalid prediction display type")
+	(aset rate-string 0 ?|) 
+	(aset rate-string 11 ?|)
+	rate-string)))))
+
+(defun bbb-valid-score (score)
+  (or (equal grouplens-prediction-display 'prediction-num)
+      (and (>= score grplens-minrating)
+	   (<= score grplens-maxrating))))
+
+(defun bbb-requires-confidence (format-type)
+  (or (equal format-type 'confidence-plus-minus)
+      (equal format-type 'confidence-spot)
+      (equal format-type 'confidence-interval)))
+
+(defun bbb-have-confidence (clow chigh)
+  (not (or (null clow)
+	   (null chigh))))
+
+(defun bbb-fmt-prediction-spot (rate-string score)
+  (aset rate-string
+	(round (* (/ (- score grplens-minrating) grplens-rating-range)
+		  (+ (- grplens-predstringsize 4) 1.49)))
+	?*)
+  rate-string)
+
+(defun bbb-fmt-confidence-interval (score low high)
+  (if (bbb-have-confidence low high)
+      (format "|%4.2f-%4.2f |" low high)
+    (bbb-fmt-prediction-num score)))
+
+(defun bbb-fmt-confidence-plus-minus (score low high)
+  (if (bbb-have-confidence low high)
+      (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
+    (bbb-fmt-prediction-num score)))
+
+(defun bbb-fmt-prediction-bar (rate-string score)
+  (let* ((i 1) 
+	 (step (/ grplens-rating-range (- grplens-predstringsize 4)))
+	 (half-step (/ step 2))
+	 (loc (- grplens-minrating half-step)))
+    (while (< i (- grplens-predstringsize 2))
+      (if (> score loc)
+	  (aset rate-string i ?#)
+	(aset rate-string i ? ))
+      (setq i (+ i 1))
+      (setq loc (+ loc step)))
+    )
+  rate-string)
+
+(defun bbb-fmt-prediction-num (score)
+  (format "|   %4.2f   |" score))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;       Put Ratings
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; The message-id for the current article can be found in
+;; (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index)))
+
+(defun bbb-put-ratings ()
+  (if (and grouplens-rating-alist 
+	   (member gnus-newsgroup-name grouplens-newsgroups))
+      (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host 
+					  grouplens-bbb-port))
+	    (rate-command (bbb-build-rate-command grouplens-rating-alist)))
+	(if bbb-process
+	    (save-excursion 
+	      (set-buffer (process-buffer bbb-process))
+	      (gnus-message 5 "Sending Ratings...")
+	      (bbb-send-command bbb-process rate-command)
+	      (if (bbb-read-response bbb-process)
+		  (setq grouplens-rating-alist nil)
+		(gnus-message 1 
+			      "Token timed out: call bbb-login and quit again")
+		(ding))
+	      (gnus-message 5 "Sending Ratings...Done"))
+	  (gnus-message 3 "No BBB connection")))
+    (setq grouplens-rating-alist nil)))
+
+(defun bbb-build-rate-command (rate-alist)
+  (let (this
+	(cmd (concat "putratings " grouplens-bbb-token 
+		     " " grouplens-current-group " \r\n")))
+    (while rate-alist
+      (setq this (car rate-alist)
+	    cmd (concat cmd (car this) " :rating=" (cadr this) ".00"
+			" :time=" (cddr this) "\r\n")
+	    rate-alist (cdr rate-alist)))
+    (concat cmd ".\r\n")))
+
+;; Interactive rating functions.
+(defun bbb-summary-rate-article (rating &optional midin)
+  (interactive "nRating: ")
+  (when (member gnus-newsgroup-name grouplens-newsgroups)
+    (let ((mid (or midin (bbb-get-current-id))))
+      (if (and rating 
+	       (>= rating grplens-minrating) 
+	       (<= rating grplens-maxrating)
+	       mid)
+	  (let ((oldrating (assoc mid grouplens-rating-alist)))
+	    (if oldrating
+		(setcdr oldrating (cons rating 0))
+	      (push `(,mid . (,rating . 0)) grouplens-rating-alist))
+	    (gnus-summary-mark-article nil (int-to-string rating)))	
+	(gnus-message 3 "Invalid rating")))))
+
+(defun grouplens-next-unread-article (rating)
+  "Select unread article after current one."
+  (interactive "P")
+  (if rating (bbb-summary-rate-article rating))
+  (gnus-summary-next-unread-article))
+
+(defun grouplens-best-unread-article (rating)
+  "Select unread article after current one."
+  (interactive "P")
+  (if rating (bbb-summary-rate-article rating))
+  (gnus-summary-best-unread-article))
+
+(defun grouplens-summary-catchup-and-exit (rating)
+   "Mark all articles not marked as unread in this newsgroup as read, 
+    then exit.   If prefix argument ALL is non-nil, all articles are 
+    marked as read."
+   (interactive "P")
+   (if rating
+       (bbb-summary-rate-article rating))
+   (if (numberp rating)
+       (gnus-summary-catchup-and-exit)
+     (gnus-summary-catchup-and-exit rating)))
+
+(defun grouplens-score-thread (score)
+  "Raise the score of the articles in the current thread with SCORE."
+  (interactive "nRating: ")
+  (let (e)
+    (save-excursion
+      (let ((articles (gnus-summary-articles-in-thread)))
+	(while articles
+	  (gnus-summary-goto-subject (car articles))
+	  (gnus-set-global-variables)
+	  (bbb-summary-rate-article score
+				    (mail-header-id 
+				     (gnus-summary-article-header 
+				      (car articles))))
+	  (setq articles (cdr articles))))
+      (setq e (point)))
+    (let ((gnus-summary-check-current t))
+      (or (zerop (gnus-summary-next-subject 1 t))
+	  (goto-char e))))
+  (gnus-summary-recenter)
+  (gnus-summary-position-point)
+  (gnus-set-mode-line 'summary))
+
+
+(defun bbb-get-current-id ()
+  (if gnus-current-headers
+      (aref gnus-current-headers 
+	    (nth 1 (assoc "message-id" gnus-header-index)))
+    (gnus-message 3 "You must select an article before you rate it")))
+
+(defun bbb-grouplens-group-p (group)
+  "Say whether GROUP is a GroupLens group."
+  (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" ""))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;          TIME SPENT READING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar grouplens-current-starting-time nil)
+
+(defun grouplens-start-timer ()
+  (setq grouplens-current-starting-time (current-time)))
+
+(defun grouplens-elapsed-time ()
+  (let ((et (bbb-time-float (current-time))))
+    (- et (bbb-time-float grouplens-current-starting-time))))
+
+(defun bbb-time-float (timeval)
+  (+ (* (car timeval) 65536) 
+	(cadr timeval)))
+
+(defun grouplens-do-time ()
+  (when (member gnus-newsgroup-name grouplens-newsgroups)
+    (when grouplens-previous-article
+      (let ((elapsed-time (grouplens-elapsed-time))
+	    (oldrating (assoc grouplens-previous-article 
+			      grouplens-rating-alist)))
+	(if (not oldrating)
+	    (push `(,grouplens-previous-article . (0 . ,elapsed-time))
+		  grouplens-rating-alist)
+	  (setcdr oldrating (cons (cadr oldrating) elapsed-time)))))
+    (grouplens-start-timer)
+    (setq grouplens-previous-article (bbb-get-current-id))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;          BUG REPORTING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst gnus-gl-version "gnus-gl.el 2.12")
+(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
+(defun gnus-gl-submit-bug-report ()
+  "Submit via mail a bug report on gnus-gl"
+  (interactive)
+  (require 'reporter)
+  (reporter-submit-bug-report gnus-gl-maintainer-address
+			      (concat "gnus-gl.el " gnus-gl-version)
+			      (list 'grouplens-pseudonym
+				    'grouplens-bbb-host
+				    'grouplens-bbb-port
+				    'grouplens-newsgroups
+				    'grouplens-bbb-token
+				    'grouplens-bbb-process
+				    'grouplens-current-group
+				    'grouplens-previous-article
+				    'grouplens-mid-list
+				    'bbb-alist)
+			      nil
+			      'gnus-gl-get-trace))
+
+(defun gnus-gl-get-trace ()
+  "Insert the contents of the BBBD trace buffer"
+  (if grouplens-bbb-buffer (insert-buffer grouplens-bbb-buffer)))
+
+;;;
+;;; Additions to make gnus-grouplens-mode  Warning Warning!!
+;;;      This version of the gnus-grouplens-mode does
+;;;      not work with gnus-5.x.  The "old" way of
+;;;      setting up GroupLens still works however.
+;;;
+(defvar gnus-grouplens-mode nil
+  "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
+
+(defvar gnus-grouplens-mode-map nil)
+
+(unless gnus-grouplens-mode-map
+  (setq gnus-grouplens-mode-map (make-keymap))
+  (gnus-define-keys
+   gnus-grouplens-mode-map
+   "n" grouplens-next-unread-article
+   "r" bbb-summary-rate-article
+   "k" grouplens-score-thread
+   "c" grouplens-summary-catchup-and-exit
+   "," grouplens-best-unread-article))
+
+(defun gnus-grouplens-make-menu-bar ()
+  (unless (boundp 'gnus-grouplens-menu)
+    (easy-menu-define
+     gnus-grouplens-menu gnus-grouplens-mode-map ""
+     '("GroupLens"
+       ["Login" bbb-login t]
+       ["Rate" bbb-summary-rate-article t]
+       ["Next article" grouplens-next-unread-article t]
+       ["Best article" grouplens-best-unread-article t]
+       ["Raise thread" grouplens-score-thread t]
+       ["Report bugs" gnus-gl-submit-bug-report t]))))
+
+(defun gnus-grouplens-mode (&optional arg)
+  "Minor mode for providing a GroupLens interface in Gnus summary buffers."
+  (interactive "P")
+  (when (and (eq major-mode 'gnus-summary-mode)
+	     (member gnus-newsgroup-name grouplens-newsgroups))
+    (make-local-variable 'gnus-grouplens-mode)
+    (setq gnus-grouplens-mode 
+	  (if (null arg) (not gnus-grouplens-mode)
+	    (> (prefix-numeric-value arg) 0)))
+    (when gnus-grouplens-mode
+      (if (not (fboundp 'make-local-hook))
+	  (add-hook 'gnus-select-article-hook 'grouplens-do-time)
+	(make-local-hook 'gnus-select-article-hook)
+	(add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local))
+      (if (not (fboundp 'make-local-hook))
+	  (add-hook 'gnus-exit-group-hook 'bbb-put-ratings)
+	(make-local-hook 'gnus-exit-group-hook)
+	(add-hook 'gnus-exit-group-hook 'bbb-put-ratings nil 'local))
+      (make-local-variable 'gnus-score-find-score-files-function)
+      (cond ((eq gnus-grouplens-override-scoring 'combine)
+	     ;; either add bbb-buld-mid-scores-alist to a list
+             ;; or make a list
+	     (if (listp gnus-score-find-score-files-function)
+		 (setq gnus-score-find-score-files-function 
+		   (append 'bbb-build-mid-scores-alist      
+			   gnus-score-find-score-files-function ))
+	       (setq gnus-score-find-score-files-function 
+		     (list gnus-score-find-score-files-function 
+			   'bbb-build-mid-scores-alist))))
+	     ;; leave the gnus-score-find-score-files variable alone
+	    ((eq gnus-grouplens-override-scoring 'separate)
+	     (add-hook 'gnus-select-group-hook 
+		       '(lambda() 
+			  (bbb-build-mid-scores-alist gnus-newsgroup-name))))
+	    ;; default is to override
+	    (t (setq gnus-score-find-score-files-function 
+		     'bbb-build-mid-scores-alist)))
+      (make-local-variable 'gnus-summary-line-format)
+      (setq gnus-summary-line-format 
+	    gnus-summary-grouplens-line-format)
+      (make-local-variable 'gnus-summary-line-format-spec)
+      (setq gnus-summary-line-format-spec nil)
+
+      ;; Set up the menu.
+      (when (and menu-bar-mode
+		 (gnus-visual-p 'grouplens-menu 'menu))
+	(gnus-grouplens-make-menu-bar))
+      (unless (assq 'gnus-grouplens-mode minor-mode-alist)
+	(push '(gnus-grouplens-mode " GroupLens") minor-mode-alist))
+      (unless (assq 'gnus-grouplens-mode minor-mode-map-alist)
+	(push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map)
+	      minor-mode-map-alist))
+      (run-hooks 'gnus-grouplens-mode-hook))))
+
+(provide 'gnus-gl)
+
+;;; gnus-gl.el ends here
diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el
new file mode 100644
index 00000000000..d73cf3382fd
--- /dev/null
+++ b/lisp/gnus-nocem.el
@@ -0,0 +1,246 @@
+;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
+;; Copyright (C) 1995,96 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(require 'nnmail)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-nocem-groups 
+  '("alt.nocem.misc" "news.admin.net-abuse.announce")
+  "*List of groups that will be searched for NoCeM messages.")
+
+(defvar gnus-nocem-issuers 
+  '("Automoose-1" ; The CancelMoose[tm] on autopilot.
+    "clewis@ferret.ocunix.on.ca;" ; Chris Lewis -- Canadian angel & despammer.
+    "jem@xpat.com;"  ; John Milburn -- despammer in Korea.
+    "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; Spew/bincancel guy.
+    )
+  "*List of NoCeM issuers to pay attention to.")
+
+(defvar gnus-nocem-directory 
+  (concat (file-name-as-directory gnus-article-save-directory) "NoCeM/")
+  "*Directory where NoCeM files will be stored.")
+
+(defvar gnus-nocem-expiry-wait 15
+  "*Number of days to keep NoCeM headers in the cache.")
+
+(defvar gnus-nocem-verifyer nil
+  "*Function called to verify that the NoCeM message is valid.
+One likely value is `mc-verify'.  If the function in this variable
+isn't bound, the message will be used unconditionally.")
+
+;;; Internal variables
+
+(defvar gnus-nocem-active nil)
+(defvar gnus-nocem-alist nil)
+(defvar gnus-nocem-touched-alist nil)
+(defvar gnus-nocem-hashtb nil)
+
+;;; Functions
+
+(defun gnus-nocem-active-file ()
+  (concat (file-name-as-directory gnus-nocem-directory) "active"))
+
+(defun gnus-nocem-cache-file ()
+  (concat (file-name-as-directory gnus-nocem-directory) "cache"))
+
+(defun gnus-nocem-scan-groups ()
+  "Scan all NoCeM groups for new NoCeM messages."
+  (interactive)
+  (let ((groups gnus-nocem-groups)
+	group active gactive articles)
+    (or (file-exists-p gnus-nocem-directory)
+	(make-directory gnus-nocem-directory t))
+    ;; Load any previous NoCeM headers.
+    (gnus-nocem-load-cache)
+    ;; Read the active file if it hasn't been read yet.
+    (and (file-exists-p (gnus-nocem-active-file))
+	 (not gnus-nocem-active)
+	 (condition-case ()
+	     (load (gnus-nocem-active-file) t t t)
+	   (error nil)))
+    ;; Go through all groups and see whether new articles have
+    ;; arrived.  
+    (while (setq group (pop groups))
+      (if (not (setq gactive (gnus-activate-group group)))
+	  () ; This group doesn't exist.
+	(setq active (nth 1 (assoc group gnus-nocem-active)))
+	(when (and (not (< (cdr gactive) (car gactive))) ; Empty group.
+		   (or (not active)
+		       (< (cdr active) (cdr gactive))))
+	  ;; Ok, there are new articles in this group, se we fetch the
+	  ;; headers.
+	  (save-excursion
+	    (let ((dependencies (make-vector 10 nil))
+		  (buffer (nnheader-set-temp-buffer " *Gnus NoCeM*"))
+		  headers)
+	      (setq headers
+		    (if (eq 'nov
+			    (gnus-retrieve-headers 
+			     (setq articles
+				   (gnus-uncompress-range
+				    (cons 
+				     (if active (1+ (cdr active)) 
+				       (car gactive))
+				     (cdr gactive))))
+			     group))
+			(gnus-get-newsgroup-headers-xover 
+			 articles nil dependencies)
+		      (gnus-get-newsgroup-headers dependencies)))
+	      (while headers
+		;; We take a closer look on all articles that have
+		;; "@@NCM" in the subject.  
+		(when (string-match "@@NCM"
+				    (mail-header-subject (car headers)))
+		  (gnus-nocem-check-article group (car headers)))
+		(setq headers (cdr headers)))
+	      (kill-buffer (current-buffer)))))
+	(setq gnus-nocem-active
+	      (cons (list group gactive) 
+		    (delq (assoc group gnus-nocem-active)
+			  gnus-nocem-active)))))
+    ;; Save the results, if any.
+    (gnus-nocem-save-cache)
+    (gnus-nocem-save-active)))
+
+(defun gnus-nocem-check-article (group header)
+  "Check whether the current article is an NCM article and that we want it."
+  ;; Get the article.
+  (gnus-message 7 "Checking article %d in %s for NoCeM..."
+		(mail-header-number header) group)
+  (let ((date (mail-header-date header))
+	issuer b e)
+    (when (or (not date)
+	      (nnmail-time-less 
+	       (nnmail-time-since (nnmail-date-to-time date))
+	       (nnmail-days-to-time gnus-nocem-expiry-wait)))
+      (gnus-request-article-this-buffer (mail-header-number header) group)
+      ;; The article has to have proper NoCeM headers.
+      (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
+		 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
+	;; We get the name of the issuer.
+	(narrow-to-region b e)
+	(setq issuer (mail-fetch-field "issuer"))
+	(and (member issuer gnus-nocem-issuers) ; We like her...
+	     (gnus-nocem-verify-issuer issuer) ; She is who she says she is..
+	     (gnus-nocem-enter-article)))))) ; We gobble the message.
+  
+(defun gnus-nocem-verify-issuer (person)
+  "Verify using PGP that the canceler is who she says she is."
+  (widen)
+  (if (fboundp gnus-nocem-verifyer)
+      (funcall gnus-nocem-verifyer)
+    ;; If we don't have MailCrypt, then we use the message anyway.
+    t))
+
+(defun gnus-nocem-enter-article ()
+  "Enter the current article into the NoCeM cache."
+  (goto-char (point-min))
+  (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t))
+	(e (search-forward "\n@@END NCM BODY\n" nil t))
+	(buf (current-buffer))
+	ncm id)
+    (when (and b e)
+      (narrow-to-region b (1+ (match-beginning 0)))
+      (goto-char (point-min))
+      (while (search-forward "\t" nil t)
+	(when (condition-case nil
+		  (boundp (let ((obarray gnus-active-hashtb)) (read buf)))
+		(error nil))
+	  (beginning-of-line)
+	  (while (= (following-char) ?\t)
+	    (forward-line -1))
+	  (setq id (buffer-substring (point) (1- (search-forward "\t"))))
+	  (push id ncm)
+	  (gnus-sethash id t gnus-nocem-hashtb)
+	  (forward-line 1)
+	  (while (= (following-char) ?\t)
+	    (forward-line 1))))
+      (when ncm
+	(setq gnus-nocem-touched-alist t)
+	(push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time)
+		    ncm) 
+	      gnus-nocem-alist)))))
+
+(defun gnus-nocem-load-cache ()
+  "Load the NoCeM cache."
+  (unless gnus-nocem-alist
+    ;; The buffer doesn't exist, so we create it and load the NoCeM
+    ;; cache.  
+    (when (file-exists-p (gnus-nocem-cache-file))
+      (load (gnus-nocem-cache-file) t t t)
+      (gnus-nocem-alist-to-hashtb))))
+      
+(defun gnus-nocem-save-cache ()
+  "Save the NoCeM cache."
+  (when (and gnus-nocem-alist
+	     gnus-nocem-touched-alist)
+    (nnheader-temp-write (gnus-nocem-cache-file)
+      (prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist) (current-buffer)))
+    (setq gnus-nocem-touched-alist nil)))
+
+(defun gnus-nocem-save-active ()
+  "Save the NoCeM active file."
+  (nnheader-temp-write (gnus-nocem-active-file)
+    (prin1 `(setq gnus-nocem-active ',gnus-nocem-active) (current-buffer))))
+
+(defun gnus-nocem-alist-to-hashtb ()
+  "Create a hashtable from the Message-IDs we have."
+  (let* ((alist gnus-nocem-alist)
+	 (pprev (cons nil alist))
+	 (prev pprev)
+	 (expiry (nnmail-days-to-time gnus-nocem-expiry-wait))
+	 entry)
+    (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51)))
+    (while (setq entry (car alist))
+      (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry))
+	  ;; This entry has expired, so we remove it.
+	  (setcdr prev (cdr alist))
+	(setq prev alist)
+	;; This is ok, so we enter it into the hashtable.
+	(setq entry (cdr entry))
+	(while entry
+	  (gnus-sethash (car entry) t gnus-nocem-hashtb)
+	  (setq entry (cdr entry))))
+      (setq alist (cdr alist)))))
+
+(gnus-add-shutdown 'gnus-nocem-close 'gnus)
+
+(defun gnus-nocem-close ()
+  "Clear internal NoCeM variables."
+  (setq gnus-nocem-alist nil
+	gnus-nocem-hashtb nil
+	gnus-nocem-active nil
+	gnus-nocem-touched-alist nil))
+
+(defun gnus-nocem-unwanted-article-p (id)
+  "Say whether article ID in the current group is wanted."
+  (gnus-gethash id gnus-nocem-hashtb))
+
+(provide 'gnus-nocem)
+
+;;; gnus-nocem.el ends here
diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el
new file mode 100644
index 00000000000..b5e38677212
--- /dev/null
+++ b/lisp/gnus-salt.el
@@ -0,0 +1,654 @@
+;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(eval-when-compile (require 'cl))
+
+;;;
+;;; gnus-pick-mode
+;;;
+
+(defvar gnus-pick-mode nil
+  "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
+
+(defvar gnus-pick-display-summary nil
+  "*Display summary while reading.")
+
+(defvar gnus-pick-mode-hook nil
+  "Hook run in summary pick mode buffers.")
+
+;;; Internal variables.
+
+(defvar gnus-pick-mode-map nil)
+
+(unless gnus-pick-mode-map
+  (setq gnus-pick-mode-map (make-sparse-keymap))
+
+  (gnus-define-keys
+   gnus-pick-mode-map
+   "t" gnus-uu-mark-thread
+   "T" gnus-uu-unmark-thread
+   " " gnus-summary-mark-as-processable
+   "u" gnus-summary-unmark-as-processable
+   "U" gnus-summary-unmark-all-processable
+   "v" gnus-uu-mark-over
+   "r" gnus-uu-mark-region
+   "R" gnus-uu-unmark-region
+   "e" gnus-uu-mark-by-regexp
+   "E" gnus-uu-mark-by-regexp
+   "b" gnus-uu-mark-buffer
+   "B" gnus-uu-unmark-buffer
+   "\r" gnus-pick-start-reading))
+
+(defun gnus-pick-make-menu-bar ()
+  (unless (boundp 'gnus-pick-menu)
+    (easy-menu-define
+     gnus-pick-menu gnus-pick-mode-map ""
+     '("Pick"
+       ("Pick"
+	["Article" gnus-summary-mark-as-processable t]
+	["Thread" gnus-uu-mark-thread t]
+	["Region" gnus-uu-mark-region t]
+	["Regexp" gnus-uu-mark-regexp t]
+	["Buffer" gnus-uu-mark-buffer t])
+       ("Unpick"
+	["Article" gnus-summary-unmark-as-processable t]
+	["Thread" gnus-uu-unmark-thread t]
+	["Region" gnus-uu-unmark-region t]
+	["Regexp" gnus-uu-unmark-regexp t]
+	["Buffer" gnus-uu-unmark-buffer t])
+       ["Start reading" gnus-pick-start-reading t]
+       ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
+
+(defun gnus-pick-mode (&optional arg)
+  "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
+
+\\{gnus-pick-mode-map}"
+  (interactive "P")
+  (when (eq major-mode 'gnus-summary-mode)
+    (make-local-variable 'gnus-pick-mode)
+    (setq gnus-pick-mode 
+	  (if (null arg) (not gnus-pick-mode)
+	    (> (prefix-numeric-value arg) 0)))
+    (when gnus-pick-mode
+      ;; Make sure that we don't select any articles upon group entry.
+      (make-local-variable 'gnus-auto-select-first)
+      (setq gnus-auto-select-first nil)
+      ;; Set up the menu.
+      (when (and menu-bar-mode
+		 (gnus-visual-p 'pick-menu 'menu))
+	(gnus-pick-make-menu-bar))
+      (unless (assq 'gnus-pick-mode minor-mode-alist)
+	(push '(gnus-pick-mode " Pick") minor-mode-alist))
+      (unless (assq 'gnus-pick-mode minor-mode-map-alist)
+	(push (cons 'gnus-pick-mode gnus-pick-mode-map)
+	      minor-mode-map-alist))
+      (run-hooks 'gnus-pick-mode-hook))))
+
+(defun gnus-pick-start-reading (&optional catch-up)
+  "Start reading the picked articles.
+If given a prefix, mark all unpicked articles as read."
+  (interactive "P")
+  (unless gnus-newsgroup-processable
+    (error "No articles have been picked"))
+  (gnus-summary-limit-to-articles nil)
+  (when catch-up
+    (gnus-summary-limit-mark-excluded-as-read))
+  (gnus-summary-first-unread-article)
+  (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
+
+
+;;;
+;;; gnus-binary-mode
+;;;
+
+(defvar gnus-binary-mode nil
+  "Minor mode for provind a binary group interface in Gnus summary buffers.")
+
+(defvar gnus-binary-mode-hook nil
+  "Hook run in summary binary mode buffers.")
+
+(defvar gnus-binary-mode-map nil)
+
+(unless gnus-binary-mode-map
+  (setq gnus-binary-mode-map (make-sparse-keymap))
+
+  (gnus-define-keys
+   gnus-binary-mode-map
+   "g" gnus-binary-show-article))
+
+(defun gnus-binary-make-menu-bar ()
+  (unless (boundp 'gnus-binary-menu)
+    (easy-menu-define
+     gnus-binary-menu gnus-binary-mode-map ""
+     '("Pick"
+       ["Switch binary mode off" gnus-binary-mode t]))))
+
+(defun gnus-binary-mode (&optional arg)
+  "Minor mode for providing a binary group interface in Gnus summary buffers."
+  (interactive "P")
+  (when (eq major-mode 'gnus-summary-mode)
+    (make-local-variable 'gnus-binary-mode)
+    (setq gnus-binary-mode 
+	  (if (null arg) (not gnus-binary-mode)
+	    (> (prefix-numeric-value arg) 0)))
+    (when gnus-binary-mode
+      ;; Make sure that we don't select any articles upon group entry.
+      (make-local-variable 'gnus-auto-select-first)
+      (setq gnus-auto-select-first nil)
+      (make-local-variable 'gnus-summary-display-article-function)
+      (setq gnus-summary-display-article-function 'gnus-binary-display-article)
+      ;; Set up the menu.
+      (when (and menu-bar-mode
+		 (gnus-visual-p 'binary-menu 'menu))
+	(gnus-binary-make-menu-bar))
+      (unless (assq 'gnus-binary-mode minor-mode-alist)
+	(push '(gnus-binary-mode " Binary") minor-mode-alist))
+      (unless (assq 'gnus-binary-mode minor-mode-map-alist)
+	(push (cons 'gnus-binary-mode gnus-binary-mode-map)
+	      minor-mode-map-alist))
+      (run-hooks 'gnus-binary-mode-hook))))
+
+(defun gnus-binary-display-article (article &optional all-header)
+  "Run ARTICLE through the binary decode functions."
+  (when (gnus-summary-goto-subject article)
+    (let ((gnus-view-pseudos 'automatic))
+      (gnus-uu-decode-uu))))
+
+(defun gnus-binary-show-article (&optional arg)
+  "Bypass the binary functions and show the article."
+  (interactive "P")
+  (let (gnus-summary-display-article-function)
+    (gnus-summary-show-article arg)))
+
+;;;
+;;; gnus-tree-mode
+;;;
+
+(defvar gnus-tree-line-format "%(%[%3,3n%]%)"
+  "Format of tree elements.")
+
+(defvar gnus-tree-minimize-window t
+  "If non-nil, minimize the tree buffer window.
+If a number, never let the tree buffer grow taller than that number of
+lines.")
+
+(defvar gnus-selected-tree-face 'modeline
+  "*Face used for highlighting selected articles in the thread tree.")
+
+(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
+			     (?\{ . ?\}) (?< . ?>))
+  "Brackets used in tree nodes.")
+
+(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
+  "Charaters used to connect parents with children.")
+
+(defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
+  "*The format specification for the tree mode line.")
+
+(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree
+  "*Function for generating a thread tree.
+Two predefined functions are available:
+`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.")
+
+(defvar gnus-tree-mode-hook nil
+  "*Hook run in tree mode buffers.")
+
+;;; Internal variables.
+
+(defvar gnus-tree-line-format-alist 
+  `((?n gnus-tmp-name ?s)
+    (?f gnus-tmp-from ?s)
+    (?N gnus-tmp-number ?d)
+    (?\[ gnus-tmp-open-bracket ?c)
+    (?\] gnus-tmp-close-bracket ?c)
+    (?s gnus-tmp-subject ?s)))
+
+(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
+
+(defvar gnus-tree-mode-line-format-spec nil)
+(defvar gnus-tree-line-format-spec nil)
+
+(defvar gnus-tree-node-length nil)
+(defvar gnus-selected-tree-overlay nil)
+
+(defvar gnus-tree-displayed-thread nil)
+
+(defvar gnus-tree-mode-map nil)
+(put 'gnus-tree-mode 'mode-class 'special)
+
+(unless gnus-tree-mode-map
+  (setq gnus-tree-mode-map (make-keymap))
+  (suppress-keymap gnus-tree-mode-map)
+  (gnus-define-keys
+   gnus-tree-mode-map
+   "\r" gnus-tree-select-article
+   gnus-mouse-2 gnus-tree-pick-article
+   "\C-?" gnus-tree-read-summary-keys
+
+   "\C-c\C-i" gnus-info-find-node)
+
+  (substitute-key-definition
+   'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
+
+(defun gnus-tree-make-menu-bar ()
+  (unless (boundp 'gnus-tree-menu)
+    (easy-menu-define
+     gnus-tree-menu gnus-tree-mode-map ""
+     '("Tree"
+       ["Select article" gnus-tree-select-article t]))))
+
+(defun gnus-tree-mode ()
+  "Major mode for displaying thread trees."
+  (interactive)
+  (setq gnus-tree-mode-line-format-spec 
+	(gnus-parse-format gnus-tree-mode-line-format 
+			   gnus-summary-mode-line-format-alist))
+  (setq gnus-tree-line-format-spec 
+	(gnus-parse-format gnus-tree-line-format 
+			   gnus-tree-line-format-alist t))
+  (when (and menu-bar-mode
+	     (gnus-visual-p 'tree-menu 'menu))
+    (gnus-tree-make-menu-bar))
+  (kill-all-local-variables)
+  (gnus-simplify-mode-line)
+  (setq mode-name "Tree")
+  (setq major-mode 'gnus-tree-mode)
+  (use-local-map gnus-tree-mode-map)
+  (buffer-disable-undo (current-buffer))
+  (setq buffer-read-only t)
+  (setq truncate-lines t)
+  (save-excursion
+    (gnus-set-work-buffer)
+    (gnus-tree-node-insert (make-mail-header "") nil)
+    (setq gnus-tree-node-length (1- (point))))
+  (run-hooks 'gnus-tree-mode-hook))
+
+(defun gnus-tree-read-summary-keys (&optional arg)
+  "Read a summary buffer key sequence and execute it."
+  (interactive "P")
+  (let ((buf (current-buffer))
+	win)
+    (gnus-article-read-summary-keys arg nil t)
+    (when (setq win (get-buffer-window buf))
+      (select-window win)
+      (when gnus-selected-tree-overlay
+	(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+      (gnus-tree-minimize))))
+
+(defun gnus-tree-select-article (article)
+  "Select the article under point, if any."
+  (interactive (list (gnus-tree-article-number)))
+  (let ((buf (current-buffer)))
+    (when article
+      (save-excursion
+	(set-buffer gnus-summary-buffer)
+	(gnus-summary-goto-article article))
+      (select-window (get-buffer-window buf)))))
+
+(defun gnus-tree-pick-article (e)
+  "Select the article under the mouse pointer."
+  (interactive "e")
+  (mouse-set-point e)
+  (gnus-tree-select-article (gnus-tree-article-number)))
+
+(defun gnus-tree-article-number ()
+  (get-text-property (point) 'gnus-number))
+
+(defun gnus-tree-article-region (article)
+  "Return a cons with BEG and END of the article region."
+  (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
+    (when pos
+      (cons pos (next-single-property-change pos 'gnus-number)))))
+
+(defun gnus-tree-goto-article (article)
+  (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
+    (when pos
+      (goto-char pos))))
+
+(defun gnus-tree-recenter ()
+  "Center point in the tree window."
+  (let ((selected (selected-window))
+	(tree-window (get-buffer-window gnus-tree-buffer t)))
+    (when tree-window
+      (select-window tree-window)
+      (when gnus-selected-tree-overlay
+	(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+      (let* ((top (cond ((< (window-height) 4) 0)
+			((< (window-height) 7) 1)
+			(t 2))) 
+	     (height (1- (window-height)))
+	     (bottom (save-excursion (goto-char (point-max))
+				     (forward-line (- height))
+				     (point))))
+	;; 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
+	 tree-window (min bottom (save-excursion 
+				   (forward-line (- top)) (point)))))
+      (select-window selected))))
+
+(defun gnus-get-tree-buffer ()
+  "Return the tree buffer properly initialized."
+  (save-excursion
+    (set-buffer (get-buffer-create gnus-tree-buffer))
+    (unless (eq major-mode 'gnus-tree-mode)
+      (gnus-add-current-to-buffer-list)
+      (gnus-tree-mode))
+    (current-buffer)))
+
+(defun gnus-tree-minimize ()
+  (when (and gnus-tree-minimize-window
+	     (not (one-window-p)))
+    (let ((windows 0)
+	  tot-win-height)
+      (walk-windows (lambda (window) (incf windows)))
+      (setq tot-win-height 
+	    (- (frame-height) 
+	       (* window-min-height (1- windows))
+	       2))
+      (let* ((window-min-height 2)
+	     (height (count-lines (point-min) (point-max)))
+	     (min (max (1- window-min-height) height))
+	     (tot (if (numberp gnus-tree-minimize-window)
+		      (min gnus-tree-minimize-window min)
+		    min))
+	     (win (get-buffer-window (current-buffer)))
+	     (wh (and win (1- (window-height win)))))
+	(setq tot (min tot tot-win-height))
+	(when (and win
+		   (not (eq tot wh)))
+	  (let ((selected (selected-window)))
+	    (select-window win)
+	    (enlarge-window (- tot wh))
+	    (select-window selected)))))))
+
+;;; Generating the tree.
+
+(defun gnus-tree-node-insert (header sparse &optional adopted)
+  (let* ((dummy (stringp header))
+	 (header (if (vectorp header) header
+		   (progn
+		     (setq header (make-mail-header "*****"))
+		     (mail-header-set-number header 0)
+		     (mail-header-set-lines header 0)
+		     (mail-header-set-chars header 0)
+		     header)))
+	 (gnus-tmp-from (mail-header-from header))
+	 (gnus-tmp-subject (mail-header-subject header))
+	 (gnus-tmp-number (mail-header-number header))
+	 (gnus-tmp-name
+	  (cond
+	   ((string-match "(.+)" gnus-tmp-from)
+	    (substring gnus-tmp-from
+		       (1+ (match-beginning 0)) (1- (match-end 0))))
+	   ((string-match "<[^>]+> *$" gnus-tmp-from)
+	    (let ((beg (match-beginning 0)))
+	      (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
+		       (substring gnus-tmp-from (1+ (match-beginning 0))
+				  (1- (match-end 0))))
+		  (substring gnus-tmp-from 0 beg))))
+	   ((memq gnus-tmp-number sparse)
+	    "***")
+	   (t gnus-tmp-from)))
+	 (gnus-tmp-open-bracket
+	  (cond ((memq gnus-tmp-number sparse) 
+		 (caadr gnus-tree-brackets))
+		(dummy (caaddr gnus-tree-brackets))
+		(adopted (car (nth 3 gnus-tree-brackets)))
+		(t (caar gnus-tree-brackets))))
+	 (gnus-tmp-close-bracket
+	  (cond ((memq gnus-tmp-number sparse)
+		 (cdadr gnus-tree-brackets))
+		(adopted (cdr (nth 3 gnus-tree-brackets)))
+		(dummy
+		 (cdaddr gnus-tree-brackets))
+		(t (cdar gnus-tree-brackets))))
+	 (buffer-read-only nil)
+	 beg end)
+    (gnus-add-text-properties
+     (setq beg (point))
+     (setq end (progn (eval gnus-tree-line-format-spec) (point)))
+     (list 'gnus-number gnus-tmp-number))
+    (when (or t (gnus-visual-p 'tree-highlight 'highlight))
+      (gnus-tree-highlight-node gnus-tmp-number beg end))))
+
+(defun gnus-tree-highlight-node (article beg end)
+  "Highlight current line according to `gnus-summary-highlight'."
+  (let ((list gnus-summary-highlight)
+	face)
+    (save-excursion
+      (set-buffer gnus-summary-buffer)
+      (let* ((score (or (cdr (assq article gnus-newsgroup-scored))
+			gnus-summary-default-score 0))
+	     (default gnus-summary-default-score)
+	     (mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
+	;; Eval the cars of the lists until we find a match.
+	(while (and list
+		    (not (eval (caar list))))
+	  (setq list (cdr list)))))
+    (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
+      (gnus-put-text-property 
+       beg end 'face 
+       (if (boundp face) (symbol-value face) face)))))
+
+(defun gnus-tree-indent (level)
+  (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
+
+(defvar gnus-tmp-limit)
+(defvar gnus-tmp-sparse)
+(defvar gnus-tmp-indent)
+
+(defun gnus-generate-tree (thread)
+  "Generate a thread tree for THREAD."
+  (save-excursion
+    (set-buffer (gnus-get-tree-buffer))
+    (let ((buffer-read-only nil)
+	  (gnus-tmp-indent 0))
+      (erase-buffer)
+      (funcall gnus-generate-tree-function thread 0)
+      (gnus-set-mode-line 'tree)
+      (goto-char (point-min))
+      (gnus-tree-minimize)
+      (gnus-tree-recenter)
+      (let ((selected (selected-window)))
+	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+	  (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+	  (gnus-horizontal-recenter)
+	  (select-window selected))))))
+
+(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
+  "Generate a horizontal tree."
+  (let* ((dummy (stringp (car thread)))
+	 (do (or dummy
+		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
+	 col beg)
+    (if (not do)
+	;; We don't want this article.
+	(setq thread (cdr thread))
+      (if (not (bolp))
+	  ;; Not the first article on the line, so we insert a "-".
+	  (insert (car gnus-tree-parent-child-edges))
+	;; If the level isn't zero, then we insert some indentation.
+	(unless (zerop level)
+	  (gnus-tree-indent level)
+	  (insert (cadr gnus-tree-parent-child-edges))
+	  (setq col (- (setq beg (point)) (gnus-point-at-bol) 1))
+	  ;; Draw "|" lines upwards.
+	  (while (progn
+		   (forward-line -1)
+		   (forward-char col)
+		   (= (following-char) ? ))
+	    (delete-char 1)
+	    (insert (caddr gnus-tree-parent-child-edges)))
+	  (goto-char beg)))
+      (setq dummyp nil)
+      ;; Insert the article node.
+      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
+    (if (null thread)
+	;; End of the thread, so we go to the next line.
+	(unless (bolp)
+	  (insert "\n"))
+      ;; Recurse downwards in all children of this article.
+      (while thread
+	(gnus-generate-horizontal-tree
+	 (pop thread) (if do (1+ level) level) 
+	 (or dummyp dummy) dummy)))))
+
+(defsubst gnus-tree-indent-vertical ()
+  (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) 
+		(- (point) (gnus-point-at-bol)))))
+    (when (> len 0)
+      (insert (make-string len ? )))))
+
+(defsubst gnus-tree-forward-line (n)
+  (while (>= (decf n) 0)
+    (unless (zerop (forward-line 1))
+      (end-of-line)
+      (insert "\n")))
+  (end-of-line))
+
+(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
+  "Generate a vertical tree."
+  (let* ((dummy (stringp (car thread)))
+	 (do (or dummy
+		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
+	 beg)
+    (if (not do)
+	;; We don't want this article.
+	(setq thread (cdr thread))
+      (if (not (save-excursion (beginning-of-line) (bobp)))
+	  ;; Not the first article on the line, so we insert a "-".
+	  (progn
+	    (gnus-tree-indent-vertical)
+	    (insert (make-string (/ gnus-tree-node-length 2) ? ))
+	    (insert (caddr gnus-tree-parent-child-edges))
+	    (gnus-tree-forward-line 1))
+	;; If the level isn't zero, then we insert some indentation.
+	(unless (zerop gnus-tmp-indent)
+	  (gnus-tree-forward-line (1- (* 2 level)))
+	  (gnus-tree-indent-vertical)
+	  (delete-char -1)
+	  (insert (cadr gnus-tree-parent-child-edges))
+	  (setq beg (point))
+	  ;; Draw "-" lines leftwards.
+	  (while (progn
+		   (forward-char -2)
+		   (= (following-char) ? ))
+	    (delete-char 1)
+	    (insert (car gnus-tree-parent-child-edges)))
+	  (goto-char beg)
+	  (gnus-tree-forward-line 1)))
+      (setq dummyp nil)
+      ;; Insert the article node.
+      (gnus-tree-indent-vertical)
+      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
+      (gnus-tree-forward-line 1))
+    (if (null thread)
+	;; End of the thread, so we go to the next line.
+	(progn
+	  (goto-char (point-min))
+	  (end-of-line)
+	  (incf gnus-tmp-indent))
+      ;; Recurse downwards in all children of this article.
+      (while thread
+	(gnus-generate-vertical-tree
+	 (pop thread) (if do (1+ level) level) 
+	 (or dummyp dummy) dummy)))))
+
+;;; Interface functions.
+
+(defun gnus-possibly-generate-tree (article &optional force)
+  "Generate the thread tree for ARTICLE if it isn't displayed already."
+  (when (save-excursion
+	  (set-buffer gnus-summary-buffer)
+	  (and gnus-use-trees
+	       (vectorp (gnus-summary-article-header article))))
+    (save-excursion
+      (let ((top (save-excursion
+		   (set-buffer gnus-summary-buffer)
+		   (gnus-cut-thread
+		    (gnus-remove-thread 
+		     (mail-header-id 
+		      (gnus-summary-article-header article)) t))))
+	    (gnus-tmp-limit gnus-newsgroup-limit)
+	    (gnus-tmp-sparse gnus-newsgroup-sparse))
+	(when (or force
+		  (not (eq top gnus-tree-displayed-thread)))
+	  (gnus-generate-tree top)
+	  (setq gnus-tree-displayed-thread top))))))
+
+(defun gnus-tree-open (group)
+  (gnus-get-tree-buffer))
+
+(defun gnus-tree-close (group)
+  ;(gnus-kill-buffer gnus-tree-buffer)
+  )
+
+(defun gnus-highlight-selected-tree (article)
+  "Highlight the selected article in the tree."
+  (let ((buf (current-buffer))
+	region)
+    (set-buffer gnus-tree-buffer)
+    (when (setq region (gnus-tree-article-region article))
+      (when (or (not gnus-selected-tree-overlay)
+		(gnus-extent-detached-p gnus-selected-tree-overlay))
+	;; Create a new overlay.
+	(gnus-overlay-put
+	 (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
+	 'face gnus-selected-tree-face))
+      ;; Move the overlay to the article.
+      (gnus-move-overlay 
+       gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
+      (gnus-tree-minimize)
+      (gnus-tree-recenter)
+      (let ((selected (selected-window)))
+	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+	  (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+	  (gnus-horizontal-recenter)
+	  (select-window selected))))
+    ;; If we remove this save-excursion, it updates the wrong mode lines?!?
+    (save-excursion
+      (set-buffer gnus-tree-buffer)
+      (gnus-set-mode-line 'tree))
+    (set-buffer buf)))
+
+(defun gnus-tree-highlight-article (article face)
+  (save-excursion
+    (set-buffer (gnus-get-tree-buffer))
+    (let (region)
+      (when (setq region (gnus-tree-article-region article))
+	(gnus-put-text-property (car region) (cdr region) 'face face)
+	(set-window-point 
+	 (get-buffer-window (current-buffer) t) (cdr region))))))
+
+;;; Allow redefinition of functions.
+(gnus-ems-redefine)
+
+(provide 'gnus-salt)
+
+;;; gnus-salt.el ends here
diff --git a/lisp/gnus-scomo.el b/lisp/gnus-scomo.el
new file mode 100644
index 00000000000..668941c05e2
--- /dev/null
+++ b/lisp/gnus-scomo.el
@@ -0,0 +1,110 @@
+;;; gnus-scomo.el --- mode for editing Gnus score files
+;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'easymenu)
+(require 'timezone)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-score-mode-hook nil
+  "*Hook run in score mode buffers.")
+
+(defvar gnus-score-menu-hook nil
+  "*Hook run after creating the score mode menu.")
+
+(defvar gnus-score-edit-exit-function nil
+  "Function run on exit from the score buffer.")
+
+(defvar gnus-score-mode-map nil)
+(unless gnus-score-mode-map
+  (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
+  (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
+  (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
+  (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
+
+;;;###autoload
+(defun gnus-score-mode ()
+  "Mode for editing Gnus score files.
+This mode is an extended emacs-lisp mode.
+
+\\{gnus-score-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map gnus-score-mode-map)
+  (when menu-bar-mode
+    (gnus-score-make-menu-bar))
+  (set-syntax-table emacs-lisp-mode-syntax-table)
+  (setq major-mode 'gnus-score-mode)
+  (setq mode-name "Score")
+  (lisp-mode-variables nil)
+  (make-local-variable 'gnus-score-edit-exit-function)
+  (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
+
+(defun gnus-score-make-menu-bar ()
+  (unless (boundp 'gnus-score-menu)
+    (easy-menu-define
+     gnus-score-menu gnus-score-mode-map ""
+     '("Score"
+       ["Exit" gnus-score-edit-exit t]
+       ["Insert date" gnus-score-edit-insert-date t]
+       ["Format" gnus-score-pretty-print t]))
+    (run-hooks 'gnus-score-menu-hook)))
+
+(defun gnus-score-edit-insert-date ()
+  "Insert date in numerical format."
+  (interactive)
+  (princ (gnus-score-day-number (current-time)) (current-buffer)))
+
+(defun gnus-score-pretty-print ()
+  "Format the current score file."
+  (interactive)
+  (goto-char (point-min))
+  (let ((form (read (current-buffer))))
+    (erase-buffer)
+    (pp form (current-buffer)))
+  (goto-char (point-min)))
+
+(defun gnus-score-edit-exit ()
+  "Stop editing the score file."
+  (interactive)
+  (unless (file-exists-p (file-name-directory (buffer-file-name)))
+    (make-directory (file-name-directory (buffer-file-name)) t))
+  (save-buffer)
+  (bury-buffer (current-buffer))
+  (let ((buf (current-buffer)))
+    (when gnus-score-edit-exit-function
+      (funcall gnus-score-edit-exit-function))
+    (when (eq buf (current-buffer))
+      (switch-to-buffer (other-buffer (current-buffer))))))
+
+(defun gnus-score-day-number (time)
+  (let ((dat (decode-time time)))
+    (timezone-absolute-from-gregorian
+     (nth 4 dat) (nth 3 dat) (nth 5 dat))))
+
+(provide 'gnus-scomo)
+
+;;; gnus-scomo.el ends here
diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el
new file mode 100644
index 00000000000..20613d8bebd
--- /dev/null
+++ b/lisp/gnus-setup.el
@@ -0,0 +1,210 @@
+;;; gnus-setup.el --- Initialization & Setup for Gnus 5
+;; Copyright (C) 1995, 96 Free Software Foundation, Inc.
+
+;; Author: Steven L. Baur <steve@miranova.com>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; My head is starting to spin with all the different mail/news packages.
+;; Stop The Madness!
+
+;; Given that Emacs Lisp byte codes may be diverging, it is probably best
+;; not to byte compile this, and just arrange to have the .el loaded out
+;; of .emacs.
+
+;;; Code:
+
+(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
+
+(defvar gnus-emacs-lisp-directory (if running-xemacs
+				      "/usr/local/lib/xemacs/"
+				    "/usr/local/share/emacs/")
+  "Directory where Emacs site lisp is located.")
+
+(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
+					 "gnus-5.0.15/lisp/")
+  "Directory where Gnus Emacs lisp is found.")
+
+(defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory
+					  "sgnus/lisp/")
+  "Directory where September Gnus Emacs lisp is found.")
+
+(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory
+				       "site-lisp/")
+  "Directory where TM Emacs lisp is found.")
+
+(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory
+					      "site-lisp/mailcrypt-3.4/")
+  "Directory where Mailcrypt Emacs Lisp is found.")
+
+(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory
+					 "site-lisp/bbdb-1.50/")
+  "Directory where Big Brother Database is found.")
+
+(defvar gnus-use-tm t
+  "Set this if you want MIME support for Gnus")
+(defvar gnus-use-mhe nil
+  "Set this if you want to use MH-E for mail reading")
+(defvar gnus-use-rmail nil
+  "Set this if you want to use RMAIL for mail reading")
+(defvar gnus-use-sendmail t
+  "Set this if you want to use SENDMAIL for mail reading")
+(defvar gnus-use-vm nil
+  "Set this if you want to use the VM package for mail reading")
+(defvar gnus-use-sc t
+  "Set this if you want to use Supercite")
+(defvar gnus-use-mailcrypt t
+  "Set this if you want to use Mailcrypt for dealing with PGP messages")
+(defvar gnus-use-bbdb nil
+  "Set this if you want to use the Big Brother DataBase")
+(defvar gnus-use-september nil
+  "Set this if you are using the experimental September Gnus")
+
+(let ((gnus-directory (if gnus-use-september
+			  gnus-sgnus-lisp-directory
+			gnus-gnus-lisp-directory)))
+  (if (null (member gnus-directory load-path))
+      (setq load-path (cons gnus-directory load-path))))
+
+;;; Tools for MIME by
+;;; UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
+;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+(if gnus-use-tm
+    (progn
+      (if (null (member gnus-tm-lisp-directory load-path))
+ 	  (setq load-path (cons gnus-tm-lisp-directory load-path)))
+       (load "mime-setup")))
+
+;;; Mailcrypt by
+;;; Jin Choi <jin@atype.com>
+;;; Patrick LoPresti <patl@lcs.mit.edu>
+
+(if gnus-use-mailcrypt
+    (progn
+      (if (null (member gnus-mailcrypt-lisp-directory load-path))
+ 	  (setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
+      (autoload 'mc-install-write-mode "mailcrypt" nil t)
+      (autoload 'mc-install-read-mode "mailcrypt" nil t)
+      (add-hook 'message-mode-hook 'mc-install-write-mode)
+      (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
+      (if gnus-use-mhe
+	  (progn
+	    (add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
+ 	    (add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))))
+
+;;; BBDB by
+;;; Jamie Zawinski <jwz@lucid.com>
+
+(if gnus-use-bbdb
+    (progn
+      (if (null (member gnus-bbdb-lisp-directory load-path))
+ 	  (setq load-path (cons gnus-bbdb-lisp-directory load-path)))
+      (autoload 'bbdb "bbdb-com"
+	"Insidious Big Brother Database" t)
+      (autoload 'bbdb-name "bbdb-com"
+	"Insidious Big Brother Database" t)
+      (autoload 'bbdb-company "bbdb-com"
+	"Insidious Big Brother Database" t)
+      (autoload 'bbdb-net "bbdb-com"
+	"Insidious Big Brother Database" t)
+      (autoload 'bbdb-notes "bbdb-com"
+	"Insidious Big Brother Database" t)
+
+      (if gnus-use-vm
+	  (progn
+	    (autoload 'bbdb-insinuate-vm "bbdb-vm"
+	      "Hook BBDB into VM" t)))
+
+      (if gnus-use-rmail
+	  (progn
+	    (autoload 'bbdb-insinuate-rmail "bbdb-rmail"
+	      "Hook BBDB into RMAIL" t)
+	    (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)))
+
+      (if gnus-use-mhe
+	  (progn
+	    (autoload 'bbdb-insinuate-mh "bbdb-mh"
+	      "Hook BBDB into MH-E" t)
+	    (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)))
+
+      (autoload 'bbdb-insinuate-gnus "bbdb-gnus"
+	"Hook BBDB into Gnus" t)
+      (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
+
+      (if gnus-use-sendmail
+	  (progn
+	    (autoload 'bbdb-insinuate-sendmail "bbdb"
+	      "Insidious Big Brother Database" t)
+	    (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
+	    (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail)))))
+
+(if gnus-use-sc
+    (progn
+      (add-hook 'mail-citation-hook 'sc-cite-original)
+      (setq message-cite-function 'sc-cite-original)
+      (autoload 'sc-cite-original "supercite")))
+
+;;;### (autoloads (gnus-batch-score gnus-fetch-group gnus gnus-slave gnus-no-server gnus-update-format) "gnus" "lisp/gnus.el" (12473 2137))
+;;; Generated autoloads from lisp/gnus.el
+
+(autoload 'gnus-update-format "gnus" "\
+Update the format specification near point." t nil)
+
+(autoload 'gnus-slave-no-server "gnus" "\
+Read network news as a slave without connecting to local server." t nil)
+
+(autoload 'gnus-no-server "gnus" "\
+Read network news.
+If ARG is a positive number, Gnus will use that as the
+startup level.  If ARG is nil, Gnus will be started at level 2. 
+If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use.
+As opposed to `gnus', this command will not connect to the local server." t nil)
+
+(autoload 'gnus-slave "gnus" "\
+Read news as a slave." t nil)
+
+(autoload 'gnus "gnus" "\
+Read network news.
+If ARG is non-nil and a positive number, Gnus will use that as the
+startup level.  If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use." t nil)
+
+(autoload 'gnus-fetch-group "gnus" "\
+Start Gnus if necessary and enter GROUP.
+Returns whether the fetching was successful or not." t nil)
+
+(defalias 'gnus-batch-kill 'gnus-batch-score)
+
+(autoload 'gnus-batch-score "gnus" "\
+Run batched scoring.
+Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
+Newsgroups is a list of strings in Bnews format.  If you want to score
+the comp hierarchy, you'd say \"comp.all\".  If you would not like to
+score the alt hierarchy, you'd say \"!alt.all\"." t nil)
+
+;;;***
+
+(provide 'gnus-setup)
+
+(run-hooks 'gnus-setup-load-hook)
+
+;;; gnus-setup.el ends here
diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el
new file mode 100644
index 00000000000..c4a8fd798b9
--- /dev/null
+++ b/lisp/gnus-soup.el
@@ -0,0 +1,563 @@
+;;; gnus-soup.el --- SOUP packet writing support for Gnus
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;;	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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus-msg)
+(require 'gnus)
+(eval-when-compile (require 'cl))
+
+;;; User Variables:
+
+(defvar gnus-soup-directory "~/SoupBrew/"
+  "*Directory containing an unpacked SOUP packet.")
+
+(defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/")
+  "*Directory where Gnus will do processing of replies.")
+
+(defvar gnus-soup-prefix-file "gnus-prefix"
+  "*Name of the file where Gnus stores the last used prefix.")
+
+(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
+  "Format string command for packing a SOUP packet.
+The SOUP files will be inserted where the %s is in the string.
+This string MUST contain both %s and %d. The file number will be
+inserted where %d appears.")
+
+(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -"
+  "*Format string command for unpacking a SOUP packet.
+The SOUP packet file name will be inserted at the %s.")
+
+(defvar gnus-soup-packet-directory "~/"
+  "*Where gnus-soup will look for REPLIES packets.")
+
+(defvar gnus-soup-packet-regexp "Soupin"
+  "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.")
+
+(defvar gnus-soup-ignored-headers "^Xref:"
+  "*Regexp to match headers to be removed when brewing SOUP packets.")
+
+;;; Internal Variables:
+
+(defvar gnus-soup-encoding-type ?n
+  "*Soup encoding type.
+`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox
+format.")
+
+(defvar gnus-soup-index-type ?c
+  "*Soup index type.
+`n' means no index file and `c' means standard Cnews overview
+format.") 
+
+(defvar gnus-soup-areas nil)
+(defvar gnus-soup-last-prefix nil)
+(defvar gnus-soup-prev-prefix nil)
+(defvar gnus-soup-buffers nil)
+
+;;; Access macros:
+
+(defmacro gnus-soup-area-prefix (area)
+  `(aref ,area 0))
+(defmacro gnus-soup-set-area-prefix (area prefix)
+  `(aset ,area 0 ,prefix))
+(defmacro gnus-soup-area-name (area)
+  `(aref ,area 1))
+(defmacro gnus-soup-area-encoding (area)
+  `(aref ,area 2))
+(defmacro gnus-soup-area-description (area)
+  `(aref ,area 3))
+(defmacro gnus-soup-area-number (area)
+  `(aref ,area 4))
+(defmacro gnus-soup-area-set-number (area value)
+  `(aset ,area 4 ,value))
+
+(defmacro gnus-soup-encoding-format (encoding)
+  `(aref ,encoding 0))
+(defmacro gnus-soup-encoding-index (encoding)
+  `(aref ,encoding 1))
+(defmacro gnus-soup-encoding-kind (encoding)
+  `(aref ,encoding 2))
+
+(defmacro gnus-soup-reply-prefix (reply)
+  `(aref ,reply 0))
+(defmacro gnus-soup-reply-kind (reply)
+  `(aref ,reply 1))
+(defmacro gnus-soup-reply-encoding (reply)
+  `(aref ,reply 2))
+
+;;; Commands:
+
+(defun gnus-soup-send-replies ()
+  "Unpack and send all replies in the reply packet."
+  (interactive)
+  (let ((packets (directory-files
+		  gnus-soup-packet-directory t gnus-soup-packet-regexp)))
+    (while packets
+      (and (gnus-soup-send-packet (car packets))
+	   (delete-file (car packets)))
+      (setq packets (cdr packets)))))
+
+(defun gnus-soup-add-article (n)
+  "Add the current article to SOUP packet.
+If N is a positive number, add the N next articles.
+If N is a negative number, add the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+move those articles instead."
+  (interactive "P")
+  (gnus-set-global-variables)
+  (let* ((articles (gnus-summary-work-articles n))
+	 (tmp-buf (get-buffer-create "*soup work*"))
+	 (area (gnus-soup-area gnus-newsgroup-name))
+	 (prefix (gnus-soup-area-prefix area))
+	 headers)
+    (buffer-disable-undo tmp-buf)
+    (save-excursion
+      (while articles
+	;; Find the header of the article.
+	(set-buffer gnus-summary-buffer)
+	(when (setq headers (gnus-summary-article-header (car articles)))
+	  ;; Put the article in a buffer.
+	  (set-buffer tmp-buf)
+	  (when (gnus-request-article-this-buffer 
+		 (car articles) gnus-newsgroup-name)
+	    (save-restriction
+	      (message-narrow-to-head)
+	      (message-remove-header gnus-soup-ignored-headers t))
+	    (gnus-soup-store gnus-soup-directory prefix headers
+			     gnus-soup-encoding-type 
+			     gnus-soup-index-type)
+	    (gnus-soup-area-set-number 
+	     area (1+ (or (gnus-soup-area-number area) 0)))))
+	;; Mark article as read. 
+	(set-buffer gnus-summary-buffer)
+	(gnus-summary-remove-process-mark (car articles))
+	(gnus-summary-mark-as-read (car articles) gnus-souped-mark)
+	(setq articles (cdr articles)))
+      (kill-buffer tmp-buf))
+    (gnus-soup-save-areas)))
+
+(defun gnus-soup-pack-packet ()
+  "Make a SOUP packet from the SOUP areas."
+  (interactive)
+  (gnus-soup-read-areas)
+  (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
+
+(defun gnus-group-brew-soup (n)
+  "Make a soup packet from the current group.
+Uses the process/prefix convention."
+  (interactive "P")
+  (let ((groups (gnus-group-process-prefix n)))
+    (while groups
+      (gnus-group-remove-mark (car groups))
+      (gnus-soup-group-brew (car groups) t)
+      (setq groups (cdr groups)))
+    (gnus-soup-save-areas)))
+
+(defun gnus-brew-soup (&optional level)
+  "Go through all groups on LEVEL or less and make a soup packet."
+  (interactive "P")
+  (let ((level (or level gnus-level-subscribed))
+	(newsrc (cdr gnus-newsrc-alist)))
+    (while newsrc
+      (and (<= (nth 1 (car newsrc)) level)
+	   (gnus-soup-group-brew (caar newsrc) t))
+      (setq newsrc (cdr newsrc)))
+    (gnus-soup-save-areas)))
+
+;;;###autoload
+(defun gnus-batch-brew-soup ()
+  "Brew a SOUP packet from groups mention on the command line.
+Will use the remaining command line arguments as regular expressions
+for matching on group names.
+
+For instance, if you want to brew on all the nnml groups, as well as
+groups with \"emacs\" in the name, you could say something like:
+
+$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
+  (interactive)
+  )
+  
+;;; Internal Functions:
+
+;; Store the current buffer. 
+(defun gnus-soup-store (directory prefix headers format index)
+  ;; Create the directory, if needed. 
+  (or (file-directory-p directory)
+      (gnus-make-directory directory))
+  (let* ((msg-buf (find-file-noselect
+		   (concat directory prefix ".MSG")))
+	 (idx-buf (if (= index ?n)
+		      nil
+		    (find-file-noselect
+		     (concat directory prefix ".IDX"))))
+	 (article-buf (current-buffer))
+	 from head-line beg type)
+    (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
+    (buffer-disable-undo msg-buf)
+    (and idx-buf 
+	 (progn
+	   (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers))
+	   (buffer-disable-undo idx-buf)))
+    (save-excursion
+      ;; Make sure the last char in the buffer is a newline.
+      (goto-char (point-max))
+      (or (= (current-column) 0)
+	  (insert "\n"))
+      ;; Find the "from".
+      (goto-char (point-min))
+      (setq from
+	    (gnus-mail-strip-quoted-names
+	     (or (mail-fetch-field "from")
+		 (mail-fetch-field "really-from")
+		 (mail-fetch-field "sender"))))
+      (goto-char (point-min))
+      ;; Depending on what encoding is supposed to be used, we make
+      ;; a soup header. 
+      (setq head-line
+	    (cond 
+	     ((= gnus-soup-encoding-type ?n)
+	      (format "#! rnews %d\n" (buffer-size)))
+	     ((= gnus-soup-encoding-type ?m)
+	      (while (search-forward "\nFrom " nil t)
+		(replace-match "\n>From " t t))
+	      (concat "From " (or from "unknown")
+		      " " (current-time-string) "\n"))
+	     ((= gnus-soup-encoding-type ?M)
+	      "\^a\^a\^a\^a\n")
+	     (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
+      ;; Insert the soup header and the article in the MSG buf.
+      (set-buffer msg-buf)
+      (goto-char (point-max))
+      (insert head-line)
+      (setq beg (point))
+      (insert-buffer-substring article-buf)
+      ;; Insert the index in the IDX buf.
+      (cond ((= index ?c)
+	     (set-buffer idx-buf)
+	     (gnus-soup-insert-idx beg headers))
+	    ((/= index ?n)
+	     (error "Unknown index type: %c" type)))
+      ;; Return the MSG buf.
+      msg-buf)))
+
+(defun gnus-soup-group-brew (group &optional not-all)
+  "Enter GROUP and add all articles to a SOUP package.
+If NOT-ALL, don't pack ticked articles."
+  (let ((gnus-expert-user t)
+	(gnus-large-newsgroup nil)
+	(entry (gnus-gethash group gnus-newsrc-hashtb)))
+    (when (or (null entry)
+	      (eq (car entry) t)
+	      (and (car entry)
+		   (> (car entry) 0))
+	      (and (not not-all)
+		   (gnus-range-length (cdr (assq 'tick (gnus-info-marks 
+							(nth 2 entry)))))))
+      (when (gnus-summary-read-group group nil t)
+	(setq gnus-newsgroup-processable
+	      (reverse
+	       (if (not not-all)
+		   (append gnus-newsgroup-marked gnus-newsgroup-unreads)
+		 gnus-newsgroup-unreads)))
+	(gnus-soup-add-article nil)
+	(gnus-summary-exit)))))
+
+(defun gnus-soup-insert-idx (offset header)
+  ;; [number subject from date id references chars lines xref]
+  (goto-char (point-max))
+  (insert
+   (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
+	   offset
+	   (or (mail-header-subject header) "(none)")
+	   (or (mail-header-from header) "(nobody)")
+	   (or (mail-header-date header) "")
+	   (or (mail-header-id header)
+	       (concat "soup-dummy-id-" 
+		       (mapconcat 
+			(lambda (time) (int-to-string time))
+			(current-time) "-")))
+	   (or (mail-header-references header) "")
+	   (or (mail-header-chars header) 0) 
+	   (or (mail-header-lines header) "0"))))
+
+(defun gnus-soup-save-areas ()
+  (gnus-soup-write-areas)
+  (save-excursion
+    (let (buf)
+      (while gnus-soup-buffers
+	(setq buf (car gnus-soup-buffers)
+	      gnus-soup-buffers (cdr gnus-soup-buffers))
+	(if (not (buffer-name buf))
+	    ()
+	  (set-buffer buf)
+	  (and (buffer-modified-p) (save-buffer))
+	  (kill-buffer (current-buffer)))))
+    (gnus-soup-write-prefixes)))
+
+(defun gnus-soup-write-prefixes ()
+  (let ((prefix gnus-soup-last-prefix))
+    (save-excursion
+      (while prefix
+	(gnus-set-work-buffer)
+	(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix)))
+	(gnus-make-directory (caar prefix))
+	(write-region (point-min) (point-max)
+		      (concat (caar prefix) gnus-soup-prefix-file) 
+		      nil 'nomesg)
+	(setq prefix (cdr prefix))))))
+
+(defun gnus-soup-pack (dir packer)
+  (let* ((files (mapconcat 'identity
+			   '("AREAS" "*.MSG" "*.IDX" "INFO"
+			     "LIST" "REPLIES" "COMMANDS" "ERRORS")
+			   " "))
+	 (packer (if (< (string-match "%s" packer)
+			(string-match "%d" packer))
+		     (format packer files
+			     (string-to-int (gnus-soup-unique-prefix dir)))
+		   (format packer 
+			   (string-to-int (gnus-soup-unique-prefix dir))
+			   files)))
+	 (dir (expand-file-name dir)))
+    (or (file-directory-p dir)
+	(gnus-make-directory dir))
+    (setq gnus-soup-areas nil)
+    (gnus-message 4 "Packing %s..." packer)
+    (if (zerop (call-process shell-file-name
+			     nil nil nil shell-command-switch 
+			     (concat "cd " dir " ; " packer)))
+	(progn
+	  (call-process shell-file-name nil nil nil shell-command-switch 
+			(concat "cd " dir " ; rm " files))
+	  (gnus-message 4 "Packing...done" packer))
+      (error "Couldn't pack packet."))))
+
+(defun gnus-soup-parse-areas (file)
+  "Parse soup area file FILE.
+The result is a of vectors, each containing one entry from the AREA file.
+The vector contain five strings, 
+  [prefix name encoding description number]
+though the two last may be nil if they are missing."
+  (let (areas)
+    (save-excursion
+      (set-buffer (find-file-noselect file 'force))
+      (buffer-disable-undo (current-buffer))
+      (goto-char (point-min))
+      (while (not (eobp))
+	(setq areas
+	      (cons (vector (gnus-soup-field) 
+			    (gnus-soup-field)
+			    (gnus-soup-field)
+			    (and (eq (preceding-char) ?\t)
+				 (gnus-soup-field))
+			    (and (eq (preceding-char) ?\t)
+				 (string-to-int (gnus-soup-field))))
+		    areas))
+	(if (eq (preceding-char) ?\t)
+	    (beginning-of-line 2)))
+      (kill-buffer (current-buffer)))
+    areas))
+
+(defun gnus-soup-parse-replies (file)
+  "Parse soup REPLIES file FILE.
+The result is a of vectors, each containing one entry from the REPLIES
+file. The vector contain three strings, [prefix name encoding]."
+  (let (replies)
+    (save-excursion
+      (set-buffer (find-file-noselect file))
+      (buffer-disable-undo (current-buffer))
+      (goto-char (point-min))
+      (while (not (eobp))
+	(setq replies
+	      (cons (vector (gnus-soup-field) (gnus-soup-field)
+			    (gnus-soup-field))
+		    replies))
+	(if (eq (preceding-char) ?\t)
+	    (beginning-of-line 2)))
+      (kill-buffer (current-buffer)))
+    replies))
+
+(defun gnus-soup-field ()
+  (prog1
+      (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
+    (forward-char 1)))
+
+(defun gnus-soup-read-areas ()
+  (or gnus-soup-areas
+      (setq gnus-soup-areas
+	    (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
+
+(defun gnus-soup-write-areas ()
+  "Write the AREAS file."
+  (interactive)
+  (when gnus-soup-areas
+    (nnheader-temp-write (concat gnus-soup-directory "AREAS")
+      (let ((areas gnus-soup-areas)
+	    area)
+	(while (setq area (pop areas))
+	  (insert
+	   (format 
+	    "%s\t%s\t%s%s\n"
+	    (gnus-soup-area-prefix area)
+	    (gnus-soup-area-name area) 
+	    (gnus-soup-area-encoding area)
+	    (if (or (gnus-soup-area-description area) 
+		    (gnus-soup-area-number area))
+		(concat "\t" (or (gnus-soup-area-description
+				  area) "")
+			(if (gnus-soup-area-number area)
+			    (concat "\t" (int-to-string 
+					  (gnus-soup-area-number area)))
+			  "")) ""))))))))
+
+(defun gnus-soup-write-replies (dir areas)
+  "Write a REPLIES file in DIR containing AREAS."
+  (nnheader-temp-write (concat dir "REPLIES")
+    (let (area)
+      (while (setq area (pop areas))
+	(insert (format "%s\t%s\t%s\n"
+			(gnus-soup-reply-prefix area)
+			(gnus-soup-reply-kind area) 
+			(gnus-soup-reply-encoding area)))))))
+
+(defun gnus-soup-area (group)
+  (gnus-soup-read-areas)
+  (let ((areas gnus-soup-areas)
+	(real-group (gnus-group-real-name group))
+	area result)
+    (while areas
+      (setq area (car areas)
+	    areas (cdr areas))
+      (if (equal (gnus-soup-area-name area) real-group)
+	  (setq result area)))
+    (or result
+	(setq result
+	      (vector (gnus-soup-unique-prefix)
+		      real-group 
+		      (format "%c%c%c"
+			      gnus-soup-encoding-type
+			      gnus-soup-index-type
+			      (if (gnus-member-of-valid 'mail group) ?m ?n))
+		      nil nil)
+	      gnus-soup-areas (cons result gnus-soup-areas)))
+    result))
+
+(defun gnus-soup-unique-prefix (&optional dir)
+  (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
+	 (entry (assoc dir gnus-soup-last-prefix))
+	 gnus-soup-prev-prefix)
+    (if entry
+	()
+      (and (file-exists-p (concat dir gnus-soup-prefix-file))
+	   (condition-case nil
+	       (load (concat dir gnus-soup-prefix-file) nil t t)
+	     (error nil)))
+      (setq gnus-soup-last-prefix 
+	    (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
+		  gnus-soup-last-prefix)))
+    (setcdr entry (1+ (cdr entry)))
+    (gnus-soup-write-prefixes)
+    (int-to-string (cdr entry))))
+
+(defun gnus-soup-unpack-packet (dir unpacker packet)
+  "Unpack PACKET into DIR using UNPACKER.
+Return whether the unpacking was successful."
+  (gnus-make-directory dir)
+  (gnus-message 4 "Unpacking: %s" (format unpacker packet))
+  (prog1
+      (zerop (call-process
+	      shell-file-name nil nil nil shell-command-switch
+	      (format "cd %s ; %s" (expand-file-name dir) 
+		      (format unpacker packet))))
+    (gnus-message 4 "Unpacking...done")))
+
+(defun gnus-soup-send-packet (packet)
+  (gnus-soup-unpack-packet 
+   gnus-soup-replies-directory gnus-soup-unpacker packet)
+  (let ((replies (gnus-soup-parse-replies 
+		  (concat gnus-soup-replies-directory "REPLIES"))))
+    (save-excursion
+      (while replies
+	(let* ((msg-file (concat gnus-soup-replies-directory
+				 (gnus-soup-reply-prefix (car replies))
+				 ".MSG"))
+	       (msg-buf (and (file-exists-p msg-file)
+			     (find-file-noselect msg-file)))
+	       (tmp-buf (get-buffer-create " *soup send*"))
+	       beg end)
+	  (cond 
+	   ((/= (gnus-soup-encoding-format 
+		 (gnus-soup-reply-encoding (car replies))) ?n)
+	    (error "Unsupported encoding"))
+	   ((null msg-buf)
+	    t)
+	   (t
+	    (buffer-disable-undo msg-buf)
+	    (buffer-disable-undo tmp-buf)
+	    (set-buffer msg-buf)
+	    (goto-char (point-min))
+	    (while (not (eobp))
+	      (or (looking-at "#! *rnews +\\([0-9]+\\)")
+		  (error "Bad header."))
+	      (forward-line 1)
+	      (setq beg (point)
+		    end (+ (point) (string-to-int 
+				    (buffer-substring 
+				     (match-beginning 1) (match-end 1)))))
+	      (switch-to-buffer tmp-buf)
+	      (erase-buffer)
+	      (insert-buffer-substring msg-buf beg end)
+	      (goto-char (point-min))
+	      (search-forward "\n\n")
+	      (forward-char -1)
+	      (insert mail-header-separator)
+	      (setq message-newsreader (setq message-mailer
+					     (gnus-extended-version)))
+	      (cond 
+	       ((string= (gnus-soup-reply-kind (car replies)) "news")
+		(gnus-message 5 "Sending news message to %s..."
+			      (mail-fetch-field "newsgroups"))
+		(sit-for 1)
+		(funcall message-send-news-function))
+	       ((string= (gnus-soup-reply-kind (car replies)) "mail")
+		(gnus-message 5 "Sending mail to %s..."
+			 (mail-fetch-field "to"))
+		(sit-for 1)
+		(message-send-mail))
+	       (t
+		(error "Unknown reply kind")))
+	      (set-buffer msg-buf)
+	      (goto-char end))
+	    (delete-file (buffer-file-name))
+	    (kill-buffer msg-buf)
+	    (kill-buffer tmp-buf)
+	    (gnus-message 4 "Sent packet"))))
+	(setq replies (cdr replies)))
+      t)))
+		   
+(provide 'gnus-soup)
+
+;;; gnus-soup.el ends here
diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
new file mode 100644
index 00000000000..7a29e0f7532
--- /dev/null
+++ b/lisp/gnus-srvr.el
@@ -0,0 +1,708 @@
+;;; gnus-srvr.el --- virtual server support for Gnus
+;; Copyright (C) 1995,96 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-server-mode-hook nil
+  "Hook run in `gnus-server-mode' buffers.")
+
+(defconst gnus-server-line-format "     {%(%h:%w%)} %s\n"
+  "Format of server lines.
+It works along the same lines as a normal formatting string,
+with some simple extensions.")
+
+(defvar gnus-server-mode-line-format "Gnus  List of servers"
+  "The format specification for the server mode line.")
+
+(defvar gnus-server-exit-hook nil
+  "*Hook run when exiting the server buffer.")
+
+;;; Internal variables.
+
+(defvar gnus-inserted-opened-servers nil)
+
+(defvar gnus-server-line-format-alist
+  `((?h how ?s)
+    (?n name ?s)
+    (?w where ?s)
+    (?s status ?s)))
+
+(defvar gnus-server-mode-line-format-alist 
+  `((?S news-server ?s)
+    (?M news-method ?s)
+    (?u user-defined ?s)))
+
+(defvar gnus-server-line-format-spec nil)
+(defvar gnus-server-mode-line-format-spec nil)
+(defvar gnus-server-killed-servers nil)
+
+(defvar gnus-server-mode-map)
+
+(defvar gnus-server-menu-hook nil
+  "*Hook run after the creation of the server mode menu.")
+
+(defun gnus-server-make-menu-bar ()
+  (gnus-visual-turn-off-edit-menu 'server)
+  (unless (boundp 'gnus-server-server-menu)
+    (easy-menu-define
+     gnus-server-server-menu gnus-server-mode-map ""
+     '("Server"
+       ["Add" gnus-server-add-server t]
+       ["Browse" gnus-server-read-server t]
+       ["List" gnus-server-list-servers t]
+       ["Kill" gnus-server-kill-server t]
+       ["Yank" gnus-server-yank-server t]
+       ["Copy" gnus-server-copy-server t]
+       ["Edit" gnus-server-edit-server t]
+       ["Exit" gnus-server-exit t]
+       ))
+
+    (easy-menu-define
+     gnus-server-connections-menu gnus-server-mode-map ""
+     '("Connections"
+       ["Open" gnus-server-open-server t]
+       ["Close" gnus-server-close-server t]
+       ["Deny" gnus-server-deny-server t]
+       ["Reset" gnus-server-remove-denials t]
+       ))
+
+    (run-hooks 'gnus-server-menu-hook)))
+
+(defvar gnus-server-mode-map nil)
+(put 'gnus-server-mode 'mode-class 'special)
+
+(unless gnus-server-mode-map
+  (setq gnus-server-mode-map (make-sparse-keymap))
+  (suppress-keymap gnus-server-mode-map)
+
+  (gnus-define-keys
+   gnus-server-mode-map
+   " " gnus-server-read-server
+   "\r" gnus-server-read-server
+   gnus-mouse-2 gnus-server-pick-server
+   "q" gnus-server-exit
+   "l" gnus-server-list-servers
+   "k" gnus-server-kill-server
+   "y" gnus-server-yank-server
+   "c" gnus-server-copy-server
+   "a" gnus-server-add-server
+   "e" gnus-server-edit-server
+
+   "O" gnus-server-open-server
+   "C" gnus-server-close-server
+   "D" gnus-server-deny-server
+   "R" gnus-server-remove-denials
+
+    "\C-c\C-i" gnus-info-find-node))
+
+(defun gnus-server-mode ()
+  "Major mode for listing and editing servers.
+
+All normal editing commands are switched off.
+\\<gnus-server-mode-map>
+For more in-depth information on this mode, read the manual 
+(`\\[gnus-info-find-node]'). 
+
+The following commands are available:
+
+\\{gnus-server-mode-map}"
+  (interactive)
+  (when (and menu-bar-mode
+	     (gnus-visual-p 'server-menu 'menu))
+    (gnus-server-make-menu-bar))
+  (kill-all-local-variables)
+  (gnus-simplify-mode-line)
+  (setq major-mode 'gnus-server-mode)
+  (setq mode-name "Server")
+					;  (gnus-group-set-mode-line)
+  (setq mode-line-process nil)
+  (use-local-map gnus-server-mode-map)
+  (buffer-disable-undo (current-buffer))
+  (setq truncate-lines t)
+  (setq buffer-read-only t)
+  (run-hooks 'gnus-server-mode-hook))
+
+(defun gnus-server-insert-server-line (name method)
+  (let* ((how (car method))
+	 (where (nth 1 method))
+	 (elem (assoc method gnus-opened-servers))
+	 (status (cond ((eq (nth 1 elem) 'denied)
+			"(denied)")
+		       ((or (gnus-server-opened method)
+			    (eq (nth 1 elem) 'ok))
+			"(opened)")
+		       (t
+			"(closed)"))))
+    (beginning-of-line)
+    (gnus-add-text-properties
+     (point)
+     (prog1 (1+ (point))
+       ;; Insert the text.
+       (eval gnus-server-line-format-spec))
+     (list 'gnus-server (intern name)))))
+
+(defun gnus-enter-server-buffer ()
+  "Set up the server buffer."
+  (gnus-server-setup-buffer)
+  (gnus-configure-windows 'server)
+  (gnus-server-prepare))
+
+(defun gnus-server-setup-buffer ()
+  "Initialize the server buffer."
+  (unless (get-buffer gnus-server-buffer)
+    (save-excursion
+      (set-buffer (get-buffer-create gnus-server-buffer))
+      (gnus-server-mode)
+      (when gnus-carpal 
+	(gnus-carpal-setup-buffer 'server)))))
+
+(defun gnus-server-prepare ()
+  (setq gnus-server-mode-line-format-spec 
+	(gnus-parse-format gnus-server-mode-line-format 
+			   gnus-server-mode-line-format-alist))
+  (setq gnus-server-line-format-spec 
+	(gnus-parse-format gnus-server-line-format 
+			   gnus-server-line-format-alist t))
+  (let ((alist gnus-server-alist)
+	(buffer-read-only nil)
+	(opened gnus-opened-servers)
+	done server op-ser)
+    (erase-buffer)
+    (setq gnus-inserted-opened-servers nil)
+    ;; First we do the real list of servers.
+    (while alist
+      (push (cdr (setq server (pop alist))) done)
+      (when (and server (car server) (cdr server))
+	(gnus-server-insert-server-line (car server) (cdr server))))
+    ;; Then we insert the list of servers that have been opened in
+    ;; this session.
+    (while opened 
+      (unless (member (caar opened) done)
+	(gnus-server-insert-server-line 
+	 (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
+	 (caar opened))
+	(push (list op-ser (caar opened)) gnus-inserted-opened-servers))
+      (setq opened (cdr opened))))
+  (goto-char (point-min))
+  (gnus-server-position-point))
+
+(defun gnus-server-server-name ()
+  (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
+    (and server (symbol-name server))))
+
+(defalias 'gnus-server-position-point 'gnus-goto-colon)
+
+(defconst gnus-server-edit-buffer "*Gnus edit server*")
+
+(defun gnus-server-update-server (server)
+  (save-excursion
+    (set-buffer gnus-server-buffer)
+    (let* ((buffer-read-only nil)
+	   (entry (assoc server gnus-server-alist))
+	   (oentry (assoc (gnus-server-to-method server)
+			  gnus-opened-servers)))
+      (when entry
+	(gnus-dribble-enter 
+	 (concat "(gnus-server-set-info \"" server "\" '"
+		 (prin1-to-string (cdr entry)) ")")))
+      (when (or entry oentry)
+	;; Buffer may be narrowed.
+	(save-restriction
+	  (widen)
+	  (when (gnus-server-goto-server server)
+	    (gnus-delete-line))
+	  (if entry
+	      (gnus-server-insert-server-line (car entry) (cdr entry))
+	    (gnus-server-insert-server-line 
+	     (format "%s:%s" (caar oentry) (nth 1 (car oentry)))
+	     (car oentry)))
+	  (gnus-server-position-point))))))
+
+(defun gnus-server-set-info (server info)
+  ;; Enter a select method into the virtual server alist.
+  (when (and server info)
+    (gnus-dribble-enter 
+     (concat "(gnus-server-set-info \"" server "\" '"
+	     (prin1-to-string info) ")"))
+    (let* ((server (nth 1 info))
+	   (entry (assoc server gnus-server-alist)))
+      (if entry (setcdr entry info)
+	(setq gnus-server-alist
+	      (nconc gnus-server-alist (list (cons server info))))))))
+
+;;; Interactive server functions.
+
+(defun gnus-server-kill-server (server)
+  "Kill the server on the current line."
+  (interactive (list (gnus-server-server-name)))
+  (unless (gnus-server-goto-server server)
+    (if server (error "No such server: %s" server)
+      (error "No server on the current line")))
+  (unless (assoc server gnus-server-alist)
+    (error "Read-only server %s" server))
+  (gnus-dribble-enter "")
+  (let ((buffer-read-only nil))
+    (gnus-delete-line))
+  (setq gnus-server-killed-servers 
+	(cons (assoc server gnus-server-alist) gnus-server-killed-servers))
+  (setq gnus-server-alist (delq (car gnus-server-killed-servers)
+				gnus-server-alist))
+  (gnus-server-position-point))
+
+(defun gnus-server-yank-server ()
+  "Yank the previously killed server."
+  (interactive)
+  (or gnus-server-killed-servers
+      (error "No killed servers to be yanked"))
+  (let ((alist gnus-server-alist)
+	(server (gnus-server-server-name))
+	(killed (car gnus-server-killed-servers)))
+    (if (not server) 
+	(setq gnus-server-alist (nconc gnus-server-alist (list killed)))
+      (if (string= server (caar gnus-server-alist))
+	  (setq gnus-server-alist (cons killed gnus-server-alist))
+	(while (and (cdr alist)
+		    (not (string= server (caadr alist))))
+	  (setq alist (cdr alist)))
+	(if alist
+	    (setcdr alist (cons killed (cdr alist)))
+ 	  (setq gnus-server-alist (list killed)))))
+    (gnus-server-update-server (car killed))
+    (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
+    (gnus-server-position-point)))
+
+(defun gnus-server-exit ()
+  "Return to the group buffer."
+  (interactive)
+  (kill-buffer (current-buffer))
+  (switch-to-buffer gnus-group-buffer)
+  (run-hooks 'gnus-server-exit-hook))
+
+(defun gnus-server-list-servers ()
+  "List all available servers."
+  (interactive)
+  (let ((cur (gnus-server-server-name)))
+    (gnus-server-prepare)
+    (if cur (gnus-server-goto-server cur)
+      (goto-char (point-max))
+      (forward-line -1))
+    (gnus-server-position-point)))
+
+(defun gnus-server-set-status (method status)
+  "Make METHOD have STATUS."
+  (let ((entry (assoc method gnus-opened-servers)))
+    (if entry
+	(setcar (cdr entry) status)
+      (push (list method status) gnus-opened-servers))))
+
+(defun gnus-opened-servers-remove (method)
+  "Remove METHOD from the list of opened servers."
+  (setq gnus-opened-servers (delq (assoc method gnus-opened-servers)
+				  gnus-opened-servers)))
+
+(defun gnus-server-open-server (server)
+  "Force an open of SERVER."
+  (interactive (list (gnus-server-server-name)))
+  (let ((method (gnus-server-to-method server)))
+    (or method (error "No such server: %s" server))
+    (gnus-server-set-status method 'ok)
+    (prog1
+	(or (gnus-open-server method)
+	    (progn (message "Couldn't open %s" server) nil))
+      (gnus-server-update-server server)
+      (gnus-server-position-point))))
+
+(defun gnus-server-close-server (server)
+  "Close SERVER."
+  (interactive (list (gnus-server-server-name)))
+  (let ((method (gnus-server-to-method server)))
+    (or method (error "No such server: %s" server))
+    (gnus-server-set-status method 'closed)
+    (prog1
+	(gnus-close-server method)
+      (gnus-server-update-server server)
+      (gnus-server-position-point))))
+
+(defun gnus-server-deny-server (server)
+  "Make sure SERVER will never be attempted opened."
+  (interactive (list (gnus-server-server-name)))
+  (let ((method (gnus-server-to-method server)))
+    (or method (error "No such server: %s" server))
+    (gnus-server-set-status method 'denied))
+  (gnus-server-update-server server)
+  (gnus-server-position-point)
+  t)
+
+(defun gnus-server-remove-denials ()
+  "Make all denied servers into closed servers."
+  (interactive)
+  (let ((servers gnus-opened-servers))
+    (while servers
+      (when (eq (nth 1 (car servers)) 'denied)
+	(setcar (nthcdr 1 (car servers)) 'closed))
+      (setq servers (cdr servers))))
+  (gnus-server-list-servers))
+
+(defun gnus-server-copy-server (from to)
+  (interactive
+   (list
+    (or (gnus-server-server-name)
+	(error "No server on the current line"))
+    (read-string "Copy to: ")))
+  (or from (error "No server on current line"))
+  (or (and to (not (string= to ""))) (error "No name to copy to"))
+  (and (assoc to gnus-server-alist) (error "%s already exists" to))
+  (or (assoc from gnus-server-alist) 
+      (error "%s: no such server" from))
+  (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist))))
+    (setcar to-entry to)
+    (setcar (nthcdr 2 to-entry) to)
+    (setq gnus-server-killed-servers 
+	  (cons to-entry gnus-server-killed-servers))
+    (gnus-server-yank-server)))
+
+(defun gnus-server-add-server (how where)
+  (interactive 
+   (list (intern (completing-read "Server method: "
+				  gnus-valid-select-methods nil t))
+	 (read-string "Server name: ")))
+  (setq gnus-server-killed-servers 
+	(cons (list where how where) gnus-server-killed-servers))
+  (gnus-server-yank-server))
+
+(defun gnus-server-goto-server (server)
+  "Jump to a server line."
+  (interactive
+   (list (completing-read "Goto server: " gnus-server-alist nil t)))
+  (let ((to (text-property-any (point-min) (point-max) 
+			       'gnus-server (intern server))))
+    (and to
+	 (progn
+	   (goto-char to) 
+	   (gnus-server-position-point)))))
+
+(defun gnus-server-edit-server (server)
+  "Edit the server on the current line."
+  (interactive (list (gnus-server-server-name)))
+  (unless server
+    (error "No server on current line"))
+  (unless (assoc server gnus-server-alist)
+    (error "This server can't be edited"))
+  (let ((winconf (current-window-configuration))
+	(info (cdr (assoc server gnus-server-alist))))
+    (gnus-close-server info)
+    (get-buffer-create gnus-server-edit-buffer)
+    (gnus-configure-windows 'edit-server)
+    (gnus-add-current-to-buffer-list)
+    (emacs-lisp-mode)
+    (make-local-variable 'gnus-prev-winconf)
+    (setq gnus-prev-winconf winconf)
+    (use-local-map (copy-keymap (current-local-map)))
+    (let ((done-func '(lambda () 
+			"Exit editing mode and update the information."
+			(interactive)
+			(gnus-server-edit-server-done 'group))))
+      (setcar (cdr (nth 4 done-func)) server)
+      (local-set-key "\C-c\C-c" done-func))
+    (erase-buffer)
+    (insert ";; Type `C-c C-c' after you have edited the server.\n\n")
+    (insert (pp-to-string info))))
+
+(defun gnus-server-edit-server-done (server)
+  (interactive)
+  (set-buffer (get-buffer-create gnus-server-edit-buffer))
+  (goto-char (point-min))
+  (let ((form (read (current-buffer)))
+	(winconf gnus-prev-winconf))
+    (gnus-server-set-info server form)
+    (kill-buffer (current-buffer))
+    (and winconf (set-window-configuration winconf))
+    (set-buffer gnus-server-buffer)
+    (gnus-server-update-server server)
+    (gnus-server-list-servers)
+    (gnus-server-position-point)))
+
+(defun gnus-server-read-server (server)
+  "Browse a server."
+  (interactive (list (gnus-server-server-name)))
+  (let ((buf (current-buffer)))
+    (prog1
+	(gnus-browse-foreign-server (gnus-server-to-method server) buf)
+      (save-excursion
+	(set-buffer buf)
+	(gnus-server-update-server (gnus-server-server-name))
+	(gnus-server-position-point)))))
+    
+(defun gnus-server-pick-server (e)
+  (interactive "e")
+  (mouse-set-point e)
+  (gnus-server-read-server (gnus-server-server-name)))
+
+
+;;;
+;;; Browse Server Mode
+;;;
+
+(defvar gnus-browse-menu-hook nil
+  "*Hook run after the creation of the browse mode menu.")
+
+(defvar gnus-browse-mode-hook nil)
+(defvar gnus-browse-mode-map nil)
+(put 'gnus-browse-mode 'mode-class 'special)
+
+(unless gnus-browse-mode-map
+  (setq gnus-browse-mode-map (make-keymap))
+  (suppress-keymap gnus-browse-mode-map)
+
+  (gnus-define-keys
+   gnus-browse-mode-map
+   " " gnus-browse-read-group
+   "=" gnus-browse-select-group
+   "n" gnus-browse-next-group
+   "p" gnus-browse-prev-group
+   "\177" gnus-browse-prev-group
+   "N" gnus-browse-next-group
+   "P" gnus-browse-prev-group
+   "\M-n" gnus-browse-next-group
+   "\M-p" gnus-browse-prev-group
+   "\r" gnus-browse-select-group
+   "u" gnus-browse-unsubscribe-current-group
+   "l" gnus-browse-exit
+   "L" gnus-browse-exit
+   "q" gnus-browse-exit
+   "Q" gnus-browse-exit
+   "\C-c\C-c" gnus-browse-exit
+   "?" gnus-browse-describe-briefly
+
+   "\C-c\C-i" gnus-info-find-node))
+
+(defun gnus-browse-make-menu-bar ()
+  (gnus-visual-turn-off-edit-menu 'browse)
+  (or
+   (boundp 'gnus-browse-menu)
+   (progn
+     (easy-menu-define
+      gnus-browse-menu gnus-browse-mode-map ""
+      '("Browse"
+	["Subscribe" gnus-browse-unsubscribe-current-group t]
+	["Read" gnus-browse-read-group t]
+	["Select" gnus-browse-read-group t]
+	["Next" gnus-browse-next-group t]
+	["Prev" gnus-browse-next-group t]
+	["Exit" gnus-browse-exit t]
+	))
+      (run-hooks 'gnus-browse-menu-hook))))
+
+(defvar gnus-browse-current-method nil)
+(defvar gnus-browse-return-buffer nil)
+
+(defvar gnus-browse-buffer "*Gnus Browse Server*")
+
+(defun gnus-browse-foreign-server (method &optional return-buffer)
+  "Browse the server METHOD."
+  (setq gnus-browse-current-method method)
+  (setq gnus-browse-return-buffer return-buffer)
+  (let ((gnus-select-method method)
+	groups group)
+    (gnus-message 5 "Connecting to %s..." (nth 1 method))
+    (cond
+     ((not (gnus-check-server method))
+      (gnus-message
+       1 "Unable to contact server: %s" (gnus-status-message method))
+      nil)
+     ((not (gnus-request-list method))
+      (gnus-message
+       1 "Couldn't request list: %s" (gnus-status-message method))
+      nil)
+     (t
+      (get-buffer-create gnus-browse-buffer)
+      (gnus-add-current-to-buffer-list)
+      (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
+      (gnus-configure-windows 'browse)
+      (buffer-disable-undo (current-buffer))
+      (let ((buffer-read-only nil))
+	(erase-buffer))
+      (gnus-browse-mode)
+      (setq mode-line-buffer-identification
+	    (list
+	     (format
+	      "Gnus: %%b {%s:%s}" (car method) (cadr method))))
+      (save-excursion
+	(set-buffer nntp-server-buffer)
+	(let ((cur (current-buffer)))
+	  (goto-char (point-min))
+	  (or (string= gnus-ignored-newsgroups "")
+	      (delete-matching-lines gnus-ignored-newsgroups))
+	  (while (re-search-forward
+		  "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
+	    (goto-char (match-end 1))
+	    (setq groups (cons (cons (match-string 1)
+				     (max 0 (- (1+ (read cur)) (read cur))))
+			       groups)))))
+      (setq groups (sort groups
+			 (lambda (l1 l2)
+			   (string< (car l1) (car l2)))))
+      (let ((buffer-read-only nil))
+	(while groups
+	  (setq group (car groups))
+	  (insert
+	   (format "K%7d: %s\n" (cdr group) (car group)))
+	  (setq groups (cdr groups))))
+      (switch-to-buffer (current-buffer))
+      (goto-char (point-min))
+      (gnus-group-position-point)
+      (gnus-message 5 "Connecting to %s...done" (nth 1 method))
+      t))))
+
+(defun gnus-browse-mode ()
+  "Major mode for browsing a foreign server.
+
+All normal editing commands are switched off.
+
+\\<gnus-browse-mode-map>
+The only things you can do in this buffer is
+
+1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
+The group will be inserted into the group buffer upon exit from this
+buffer.
+
+2) `\\[gnus-browse-read-group]' to read a group ephemerally.
+
+3) `\\[gnus-browse-exit]' to return to the group buffer."
+  (interactive)
+  (kill-all-local-variables)
+  (when (and menu-bar-mode
+	     (gnus-visual-p 'browse-menu 'menu))
+    (gnus-browse-make-menu-bar))
+  (gnus-simplify-mode-line)
+  (setq major-mode 'gnus-browse-mode)
+  (setq mode-name "Browse Server")
+  (setq mode-line-process nil)
+  (use-local-map gnus-browse-mode-map)
+  (buffer-disable-undo (current-buffer))
+  (setq truncate-lines t)
+  (setq buffer-read-only t)
+  (run-hooks 'gnus-browse-mode-hook))
+
+(defun gnus-browse-read-group (&optional no-article)
+  "Enter the group at the current line."
+  (interactive)
+  (let ((group (gnus-browse-group-name)))
+    (or (gnus-group-read-ephemeral-group
+	 group gnus-browse-current-method nil
+	 (cons (current-buffer) 'browse))
+	(error "Couldn't enter %s" group))))
+
+(defun gnus-browse-select-group ()
+  "Select the current group."
+  (interactive)
+  (gnus-browse-read-group 'no))
+
+(defun gnus-browse-next-group (n)
+  "Go to the next group."
+  (interactive "p")
+  (prog1
+      (forward-line n)
+    (gnus-group-position-point)))
+
+(defun gnus-browse-prev-group (n)
+  "Go to the next group."
+  (interactive "p")
+  (gnus-browse-next-group (- n)))
+
+(defun gnus-browse-unsubscribe-current-group (arg)
+  "(Un)subscribe to the next ARG groups."
+  (interactive "p")
+  (when (eobp)
+    (error "No group at current line."))
+  (let ((ward (if (< arg 0) -1 1))
+	(arg (abs arg)))
+    (while (and (> arg 0)
+		(not (eobp))
+		(gnus-browse-unsubscribe-group)
+		(zerop (gnus-browse-next-group ward)))
+      (decf arg))
+    (gnus-group-position-point)
+    (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
+    arg))
+
+(defun gnus-browse-group-name ()
+  (save-excursion
+    (beginning-of-line)
+    (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
+      (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method))))
+
+(defun gnus-browse-unsubscribe-group ()
+  "Toggle subscription of the current group in the browse buffer."
+  (let ((sub nil)
+	(buffer-read-only nil)
+	group)
+    (save-excursion
+      (beginning-of-line)
+      ;; If this group it killed, then we want to subscribe it.
+      (if (= (following-char) ?K) (setq sub t))
+      (setq group (gnus-browse-group-name))
+      (delete-char 1)
+      (if sub
+	  (progn
+	    (gnus-group-change-level
+	     (list t group gnus-level-default-subscribed
+		   nil nil gnus-browse-current-method)
+	     gnus-level-default-subscribed gnus-level-killed
+	     (and (car (nth 1 gnus-newsrc-alist))
+		  (gnus-gethash (car (nth 1 gnus-newsrc-alist))
+				gnus-newsrc-hashtb))
+	     t)
+	    (insert ? ))
+	(gnus-group-change-level
+	 group gnus-level-killed gnus-level-default-subscribed)
+	(insert ?K)))
+    t))
+
+(defun gnus-browse-exit ()
+  "Quit browsing and return to the group buffer."
+  (interactive)
+  (when (eq major-mode 'gnus-browse-mode)
+    (kill-buffer (current-buffer)))
+  ;; Insert the newly subscribed groups in the group buffer.
+  (save-excursion
+    (set-buffer gnus-group-buffer)
+    (gnus-group-list-groups nil))
+  (if gnus-browse-return-buffer
+      (gnus-configure-windows 'server 'force)
+    (gnus-configure-windows 'group 'force)))
+
+(defun gnus-browse-describe-briefly ()
+  "Give a one line description of the group mode commands."
+  (interactive)
+  (gnus-message 6
+		(substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward  \\[gnus-group-prev-group]:Backward  \\[gnus-browse-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-browse-describe-briefly]:This help")))
+
+(provide 'gnus-srvr)
+
+;;; gnus-srvr.el ends here.
diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el
new file mode 100644
index 00000000000..774b149a5a4
--- /dev/null
+++ b/lisp/gnus-topic.el
@@ -0,0 +1,1057 @@
+;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+
+;; Author: Ilja Weis <kult@uni-paderborn.de>
+;;	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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-topic-mode nil
+  "Minor mode for Gnus group buffers.")
+
+(defvar gnus-topic-mode-hook nil
+  "Hook run in topic mode buffers.")
+
+(defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
+  "Format of topic lines.
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%i  Indentation based on topic level.
+%n  Topic name.
+%v  Nothing if the topic is visible, \"...\" otherwise.
+%g  Number of groups in the topic.
+%a  Number of unread articles in the groups in the topic.
+%A  Number of unread articles in the groups in the topic and its subtopics.
+")
+
+(defvar gnus-topic-indent-level 2
+  "*How much each subtopic should be indented.")
+
+;; Internal variables.
+
+(defvar gnus-topic-active-topology nil)
+(defvar gnus-topic-active-alist nil)
+
+(defvar gnus-topology-checked-p nil
+  "Whether the topology has been checked in this session.")
+
+(defvar gnus-topic-killed-topics nil)
+(defvar gnus-topic-inhibit-change-level nil)
+(defvar gnus-topic-tallied-groups nil)
+
+(defconst gnus-topic-line-format-alist
+  `((?n name ?s)
+    (?v visible ?s)
+    (?i indentation ?s)
+    (?g number-of-groups ?d)
+    (?a (gnus-topic-articles-in-topic entries) ?d)
+    (?A total-number-of-articles ?d)
+    (?l level ?d)))
+
+(defvar gnus-topic-line-format-spec nil)
+
+;; Functions.
+
+(defun gnus-group-topic-name ()
+  "The name of the topic on the current line."
+  (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+    (and topic (symbol-name topic))))
+
+(defun gnus-group-topic-level ()
+  "The level of the topic on the current line."
+  (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+
+(defun gnus-group-topic-unread ()
+  "The number of unread articles in topic on the current line."
+  (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
+
+(defun gnus-topic-unread (topic)
+  "Return the number of unread articles in TOPIC."
+  (or (save-excursion
+	(and (gnus-topic-goto-topic topic)
+	     (gnus-group-topic-unread)))
+      0))
+
+(defun gnus-topic-init-alist ()
+  "Initialize the topic structures."
+  (setq gnus-topic-topology
+	(cons (list "Gnus" 'visible)
+	      (mapcar (lambda (topic)
+			(list (list (car topic) 'visible)))
+		      '(("misc")))))
+  (setq gnus-topic-alist
+	(list (cons "misc"
+		    (mapcar (lambda (info) (gnus-info-group info))
+			    (cdr gnus-newsrc-alist)))
+	      (list "Gnus")))
+  (gnus-topic-enter-dribble))
+
+(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
+  "List all newsgroups with unread articles of level LEVEL or lower, and
+use the `gnus-group-topics' to sort the groups.
+If ALL is non-nil, list groups that have no unread articles.
+If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
+  (set-buffer gnus-group-buffer)
+  (let ((buffer-read-only nil)
+        (lowest (or lowest 1)))
+
+    (setq gnus-topic-tallied-groups nil)
+
+    (when (or (not gnus-topic-alist)
+	      (not gnus-topology-checked-p))
+      (gnus-topic-check-topology))
+
+    (unless list-topic 
+      (erase-buffer))
+    
+    ;; List dead groups?
+    (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
+      (gnus-group-prepare-flat-list-dead 
+       (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
+       gnus-level-zombie ?Z
+       regexp))
+    
+    (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
+      (gnus-group-prepare-flat-list-dead 
+       (setq gnus-killed-list (sort gnus-killed-list 'string<))
+       gnus-level-killed ?K
+       regexp))
+
+    ;; Use topics.
+    (when (< lowest gnus-level-zombie)
+      (if list-topic
+	  (let ((top (gnus-topic-find-topology list-topic)))
+	    (gnus-topic-prepare-topic (cdr top) (car top)
+				      (or topic-level level) all))
+	(gnus-topic-prepare-topic gnus-topic-topology 0
+				  (or topic-level level) all))))
+
+  (gnus-group-set-mode-line)
+  (setq gnus-group-list-mode (cons level all))
+  (run-hooks 'gnus-group-prepare-hook))
+
+(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent)
+  "Insert TOPIC into the group buffer.
+If SILENT, don't insert anything.  Return the number of unread
+articles in the topic and its subtopics."
+  (let* ((type (pop topicl))
+	 (entries (gnus-topic-find-groups (car type) list-level all))
+	 (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
+	 (gnus-group-indentation 
+	  (make-string (* gnus-topic-indent-level level) ? ))
+	 (beg (progn (beginning-of-line) (point)))
+	 (topicl (reverse topicl))
+	 (all-entries entries)
+	 (unread 0)
+	 (topic (car type))
+	 info entry end active)
+    ;; Insert any sub-topics.
+    (while topicl
+      (incf unread
+	    (gnus-topic-prepare-topic 
+	     (pop topicl) (1+ level) list-level all
+	     (not visiblep))))
+    (setq end (point))
+    (goto-char beg)
+    ;; Insert all the groups that belong in this topic.
+    (while (setq entry (pop entries))
+      (when visiblep 
+	(if (stringp entry)
+	    ;; Dead groups.
+	    (gnus-group-insert-group-line
+	     entry (if (member entry gnus-zombie-list) 8 9)
+	     nil (- (1+ (cdr (setq active (gnus-active entry))))
+		    (car active)) nil)
+	  ;; Living groups.
+	  (when (setq info (nth 2 entry))
+	    (gnus-group-insert-group-line 
+	     (gnus-info-group info)
+	     (gnus-info-level info) (gnus-info-marks info) 
+	     (car entry) (gnus-info-method info)))))
+      (when (and (listp entry)
+		 (numberp (car entry))
+		 (not (member (gnus-info-group (setq info (nth 2 entry)))
+			      gnus-topic-tallied-groups)))
+	(push (gnus-info-group info) gnus-topic-tallied-groups)
+	(incf unread (car entry))))
+    (goto-char beg)
+    ;; Insert the topic line.
+    (unless silent
+      (gnus-extent-start-open (point))
+      (gnus-topic-insert-topic-line 
+       (car type) visiblep
+       (not (eq (nth 2 type) 'hidden))
+       level all-entries unread))
+    (goto-char end)
+    unread))
+
+(defun gnus-topic-find-groups (topic &optional level all)
+  "Return entries for all visible groups in TOPIC."
+  (let ((groups (cdr (assoc topic gnus-topic-alist)))
+        info clevel unread group lowest params visible-groups entry active)
+    (setq lowest (or lowest 1))
+    (setq level (or level 7))
+    ;; We go through the newsrc to look for matches.
+    (while groups
+      (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
+	    info (nth 2 entry)
+	    params (gnus-info-params info)
+	    active (gnus-active group)
+            unread (or (car entry)
+		       (and (not (equal group "dummy.group"))
+			    active
+			    (- (1+ (cdr active)) (car active))))
+	    clevel (or (gnus-info-level info)
+		       (if (member group gnus-zombie-list) 8 9)))
+      (and 
+       unread				; nil means that the group is dead.
+       (<= clevel level) 
+       (>= clevel lowest)		; Is inside the level we want.
+       (or all
+	   (if (eq unread t)
+	       gnus-group-list-inactive-groups
+	     (> unread 0))
+	   (and gnus-list-groups-with-ticked-articles
+		(cdr (assq 'tick (gnus-info-marks info))))
+					; Has right readedness.
+	   ;; Check for permanent visibility.
+	   (and gnus-permanently-visible-groups
+		(string-match gnus-permanently-visible-groups group))
+	   (memq 'visible params)
+	   (cdr (assq 'visible params)))
+       ;; Add this group to the list of visible groups.
+       (push (or entry group) visible-groups)))
+    (nreverse visible-groups)))
+
+(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
+  "Remove the current topic."
+  (let ((topic (gnus-group-topic-name))
+	(level (gnus-group-topic-level))
+	(beg (progn (beginning-of-line) (point)))
+	buffer-read-only)
+    (when topic
+      (while (and (zerop (forward-line 1))
+		  (> (or (gnus-group-topic-level) (1+ level)) level)))
+      (delete-region beg (point))
+      (setcar (cdadr (gnus-topic-find-topology topic))
+	      (if insert 'visible 'invisible))
+      (when hide
+	(setcdr (cdadr (gnus-topic-find-topology topic))
+		(list hide)))
+      (unless total-remove
+	(gnus-topic-insert-topic topic in-level)))))
+
+(defun gnus-topic-insert-topic (topic &optional level)
+  "Insert TOPIC."
+  (gnus-group-prepare-topics 
+   (car gnus-group-list-mode) (cdr gnus-group-list-mode)
+   nil nil topic level))
+  
+(defun gnus-topic-fold (&optional insert)
+  "Remove/insert the current topic."
+  (let ((topic (gnus-group-topic-name))) 
+    (when topic
+      (save-excursion
+	(if (not (gnus-group-active-topic-p))
+	    (gnus-topic-remove-topic
+	     (or insert (not (gnus-topic-visible-p))))
+	  (let ((gnus-topic-topology gnus-topic-active-topology)
+		(gnus-topic-alist gnus-topic-active-alist)
+		(gnus-group-list-mode (cons 5 t)))
+	    (gnus-topic-remove-topic
+	     (or insert (not (gnus-topic-visible-p))) nil nil 9)))))))
+
+(defun gnus-group-topic-p ()
+  "Return non-nil if the current line is a topic."
+  (gnus-group-topic-name))
+
+(defun gnus-topic-visible-p ()
+  "Return non-nil if the current topic is visible."
+  (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
+
+(defun gnus-topic-insert-topic-line (name visiblep shownp level entries 
+					  &optional unread)
+  (let* ((visible (if visiblep "" "..."))
+	 (indentation (make-string (* gnus-topic-indent-level level) ? ))
+	 (total-number-of-articles unread)
+	 (number-of-groups (length entries))
+	 (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
+    (beginning-of-line)
+    ;; Insert the text.
+    (gnus-add-text-properties 
+     (point)
+     (prog1 (1+ (point)) 
+       (eval gnus-topic-line-format-spec)
+       (gnus-topic-remove-excess-properties)1)
+     (list 'gnus-topic (intern name)
+	   'gnus-topic-level level
+	   'gnus-topic-unread unread
+	   'gnus-active active-topic
+	   'gnus-topic-visible visiblep))))
+
+(defun gnus-topic-previous-topic (topic)
+  "Return the previous topic on the same level as TOPIC."
+  (let ((top (cddr (gnus-topic-find-topology
+		    (gnus-topic-parent-topic topic)))))
+    (unless (equal topic (caaar top))
+      (while (and top (not (equal (caaadr top) topic)))
+	(setq top (cdr top)))
+      (caaar top))))
+
+(defun gnus-topic-parent-topic (topic &optional topology)
+  "Return the parent of TOPIC."
+  (unless topology
+    (setq topology gnus-topic-topology))
+  (let ((parent (car (pop topology)))
+	result found)
+    (while (and topology
+		(not (setq found (equal (caaar topology) topic)))
+		(not (setq result (gnus-topic-parent-topic topic 
+							   (car topology)))))
+      (setq topology (cdr topology)))
+    (or result (and found parent))))
+
+(defun gnus-topic-next-topic (topic &optional previous)
+  "Return the next sibling of TOPIC."
+  (let ((topology gnus-topic-topology)
+	(parentt (cddr (gnus-topic-find-topology 
+			(gnus-topic-parent-topic topic))))
+	prev)
+    (while (and parentt
+		(not (equal (caaar parentt) topic)))
+      (setq prev (caaar parentt)
+	    parentt (cdr parentt)))
+    (if previous
+	prev
+      (caaadr parentt))))
+
+(defun gnus-topic-find-topology (topic &optional topology level remove)
+  "Return the topology of TOPIC."
+  (unless topology
+    (setq topology gnus-topic-topology)
+    (setq level 0))
+  (let ((top topology)
+	result)
+    (if (equal (caar topology) topic)
+	(progn
+	  (when remove
+	    (delq topology remove))
+	  (cons level topology))
+      (setq topology (cdr topology))
+      (while (and topology
+		  (not (setq result (gnus-topic-find-topology
+				     topic (car topology) (1+ level)
+				     (and remove top)))))
+	(setq topology (cdr topology)))
+      result)))
+
+(gnus-add-shutdown 'gnus-topic-close 'gnus)
+
+(defun gnus-topic-close ()
+  (setq gnus-topic-active-topology nil
+	gnus-topic-active-alist nil
+	gnus-topic-killed-topics nil
+	gnus-topic-tallied-groups nil
+	gnus-topology-checked-p nil))
+
+(defun gnus-topic-check-topology ()  
+  ;; The first time we set the topology to whatever we have
+  ;; gotten here, which can be rather random.
+  (unless gnus-topic-alist
+    (gnus-topic-init-alist))
+
+  (setq gnus-topology-checked-p t)
+  (let ((topics (gnus-topic-list))
+	(alist gnus-topic-alist)
+	changed)
+    (while alist
+      (unless (member (caar alist) topics)
+	(nconc gnus-topic-topology
+	       (list (list (list (caar alist) 'visible))))
+	(setq changed t))
+      (setq alist (cdr alist)))
+    (when changed
+      (gnus-topic-enter-dribble)))
+  (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
+					 gnus-topic-alist)))
+	 (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
+	 (newsrc gnus-newsrc-alist)
+	 group)
+    (while newsrc
+      (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
+	(setcdr entry (cons group (cdr entry)))))))
+
+(defvar gnus-tmp-topics nil)
+(defun gnus-topic-list (&optional topology)
+  (unless topology
+    (setq topology gnus-topic-topology 
+	  gnus-tmp-topics nil))
+  (push (caar topology) gnus-tmp-topics)
+  (mapcar 'gnus-topic-list (cdr topology))
+  gnus-tmp-topics)
+
+(defun gnus-topic-enter-dribble ()
+  (gnus-dribble-enter
+   (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
+
+(defun gnus-topic-articles-in-topic (entries)
+  (let ((total 0)
+	number)
+    (while entries
+      (when (numberp (setq number (car (pop entries))))
+	(incf total number)))
+    total))
+
+(defun gnus-group-topic (group)
+  "Return the topic GROUP is a member of."
+  (let ((alist gnus-topic-alist)
+	out)
+    (while alist
+      (when (member group (cdar alist))
+	(setq out (caar alist)
+	      alist nil))
+      (setq alist (cdr alist)))
+    out))
+
+(defun gnus-topic-goto-topic (topic)
+  "Go to TOPIC."
+  (when topic
+    (gnus-goto-char (text-property-any (point-min) (point-max)
+				       'gnus-topic (intern topic)))))
+
+(defun gnus-group-parent-topic ()
+  "Return the name of the current topic."
+  (let ((result
+	 (or (get-text-property (point) 'gnus-topic)
+	     (save-excursion
+	       (and (gnus-goto-char (previous-single-property-change
+				     (point) 'gnus-topic))
+		    (get-text-property (max (1- (point)) (point-min))
+				       'gnus-topic))))))
+    (when result
+      (symbol-name result))))
+  
+(defun gnus-topic-update-topic ()
+  "Update all parent topics to the current group."
+  (when (and (eq major-mode 'gnus-group-mode)
+	     gnus-topic-mode)
+    (let ((group (gnus-group-group-name))
+	  (buffer-read-only nil))
+      (when (and group (gnus-get-info group)
+		 (gnus-topic-goto-topic (gnus-group-parent-topic)))
+	(gnus-topic-update-topic-line (gnus-group-topic-name))
+	(gnus-group-goto-group group)
+	(gnus-group-position-point)))))
+
+(defun gnus-topic-goto-missing-group (group) 
+  "Place point where GROUP is supposed to be inserted."
+  (let* ((topic (gnus-group-topic group))
+	 (groups (cdr (assoc topic gnus-topic-alist)))
+	 (g (cdr (member group groups)))
+	 (unfound t))
+    (while (and g unfound)
+      (when (gnus-group-goto-group (pop g))
+	(beginning-of-line)
+	(setq unfound nil)))
+    (when unfound
+      (setq g (cdr (member group (reverse groups))))
+      (while (and g unfound)
+	(when (gnus-group-goto-group (pop g))
+	  (forward-line 1)
+	  (setq unfound nil)))
+      (when unfound
+	(gnus-topic-goto-topic topic)
+	(forward-line 1)))))
+
+(defun gnus-topic-update-topic-line (topic-name &optional reads)
+  (let* ((top (gnus-topic-find-topology topic-name))
+	 (type (cadr top))
+	 (children (cddr top))
+	 (entries (gnus-topic-find-groups 
+		   (car type) (car gnus-group-list-mode)
+		   (cdr gnus-group-list-mode)))
+	 (parent (gnus-topic-parent-topic topic-name))
+	 (all-entries entries)
+	 (unread 0)
+	 old-unread entry)
+    (when (gnus-topic-goto-topic (car type))
+      ;; Tally all the groups that belong in this topic.
+      (if reads
+	  (setq unread (- (gnus-group-topic-unread) reads))
+	(while children
+	  (incf unread (gnus-topic-unread (caar (pop children)))))
+	(while (setq entry (pop entries))
+	  (when (numberp (car entry))
+	    (incf unread (car entry)))))
+      (setq old-unread (gnus-group-topic-unread))
+      ;; Insert the topic line.
+      (gnus-topic-insert-topic-line 
+       (car type) (gnus-topic-visible-p)
+       (not (eq (nth 2 type) 'hidden))
+       (gnus-group-topic-level) all-entries unread)
+      (gnus-delete-line))
+    (when parent
+      (forward-line -1)
+      (gnus-topic-update-topic-line
+       parent (- old-unread (gnus-group-topic-unread))))
+    unread))
+
+(defun gnus-topic-grok-active (&optional force)
+  "Parse all active groups and create topic structures for them."
+  ;; First we make sure that we have really read the active file. 
+  (when (or force
+	    (not gnus-topic-active-alist))
+    (let (groups)
+      ;; Get a list of all groups available.
+      (mapatoms (lambda (g) (when (symbol-value g)
+			      (push (symbol-name g) groups)))
+		gnus-active-hashtb)
+      (setq groups (sort groups 'string<))
+      ;; Init the variables.
+      (setq gnus-topic-active-topology (list (list "" 'visible)))
+      (setq gnus-topic-active-alist nil)
+      ;; Descend the top-level hierarchy.
+      (gnus-topic-grok-active-1 gnus-topic-active-topology groups)
+      ;; Set the top-level topic names to something nice.
+      (setcar (car gnus-topic-active-topology) "Gnus active")
+      (setcar (car gnus-topic-active-alist) "Gnus active"))))
+
+(defun gnus-topic-grok-active-1 (topology groups)
+  (let* ((name (caar topology))
+	 (prefix (concat "^" (regexp-quote name)))
+	 tgroups ntopology group)
+    (while (and groups
+		(string-match prefix (setq group (car groups))))
+      (if (not (string-match "\\." group (match-end 0)))
+	  ;; There are no further hierarchies here, so we just
+	  ;; enter this group into the list belonging to this
+	  ;; topic.
+	  (push (pop groups) tgroups)
+	;; New sub-hierarchy, so we add it to the topology.
+	(nconc topology (list (setq ntopology 
+				    (list (list (substring 
+						 group 0 (match-end 0))
+						'invisible)))))
+	;; Descend the hierarchy.
+	(setq groups (gnus-topic-grok-active-1 ntopology groups))))
+    ;; We remove the trailing "." from the topic name.
+    (setq name
+	  (if (string-match "\\.$" name)
+	      (substring name 0 (match-beginning 0))
+	    name))
+    ;; Add this topic and its groups to the topic alist.
+    (push (cons name (nreverse tgroups)) gnus-topic-active-alist)
+    (setcar (car topology) name)
+    ;; We return the rest of the groups that didn't belong
+    ;; to this topic.
+    groups))
+
+(defun gnus-group-active-topic-p ()
+  "Return whether the current active comes from the active topics."
+  (save-excursion
+    (beginning-of-line)
+    (get-text-property (point) 'gnus-active)))
+
+;;; Topic mode, commands and keymap.
+
+(defvar gnus-topic-mode-map nil)
+(defvar gnus-group-topic-map nil)
+
+(unless gnus-topic-mode-map
+  (setq gnus-topic-mode-map (make-sparse-keymap))
+
+  ;; Override certain group mode keys.
+  (gnus-define-keys
+   gnus-topic-mode-map
+   "=" gnus-topic-select-group
+   "\r" gnus-topic-select-group
+   " " gnus-topic-read-group
+   "\C-k" gnus-topic-kill-group
+   "\C-y" gnus-topic-yank-group
+   "\M-g" gnus-topic-get-new-news-this-topic
+   "AT" gnus-topic-list-active
+   gnus-mouse-2 gnus-mouse-pick-topic)
+
+  ;; Define a new submap.
+  (gnus-define-keys
+   (gnus-group-topic-map "T" gnus-group-mode-map)
+   "#" gnus-topic-mark-topic
+   "\M-#" gnus-topic-unmark-topic
+   "n" gnus-topic-create-topic
+   "m" gnus-topic-move-group
+   "D" gnus-topic-remove-group
+   "c" gnus-topic-copy-group
+   "h" gnus-topic-hide-topic
+   "s" gnus-topic-show-topic
+   "M" gnus-topic-move-matching
+   "C" gnus-topic-copy-matching
+   "\C-i" gnus-topic-indent
+   [tab] gnus-topic-indent
+   "r" gnus-topic-rename
+   "\177" gnus-topic-delete))
+
+(defun gnus-topic-make-menu-bar ()
+  (unless (boundp 'gnus-topic-menu)
+    (easy-menu-define
+     gnus-topic-menu gnus-topic-mode-map ""
+     '("Topics"
+       ["Toggle topics" gnus-topic-mode t]
+       ("Groups"
+	["Copy" gnus-topic-copy-group t]
+	["Move" gnus-topic-move-group t]
+	["Remove" gnus-topic-remove-group t]
+	["Copy matching" gnus-topic-copy-matching t]
+	["Move matching" gnus-topic-move-matching t])
+       ("Topics"
+	["Show" gnus-topic-show-topic t]
+	["Hide" gnus-topic-hide-topic t]
+	["Delete" gnus-topic-delete t]
+	["Rename" gnus-topic-rename t]
+	["Create" gnus-topic-create-topic t]
+	["Mark" gnus-topic-mark-topic t]
+	["Indent" gnus-topic-indent t])
+       ["List active" gnus-topic-list-active t]))))
+
+(defun gnus-topic-mode (&optional arg redisplay)
+  "Minor mode for topicsifying Gnus group buffers."
+  (interactive (list current-prefix-arg t))
+  (when (eq major-mode 'gnus-group-mode)
+    (make-local-variable 'gnus-topic-mode)
+    (setq gnus-topic-mode 
+	  (if (null arg) (not gnus-topic-mode)
+	    (> (prefix-numeric-value arg) 0)))
+    ;; Infest Gnus with topics.
+    (when gnus-topic-mode
+      (when (and menu-bar-mode
+		 (gnus-visual-p 'topic-menu 'menu))
+	(gnus-topic-make-menu-bar))
+      (setq gnus-topic-line-format-spec 
+	    (gnus-parse-format gnus-topic-line-format 
+			       gnus-topic-line-format-alist t))
+      (unless (assq 'gnus-topic-mode minor-mode-alist)
+	(push '(gnus-topic-mode " Topic") minor-mode-alist))
+      (unless (assq 'gnus-topic-mode minor-mode-map-alist)
+	(push (cons 'gnus-topic-mode gnus-topic-mode-map)
+	      minor-mode-map-alist))
+      (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
+      (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
+      (add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic)
+      (make-local-variable 'gnus-group-prepare-function)
+      (setq gnus-group-prepare-function 'gnus-group-prepare-topics)
+      (make-local-variable 'gnus-group-goto-next-group-function)
+      (setq gnus-group-goto-next-group-function 
+	    'gnus-topic-goto-next-group)
+      (setq gnus-group-change-level-function 'gnus-topic-change-level)
+      (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
+      (make-local-variable 'gnus-group-indentation-function)
+      (setq gnus-group-indentation-function
+	    'gnus-topic-group-indentation)
+      (setq gnus-topology-checked-p nil)
+      ;; We check the topology.
+      (when gnus-newsrc-alist
+	(gnus-topic-check-topology))
+      (run-hooks 'gnus-topic-mode-hook))
+    ;; Remove topic infestation.
+    (unless gnus-topic-mode
+      (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
+      (remove-hook 'gnus-group-change-level-function 
+		   'gnus-topic-change-level)
+      (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
+    (when redisplay
+      (gnus-group-list-groups))))
+    
+(defun gnus-topic-select-group (&optional all)
+  "Select this newsgroup.
+No article is selected automatically.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles."
+  (interactive "P")
+  (if (gnus-group-topic-p)
+      (let ((gnus-group-list-mode 
+	     (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
+	(gnus-topic-fold all))
+    (gnus-group-select-group all)))
+
+(defun gnus-mouse-pick-topic (e)
+  "Select the group or topic under the mouse pointer."
+  (interactive "e")
+  (mouse-set-point e)
+  (gnus-topic-read-group nil))
+
+(defun gnus-topic-read-group (&optional all no-article group)
+  "Read news in this newsgroup.
+If the prefix argument ALL is non-nil, already read articles become
+readable.  IF ALL is a number, fetch this number of articles.  If the
+optional argument NO-ARTICLE is non-nil, no article will be
+auto-selected upon group entry.  If GROUP is non-nil, fetch that
+group."
+  (interactive "P")
+  (if (gnus-group-topic-p)
+      (let ((gnus-group-list-mode 
+	     (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
+	(gnus-topic-fold all))
+    (gnus-group-read-group all no-article group)))
+
+(defun gnus-topic-create-topic (topic parent &optional previous full-topic)
+  (interactive 
+   (list
+    (read-string "New topic: ")
+    (gnus-group-parent-topic)))
+  ;; Check whether this topic already exists.
+  (when (gnus-topic-find-topology topic)
+    (error "Topic aleady exists"))
+  (unless parent
+    (setq parent (caar gnus-topic-topology)))
+  (let ((top (cdr (gnus-topic-find-topology parent)))
+	(full-topic (or full-topic `((,topic visible)))))
+    (unless top
+      (error "No such parent topic: %s" parent))
+    (if previous
+	(progn
+	  (while (and (cdr top)
+		      (not (equal (caaadr top) previous)))
+	    (setq top (cdr top)))
+	  (setcdr top (cons full-topic (cdr top))))
+      (nconc top (list full-topic)))
+    (unless (assoc topic gnus-topic-alist)
+      (push (list topic) gnus-topic-alist)))
+  (gnus-topic-enter-dribble)
+  (gnus-group-list-groups)
+  (gnus-topic-goto-topic topic))
+
+(defun gnus-topic-move-group (n topic &optional copyp)
+  "Move the next N groups to TOPIC.
+If COPYP, copy the groups instead."
+  (interactive
+   (list current-prefix-arg
+	 (completing-read "Move to topic: " gnus-topic-alist nil t)))
+  (let ((groups (gnus-group-process-prefix n))
+	(topicl (assoc topic gnus-topic-alist))
+	entry)
+    (mapcar (lambda (g) 
+	      (gnus-group-remove-mark g)
+	      (when (and
+		     (setq entry (assoc (gnus-group-parent-topic)
+					gnus-topic-alist))
+		     (not copyp))
+		(setcdr entry (gnus-delete-first g (cdr entry))))
+	      (nconc topicl (list g)))
+	    groups)
+    (gnus-group-position-point))
+  (gnus-topic-enter-dribble)
+  (gnus-group-list-groups))
+
+(defun gnus-topic-remove-group ()
+  "Remove the current group from the topic."
+  (interactive)
+  (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist))
+	(group (gnus-group-group-name))
+	(buffer-read-only nil))
+    (when (and topicl group)
+      (gnus-delete-line)
+      (gnus-delete-first group topicl))
+    (gnus-group-position-point)))
+
+(defun gnus-topic-copy-group (n topic)
+  "Copy the current group to a topic."
+  (interactive
+   (list current-prefix-arg
+	 (completing-read "Copy to topic: " gnus-topic-alist nil t)))
+  (gnus-topic-move-group n topic t))
+
+(defun gnus-topic-group-indentation ()
+  (make-string 
+   (* gnus-topic-indent-level
+      (or (save-excursion
+	    (gnus-topic-goto-topic (gnus-group-parent-topic))
+	    (gnus-group-topic-level)) 0)) ? ))
+
+(defun gnus-topic-change-level (group level oldlevel)
+  "Run when changing levels to enter/remove groups from topics."
+  (save-excursion
+    (set-buffer gnus-group-buffer)
+    (when (and gnus-topic-mode 
+	       gnus-topic-alist
+	       (not gnus-topic-inhibit-change-level))
+      ;; Remove the group from the topics.
+      (when (and (< oldlevel gnus-level-zombie)
+		 (>= level gnus-level-zombie))
+	(let (alist)
+	  (forward-line -1)
+	  (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist))
+	    (setcdr alist (gnus-delete-first group (cdr alist))))))
+      ;; If the group is subscribed. then we enter it into the topics.
+      (when (and (< level gnus-level-zombie)
+		 (>= oldlevel gnus-level-zombie))
+	(let* ((prev (gnus-group-group-name))
+	       (gnus-topic-inhibit-change-level t)
+	       (gnus-group-indentation
+		(make-string 
+		 (* gnus-topic-indent-level
+		    (or (save-excursion
+			  (gnus-topic-goto-topic (gnus-group-parent-topic))
+			  (gnus-group-topic-level)) 0)) ? ))
+	       (yanked (list group))
+	       alist talist end)
+	  ;; Then we enter the yanked groups into the topics they belong
+	  ;; to. 
+	  (when (setq alist (assoc (save-excursion
+				     (forward-line -1)
+				     (or
+				      (gnus-group-parent-topic)
+				      (caar gnus-topic-topology)))
+				   gnus-topic-alist))
+	    (setq talist alist)
+	    (when (stringp yanked)
+	      (setq yanked (list yanked)))
+	    (if (not prev)
+		(nconc alist yanked)
+	      (if (not (cdr alist))
+		  (setcdr alist (nconc yanked (cdr alist)))
+		(while (and (not end) (cdr alist))
+		  (when (equal (cadr alist) prev)
+		    (setcdr alist (nconc yanked (cdr alist)))
+		    (setq end t))
+		  (setq alist (cdr alist)))
+		(unless end
+		  (nconc talist yanked))))))
+	(gnus-topic-update-topic)))))
+
+(defun gnus-topic-goto-next-group (group props)
+  "Go to group or the next group after group."
+  (if (null group)
+      (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
+    (if (gnus-group-goto-group group)
+	t
+      ;; The group is no longer visible.
+      (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist))
+	     (after (cdr (member group (cdr list)))))
+	;; First try to put point on a group after the current one.
+	(while (and after
+		    (not (gnus-group-goto-group (car after))))
+	  (setq after (cdr after)))
+	;; Then try to put point on a group before point.
+	(unless after
+	  (setq after (cdr (member group (reverse (cdr list)))))
+	  (while (and after 
+		      (not (gnus-group-goto-group (car after))))
+	    (setq after (cdr after))))
+	;; Finally, just put point on the topic.
+	(unless after
+	  (gnus-topic-goto-topic (car list))
+	  (setq after nil))
+	t))))
+
+(defun gnus-topic-kill-group (&optional n discard)
+  "Kill the next N groups."
+  (interactive "P")
+  (if (gnus-group-topic-p)
+      (let ((topic (gnus-group-topic-name)))
+	(gnus-topic-remove-topic nil t)
+	(push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
+	      gnus-topic-killed-topics))
+    (gnus-group-kill-group n discard)
+    (gnus-topic-update-topic)))
+  
+(defun gnus-topic-yank-group (&optional arg)
+  "Yank the last topic."
+  (interactive "p")
+  (if gnus-topic-killed-topics
+      (let ((previous 
+	     (or (gnus-group-topic-name)
+		 (gnus-topic-next-topic (gnus-group-parent-topic))))
+	    (item (cdr (pop gnus-topic-killed-topics))))
+	(gnus-topic-create-topic
+	 (caar item) (gnus-topic-parent-topic previous) previous
+	 item)
+	(gnus-topic-goto-topic (caar item)))
+    (let* ((prev (gnus-group-group-name))
+	   (gnus-topic-inhibit-change-level t)
+	   (gnus-group-indentation
+	    (make-string 
+	     (* gnus-topic-indent-level
+		(or (save-excursion
+		      (gnus-topic-goto-topic (gnus-group-parent-topic))
+		      (gnus-group-topic-level)) 0)) ? ))
+	   yanked alist)
+      ;; We first yank the groups the normal way...
+      (setq yanked (gnus-group-yank-group arg))
+      ;; Then we enter the yanked groups into the topics they belong
+      ;; to. 
+      (setq alist (assoc (save-excursion
+			   (forward-line -1)
+			   (gnus-group-parent-topic))
+			 gnus-topic-alist))
+      (when (stringp yanked)
+	(setq yanked (list yanked)))
+      (if (not prev)
+	  (nconc alist yanked)
+	(if (not (cdr alist))
+	    (setcdr alist (nconc yanked (cdr alist)))
+	  (while (cdr alist)
+	    (when (equal (cadr alist) prev)
+	      (setcdr alist (nconc yanked (cdr alist)))
+	      (setq alist nil))
+	    (setq alist (cdr alist))))))
+    (gnus-topic-update-topic)))
+
+(defun gnus-topic-hide-topic ()
+  "Hide all subtopics under the current topic."
+  (interactive)
+  (when (gnus-group-parent-topic)
+    (gnus-topic-goto-topic (gnus-group-parent-topic))
+    (gnus-topic-remove-topic nil nil 'hidden)))
+
+(defun gnus-topic-show-topic ()
+  "Show the hidden topic."
+  (interactive)
+  (when (gnus-group-topic-p)
+    (gnus-topic-remove-topic t nil 'shown)))
+
+(defun gnus-topic-mark-topic (topic &optional unmark)
+  "Mark all groups in the topic with the process mark."
+  (interactive (list (gnus-group-parent-topic)))
+  (save-excursion
+    (let ((groups (gnus-topic-find-groups topic 9 t)))
+      (while groups
+	(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
+		 (gnus-info-group (nth 2 (pop groups))))))))
+
+(defun gnus-topic-unmark-topic (topic &optional unmark)
+  "Remove the process mark from all groups in the topic."
+  (interactive (list (gnus-group-parent-topic)))
+  (gnus-topic-mark-topic topic t))
+
+(defun gnus-topic-get-new-news-this-topic (&optional n)
+  "Check for new news in the current topic."
+  (interactive "P")
+  (if (not (gnus-group-topic-p))
+      (gnus-group-get-new-news-this-group n)
+    (gnus-topic-mark-topic (gnus-group-topic-name))
+    (gnus-group-get-new-news-this-group)))
+
+(defun gnus-topic-move-matching (regexp topic &optional copyp)
+  "Move all groups that match REGEXP to some topic."
+  (interactive
+   (let (topic)
+     (nreverse
+      (list
+       (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
+       (read-string (format "Move to %s (regexp): " topic))))))
+  (gnus-group-mark-regexp regexp)
+  (gnus-topic-move-group nil topic copyp))
+
+(defun gnus-topic-copy-matching (regexp topic &optional copyp)
+  "Copy all groups that match REGEXP to some topic."
+  (interactive
+   (let (topic)
+     (nreverse
+      (list
+       (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
+       (read-string (format "Copy to %s (regexp): " topic))))))
+  (gnus-topic-move-matching regexp topic t))
+
+(defun gnus-topic-delete (topic)
+  "Delete a topic."
+  (interactive (list (gnus-group-topic-name)))
+  (unless topic
+    (error "No topic to be deleted"))
+  (let ((entry (assoc topic gnus-topic-alist))
+	(buffer-read-only nil))
+    (when (cdr entry)
+      (error "Topic not empty"))
+    ;; Delete if visible.
+    (when (gnus-topic-goto-topic topic)
+      (gnus-delete-line))
+    ;; Remove from alist.
+    (setq gnus-topic-alist (delq entry gnus-topic-alist))
+    ;; Remove from topology.
+    (gnus-topic-find-topology topic nil nil 'delete)))
+
+(defun gnus-topic-rename (old-name new-name)
+  "Rename a topic."
+  (interactive
+   (let ((topic (gnus-group-parent-topic)))
+     (list topic
+	   (read-string (format "Rename %s to: " topic)))))
+  (let ((top (gnus-topic-find-topology old-name))
+	(entry (assoc old-name gnus-topic-alist)))
+    (when top
+      (setcar (cadr top) new-name))
+    (when entry 
+      (setcar entry new-name))
+    (gnus-group-list-groups)))
+
+(defun gnus-topic-indent (&optional unindent)
+  "Indent a topic -- make it a sub-topic of the previous topic.
+If UNINDENT, remove an indentation."
+  (interactive "P")
+  (if unindent
+      (gnus-topic-unindent)
+    (let* ((topic (gnus-group-parent-topic))
+	   (parent (gnus-topic-previous-topic topic)))
+      (unless parent
+	(error "Nothing to indent %s into" topic))
+      (when topic
+	(gnus-topic-goto-topic topic)
+	(gnus-topic-kill-group)
+	(gnus-topic-create-topic
+	 topic parent nil (cdr (pop gnus-topic-killed-topics)))
+	(or (gnus-topic-goto-topic topic)
+	    (gnus-topic-goto-topic parent))))))
+
+(defun gnus-topic-unindent ()
+  "Unindent a topic."
+  (interactive)
+  (let* ((topic (gnus-group-parent-topic))
+	 (parent (gnus-topic-parent-topic topic))
+	 (grandparent (gnus-topic-parent-topic parent)))
+    (unless grandparent
+      (error "Nothing to indent %s into" topic))
+    (when topic
+      (gnus-topic-goto-topic topic)
+      (gnus-topic-kill-group)
+      (gnus-topic-create-topic
+       topic grandparent (gnus-topic-next-topic parent)
+       (cdr (pop gnus-topic-killed-topics)))
+      (gnus-topic-goto-topic topic))))
+
+(defun gnus-topic-list-active (&optional force)
+  "List all groups that Gnus knows about in a topicsified fashion.
+If FORCE, always re-read the active file."
+  (interactive "P")
+  (when force
+    (gnus-get-killed-groups))
+  (gnus-topic-grok-active force)
+  (let ((gnus-topic-topology gnus-topic-active-topology)
+	(gnus-topic-alist gnus-topic-active-alist)
+	gnus-killed-list gnus-zombie-list)
+    (gnus-group-list-groups 9 nil 1)))
+
+(provide 'gnus-topic)
+
+;;; gnus-topic.el ends here
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
new file mode 100644
index 00000000000..fa0265faf41
--- /dev/null
+++ b/lisp/mail/mailheader.el
@@ -0,0 +1,182 @@
+;;; mail-header.el --- Mail header parsing, merging, formatting
+
+;; Copyright (C) 1996 by Free Software Foundation, Inc.
+
+;; Author: Erik Naggum <erik@arcana.naggum.no>
+;; Keywords: tools, mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides an abstraction to RFC822-style messages, used in
+;; mail news, and some other systems.  The simple syntactic rules for such
+;; headers, such as quoting and line folding, are routinely reimplemented
+;; in many individual packages.  This package removes the need for this
+;; redundancy by representing message headers as association lists,
+;; offering functions to extract the set of headers from a message, to
+;; parse individual headers, to merge sets of headers, and to format a set
+;; of headers.
+
+;; The car of each element in the message-header alist is a symbol whose
+;; print name is the name of the header, in all lower-case.  The cdr of an
+;; element depends on the operation.  After extracting headers from a
+;; messge, it is a string, the value of the header.  An extracted set of
+;; headers may be parsed further, which may turn it into a list, whose car
+;; is the original value and whose subsequent elements depend on the
+;; header.  For formatting, it is evaluated to obtain the strings to be
+;; inserted.  For merging, one set of headers consists of strings, while
+;; the other set will be evaluated with the symbols in the first set of
+;; headers bound to their respective values.
+
+;;; Code:
+
+(require 'cl)
+
+;; Make the byte-compiler shut up.
+(defvar headers)
+
+(defun mail-header-extract ()
+  "Extract headers from current buffer after point.
+Returns a header alist, where each element is a cons cell (name . value),
+where NAME is a symbol, and VALUE is the string value of the header having
+that name."
+  (let ((message-headers ()) (top (point))
+	start end)
+    (while (and (setq start (point))
+		(> (skip-chars-forward "^\0- :") 0)
+		(= (following-char) ?:)
+		(setq end (point))
+		(progn (forward-char) 
+		       (> (skip-chars-forward " \t") 0)))
+      (let ((header (intern (downcase (buffer-substring start end))))
+	    (value (list (buffer-substring
+			  (point) (progn (end-of-line) (point))))))
+	(while (progn (forward-char) (> (skip-chars-forward " \t") 0))
+	  (push (buffer-substring (point) (progn (end-of-line) (point)))
+		value))
+	(push (if (cdr value)
+		  (cons header (mapconcat #'identity (nreverse value) " "))
+		  (cons header (car value)))
+	      message-headers)))
+    (goto-char top)
+    (nreverse message-headers)))
+
+(defun mail-header-extract-no-properties ()
+  "Extract headers from current buffer after point, without properties.
+Returns a header alist, where each element is a cons cell (name . value),
+where NAME is a symbol, and VALUE is the string value of the header having
+that name."
+  (mapcar
+   (lambda (elt)
+     (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
+     elt)
+   (mail-header-extract)))
+
+(defun mail-header-parse (parsing-rules headers)
+  "Apply PARSING-RULES to HEADERS.
+PARSING-RULES is an alist whose keys are header names (symbols) and whose
+value is a parsing function.  The function takes one argument, a string,
+and return a list of values, which will destructively replace the value
+associated with the key in HEADERS, after being prepended with the original
+value."
+  (dolist (rule parsing-rules)
+    (let ((header (assq (car rule) headers)))
+      (when header
+	(if (consp (cdr header))
+	    (setf (cddr header) (funcall (cdr rule) (cadr header)))
+	  (setf (cdr header)
+		(cons (cdr header) (funcall (cdr rule) (cdr header))))))))
+  headers)
+
+(defsubst mail-header (header &optional header-alist)
+  "Return the value associated with header HEADER in HEADER-ALIST.
+If the value is a string, it is the original value of the header.  If the
+value is a list, its first element is the original value of the header,
+with any subsequent elements bing the result of parsing the value.
+If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+  (cdr (assq header (or header-alist headers))))
+
+(defun mail-header-set (header value &optional header-alist)
+  "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
+HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
+See `mail-header' for the semantics of VALUE."
+  (let* ((alist (or header-alist headers))
+	(entry (assq header alist)))
+    (if entry
+	(setf (cdr entry) value)
+	(nconc alist (list (cons header value)))))
+  value)
+
+(defsetf mail-header (header &optional header-alist) (value)
+  `(mail-header-set ,header ,value ,header-alist))
+
+(defun mail-header-merge (merge-rules headers)
+  "Return a new header alist with MERGE-RULES applied to HEADERS.
+MERGE-RULES is an alist whose keys are header names (symbols) and whose
+values are forms to evaluate, the results of which are the new headers.  It
+should be a string or a list of string.  The first element may be nil to
+denote that the formatting functions must use the remaining elements, or
+skip the header altogether if there are no other elements.
+  The macro `mail-header' can be used to access headers in HEADERS."
+  (mapcar
+   (lambda (rule)
+     (cons (car rule) (eval (cdr rule))))
+   merge-rules))
+
+(defvar mail-header-format-function
+  (lambda (header value)
+    "Function to format headers without a specified formatting function."
+    (insert (capitalize (symbol-name header))
+	    ": "
+	    (if (consp value) (car value) value)
+	    "\n")))
+
+(defun mail-header-format (format-rules headers)
+  "Use FORMAT-RULES to format HEADERS and insert into current buffer.
+FORMAT-RULES is an alist whose keys are header names (symbols), and whose
+values are functions that format the header, the results of which are
+inserted, unless it is nil.  The function takes two arguments, the header
+symbol, and the value of that header.  If the function itself is nil, the
+default action is to insert the value of the header, unless it is nil.
+The headers are inserted in the order of the FORMAT-RULES.
+A key of t represents any otherwise unmentioned headers.
+A key of nil has as its value a list of defaulted headers to ignore."
+  (let ((ignore (append (cdr (assq nil format-rules))
+			(mapcar #'car format-rules))))
+    (dolist (rule format-rules)
+      (let* ((header (car rule))
+	    (value (mail-header header)))
+	(cond ((null header) 'ignore)
+	      ((eq header t)
+	       (dolist (defaulted headers)
+		 (unless (memq (car defaulted) ignore)
+		   (let* ((header (car defaulted))
+			  (value (cdr defaulted)))
+		     (if (cdr rule)
+			 (funcall (cdr rule) header value)
+			 (funcall mail-header-format-function header value))))))
+	      (value
+	       (if (cdr rule)
+		   (funcall (cdr rule) header value)
+		   (funcall mail-header-format-function header value))))))
+    (insert "\n")))
+
+(provide 'mailheader)
+
+;;; mail-header.el ends here
diff --git a/lisp/message.el b/lisp/message.el
new file mode 100644
index 00000000000..0e94d64b402
--- /dev/null
+++ b/lisp/message.el
@@ -0,0 +1,2997 @@
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This mode provides mail-sending facilities from within Emacs.  It
+;; consists mainly of large chunks of code from the sendmail.el,
+;; gnus-msg.el and rnewspost.el files.
+
+;;; Code:
+
+(eval-when-compile 
+  (require 'cl))
+(require 'mailheader)
+(require 'rmail)
+(require 'nnheader)
+(require 'timezone)
+(require 'easymenu)
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+    (require 'mail-abbrevs)
+  (require 'mailabbrev))
+
+;;;###autoload
+(defvar message-directory "~/Mail/"
+  "*Directory from which all other mail file variables are derived.")
+
+(defvar message-max-buffers 10
+  "*How many buffers to keep before starting to kill them off.")
+
+(defvar message-send-rename-function nil
+  "Function called to rename the buffer after sending it.")
+
+;;;###autoload
+(defvar message-fcc-handler-function 'rmail-output
+  "*A function called to save outgoing articles.
+This function will be called with the name of the file to store the
+article in. The default function is `rmail-output' which saves in Unix
+mailbox format.")
+
+;;;###autoload
+(defvar message-courtesy-message
+  "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
+  "*This is inserted at the start of a mailed copy of a posted message.
+If this variable is nil, no such courtesy message will be added.")
+
+;;;###autoload
+(defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
+  "*Regexp that matches headers to be removed in resent bounced mail.")
+
+;;;###autoload
+(defvar message-from-style 'default
+  "*Specifies how \"From\" headers look.
+
+If `nil', they contain just the return address like:
+	king@grassland.com
+If `parens', they look like:
+	king@grassland.com (Elvis Parsley)
+If `angles', they look like:
+	Elvis Parsley <king@grassland.com>
+
+Otherwise, most addresses look like `angles', but they look like
+`parens' if `angles' would need quoting and `parens' would not.")
+
+;;;###autoload
+(defvar message-syntax-checks nil
+  "Controls what syntax checks should not be performed on outgoing posts.
+To disable checking of long signatures, for instance, add
+ `(signature . disabled)' to this list.
+
+Don't touch this variable unless you really know what you're doing.
+
+Checks include subject-cmsg multiple-headers sendsys message-id from
+long-lines control-chars size new-text redirected-followup signature
+approved sender empty empty-headers message-id from subject.")
+
+;;;###autoload
+(defvar message-required-news-headers
+  '(From Newsgroups Subject Date Message-ID 
+	 (optional . Organization) Lines 
+	 (optional . X-Newsreader))
+  "*Headers to be generated or prompted for when posting an article.
+RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
+Message-ID.  Organization, Lines, In-Reply-To, Expires, and
+X-Newsreader are optional.  If don't you want message to insert some
+header, remove it from this list.")
+
+;;;###autoload
+(defvar message-required-mail-headers 
+  '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+	 (optional . X-Mailer))
+  "*Headers to be generated or prompted for when mailing a message.
+RFC822 required that From, Date, To, Subject and Message-ID be
+included.  Organization, Lines and X-Mailer are optional.")
+
+;;;###autoload
+(defvar message-deletable-headers '(Message-ID Date)
+  "*Headers to be deleted if they already exist and were generated by message previously.")
+
+;;;###autoload
+(defvar message-ignored-news-headers 
+  "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:"
+  "*Regexp of headers to be removed unconditionally before posting.")
+
+;;;###autoload
+(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:"
+  "*Regexp of headers to be removed unconditionally before mailing.")
+
+;;;###autoload
+(defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:"
+  "*Header lines matching this regexp will be deleted before posting.
+It's best to delete old Path and Date headers before posting to avoid
+any confusion.")
+
+;;;###autoload
+(defvar message-signature-separator "^-- *$"
+  "Regexp matching the signature separator.")
+
+;;;###autoload
+(defvar message-interactive nil 
+  "Non-nil means when sending a message wait for and display errors.
+nil means let mailer mail back a message to report errors.")
+
+;;;###autoload
+(defvar message-generate-new-buffers t
+  "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
+If this is a function, call that function with three parameters:  The type,
+the to address and the group name.  (Any of these may be nil.)  The function
+should return the new buffer name.")
+
+;;;###autoload
+(defvar message-kill-buffer-on-exit nil
+  "*Non-nil means that the message buffer will be killed after sending a message.")
+
+(defvar gnus-local-organization)
+(defvar message-user-organization 
+  (or (and (boundp 'gnus-local-organization)
+	   gnus-local-organization)
+      (getenv "ORGANIZATION")
+      t)
+  "*String to be used as an Organization header.
+If t, use `message-user-organization-file'.")
+
+;;;###autoload
+(defvar message-user-organization-file "/usr/lib/news/organization"
+  "*Local news organization file.")
+
+;;;###autoload
+(defvar message-autosave-directory
+  (concat (file-name-as-directory message-directory) "drafts/")
+  "*Directory where message autosaves buffers.
+If nil, message won't autosave.")
+
+(defvar message-forward-start-separator 
+  "------- Start of forwarded message -------\n"
+  "*Delimiter inserted before forwarded messages.")
+
+(defvar message-forward-end-separator
+  "------- End of forwarded message -------\n"
+  "*Delimiter inserted after forwarded messages.")
+
+;;;###autoload
+(defvar message-signature-before-forwarded-message t
+  "*If non-nil, put the signature before any included forwarded message.")
+
+;;;###autoload
+(defvar message-included-forward-headers 
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:"
+  "*Regexp matching headers to be included in forwarded messages.")
+
+;;;###autoload
+(defvar message-ignored-resent-headers "^Return-receipt"
+  "*All headers that match this regexp will be deleted when resending a message.")
+
+;;;###autoload
+(defvar message-ignored-cited-headers "."
+  "Delete these headers from the messages you yank.")
+
+;; Useful to set in site-init.el
+;;;###autoload
+(defvar message-send-mail-function 'message-send-mail-with-sendmail
+  "Function to call to send the current buffer as mail.
+The headers should be delimited by a line whose contents match the
+variable `mail-header-separator'.
+
+Legal values include `message-send-mail-with-mh' and
+`message-send-mail-with-sendmail', which is the default.")
+
+;;;###autoload
+(defvar message-send-news-function 'message-send-news
+  "Function to call to send the current buffer as news.
+The headers should be delimited by a line whose contents match the
+variable `mail-header-separator'.")
+
+;;;###autoload
+(defvar message-reply-to-function nil
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+
+;;;###autoload
+(defvar message-wide-reply-to-function nil
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+
+;;;###autoload
+(defvar message-followup-to-function nil
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+
+;;;###autoload
+(defvar message-use-followup-to 'ask
+  "*Specifies what to do with Followup-To header.
+If nil, ignore the header. If it is t, use its value, but query before
+using the \"poster\" value.  If it is the symbol `ask', query the user
+whether to ignore the \"poster\" value.  If it is the symbol `use',
+always use the value.")
+
+(defvar gnus-post-method)
+(defvar gnus-select-method)
+;;;###autoload
+(defvar message-post-method 
+  (cond ((and (boundp 'gnus-post-method)
+	      gnus-post-method)
+	 gnus-post-method)
+	((boundp 'gnus-select-method)
+	 gnus-select-method)
+	(t '(nnspool "")))
+  "Method used to post news.")
+
+;;;###autoload
+(defvar message-generate-headers-first nil
+  "*If non-nil, generate all possible headers before composing.")
+
+(defvar message-setup-hook nil
+  "Normal hook, run each time a new outgoing message is initialized.
+The function `message-setup' runs this hook.")
+
+(defvar message-signature-setup-hook nil
+  "Normal hook, run each time a new outgoing message is initialized.
+It is run after the headers have been inserted and before 
+the signature is inserted.")
+
+(defvar message-mode-hook nil
+  "Hook run in message mode buffers.")
+
+(defvar message-header-hook nil
+  "Hook run in a message mode buffer narrowed to the headers.")
+
+(defvar message-header-setup-hook nil
+  "Hook called narrowed to the headers when setting up a message buffer.")
+
+;;;###autoload
+(defvar message-citation-line-function 'message-insert-citation-line
+  "*Function called to insert the \"Whomever writes:\" line.")
+
+;;;###autoload
+(defvar message-yank-prefix "> "
+  "*Prefix inserted on the lines of yanked messages.
+nil means use indentation.")
+
+(defvar message-indentation-spaces 3
+  "*Number of spaces to insert at the beginning of each cited line.
+Used by `message-yank-original' via `message-yank-cite'.")
+
+;;;###autoload
+(defvar message-cite-function 'message-cite-original
+  "*Function for citing an original message.")
+
+;;;###autoload
+(defvar message-indent-citation-function 'message-indent-citation
+  "*Function for modifying a citation just inserted in the mail buffer.
+This can also be a list of functions.  Each function can find the
+citation between (point) and (mark t).  And each function should leave
+point and mark around the citation text as modified.")
+
+(defvar message-abbrevs-loaded nil)
+
+;;;###autoload
+(defvar message-signature t
+  "*String to be inserted at the end of the message buffer.
+If t, the `message-signature-file' file will be inserted instead.
+If a function, the result from the function will be used instead.
+If a form, the result from the form will be used instead.")
+
+;;;###autoload
+(defvar message-signature-file "~/.signature"
+  "*File containing the text inserted at end of message. buffer.")
+
+(defvar message-distribution-function nil
+  "*Function called to return a Distribution header.")
+
+(defvar message-expires 14
+  "*Number of days before your article expires.")
+
+(defvar message-user-path nil
+  "If nil, use the NNTP server name in the Path header.
+If stringp, use this; if non-nil, use no host name (user name only).")
+
+(defvar message-reply-buffer nil)
+(defvar message-reply-headers nil)
+(defvar message-newsreader nil)
+(defvar message-mailer nil)
+(defvar message-sent-message-via nil)
+(defvar message-checksum nil)
+(defvar message-send-actions nil
+  "A list of actions to be performed upon successful sending of a message.")
+(defvar message-exit-actions nil
+  "A list of actions to be performed upon exiting after sending a message.")
+(defvar message-kill-actions nil
+  "A list of actions to be performed before killing a message buffer.")
+(defvar message-postpone-actions nil
+  "A list of actions to be performed after postponing a message.")
+
+;;;###autoload
+(defvar message-default-headers nil
+  "*A string containing header lines to be inserted in outgoing messages.
+It is inserted before you edit the message, so you can edit or delete
+these lines.")
+
+;;;###autoload
+(defvar message-default-mail-headers nil
+  "*A string of header lines to be inserted in outgoing mails.")
+
+;;;###autoload
+(defvar message-default-news-headers nil
+  "*A string of header lines to be inserted in outgoing news articles.")
+
+;; Note: could use /usr/ucb/mail instead of sendmail;
+;; options -t, and -v if not interactive.
+(defvar message-mailer-swallows-blank-line
+  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" 
+			 system-configuration)
+	   (file-readable-p "/etc/sendmail.cf")
+	   (let ((buffer (get-buffer-create " *temp*")))
+	     (unwind-protect
+		 (save-excursion
+		   (set-buffer buffer)
+		   (insert-file-contents "/etc/sendmail.cf")
+		   (goto-char (point-min))
+		   (let ((case-fold-search nil))
+		     (re-search-forward "^OR\\>" nil t)))
+	       (kill-buffer buffer))))
+      ;; According to RFC822, "The field-name must be composed of printable
+      ;; ASCII characters (i.e. characters that have decimal values between
+      ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
+      ;; space, or colon.
+      '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
+  "Set this non-nil if the system's mailer runs the header and body together.
+\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
+The value should be an expression to test whether the problem will
+actually occur.")
+
+(defvar message-mode-syntax-table 
+  (let ((table (copy-syntax-table text-mode-syntax-table)))
+    (modify-syntax-entry ?% ". " table)
+    table)
+  "Syntax table used while in Message mode.")
+
+(defvar message-font-lock-keywords
+  (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
+    (list '("^To:" . font-lock-function-name-face)
+          '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
+	  '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
+	    (1 font-lock-comment-face) (2 font-lock-type-face nil t))
+	  (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
+		1 'font-lock-comment-face)
+	  (cons (concat "^[ \t]*"
+			"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
+			"[>|}].*")
+		'font-lock-reference-face)
+	  '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
+	    . font-lock-string-face)))
+  "Additional expressions to highlight in Message mode.")
+
+(defvar message-face-alist
+  '((bold . bold-region)
+    (underline . underline-region)
+    (default . (lambda (b e) 
+		 (unbold-region b e)
+		 (ununderline-region b e))))
+  "Alist of mail and news faces for facemenu.
+The cdr of ech entry is a function for applying the face to a region.")
+
+(defvar message-send-hook nil
+  "Hook run before sending messages.")
+
+(defvar message-sent-hook nil
+  "Hook run after sending messages.")
+
+;;; Internal variables.
+
+(defvar message-buffer-list nil)
+
+;;; Regexp matching the delimiter of messages in UNIX mail format
+;;; (UNIX From lines), minus the initial ^.  
+(defvar message-unix-mail-delimiter
+  (let ((time-zone-regexp
+	 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
+		 "\\|[-+]?[0-9][0-9][0-9][0-9]"
+		 "\\|"
+		 "\\) *")))
+    (concat
+     "From "
+
+     ;; Username, perhaps with a quoted section that can contain spaces.
+     "\\("
+     "[^ \n]*"
+     "\\(\\|\".*\"[^ \n]*\\)"
+     "\\|<[^<>\n]+>"
+     "\\)  ?"
+
+     ;; The time the message was sent.
+     "\\([^ \n]*\\) *"			; day of the week
+     "\\([^ ]*\\) *"			; month
+     "\\([0-9]*\\) *"			; day of month
+     "\\([0-9:]*\\) *"			; time of day
+
+     ;; Perhaps a time zone, specified by an abbreviation, or by a
+     ;; numeric offset.
+     time-zone-regexp
+
+     ;; The year.
+     " [0-9][0-9]\\([0-9]*\\) *"
+
+     ;; On some systems the time zone can appear after the year, too.
+     time-zone-regexp
+
+     ;; Old uucp cruft.
+     "\\(remote from .*\\)?"
+
+     "\n")))
+
+(defvar message-unsent-separator
+  (concat "^ *---+ +Unsent message follows +---+ *$\\|"
+	  "^ *---+ +Returned message +---+ *$\\|"
+	  "^Start of returned message$\\|"
+	  "^ *---+ +Original message +---+ *$\\|"
+	  "^ *--+ +begin message +--+ *$\\|"
+	  "^ *---+ +Original message follows +---+ *$\\|"
+	  "^|? *---+ +Message text follows: +---+ *|?$")
+  "A regexp that matches the separator before the text of a failed message.")
+
+(defvar message-header-format-alist 
+  `((Newsgroups)
+    (To . message-fill-address) 
+    (Cc . message-fill-address)
+    (Subject)
+    (In-Reply-To)
+    (Fcc)
+    (Bcc)
+    (Date)
+    (Organization)
+    (Distribution)
+    (Lines)
+    (Expires)
+    (Message-ID)
+    (References . message-fill-header)
+    (X-Mailer)
+    (X-Newsreader))
+  "Alist used for formatting headers.")
+
+(eval-and-compile
+  (autoload 'message-setup-toolbar "messagexmas")
+  (autoload 'mh-send-letter "mh-comp"))
+
+
+
+;;; 
+;;; Utility functions.
+;;;
+
+(defun message-point-at-bol ()
+  "Return point at the beginning of the line."
+  (let ((p (point)))
+    (beginning-of-line)
+    (prog1
+	(point)
+      (goto-char p))))
+
+(defun message-point-at-eol ()
+  "Return point at the end of the line."
+  (let ((p (point)))
+    (end-of-line)
+    (prog1
+	(point)
+      (goto-char p))))
+
+;; Delete the current line (and the next N lines.);
+(defmacro message-delete-line (&optional n)
+  `(delete-region (progn (beginning-of-line) (point))
+		  (progn (forward-line ,(or n 1)) (point))))
+
+(defun message-tokenize-header (header &optional separator)
+  "Split HEADER into a list of header elements.
+\",\" is used as the separator."
+  (let ((regexp (format "[%s]+" (or separator ",")))
+	(beg 1)
+	quoted elems)
+    (save-excursion
+      (message-set-work-buffer)
+      (insert header)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(forward-char 1)
+	(cond ((and (> (point) beg)
+		    (or (eobp)
+			(and (looking-at regexp)
+			     (not quoted))))
+	       (push (buffer-substring beg (point)) elems)
+	       (setq beg (match-end 0)))
+	      ((= (following-char) ?\")
+	       (setq quoted (not quoted)))))
+      (nreverse elems))))
+
+(defun message-fetch-field (header)
+  "The same as `mail-fetch-field', only remove all newlines."
+  (let ((value (mail-fetch-field header)))
+    (when value
+      (nnheader-replace-chars-in-string value ?\n ? ))))
+
+(defun message-fetch-reply-field (header)
+  "Fetch FIELD from the message we're replying to."
+  (when (and message-reply-buffer
+	     (buffer-name message-reply-buffer))
+    (save-excursion
+      (set-buffer message-reply-buffer)
+      (message-fetch-field header))))
+
+(defun message-set-work-buffer ()
+  (if (get-buffer " *message work*")
+      (progn
+	(set-buffer " *message work*")
+	(erase-buffer))
+    (set-buffer (get-buffer-create " *message work*"))
+    (kill-all-local-variables)
+    (buffer-disable-undo (current-buffer))))
+
+(defun message-functionp (form)
+  "Return non-nil if FORM is funcallable."
+  (or (and (symbolp form) (fboundp form))
+      (and (listp form) (eq (car form) 'lambda))))
+
+(defun message-strip-subject-re (subject)
+  "Remove \"Re:\" from subject lines."
+  (if (string-match "^[Rr][Ee]: *" subject)
+      (substring subject (match-end 0))
+    subject))
+
+(defun message-remove-header (header &optional is-regexp first reverse)
+  "Remove HEADER in the narrowed buffer.
+If REGEXP, HEADER is a regular expression.
+If FIRST, only remove the first instance of the header.
+Return the number of headers removed."
+  (goto-char (point-min))
+  (let ((regexp (if is-regexp header (concat "^" header ":")))
+	(number 0)
+	(case-fold-search t)
+	last)
+    (while (and (not (eobp))
+		(not last))
+      (if (if reverse
+	      (not (looking-at regexp))
+	    (looking-at regexp))
+	  (progn
+	    (incf number)
+	    (when first
+	      (setq last t))
+	    (delete-region
+	     (point)
+	     ;; There might be a continuation header, so we have to search
+	     ;; until we find a new non-continuation line.
+	     (progn
+	       (forward-line 1)
+	       (if (re-search-forward "^[^ \t]" nil t)
+		   (goto-char (match-beginning 0))
+		 (point-max)))))
+	(forward-line 1)
+	(if (re-search-forward "^[^ \t]" nil t)
+	    (goto-char (match-beginning 0))
+	  (point-max))))
+    number))
+
+(defun message-narrow-to-headers ()
+  "Narrow the buffer to the head of the message."
+  (widen)
+  (narrow-to-region
+   (goto-char (point-min))
+   (if (re-search-forward
+	(concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+       (match-beginning 0)
+     (point-max)))
+  (goto-char (point-min)))
+
+(defun message-narrow-to-head ()
+  "Narrow the buffer to the head of the message."
+  (widen)
+  (narrow-to-region
+   (goto-char (point-min))
+   (if (search-forward "\n\n" nil 1)
+       (1- (point))
+     (point-max)))
+  (goto-char (point-min)))
+
+(defun message-news-p ()
+  "Say whether the current buffer contains a news message."
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (message-fetch-field "newsgroups"))))
+
+(defun message-mail-p ()
+  "Say whether the current buffer contains a mail message."
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (or (message-fetch-field "to")
+	  (message-fetch-field "cc")
+	  (message-fetch-field "bcc")))))
+
+(defun message-next-header ()
+  "Go to the beginning of the next header."
+  (beginning-of-line)
+  (or (eobp) (forward-char 1))
+  (not (if (re-search-forward "^[^ \t]" nil t)
+	   (beginning-of-line)
+	 (goto-char (point-max)))))
+    
+(defun message-sort-headers-1 ()
+  "Sort the buffer as headers using `message-rank' text props."
+  (goto-char (point-min))
+  (sort-subr 
+   nil 'message-next-header 
+   (lambda ()
+     (message-next-header)
+     (unless (bobp)
+       (forward-char -1)))
+   (lambda ()
+     (or (get-text-property (point) 'message-rank)
+	 0))))
+
+(defun message-sort-headers ()
+  "Sort the headers of the current message according to `message-header-format-alist'."
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (let ((max (1+ (length message-header-format-alist)))
+	    rank)
+	(message-narrow-to-headers)
+	(while (re-search-forward "^[^ \n]+:" nil t)
+	  (put-text-property
+	   (match-beginning 0) (1+ (match-beginning 0))
+	   'message-rank
+	   (if (setq rank (length (memq (assq (intern (buffer-substring
+						       (match-beginning 0)
+						       (1- (match-end 0))))
+					      message-header-format-alist)
+					message-header-format-alist)))
+	       (- max rank)
+	     (1+ max)))))
+      (message-sort-headers-1))))
+
+
+
+;;;
+;;; Message mode
+;;;
+
+;;; Set up keymap.
+
+(defvar message-mode-map nil)
+
+(unless message-mode-map
+  (setq message-mode-map (copy-keymap text-mode-map))
+  (define-key message-mode-map "\C-c?" 'describe-mode)
+
+  (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
+  (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
+  (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
+  (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
+  (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
+  (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
+  (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
+  (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
+  (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
+  (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
+  (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+  (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
+  (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+
+  (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
+  (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
+  
+  (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+  (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
+  (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
+  (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
+  (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
+  (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
+
+  (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
+  (define-key message-mode-map "\C-c\C-s" 'message-send)
+  (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
+  (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
+
+  (define-key message-mode-map "\t" 'message-tab))
+
+(easy-menu-define message-mode-menu message-mode-map
+  "Message Menu."
+  '("Message"
+    "Go to Field:"
+    "----"
+    ["To" message-goto-to t]
+    ["Subject" message-goto-subject t]
+    ["Cc" message-goto-cc t]
+    ["Reply-to" message-goto-reply-to t]
+    ["Summary" message-goto-summary t]
+    ["Keywords" message-goto-keywords t]
+    ["Newsgroups" message-goto-newsgroups t]
+    ["Followup-To" message-goto-followup-to t]
+    ["Distribution" message-goto-distribution t]
+    ["Body" message-goto-body t]
+    ["Signature" message-goto-signature t]
+    "----"
+    "Miscellaneous Commands:"
+    "----"
+    ["Sort Headers" message-sort-headers t]
+    ["Yank Original" message-yank-original t]
+    ["Fill Yanked Message" message-fill-yanked-message t]
+    ["Insert Signature" message-insert-signature t]
+    ["Caesar (rot13) Message" message-caesar-buffer-body t]
+    ["Rename buffer" message-rename-buffer t]
+    ["Spellcheck" ispell-message t]
+    "----"
+    ["Send Message" message-send-and-exit t]
+    ["Abort Message" message-dont-send t]))
+
+(defvar facemenu-add-face-function)
+(defvar facemenu-remove-face-function)
+
+;;;###autoload
+(defun message-mode ()
+  "Major mode for editing mail and news to be sent.
+Like Text Mode but with these additional commands:
+C-c C-s  message-send (send the message)    C-c C-c  message-send-and-exit
+C-c C-f  move to a header field (and create it if there isn't):
+	 C-c C-f C-t  move to To	C-c C-f C-s  move to Subject
+	 C-c C-f C-c  move to Cc	C-c C-f C-b  move to Bcc
+	 C-c C-f C-f  move to Fcc	C-c C-f C-r  move to Reply-To
+	 C-c C-f C-u  move to Summary	C-c C-f C-n  move to Newsgroups
+	 C-c C-f C-k  move to Keywords	C-c C-f C-d  move to Distribution
+	 C-c C-f C-o  move to Followup-To
+C-c C-t  message-insert-to (add a To header to a news followup)
+C-c C-n  message-insert-newsgroups (add a Newsgroup header to a news reply)
+C-c C-b  message-goto-body (move to beginning of message text).
+C-c C-i  message-goto-signature (move to the beginning of the signature).
+C-c C-w  message-insert-signature (insert `message-signature-file' file).
+C-c C-y  message-yank-original (insert current message, if any).
+C-c C-q  message-fill-yanked-message (fill what was yanked).
+C-c C-r  message-ceasar-buffer-body (rot13 the message body)."
+  (interactive)
+  (kill-all-local-variables)
+  (make-local-variable 'message-reply-buffer)
+  (setq message-reply-buffer nil)
+  (make-local-variable 'message-send-actions)
+  (make-local-variable 'message-exit-actions)
+  (make-local-variable 'message-kill-actions)
+  (make-local-variable 'message-postpone-actions)
+  (set-syntax-table message-mode-syntax-table)
+  (use-local-map message-mode-map)
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (setq major-mode 'message-mode)
+  (setq mode-name "Message")
+  (setq buffer-offer-save t)
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '(message-font-lock-keywords t))
+  (make-local-variable 'facemenu-add-face-function)
+  (make-local-variable 'facemenu-remove-face-function)
+  (setq facemenu-add-face-function
+	(lambda (face end)
+	  (let ((face-fun (cdr (assq face message-face-alist))))
+	    (if face-fun
+		(funcall face-fun (point) end)
+	      (error "Face %s not configured for %s mode" face mode-name)))
+	  "")
+	facemenu-remove-face-function t)
+  (make-local-variable 'paragraph-separate)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat (regexp-quote mail-header-separator)
+				"$\\|[ \t]*[-_][-_][-_]+$\\|"
+				"-- $\\|"
+				paragraph-start))
+  (setq paragraph-separate (concat (regexp-quote mail-header-separator)
+				   "$\\|[ \t]*[-_][-_][-_]+$\\|"
+				   "-- $\\|"
+				   paragraph-separate))
+  (make-local-variable 'message-reply-headers)
+  (setq message-reply-headers nil)
+  (make-local-variable 'message-newsreader)
+  (make-local-variable 'message-mailer)
+  (make-local-variable 'message-post-method)
+  (make-local-variable 'message-sent-message-via)
+  (setq message-sent-message-via nil)
+  (make-local-variable 'message-checksum)
+  (setq message-checksum nil)
+  (when (fboundp 'mail-hist-define-keys)
+    (mail-hist-define-keys))
+  (when (string-match "XEmacs\\|Lucid" emacs-version)
+    (message-setup-toolbar))
+  (easy-menu-add message-mode-menu message-mode-map)
+  ;; Allow mail alias things.
+  (if (fboundp 'mail-abbrevs-setup)
+      (mail-abbrevs-setup)
+    (funcall (intern "mail-aliases-setup")))
+  (run-hooks 'text-mode-hook 'message-mode-hook))
+
+
+
+;;;
+;;; Message mode commands
+;;;
+
+;;; Movement commands
+
+(defun message-goto-to ()
+  "Move point to the To header."
+  (interactive)
+  (message-position-on-field "To"))
+
+(defun message-goto-subject ()
+  "Move point to the Subject header."
+  (interactive)
+  (message-position-on-field "Subject"))
+
+(defun message-goto-cc ()
+  "Move point to the Cc header."
+  (interactive)
+  (message-position-on-field "Cc" "To"))
+
+(defun message-goto-bcc ()
+  "Move point to the Bcc  header."
+  (interactive)
+  (message-position-on-field "Bcc" "Cc" "To"))
+
+(defun message-goto-fcc ()
+  "Move point to the Fcc header."
+  (interactive)
+  (message-position-on-field "Fcc" "To" "Newsgroups"))
+
+(defun message-goto-reply-to ()
+  "Move point to the Reply-To header."
+  (interactive)
+  (message-position-on-field "Reply-To" "Subject"))
+
+(defun message-goto-newsgroups ()
+  "Move point to the Newsgroups header."
+  (interactive)
+  (message-position-on-field "Newsgroups"))
+
+(defun message-goto-distribution ()
+  "Move point to the Distribution header."
+  (interactive)
+  (message-position-on-field "Distribution"))
+
+(defun message-goto-followup-to ()
+  "Move point to the Followup-To header."
+  (interactive)
+  (message-position-on-field "Followup-To" "Newsgroups"))
+
+(defun message-goto-keywords ()
+  "Move point to the Keywords header."
+  (interactive)
+  (message-position-on-field "Keywords" "Subject"))
+
+(defun message-goto-summary ()
+  "Move point to the Summary header."
+  (interactive)
+  (message-position-on-field "Summary" "Subject"))
+
+(defun message-goto-body ()
+  "Move point to the beginning of the message body."
+  (interactive)
+  (if (looking-at "[ \t]*\n") (expand-abbrev))
+  (goto-char (point-min))
+  (search-forward (concat "\n" mail-header-separator "\n") nil t))
+
+(defun message-goto-signature ()
+  "Move point to the beginning of the message signature."
+  (interactive)
+  (goto-char (point-min))
+  (or (re-search-forward message-signature-separator nil t)
+      (goto-char (point-max))))
+
+
+
+(defun message-insert-to ()
+  "Insert a To header that points to the author of the article being replied to."
+  (interactive)
+  (when (and (message-position-on-field "To")
+	     (mail-fetch-field "to")
+	     (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
+    (insert ", "))
+  (insert (or (message-fetch-reply-field "reply-to")
+	      (message-fetch-reply-field "from") "")))
+
+(defun message-insert-newsgroups ()
+  "Insert the Newsgroups header from the article being replied to."
+  (interactive)
+  (when (and (message-position-on-field "Newsgroups")
+	     (mail-fetch-field "newsgroups")
+	     (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
+    (insert ","))
+  (insert (or (message-fetch-reply-field "newsgroups") "")))
+
+
+
+;;; Various commands
+
+(defun message-insert-signature (&optional force)
+  "Insert a signature.  See documentation for the `message-signature' variable."
+  (interactive (list 0))
+  (let* ((signature 
+	  (cond ((and (null message-signature)
+		      (eq force 0))
+		 (save-excursion
+		   (goto-char (point-max))
+		   (not (re-search-backward
+			 message-signature-separator nil t))))
+		((and (null message-signature)
+		      force)
+		 t)
+		((message-functionp message-signature)
+		 (funcall message-signature))
+		((listp message-signature)
+		 (eval message-signature))
+		(t message-signature)))
+	 (signature
+	  (cond ((stringp signature)
+		 signature)
+		((and (eq t signature)
+		      message-signature-file
+		      (file-exists-p message-signature-file))
+		 signature))))
+    (when signature
+;      ;; Remove blank lines at the end of the message.
+      (goto-char (point-max))
+;      (skip-chars-backward " \t\n")
+;      (delete-region (point) (point-max))
+      ;; Insert the signature.
+      (unless (bolp)
+	(insert "\n"))
+      (insert "\n-- \n")
+      (if (eq signature t)
+	  (insert-file-contents message-signature-file)
+	(insert signature))
+      (goto-char (point-max))
+      (or (bolp) (insert "\n")))))
+
+(defvar message-caesar-translation-table nil)
+
+(defun message-caesar-region (b e &optional n)
+  "Caesar rotation of region by N, default 13, for decrypting netnews."
+  (interactive
+   (list
+    (min (point) (or (mark t) (point)))
+    (max (point) (or (mark t) (point)))
+    (when current-prefix-arg
+      (prefix-numeric-value current-prefix-arg))))
+
+  (setq n (if (numberp n) (mod n 26) 13)) ;canonize N
+  (unless (or (zerop n)			; no action needed for a rot of 0
+	      (= b e))			; no region to rotate
+    ;; We build the table, if necessary.
+    (when (or (not message-caesar-translation-table)
+	      (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
+      (let ((i -1) 
+	    (table (make-string 256 0)))
+	(while (< (incf i) 256)
+	  (aset table i i))
+	(setq table
+	      (concat
+	       (substring table 0 ?A)
+	       (substring table (+ ?A n) (+ ?A n (- 26 n)))
+	       (substring table ?A (+ ?A n))
+	       (substring table (+ ?A 26) ?a)
+	       (substring table (+ ?a n) (+ ?a n (- 26 n)))
+	       (substring table ?a (+ ?a n))
+	       (substring table (+ ?a 26) 255)))
+	(setq message-caesar-translation-table table)))
+    ;; Then we translate the region.  Do it this way to retain 
+    ;; text properties.
+    (while (< b e)
+      (subst-char-in-region 
+       b (1+ b) (char-after b)
+       (aref message-caesar-translation-table (char-after b)))
+      (incf b))))
+
+(defun message-caesar-buffer-body (&optional rotnum)
+  "Caesar rotates all letters in the current buffer by 13 places.
+Used to encode/decode possibly offensive messages (commonly in net.jokes).
+With prefix arg, specifies the number of places to rotate each letter forward.
+Mail and USENET news headers are not rotated."
+  (interactive (if current-prefix-arg
+		   (list (prefix-numeric-value current-prefix-arg))
+		 (list nil)))
+  (save-excursion
+    (save-restriction
+      (when (message-goto-body)
+	(narrow-to-region (point) (point-max)))
+      (message-caesar-region (point-min) (point-max) rotnum))))
+
+(defun message-rename-buffer (&optional enter-string)
+  "Rename the *message* buffer to \"*message* RECIPIENT\".  
+If the function is run with a prefix, it will ask for a new buffer
+name, rather than giving an automatic name."
+  (interactive "Pbuffer name: ")
+  (save-excursion
+    (save-restriction
+      (goto-char (point-min))
+      (narrow-to-region (point) 
+			(search-forward mail-header-separator nil 'end))
+      (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups")
+			(message-fetch-field "To")))
+	     (mail-trimmed-to
+	      (if (string-match "," mail-to)
+		  (concat (substring mail-to 0 (match-beginning 0)) ", ...")
+		mail-to))
+	     (name-default (concat "*message* " mail-trimmed-to))
+	     (name (if enter-string
+		       (read-string "New buffer name: " name-default)
+		     name-default)))
+	(rename-buffer name t)))))
+
+(defun message-fill-yanked-message (&optional justifyp)
+  "Fill the paragraphs of a message yanked into this one.
+Numeric argument means justify as well."
+  (interactive "P")
+  (save-excursion
+    (goto-char (point-min))
+    (search-forward (concat "\n" mail-header-separator "\n") nil t)
+    (let ((fill-prefix message-yank-prefix))
+      (fill-individual-paragraphs (point) (point-max) justifyp t))))
+
+(defun message-indent-citation ()
+  "Modify text just inserted from a message to be cited.
+The inserted text should be the region.
+When this function returns, the region is again around the modified text.
+
+Normally, indent each nonblank line `message-indentation-spaces' spaces.
+However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
+  (let ((start (point)))
+    ;; Remove unwanted headers.
+    (when message-ignored-cited-headers
+      (save-restriction
+	(narrow-to-region 
+	 (goto-char start)
+	 (if (search-forward "\n\n" nil t)
+	     (1- (point))
+	   (point)))
+	(message-remove-header message-ignored-cited-headers t)))
+    ;; Do the indentation.
+    (if (null message-yank-prefix)
+	(indent-rigidly start (mark t) message-indentation-spaces)
+      (save-excursion
+	(goto-char start)
+	(while (< (point) (mark t))
+	  (insert message-yank-prefix)
+	  (forward-line 1)))
+      (goto-char start))))
+
+(defun message-yank-original (&optional arg)
+  "Insert the message being replied to, if any.
+Puts point before the text and mark after.
+Normally indents each nonblank line ARG spaces (default 3).  However,
+if `message-yank-prefix' is non-nil, insert that prefix on each line.
+
+Just \\[universal-argument] as argument means don't indent, insert no
+prefix, and don't delete any headers."
+  (interactive "P")
+  (let ((modified (buffer-modified-p)))
+    (when (and message-reply-buffer
+	       message-cite-function)
+      (delete-windows-on message-reply-buffer t)
+      (insert-buffer message-reply-buffer)
+      (funcall message-cite-function)
+      (message-exchange-point-and-mark)
+      (unless (bolp)
+	(insert ?\n))
+      (unless modified
+	(setq message-checksum (cons (message-checksum) (buffer-size)))))))
+
+(defun message-cite-original ()    
+  (let ((start (point))
+	(functions 
+	 (when message-indent-citation-function
+	   (if (listp message-indent-citation-function)
+	       message-indent-citation-function
+	     (list message-indent-citation-function)))))
+    (goto-char start)
+    (while functions
+      (funcall (pop functions)))
+    (when message-citation-line-function
+      (unless (bolp)
+	(insert "\n"))
+      (funcall message-citation-line-function))))
+
+(defun message-insert-citation-line ()
+  "Function that inserts a simple citation line."
+  (when message-reply-headers
+    (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+
+(defun message-position-on-field (header &rest afters)
+  (let ((case-fold-search t))
+    (save-restriction
+      (narrow-to-region
+       (goto-char (point-min))
+       (progn
+	 (re-search-forward 
+	  (concat "^" (regexp-quote mail-header-separator) "$"))
+	 (match-beginning 0)))
+      (goto-char (point-min))
+      (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
+	  (progn
+	    (re-search-forward "^[^ \t]" nil 'move)
+	    (beginning-of-line)
+	    (skip-chars-backward "\n")
+	    t)
+	(while (and afters
+		    (not (re-search-forward 
+			  (concat "^" (regexp-quote (car afters)) ":")
+			  nil t)))
+	  (pop afters))
+	(when afters
+	  (re-search-forward "^[^ \t]" nil 'move)
+	  (beginning-of-line))
+	(insert header ": \n")
+	(forward-char -1)
+	nil))))
+
+(defun message-remove-signature ()
+  "Remove the signature from the text between point and mark.
+The text will also be indented the normal way."
+  (save-excursion
+    (let ((start (point))
+	  mark)
+    (if (not (re-search-forward message-signature-separator (mark t) t))
+	;; No signature here, so we just indent the cited text.
+	(message-indent-citation)
+      ;; Find the last non-empty line.
+      (forward-line -1)
+      (while (looking-at "[ \t]*$")
+	(forward-line -1))
+      (forward-line 1)
+      (setq mark (set-marker (make-marker) (point)))
+      (goto-char start)
+      (message-indent-citation)
+      ;; Enable undoing the deletion.
+      (undo-boundary)
+      (delete-region mark (mark t))
+      (set-marker mark nil)))))
+
+
+
+;;;
+;;; Sending messages
+;;;
+
+(defun message-send-and-exit (&optional arg)
+  "Send message like `message-send', then, if no errors, exit from mail buffer."
+  (interactive "P")
+  (let ((buf (current-buffer))
+	(actions message-exit-actions))
+    (when (and (message-send arg)
+	       (buffer-name buf))
+      (if message-kill-buffer-on-exit
+	  (kill-buffer buf)
+	(bury-buffer buf)
+	(when (eq buf (current-buffer))
+	  (message-bury buf)))
+      (message-do-actions actions))))
+
+(defun message-dont-send ()
+  "Don't send the message you have been editing."
+  (interactive)
+  (message-bury (current-buffer))
+  (message-do-actions message-postpone-actions))
+
+(defun message-kill-buffer ()
+  "Kill the current buffer."
+  (interactive)
+  (let ((actions message-kill-actions))
+    (kill-buffer (current-buffer))
+    (message-do-actions actions)))
+
+(defun message-bury (buffer)
+  "Bury this mail buffer."
+  (let ((newbuf (other-buffer buffer)))
+    (bury-buffer buffer)
+    (if (and (fboundp 'frame-parameters)
+	     (cdr (assq 'dedicated (frame-parameters)))
+	     (not (null (delq (selected-frame) (visible-frame-list)))))
+	(delete-frame (selected-frame))
+      (switch-to-buffer newbuf))))
+
+(defun message-send (&optional arg)
+  "Send the message in the current buffer.
+If `message-interactive' is non-nil, wait for success indication
+or error messages, and inform user.
+Otherwise any failure is reported in a message back to
+the user from the mailer."
+  (interactive "P")
+  (when (if buffer-file-name
+	    (y-or-n-p (format "Send buffer contents as %s message? "
+			      (if (message-mail-p)
+				  (if (message-news-p) "mail and news" "mail")
+				"news")))
+	  (or (buffer-modified-p)
+	      (y-or-n-p "No changes in the buffer; really send? ")))
+    ;; Make it possible to undo the coming changes.
+    (undo-boundary)
+    (let ((inhibit-read-only t))
+      (put-text-property (point-min) (point-max) 'read-only nil))
+    (message-fix-before-sending)
+    (run-hooks 'message-send-hook)
+    (message "Sending...")
+    (when (and (or (not (message-news-p))
+		   (and (or (not (memq 'news message-sent-message-via))
+			    (y-or-n-p
+			     "Already sent message via news; resend? "))
+			(funcall message-send-news-function arg)))
+	       (or (not (message-mail-p))
+		   (and (or (not (memq 'mail message-sent-message-via))
+			    (y-or-n-p
+			     "Already sent message via mail; resend? "))
+			(message-send-mail arg))))
+      (message-do-fcc)
+      (when (fboundp 'mail-hist-put-headers-into-history)
+	(mail-hist-put-headers-into-history))
+      (run-hooks 'message-sent-hook)
+      (message "Sending...done")
+      ;; If buffer has no file, mark it as unmodified and delete autosave.
+      (unless buffer-file-name
+	(set-buffer-modified-p nil)
+	(delete-auto-save-file-if-necessary t))
+      ;; Delete other mail buffers and stuff.
+      (message-do-send-housekeeping)
+      (message-do-actions message-send-actions)
+      ;; Return success.
+      t)))
+
+(defun message-fix-before-sending ()
+  "Do various things to make the message nice before sending it."
+  ;; Make sure there's a newline at the end of the message.
+  (goto-char (point-max))
+  (unless (bolp)
+    (insert "\n")))
+
+(defun message-add-action (action &rest types)
+  "Add ACTION to be performed when doing an exit of type TYPES."
+  (let (var)
+    (while types
+      (set (setq var (intern (format "message-%s-actions" (pop types))))
+	   (nconc (symbol-value var) (list action))))))
+
+(defun message-do-actions (actions)
+  "Perform all actions in ACTIONS."
+  ;; Now perform actions on successful sending.
+  (while actions
+    (condition-case nil
+	(cond 
+	 ;; A simple function.
+	 ((message-functionp (car actions))
+	  (funcall (car actions)))
+	 ;; Something to be evaled.
+	 (t
+	  (eval (car actions))))
+      (error))
+    (pop actions)))
+
+(defun message-send-mail (&optional arg)
+  (require 'mail-utils)
+  (let ((tembuf (generate-new-buffer " message temp"))
+	(case-fold-search nil)
+	(news (message-news-p))
+	(mailbuf (current-buffer)))
+    (save-restriction
+      (message-narrow-to-headers)
+      ;; Insert some headers.
+      (let ((message-deletable-headers
+	     (if news nil message-deletable-headers)))
+	(message-generate-headers message-required-mail-headers))
+      ;; Let the user do all of the above.
+      (run-hooks 'message-header-hook))
+    (unwind-protect
+	(save-excursion
+	  (set-buffer tembuf)
+	  (erase-buffer)
+	  (insert-buffer-substring mailbuf)
+	  ;; Remove some headers.
+	  (save-restriction
+	    (message-narrow-to-headers)
+	    ;; Remove some headers.
+	    (message-remove-header message-ignored-mail-headers t))
+	  (goto-char (point-max))
+	  ;; require one newline at the end.
+	  (or (= (preceding-char) ?\n)
+	      (insert ?\n))
+	  (when (and news
+		     (or (message-fetch-field "cc")
+			 (message-fetch-field "to")))
+	    (message-insert-courtesy-copy))
+	  (funcall message-send-mail-function))
+      (kill-buffer tembuf))
+    (set-buffer mailbuf)
+    (push 'mail message-sent-message-via)))
+
+(defun message-send-mail-with-sendmail ()
+  "Send off the prepared buffer with sendmail."
+  (let ((errbuf (if message-interactive
+		    (generate-new-buffer " sendmail errors")
+		  0))
+	resend-to-addresses delimline)
+    (let ((case-fold-search t))
+      (save-restriction
+	(message-narrow-to-headers)
+	(setq resend-to-addresses (message-fetch-field "resent-to")))
+      ;; Change header-delimiter to be what sendmail expects.
+      (goto-char (point-min))
+      (re-search-forward
+       (concat "^" (regexp-quote mail-header-separator) "\n"))
+      (replace-match "\n")
+      (backward-char 1)
+      (setq delimline (point-marker))
+      ;; Insert an extra newline if we need it to work around
+      ;; Sun's bug that swallows newlines.
+      (goto-char (1+ delimline))
+      (when (eval message-mailer-swallows-blank-line)
+	(newline))
+      (when message-interactive
+	(save-excursion
+	  (set-buffer errbuf)
+	  (erase-buffer))))
+    (let ((default-directory "/"))
+      (apply 'call-process-region
+	     (append (list (point-min) (point-max)
+			   (if (boundp 'sendmail-program)
+			       sendmail-program
+			     "/usr/lib/sendmail")
+			   nil errbuf nil "-oi")
+		     ;; Always specify who from,
+		     ;; since some systems have broken sendmails.
+		     (list "-f" (user-login-name))
+		     ;; These mean "report errors by mail"
+		     ;; and "deliver in background".
+		     (if (null message-interactive) '("-oem" "-odb"))
+		     ;; Get the addresses from the message
+		     ;; unless this is a resend.
+		     ;; We must not do that for a resend
+		     ;; because we would find the original addresses.
+		     ;; For a resend, include the specific addresses.
+		     (if resend-to-addresses
+			 (list resend-to-addresses)
+		       '("-t")))))
+    (when message-interactive
+      (save-excursion
+	(set-buffer errbuf)
+	(goto-char (point-min))
+	(while (re-search-forward "\n\n* *" nil t)
+	  (replace-match "; "))
+	(if (not (zerop (buffer-size)))
+	    (error "Sending...failed to %s"
+		   (buffer-substring (point-min) (point-max)))))
+      (when (bufferp errbuf)
+	(kill-buffer errbuf)))))
+
+(defun message-send-mail-with-mh ()
+  "Send the prepared message buffer with mh."
+  (let ((mh-previous-window-config nil)
+	(name (make-temp-name
+	       (concat (file-name-as-directory message-autosave-directory)
+		       "msg."))))
+    (setq buffer-file-name name)
+    (mh-send-letter)
+    (condition-case ()
+	(delete-file name)
+      (error nil))))
+
+(defun message-send-news (&optional arg)
+  (let ((tembuf (generate-new-buffer " *message temp*"))
+	(case-fold-search nil)
+	(method (if (message-functionp message-post-method)
+		    (funcall message-post-method arg)
+		  message-post-method))
+	(messbuf (current-buffer))
+	(message-syntax-checks
+	 (if arg
+	     (cons '(existing-newsgroups . disabled)
+		   message-syntax-checks)
+	   message-syntax-checks))
+	result)
+    (save-restriction
+      (message-narrow-to-headers)
+      ;; Insert some headers.
+      (message-generate-headers message-required-news-headers)
+      ;; Let the user do all of the above.
+      (run-hooks 'message-header-hook))
+    (message-cleanup-headers)
+    (when (message-check-news-syntax)
+      (unwind-protect
+	  (save-excursion
+	    (set-buffer tembuf)
+	    (buffer-disable-undo (current-buffer))
+	    (erase-buffer) 
+	    (insert-buffer-substring messbuf)
+	    ;; Remove some headers.
+	    (save-restriction
+	      (message-narrow-to-headers)
+	      ;; Remove some headers.
+	      (message-remove-header message-ignored-news-headers t))
+	    (goto-char (point-max))
+	    ;; require one newline at the end.
+	    (or (= (preceding-char) ?\n)
+		(insert ?\n))
+	    (let ((case-fold-search t))
+	      ;; Remove the delimeter.
+	      (goto-char (point-min))
+	      (re-search-forward
+	       (concat "^" (regexp-quote mail-header-separator) "\n"))
+	      (replace-match "\n")
+	      (backward-char 1))
+	    (require (car method))
+	    (funcall (intern (format "%s-open-server" (car method)))
+		     (cadr method) (cddr method))
+	    (setq result
+		  (funcall (intern (format "%s-request-post" (car method))))))
+	(kill-buffer tembuf))
+      (set-buffer messbuf)
+      (if result
+	  (push 'news message-sent-message-via)
+	(message "Couldn't send message via news: %s"
+		 (nnheader-get-report (car method)))
+	nil))))
+
+;;;
+;;; Header generation & syntax checking.
+;;;
+
+(defun message-check-news-syntax ()
+  "Check the syntax of the message."
+  (and 
+   ;; We narrow to the headers and check them first.
+   (save-excursion
+     (save-restriction
+       (message-narrow-to-headers)
+       (and 
+	;; Check for commands in Subject.
+	(or 
+	 (message-check-element 'subject-cmsg)
+	 (save-excursion
+	   (if (string-match "^cmsg " (message-fetch-field "subject"))
+	       (y-or-n-p
+		"The control code \"cmsg \" is in the subject. Really post? ")
+	     t)))
+	;; Check for multiple identical headers.
+	(or (message-check-element 'multiple-headers)
+	    (save-excursion
+	      (let (found)
+		(while (and (not found) 
+			    (re-search-forward "^[^ \t:]+: " nil t))
+		  (save-excursion
+		    (or (re-search-forward 
+			 (concat "^" (setq found
+					   (buffer-substring 
+					    (match-beginning 0) 
+					    (- (match-end 0) 2))))
+			 nil t)
+			(setq found nil))))
+		(if found
+		    (y-or-n-p 
+		     (format "Multiple %s headers. Really post? " found))
+		  t))))
+	;; Check for Version and Sendsys.
+	(or (message-check-element 'sendsys)
+	    (save-excursion
+	      (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
+		  (y-or-n-p
+		   (format "The article contains a %s command. Really post? "
+			   (buffer-substring (match-beginning 0) 
+					     (1- (match-end 0)))))
+		t)))
+	;; See whether we can shorten Followup-To.
+	(or (message-check-element 'shorten-followup-to)
+	    (let ((newsgroups (message-fetch-field "newsgroups"))
+		  (followup-to (message-fetch-field "followup-to"))
+		  to)
+	      (when (and newsgroups (string-match "," newsgroups)
+			 (not followup-to)
+			 (not
+			  (zerop
+			   (length
+			    (setq to (completing-read 
+				      "Followups to: (default all groups) " 
+				      (mapcar (lambda (g) (list g))
+					      (cons "poster" 
+						    (message-tokenize-header 
+						     newsgroups)))))))))
+		(goto-char (point-min))
+		(insert "Followup-To: " to "\n"))
+	      t))
+	;; Check "Shoot me".
+	(or (message-check-element 'shoot)
+	    (save-excursion
+	      (if (search-forward
+		   ".i-have-a-misconfigured-system-so-shoot-me" nil t)
+		  (y-or-n-p
+		   "You appear to have a misconfigured system.  Really post? ")
+		t)))
+	;; Check for Approved.
+	(or (message-check-element 'approved)
+	    (save-excursion
+	      (if (re-search-forward "^Approved:" nil t)
+		  (y-or-n-p
+		   "The article contains an Approved header. Really post? ")
+		t)))
+	;; Check the Message-Id header.
+	(or (message-check-element 'message-id)
+	    (save-excursion
+	      (let* ((case-fold-search t)
+		     (message-id (message-fetch-field "message-id")))
+		(or (not message-id)
+		    (and (string-match "@" message-id)
+			 (string-match "@[^\\.]*\\." message-id))
+		    (y-or-n-p
+		     (format 
+		      "The Message-ID looks strange: \"%s\". Really post? "
+		      message-id))))))
+	;; Check the Subject header.
+	(or 
+	 (message-check-element 'subject)
+	 (save-excursion
+	   (let* ((case-fold-search t)
+		  (subject (message-fetch-field "subject")))
+	     (or
+	      (and subject
+		   (not (string-match "\\`[ \t]*\\'" subject)))
+	      (progn
+		(message 
+		 "The subject field is empty or missing.  Posting is denied.")
+		nil)))))
+	;; Check the Newsgroups & Followup-To headers.
+	(or
+	 (message-check-element 'existing-newsgroups)
+	 (let* ((case-fold-search t)
+		(newsgroups (message-fetch-field "newsgroups"))
+		(followup-to (message-fetch-field "followup-to"))
+		(groups (message-tokenize-header
+			 (if followup-to
+			     (concat newsgroups "," followup-to)
+			   newsgroups)))
+		(hashtb (and (boundp 'gnus-active-hashtb)
+			     gnus-active-hashtb))
+		errors)
+	   (if (not hashtb)
+	       t
+	     (while groups
+	       (when (and (not (boundp (intern (car groups) hashtb)))
+			  (not (equal (car groups) "poster")))
+		 (push (car groups) errors))
+	       (pop groups))
+	     (if (not errors)
+		 t
+	       (y-or-n-p
+		(format
+		 "Really post to %s unknown group%s: %s "
+		 (if (= (length errors) 1) "this" "these")
+		 (if (= (length errors) 1) "" "s")
+		 (mapconcat 'identity errors ", ")))))))
+	;; Check the Newsgroups & Followup-To headers for syntax errors.
+	(or
+	 (message-check-element 'valid-newsgroups)
+	 (let ((case-fold-search t)
+	       (headers '("Newsgroups" "Followup-To"))
+	       header error)
+	   (while (and headers (not error))
+	     (when (setq header (mail-fetch-field (car headers)))
+	       (if (or
+		    (not 
+		     (string-match
+		      "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
+		      header))
+		    (memq 
+		     nil (mapcar 
+			  (lambda (g)
+			    (not (string-match "\\.\\'\\|\\.\\." g)))
+			  (message-tokenize-header header ","))))
+		   (setq error t)))
+	     (unless error
+	       (pop headers)))
+	   (if (not error)
+	       t
+	     (y-or-n-p
+	      (format "The %s header looks odd: \"%s\".  Really post? "
+		      (car headers) header)))))
+	;; Check the From header.
+	(or 
+	 (save-excursion
+	   (let* ((case-fold-search t)
+		  (from (message-fetch-field "from")))
+	     (cond
+	      ((not from)
+	       (message "There is no From line.  Posting is denied.")
+	       nil)
+	      ((not (string-match "@[^\\.]*\\." from))
+	       (message
+		"Denied posting -- the From looks strange: \"%s\"." from)
+	       nil)
+	      ((string-match "@[^@]*@" from)
+	       (message 
+		"Denied posting -- two \"@\"'s in the From header: %s." from)
+	       nil)
+	      ((string-match "(.*).*(.*)" from)
+	       (message
+		"Denied posting -- the From header looks strange: \"%s\"." 
+		from)
+	       nil)
+	      (t t))))))))
+   ;; Check for long lines.
+   (or (message-check-element 'long-lines)
+       (save-excursion
+	 (goto-char (point-min))
+	 (re-search-forward
+	  (concat "^" (regexp-quote mail-header-separator) "$"))
+	 (while (and
+		 (progn
+		   (end-of-line)
+		   (< (current-column) 80))
+		 (zerop (forward-line 1))))
+	 (or (bolp)
+	     (eobp)
+	     (y-or-n-p
+	      "You have lines longer than 79 characters.  Really post? "))))
+   ;; Check whether the article is empty.
+   (or (message-check-element 'empty)
+       (save-excursion
+	 (goto-char (point-min))
+	 (re-search-forward
+	  (concat "^" (regexp-quote mail-header-separator) "$"))
+	 (forward-line 1)
+	 (let ((b (point)))
+	   (or (re-search-forward message-signature-separator nil t)
+	       (goto-char (point-max)))
+	   (beginning-of-line)
+	   (or (re-search-backward "[^ \n\t]" b t)
+	       (y-or-n-p "Empty article.  Really post? ")))))
+   ;; Check for control characters.
+   (or (message-check-element 'control-chars)
+       (save-excursion
+	 (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
+	     (y-or-n-p 
+	      "The article contains control characters. Really post? ")
+	   t)))
+   ;; Check excessive size.
+   (or (message-check-element 'size)
+       (if (> (buffer-size) 60000)
+	   (y-or-n-p
+	    (format "The article is %d octets long. Really post? "
+		    (buffer-size)))
+	 t))
+   ;; Check whether any new text has been added.
+   (or (message-check-element 'new-text)
+       (not message-checksum)
+       (not (and (eq (message-checksum) (car message-checksum))
+		 (eq (buffer-size) (cdr message-checksum))))
+       (y-or-n-p
+	"It looks like no new text has been added.  Really post? "))
+   ;; Check the length of the signature.
+   (or
+    (message-check-element 'signature)
+    (progn
+      (goto-char (point-max))
+      (if (or (not (re-search-backward "^-- $" nil t))
+	      (search-forward message-forward-end-separator nil t))
+	  t
+	(if (> (count-lines (point) (point-max)) 5)
+	    (y-or-n-p
+	     (format
+	      "Your .sig is %d lines; it should be max 4.  Really post? "
+	      (count-lines (point) (point-max))))
+	  t))))))
+
+(defun message-check-element (type)
+  "Returns non-nil if this type is not to be checked."
+  (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
+      t
+    (let ((able (assq type message-syntax-checks)))
+      (and (consp able)
+	   (eq (cdr able) 'disabled)))))
+
+(defun message-checksum ()
+  "Return a \"checksum\" for the current buffer."
+  (let ((sum 0))
+    (save-excursion
+      (goto-char (point-min))
+      (re-search-forward
+       (concat "^" (regexp-quote mail-header-separator) "$"))
+      (while (not (eobp))
+	(when (not (looking-at "[ \t\n]"))
+	  (setq sum (logxor (ash sum 1) (following-char))))
+	(forward-char 1)))
+    sum))
+
+(defun message-do-fcc ()
+  "Process Fcc headers in the current buffer."
+  (let ((case-fold-search t)
+	(buf (current-buffer))
+	list file)
+    (save-excursion
+      (set-buffer (get-buffer-create " *message temp*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (insert-buffer-substring buf)
+      (save-restriction
+	(message-narrow-to-headers)
+	(while (setq file (message-fetch-field "fcc"))
+	  (push file list)
+	  (message-remove-header "fcc" nil t)))
+      (goto-char (point-min))
+      (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+      (replace-match "" t t)
+      ;; Process FCC operations.
+      (while list
+	(setq file (pop list))
+	(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+	    ;; Pipe the article to the program in question.
+	    (call-process-region (point-min) (point-max) shell-file-name
+				 nil nil nil shell-command-switch
+				 (match-string 1 file))
+	  ;; Save the article.
+	  (setq file (expand-file-name file))
+	  (unless (file-exists-p (file-name-directory file))
+	    (make-directory (file-name-directory file) t))
+	  (if (and message-fcc-handler-function
+		   (not (eq message-fcc-handler-function 'rmail-output)))
+	      (funcall message-fcc-handler-function file)
+	    (if (and (file-readable-p file) (mail-file-babyl-p file))
+		(rmail-output file 1)
+	      (let ((mail-use-rfc822 t))
+		(rmail-output file 1 t t))))))
+      (kill-buffer (current-buffer)))))
+
+(defun message-cleanup-headers ()
+  "Do various automatic cleanups of the headers."
+  ;; Remove empty lines in the header.
+  (save-restriction
+    (message-narrow-to-headers)
+    (while (re-search-forward "^[ \t]*\n" nil t)
+      (replace-match "" t t)))
+
+  ;; Correct Newsgroups and Followup-To headers: change sequence of
+  ;; spaces to comma and eliminate spaces around commas.  Eliminate
+  ;; embedded line breaks.
+  (goto-char (point-min))
+  (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
+    (save-restriction
+      (narrow-to-region
+       (point)
+       (if (re-search-forward "^[^ \t]" nil t)
+	   (match-beginning 0)
+	 (forward-line 1)
+	 (point)))
+      (goto-char (point-min))
+      (while (re-search-forward "\n[ \t]+" nil t)
+	(replace-match " " t t))	;No line breaks (too confusing)
+      (goto-char (point-min))
+      (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+	(replace-match "," t t))
+      (goto-char (point-min))
+      ;; Remove trailing commas.
+      (when (re-search-forward ",+$" nil t)
+	(replace-match "" t t)))))
+
+(defun message-make-date ()
+  "Make a valid data header."
+  (let ((now (current-time)))
+    (timezone-make-date-arpa-standard 
+     (current-time-string now) (current-time-zone now))))
+
+(defun message-make-message-id ()
+  "Make a unique Message-ID."
+  (concat "<" (message-unique-id) 
+	  (let ((psubject (save-excursion (message-fetch-field "subject"))))
+	    (if (and message-reply-headers
+		     (mail-header-references message-reply-headers)
+		     (mail-header-subject message-reply-headers)
+		     psubject
+		     (mail-header-subject message-reply-headers)
+		     (not (string= 
+			   (message-strip-subject-re
+			    (mail-header-subject message-reply-headers))
+			   (message-strip-subject-re psubject))))
+		"_-_" ""))
+	  "@" (message-make-fqdn) ">"))
+
+(defvar message-unique-id-char nil)
+
+;; If you ever change this function, make sure the new version
+;; cannot generate IDs that the old version could.
+;; You might for example insert a "." somewhere (not next to another dot
+;; or string boundary), or modify the "fsf" string.
+(defun message-unique-id ()
+  ;; Don't use microseconds from (current-time), they may be unsupported.
+  ;; Instead we use this randomly inited counter.
+  (setq message-unique-id-char
+	(% (1+ (or message-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 (current-time)))
+    (concat
+     (if (memq system-type '(ms-dos emx vax-vms))
+	 (let ((user (downcase (user-login-name))))
+	   (while (string-match "[^a-z0-9_]" user)
+	     (aset user (match-beginning 0) ?_))
+	   user)
+       (message-number-base36 (user-uid) -1))
+     (message-number-base36 (+ (car   tm) 
+			       (lsh (% message-unique-id-char 25) 16)) 4)
+     (message-number-base36 (+ (nth 1 tm)
+			       (lsh (/ message-unique-id-char 25) 16)) 4)
+     ;; Append the newsreader name, because while the generated
+     ;; ID is unique to this newsreader, other newsreaders might
+     ;; otherwise generate the same ID via another algorithm.
+     ".fsf")))
+
+(defun message-number-base36 (num len)
+  (if (if (< len 0) (<= num 0) (= len 0))
+      ""
+    (concat (message-number-base36 (/ num 36) (1- len))
+	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+				  (% num 36))))))
+
+(defun message-make-organization ()
+  "Make an Organization header."
+  (let* ((organization 
+	  (or (getenv "ORGANIZATION")
+	      (when message-user-organization
+		(if (message-functionp message-user-organization)
+		    (funcall message-user-organization)
+		  message-user-organization)))))
+    (save-excursion
+      (message-set-work-buffer)
+      (cond ((stringp organization)
+	     (insert organization))
+	    ((and (eq t organization)
+		  message-user-organization-file
+		  (file-exists-p message-user-organization-file))
+	     (insert-file-contents message-user-organization-file)))
+      (goto-char (point-min))
+      (while (re-search-forward "[\t\n]+" nil t)
+	(replace-match "" t t))
+      (unless (zerop (buffer-size))
+	(buffer-string)))))
+
+(defun message-make-lines ()
+  "Count the number of lines and return numeric string."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (re-search-forward 
+       (concat "^" (regexp-quote mail-header-separator) "$"))
+      (forward-line 1)
+      (int-to-string (count-lines (point) (point-max))))))
+
+(defun message-make-in-reply-to ()
+  "Return the In-Reply-To header for this message."
+  (when message-reply-headers
+    (let ((from (mail-header-from message-reply-headers))
+	  (date (mail-header-date message-reply-headers)))
+      (when from
+	(let ((stop-pos 
+	       (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+	  (concat (if stop-pos (substring from 0 stop-pos) from)
+		  "'s message of " 
+		  (if (or (not date) (string= date ""))
+		      "(unknown date)" date)))))))
+
+(defun message-make-distribution ()
+  "Make a Distribution header."
+  (let ((orig-distribution (message-fetch-reply-field "distribution")))
+    (cond ((message-functionp message-distribution-function)
+	   (funcall message-distribution-function))
+	  (t orig-distribution))))
+
+(defun message-make-expires ()
+  "Return an Expires header based on `message-expires'."
+  (let ((current (current-time))
+	(future (* 1.0 message-expires 60 60 24)))
+    ;; Add the future to current.
+    (setcar current (+ (car current) (round (/ future (expt 2 16)))))
+    (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
+    ;; Return the date in the future in UT.
+    (timezone-make-date-arpa-standard 
+     (current-time-string current) (current-time-zone current) '(0 "UT"))))
+
+(defun message-make-path ()
+  "Return uucp path."
+  (let ((login-name (user-login-name)))
+    (cond ((null message-user-path)
+	   (concat (system-name) "!" login-name))
+	  ((stringp message-user-path)
+	   ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
+	   (concat message-user-path "!" login-name))
+	  (t login-name))))
+
+(defun message-make-from ()
+  "Make a From header."
+  (let* ((login (message-make-address))
+	 (fullname 
+	  (or (and (boundp 'user-full-name)
+		   user-full-name)
+	      (user-full-name))))
+    (when (string= fullname "&")
+      (setq fullname (user-login-name)))
+    (save-excursion
+      (message-set-work-buffer)
+      (cond 
+       ((or (null message-from-style)
+	    (equal fullname ""))
+	(insert login))
+       ((or (eq message-from-style 'angles)
+	    (and (not (eq message-from-style 'parens))
+		 ;; Use angles if no quoting is needed, or if parens would
+		 ;; need quoting too.
+		 (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
+		     (let ((tmp (concat fullname nil)))
+		       (while (string-match "([^()]*)" tmp)
+			 (aset tmp (match-beginning 0) ?-)
+			 (aset tmp (1- (match-end 0)) ?-))
+		       (string-match "[\\()]" tmp)))))
+	(insert fullname)
+	(goto-char (point-min))
+	;; Look for a character that cannot appear unquoted
+	;; according to RFC 822.
+	(when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
+	  ;; Quote fullname, escaping specials.
+	  (goto-char (point-min))
+	  (insert "\"")
+	  (while (re-search-forward "[\"\\]" nil 1)
+	    (replace-match "\\\\\\&" t))
+	  (insert "\""))
+	(insert " <" login ">"))
+       (t				; 'parens or default
+	(insert login " (")
+	(let ((fullname-start (point)))
+	  (insert fullname)
+	  (goto-char fullname-start)
+	  ;; RFC 822 says \ and nonmatching parentheses
+	  ;; must be escaped in comments.
+	  ;; Escape every instance of ()\ ...
+	  (while (re-search-forward "[()\\]" nil 1)
+	    (replace-match "\\\\\\&" t))
+	  ;; ... then undo escaping of matching parentheses,
+	  ;; including matching nested parentheses.
+	  (goto-char fullname-start)
+	  (while (re-search-forward 
+		  "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+		    nil 1)
+	    (replace-match "\\1(\\3)" t)
+	    (goto-char fullname-start)))
+	(insert ")")))
+      (buffer-string))))
+
+(defun message-make-sender ()
+  "Return the \"real\" user address.
+This function tries to ignore all user modifications, and 
+give as trustworthy answer as possible."
+  (concat (user-login-name) "@" (system-name)))
+
+(defun message-make-address ()
+  "Make the address of the user."
+  (or (message-user-mail-address)
+      (concat (user-login-name) "@" (message-make-domain))))
+
+(defun message-user-mail-address ()
+  "Return the pertinent part of `user-mail-address'."
+  (when user-mail-address
+    (nth 1 (mail-extract-address-components user-mail-address))))
+
+(defun message-make-fqdn ()
+  "Return user's fully qualified domain name."
+  (let ((system-name (system-name))
+	(user-mail (message-user-mail-address)))
+    (cond 
+     ((string-match "[^.]\\.[^.]" system-name)
+      ;; `system-name' returned the right result.
+      system-name)
+     ;; Try `mail-host-address'.
+     ((and (boundp 'mail-host-address)
+	   (stringp mail-host-address)
+	   (string-match "\\." mail-host-address))
+      mail-host-address)
+     ;; We try `user-mail-address' as a backup.
+     ((and (string-match "\\." user-mail)
+	   (string-match "@\\(.*\\)\\'" user-mail))
+      (match-string 1 user-mail))
+     ;; Default to this bogus thing.
+     (t
+      (concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
+
+(defun message-make-host-name ()
+  "Return the name of the host."
+  (let ((fqdn (message-make-fqdn)))
+    (string-match "^[^.]+\\." fqdn)
+    (substring fqdn 0 (1- (match-end 0)))))
+
+(defun message-make-domain ()
+  "Return the domain name."
+  (or mail-host-address
+      (message-make-fqdn)))
+
+(defun message-generate-headers (headers)
+  "Prepare article HEADERS.
+Headers already prepared in the buffer are not modified."
+  (save-restriction
+    (message-narrow-to-headers)
+    (let* ((Date (message-make-date))
+	   (Message-ID (message-make-message-id))
+	   (Organization (message-make-organization))
+	   (From (message-make-from))
+	   (Path (message-make-path))
+	   (Subject nil)
+	   (Newsgroups nil)
+	   (In-Reply-To (message-make-in-reply-to))
+	   (To nil)
+	   (Distribution (message-make-distribution))
+	   (Lines (message-make-lines))
+	   (X-Newsreader message-newsreader)
+	   (X-Mailer (and (not (message-fetch-field "X-Newsreader"))
+			  message-mailer))
+	   (Expires (message-make-expires))
+	   (case-fold-search t)
+	   header value elem)
+      ;; First we remove any old generated headers.
+      (let ((headers message-deletable-headers))
+	(while headers
+	  (goto-char (point-min))
+	  (and (re-search-forward 
+		(concat "^" (symbol-name (car headers)) ": *") nil t)
+	       (get-text-property (1+ (match-beginning 0)) 'message-deletable)
+	       (message-delete-line))
+	  (pop headers)))
+      ;; Go through all the required headers and see if they are in the
+      ;; articles already. If they are not, or are empty, they are
+      ;; inserted automatically - except for Subject, Newsgroups and
+      ;; Distribution. 
+      (while headers
+	(goto-char (point-min))
+	(setq elem (pop headers))
+	(if (consp elem)
+	    (if (eq (car elem) 'optional)
+		(setq header (cdr elem))
+	      (setq header (car elem)))
+	  (setq header elem))
+	(when (or (not (re-search-forward 
+			(concat "^" (downcase (symbol-name header)) ":") 
+			nil t))
+		  (progn
+		    ;; The header was found. We insert a space after the
+		    ;; colon, if there is none.
+		    (if (/= (following-char) ? ) (insert " ") (forward-char 1))
+		    ;; Find out whether the header is empty...
+		    (looking-at "[ \t]*$")))
+	  ;; So we find out what value we should insert.
+	  (setq value
+		(cond 
+		 ((and (consp elem) (eq (car elem) 'optional))
+		  ;; This is an optional header.  If the cdr of this
+		  ;; is something that is nil, then we do not insert
+		  ;; this header.
+		  (setq header (cdr elem))
+		  (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
+		      (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+		 ((consp elem)
+		  ;; The element is a cons.  Either the cdr is a
+		  ;; string to be inserted verbatim, or it is a
+		  ;; function, and we insert the value returned from
+		  ;; this function.
+		  (or (and (stringp (cdr elem)) (cdr elem))
+		      (and (fboundp (cdr elem)) (funcall (cdr elem)))))
+		 ((and (boundp header) (symbol-value header))
+		  ;; The element is a symbol.  We insert the value
+		  ;; of this symbol, if any.
+		  (symbol-value header))
+		 (t
+		  ;; We couldn't generate a value for this header,
+		  ;; so we just ask the user.
+		  (read-from-minibuffer
+		   (format "Empty header for %s; enter value: " header)))))
+	  ;; Finally insert the header.
+	  (when (and value 
+		     (not (equal value "")))
+	    (save-excursion
+	      (if (bolp)
+		  (progn
+		    ;; This header didn't exist, so we insert it.
+		    (goto-char (point-max))
+		    (insert (symbol-name header) ": " value "\n")
+		    (forward-line -1))
+		;; The value of this header was empty, so we clear
+		;; totally and insert the new value.
+		(delete-region (point) (message-point-at-eol))
+		(insert value))
+	      ;; Add the deletable property to the headers that require it.
+	      (and (memq header message-deletable-headers)
+		   (progn (beginning-of-line) (looking-at "[^:]+: "))
+		   (add-text-properties 
+		    (point) (match-end 0)
+		    '(message-deletable t face italic) (current-buffer)))))))
+      ;; Insert new Sender if the From is strange. 
+      (let ((from (message-fetch-field "from"))
+	    (sender (message-fetch-field "sender"))
+	    (secure-sender (message-make-sender)))
+	(when (and from 
+		   (not (message-check-element 'sender))
+		   (not (string=
+			 (downcase
+			  (cadr (mail-extract-address-components from)))
+			 (downcase secure-sender)))
+		   (or (null sender)
+		       (not 
+			(string=
+			 (downcase
+			  (cadr (mail-extract-address-components sender)))
+			 (downcase secure-sender)))))
+	  (goto-char (point-min))    
+	  ;; Rename any old Sender headers to Original-Sender.
+	  (when (re-search-forward "^Sender:" nil t)
+	    (beginning-of-line)
+	    (insert "Original-")
+	    (beginning-of-line))
+	  (insert "Sender: " secure-sender "\n"))))))
+
+(defun message-insert-courtesy-copy ()
+  "Insert a courtesy message in mail copies of combined messages."
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers)
+      (let ((newsgroups (message-fetch-field "newsgroups")))
+	(when newsgroups
+	  (goto-char (point-max))
+	  (insert "Posted-To: " newsgroups "\n"))))
+    (forward-line 1)
+    (insert message-courtesy-message)))
+    
+;;;
+;;; Setting up a message buffer
+;;;
+
+(defun message-fill-address (header value)
+  (save-restriction
+    (narrow-to-region (point) (point))
+    (insert (capitalize (symbol-name header))
+	    ": "
+	    (if (consp value) (car value) value)
+	    "\n")
+    (narrow-to-region (point-min) (1- (point-max)))
+    (let (quoted last)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(skip-chars-forward "^,\"" (point-max))
+	(if (or (= (following-char) ?,)
+		(eobp))
+	    (when (not quoted)
+	      (if (and (> (current-column) 78)
+		       last)
+		  (progn
+		    (save-excursion
+		      (goto-char last)
+		      (insert "\n\t"))
+		    (setq last (1+ (point))))
+		(setq last (1+ (point)))))
+	  (setq quoted (not quoted)))
+	(unless (eobp)
+	  (forward-char 1))))
+    (goto-char (point-max))
+    (widen)
+    (forward-line 1)))
+
+(defun message-fill-header (header value)
+  (let ((begin (point))
+	(fill-column 78)
+	(fill-prefix "\t"))
+    (insert (capitalize (symbol-name header))
+	    ": "
+	    (if (consp value) (car value) value)
+	    "\n")
+    (save-restriction
+      (narrow-to-region begin (point))
+      (fill-region-as-paragraph begin (point))
+      ;; Tapdance around looong Message-IDs.
+      (forward-line -1)
+      (when (looking-at "[ \t]*$")
+	(message-delete-line))
+      (goto-char begin)
+      (re-search-forward ":" nil t)
+      (when (looking-at "\n[ \t]+")
+	(replace-match " " t t))
+      (goto-char (point-max)))))
+
+(defun message-position-point ()
+  "Move point to where the user probably wants to find it."
+  (message-narrow-to-headers)
+  (cond 
+   ((re-search-forward "^[^:]+:[ \t]*$" nil t)
+    (search-backward ":" )
+    (widen)
+    (forward-char 1)
+    (if (= (following-char) ? )
+	(forward-char 1)
+      (insert " ")))
+   (t
+    (goto-char (point-max))
+    (widen)
+    (forward-line 1)
+    (unless (looking-at "$")
+      (forward-line 2)))
+   (sit-for 0)))
+
+(defun message-buffer-name (type &optional to group)
+  "Return a new (unique) buffer name based on TYPE and TO."
+  (cond
+   ;; Check whether `message-generate-new-buffers' is a function, 
+   ;; and if so, call it.
+   ((message-functionp message-generate-new-buffers)
+    (funcall message-generate-new-buffers type to group))
+   ;; Generate a new buffer name The Message Way.
+   (message-generate-new-buffers
+    (generate-new-buffer-name
+     (concat "*" type
+	     (if to
+		 (concat " to "
+			 (or (car (mail-extract-address-components to))
+			     to) "")
+	       "")
+	     (if (and group (not (string= group ""))) (concat " on " group) "")
+	     "*")))
+   ;; Use standard name.
+   (t
+    (format "*%s message*" type))))
+
+(defun message-pop-to-buffer (name)
+  "Pop to buffer NAME, and warn if it already exists and is modified."
+  (let ((buffer (get-buffer name)))
+    (if (and buffer
+	     (buffer-name buffer))
+	(progn
+	  (set-buffer (pop-to-buffer buffer))
+	  (when (and (buffer-modified-p)
+		     (not (y-or-n-p
+			   "Message already being composed; erase? ")))
+	    (error "Message being composed")))
+      (set-buffer (pop-to-buffer name))))
+  (erase-buffer)
+  (message-mode))
+
+(defun message-do-send-housekeeping ()
+  "Kill old message buffers."
+  ;; We might have sent this buffer already.  Delete it from the
+  ;; list of buffers.
+  (setq message-buffer-list (delq (current-buffer) message-buffer-list))
+  (when (and message-max-buffers
+	     (>= (length message-buffer-list) message-max-buffers))
+    ;; Kill the oldest buffer -- unless it has been changed.
+    (let ((buffer (pop message-buffer-list)))
+      (when (and (buffer-name buffer)
+		 (not (buffer-modified-p buffer)))
+	(kill-buffer buffer))))
+  ;; Rename the buffer.
+  (if message-send-rename-function
+      (funcall message-send-rename-function)
+    (when (string-match "\\`\\*" (buffer-name))
+      (rename-buffer 
+       (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+  ;; Push the current buffer onto the list.
+  (when message-max-buffers
+    (setq message-buffer-list 
+	  (nconc message-buffer-list (list (current-buffer))))))
+
+(defvar mc-modes-alist)
+(defun message-setup (headers &optional replybuffer actions)
+  (when (and (boundp 'mc-modes-alist)
+	     (not (assq 'message-mode mc-modes-alist)))
+    (push '(message-mode (encrypt . mc-encrypt-message)
+			 (sign . mc-sign-message))
+	  mc-modes-alist))
+  (when actions
+    (setq message-send-actions actions))
+  (setq message-reply-buffer replybuffer)
+  (goto-char (point-min))
+  ;; Insert all the headers.
+  (mail-header-format 
+   (let ((h headers)
+	 (alist message-header-format-alist))
+     (while h
+       (unless (assq (caar h) message-header-format-alist)
+	 (push (list (caar h)) alist))
+       (pop h))
+     alist)
+   headers)
+  (delete-region (point) (progn (forward-line -1) (point)))
+  (when message-default-headers
+    (insert message-default-headers))
+  (put-text-property
+   (point)
+   (progn
+     (insert mail-header-separator "\n")
+     (1- (point)))
+   'read-only nil)
+  (forward-line -1)
+  (when (message-news-p)
+    (when message-default-news-headers
+      (insert message-default-news-headers))
+    (when message-generate-headers-first
+      (message-generate-headers
+       (delq 'Lines
+	     (delq 'Subject
+		   (copy-sequence message-required-news-headers))))))
+  (when (message-mail-p)
+    (when message-default-mail-headers
+      (insert message-default-mail-headers))
+    (when message-generate-headers-first
+      (message-generate-headers
+       (delq 'Lines
+	     (delq 'Subject
+		   (copy-sequence message-required-mail-headers))))))
+  (run-hooks 'message-signature-setup-hook)
+  (message-insert-signature)
+  (message-set-auto-save-file-name)
+  (save-restriction
+    (message-narrow-to-headers)
+    (run-hooks 'message-header-setup-hook))
+  (set-buffer-modified-p nil)
+  (run-hooks 'message-setup-hook)
+  (message-position-point)
+  (undo-boundary))
+
+(defun message-set-auto-save-file-name ()
+  "Associate the message buffer with a file in the drafts directory."
+  (when message-autosave-directory
+    (unless (file-exists-p message-autosave-directory)
+      (make-directory message-autosave-directory t))
+    (let ((name (make-temp-name
+		 (concat (file-name-as-directory message-autosave-directory)
+			 "msg."))))
+      (setq buffer-auto-save-file-name
+	    (save-excursion
+	      (prog1
+		  (progn
+		    (set-buffer (get-buffer-create " *draft tmp*"))
+		    (setq buffer-file-name name)
+		    (make-auto-save-file-name))
+		(kill-buffer (current-buffer)))))
+      (clear-visited-file-modtime))))
+
+
+
+;;;
+;;; Commands for interfacing with message
+;;;
+
+;;;###autoload
+(defun message-mail (&optional to subject)
+  "Start editing a mail message to be sent."
+  (interactive)
+  (message-pop-to-buffer (message-buffer-name "mail" to))
+  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news (&optional newsgroups subject)
+  "Start editing a news article to be sent."
+  (interactive)
+  (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+  (message-setup `((Newsgroups . ,(or newsgroups "")) 
+		   (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-reply (&optional to-address wide ignore-reply-to)
+  "Start editing a reply to the article in the current buffer."
+  (interactive)
+  (let ((cur (current-buffer))
+	from subject date reply-to to cc
+	references message-id follow-to 
+	mct never-mct gnus-warning)
+    (save-restriction
+      (narrow-to-region
+       (goto-char (point-min))
+       (if (search-forward "\n\n" nil t)
+	   (1- (point))
+	 (point-max)))
+      ;; Allow customizations to have their say.
+      (if (not wide)
+	  ;; This is a regular reply.
+	  (if (message-functionp message-reply-to-function)
+	      (setq follow-to (funcall message-reply-to-function)))
+	;; This is a followup.
+	(if (message-functionp message-wide-reply-to-function)
+	    (save-excursion
+	      (setq follow-to
+		    (funcall message-wide-reply-to-function)))))
+      ;; Find all relevant headers we need.
+      (setq from (message-fetch-field "from")
+	    date (message-fetch-field "date") 
+	    subject (or (message-fetch-field "subject") "none")
+	    to (message-fetch-field "to")
+	    cc (message-fetch-field "cc")
+	    mct (message-fetch-field "mail-copies-to")
+	    reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
+	    references (message-fetch-field "references")
+	    message-id (message-fetch-field "message-id"))
+      ;; Remove any (buggy) Re:'s that are present and make a
+      ;; proper one.
+      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+	(setq subject (substring subject (match-end 0))))
+      (setq subject (concat "Re: " subject))
+
+      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+		 (string-match "<[^>]+>" gnus-warning))
+	(setq message-id (match-string 0 gnus-warning)))
+	    
+      ;; Handle special values of Mail-Copies-To.
+      (when mct
+	(cond ((equal (downcase mct) "never")
+	       (setq never-mct t)
+	       (setq mct nil))
+	      ((equal (downcase mct) "always")
+	       (setq mct (or reply-to from)))))
+
+      (unless follow-to
+	(if (or (not wide)
+		to-address)
+	    (setq follow-to (list (cons 'To (or to-address reply-to from))))
+	  (let (ccalist)
+	    (save-excursion
+	      (message-set-work-buffer)
+	      (unless never-mct
+		(insert (or reply-to from "")))
+	      (insert 
+	       (if (bolp) "" ", ") (or to "")
+	       (if mct (concat (if (bolp) "" ", ") mct) "")
+	       (if cc (concat (if (bolp) "" ", ") cc) ""))
+	      ;; Remove addresses that match `rmail-dont-reply-to-names'. 
+	      (insert (prog1 (rmail-dont-reply-to (buffer-string))
+			(erase-buffer)))
+	      (goto-char (point-min))
+	      (setq ccalist
+		    (mapcar
+		     (lambda (addr)
+		       (cons (mail-strip-quoted-names addr) addr))
+		     (nreverse (mail-parse-comma-list))))
+	      (let ((s ccalist))
+		(while s
+		  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+	    (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
+	    (when ccalist
+	      (push (cons 'Cc
+			  (mapconcat (lambda (addr) (cdr addr)) ccalist ", "))
+		    follow-to)))))
+      (widen))
+
+    (message-pop-to-buffer (message-buffer-name "reply" from))
+
+    (setq message-reply-headers
+	  (vector 0 subject from date message-id references 0 0 ""))
+
+    (message-setup
+     `((Subject . ,subject)
+       ,@follow-to 
+       ,@(if (or references message-id)
+	     `((References . ,(concat (or references "") (and references " ")
+				      (or message-id ""))))
+	   nil))
+     cur)))
+
+;;;###autoload
+(defun message-wide-reply (&optional to-address)
+  (interactive)
+  (message-reply to-address t))
+
+;;;###autoload
+(defun message-followup ()
+  (interactive)
+  (let ((cur (current-buffer))
+	from subject date reply-to mct
+	references message-id follow-to 
+	followup-to distribution newsgroups gnus-warning)
+    (save-restriction
+      (narrow-to-region
+       (goto-char (point-min))
+       (if (search-forward "\n\n" nil t)
+	   (1- (point))
+	 (point-max)))
+      (when (message-functionp message-followup-to-function)
+	(setq follow-to
+	      (funcall message-followup-to-function)))
+      (setq from (message-fetch-field "from")
+	    date (message-fetch-field "date") 
+	    subject (or (message-fetch-field "subject") "none")
+	    references (message-fetch-field "references")
+	    message-id (message-fetch-field "message-id")
+	    followup-to (message-fetch-field "followup-to")
+	    newsgroups (message-fetch-field "newsgroups")
+	    reply-to (message-fetch-field "reply-to")
+	    distribution (message-fetch-field "distribution")
+	    mct (message-fetch-field "mail-copies-to"))
+      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+		 (string-match "<[^>]+>" gnus-warning))
+	(setq message-id (match-string 0 gnus-warning)))
+      ;; Remove bogus distribution.
+      (and (stringp distribution)
+	   (string-match "world" distribution)
+	   (setq distribution nil))
+      ;; Remove any (buggy) Re:'s that are present and make a
+      ;; proper one.
+      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
+	(setq subject (substring subject (match-end 0))))
+      (setq subject (concat "Re: " subject))
+      (widen))
+
+    (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+
+    (message-setup
+     `((Subject . ,subject)
+       ,@(cond 
+	  (follow-to follow-to)
+	  ((and followup-to message-use-followup-to)
+	   (list
+	    (cond 
+	     ((equal (downcase followup-to) "poster")
+	      (if (or (eq message-use-followup-to 'use)
+		      (message-y-or-n-p "Obey Followup-To: poster? " t "\
+You should normally obey the Followup-To: header.
+
+`Followup-To: poster' sends your response via e-mail instead of news.
+
+A typical situation where `Followup-To: poster' is used is when the poster
+does not read the newsgroup, so he wouldn't see any replies sent to it."))
+		  (cons 'To (or reply-to from ""))
+		(cons 'Newsgroups newsgroups)))
+	     (t
+	      (if (or (equal followup-to newsgroups)
+		      (not (eq message-use-followup-to 'ask))
+		      (message-y-or-n-p
+		       (concat "Obey Followup-To: " followup-to "? ") t "\
+You should normally obey the Followup-To: header.
+
+	`Followup-To: " followup-to "'
+directs your response to " (if (string-match "," followup-to)
+			       "the specified newsgroups"
+			     "that newsgroup only") ".
+
+If a message is posted to several newsgroups, Followup-To is often
+used to direct the following discussion to one newsgroup only,
+because discussions that are spread over several newsgroup tend to
+be fragmented and very difficult to follow.
+
+Also, some source/announcment newsgroups are not indented for discussion;
+responses here are directed to other newsgroups."))
+		  (cons 'Newsgroups followup-to)
+		(cons 'Newsgroups newsgroups))))))
+	  (t
+	   `((Newsgroups . ,newsgroups))))
+       ,@(and distribution (list (cons 'Distribution distribution)))
+       (References . ,(concat (or references "") (and references " ")
+			      (or message-id "")))
+       ,@(when (and mct
+		    (not (equal (downcase mct) "never")))
+	   (list (cons 'Cc (if (equal (downcase mct) "always")
+			       (or reply-to from "")
+			     mct)))))
+
+     cur)
+
+    (setq message-reply-headers
+	  (vector 0 subject from date message-id references 0 0 ""))))
+
+
+;;;###autoload
+(defun message-cancel-news ()
+  "Cancel an article you posted."
+  (interactive)
+  (unless (message-news-p)
+    (error "This is not a news article; canceling is impossible"))
+  (when (yes-or-no-p "Do you really want to cancel this article? ")
+    (let (from newsgroups message-id distribution buf)
+      (save-excursion
+	;; Get header info. from original article.
+	(save-restriction
+	  (message-narrow-to-head)
+	  (setq from (message-fetch-field "from")
+		newsgroups (message-fetch-field "newsgroups")
+		message-id (message-fetch-field "message-id")
+		distribution (message-fetch-field "distribution")))
+	;; Make sure that this article was written by the user.
+	(unless (string-equal
+		 (downcase (cadr (mail-extract-address-components from)))
+		 (downcase (message-make-address)))
+	  (error "This article is not yours"))
+	;; Make control message.
+	(setq buf (set-buffer (get-buffer-create " *message cancel*")))
+	(buffer-disable-undo (current-buffer))
+	(erase-buffer)
+	(insert "Newsgroups: " newsgroups "\n"
+		"From: " (message-make-from) "\n"
+		"Subject: cmsg cancel " message-id "\n"
+		"Control: cancel " message-id "\n"
+		(if distribution
+		    (concat "Distribution: " distribution "\n")
+		  "")
+		mail-header-separator "\n"
+		"This is a cancel message from " from ".\n")
+	(message "Canceling your article...")
+	(let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
+	  (funcall message-send-news-function))
+	(message "Canceling your article...done")
+	(kill-buffer buf)))))
+
+;;;###autoload
+(defun message-supersede ()
+  "Start composing a message to supersede the current message.
+This is done simply by taking the old article and adding a Supersedes
+header line with the old Message-ID."
+  (interactive)
+  (let ((cur (current-buffer)))
+    ;; Check whether the user owns the article that is to be superseded. 
+    (unless (string-equal
+	     (downcase (cadr (mail-extract-address-components
+			      (message-fetch-field "from"))))
+	     (downcase (message-make-address)))
+      (error "This article is not yours"))
+    ;; Get a normal message buffer.
+    (message-pop-to-buffer (message-buffer-name "supersede"))
+    (insert-buffer-substring cur)
+    (message-narrow-to-head)
+    ;; Remove unwanted headers.
+    (when message-ignored-supersedes-headers
+      (message-remove-header message-ignored-supersedes-headers t))
+    (goto-char (point-min))
+    (if (not (re-search-forward "^Message-ID: " nil t))
+	(error "No Message-ID in this article")
+      (replace-match "Supersedes: " t t))
+    (goto-char (point-max))
+    (insert mail-header-separator)
+    (widen)
+    (forward-line 1)))
+
+;;;###autoload
+(defun message-recover ()
+  "Reread contents of current buffer from its last auto-save file."
+  (interactive)
+  (let ((file-name (make-auto-save-file-name)))
+    (cond ((save-window-excursion
+	     (if (not (eq system-type 'vax-vms))
+		 (with-output-to-temp-buffer "*Directory*"
+		   (buffer-disable-undo standard-output)
+		   (let ((default-directory "/"))
+		     (call-process
+		      "ls" nil standard-output nil "-l" file-name))))
+	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+	   (let ((buffer-read-only nil))
+	     (erase-buffer)
+	     (insert-file-contents file-name nil)))
+	  (t (error "message-recover cancelled")))))
+
+;;; Forwarding messages.
+
+(defun message-make-forward-subject ()
+  "Return a Subject header suitable for the message in the current buffer."
+  (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from"))
+		  "(nowhere)")
+	  "] " (or (message-fetch-field "Subject") "")))
+
+;;;###autoload
+(defun message-forward (&optional news)
+  "Forward the current message via mail.  
+Optional NEWS will use news to forward instead of mail."
+  (interactive "P")
+  (let ((cur (current-buffer))
+	(subject (message-make-forward-subject)))
+    (if news (message-news nil subject) (message-mail nil subject))
+    ;; Put point where we want it before inserting the forwarded
+    ;; message. 
+    (if message-signature-before-forwarded-message
+	(goto-char (point-max))
+      (message-goto-body))
+    ;; Make sure we're at the start of the line.
+    (unless (eolp)
+      (insert "\n"))
+    ;; Narrow to the area we are to insert.
+    (narrow-to-region (point) (point))
+    ;; Insert the separators and the forwarded buffer.
+    (insert message-forward-start-separator)
+    (insert-buffer-substring cur)
+    (goto-char (point-max))
+    (insert message-forward-end-separator)
+    (set-text-properties (point-min) (point-max) nil)
+    ;; Remove all unwanted headers.
+    (goto-char (point-min))
+    (forward-line 1)
+    (narrow-to-region (point) (if (search-forward "\n\n" nil t)
+				  (1- (point))
+				(point)))
+    (goto-char (point-min))
+    (message-remove-header message-included-forward-headers t nil t)
+    (widen)
+    (message-position-point)))
+
+;;;###autoload
+(defun message-resend (address)
+  "Resend the current article to ADDRESS."
+  (interactive "sResend message to: ")
+  (save-excursion
+    (let ((cur (current-buffer))
+	  beg)
+      ;; We first set up a normal mail buffer.
+      (set-buffer (get-buffer-create " *message resend*"))
+      (buffer-disable-undo (current-buffer))
+      (erase-buffer)
+      (message-setup `((To . ,address)))
+      ;; Insert our usual headers.
+      (message-generate-headers '(From Date To))
+      (message-narrow-to-headers)
+      ;; Rename them all to "Resent-*".
+      (while (re-search-forward "^[A-Za-z]" nil t)
+	(forward-char -1)
+	(insert "Resent-"))
+      (widen)
+      (forward-line)
+      (delete-region (point) (point-max))
+      (setq beg (point))
+      ;; Insert the message to be resent.
+      (insert-buffer-substring cur)
+      (goto-char (point-min))
+      (search-forward "\n\n")
+      (forward-char -1)
+      (save-restriction
+	(narrow-to-region beg (point))
+	(message-remove-header message-ignored-resent-headers t)
+	(goto-char (point-max)))
+      (insert mail-header-separator)
+      ;; Rename all old ("Also-")Resent headers.
+      (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+	(beginning-of-line)
+	(insert "Also-"))
+      ;; Send it.
+      (message-send-mail)
+      (kill-buffer (current-buffer)))))
+
+;;;###autoload
+(defun message-bounce ()
+  "Re-mail the current message.
+This only makes sense if the current message is a bounce message than
+contains some mail you have written which has been bounced back to
+you."
+  (interactive)
+  (let ((cur (current-buffer))
+	boundary)
+    (message-pop-to-buffer (message-buffer-name "bounce"))
+    (insert-buffer-substring cur)
+    (undo-boundary)
+    (message-narrow-to-head)
+    (if (and (message-fetch-field "Mime-Version")
+	     (setq boundary (message-fetch-field "Content-Type")))
+	(if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
+	    (setq boundary (concat (match-string 1 boundary) " *\n"
+				   "Content-Type: message/rfc822"))
+	  (setq boundary nil)))
+    (widen)
+    (goto-char (point-min))
+    (search-forward "\n\n" nil t)
+    (or (and boundary
+	     (re-search-forward boundary nil t)
+	     (forward-line 2))
+	(and (re-search-forward message-unsent-separator nil t)
+	     (forward-line 1))
+	(and (search-forward "\n\n" nil t)
+	     (re-search-forward "^Return-Path:.*\n" nil t)))
+    ;; We remove everything before the bounced mail.
+    (delete-region 
+     (point-min)
+     (if (re-search-forward "^[^ \n\t]+:" nil t)
+	 (match-beginning 0)
+       (point)))
+    (save-restriction
+      (message-narrow-to-head)
+      (message-remove-header message-ignored-bounced-headers t)
+      (goto-char (point-max))
+      (insert mail-header-separator))
+    (message-position-point)))
+
+;;;
+;;; Interactive entry points for new message buffers.
+;;;
+
+;;;###autoload
+(defun message-mail-other-window (&optional to subject)
+  "Like `message-mail' command, but display mail buffer in another window."
+  (interactive)
+  (let ((pop-up-windows t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(same-window-buffer-names nil)
+	(same-window-regexps nil))
+    (message-pop-to-buffer (message-buffer-name "mail" to)))
+  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-mail-other-frame (&optional to subject)
+  "Like `message-mail' command, but display mail buffer in another frame."
+  (interactive)
+  (let ((pop-up-frames t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(same-window-buffer-names nil)
+	(same-window-regexps nil))
+    (message-pop-to-buffer (message-buffer-name "mail" to)))
+  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news-other-window (&optional newsgroups subject)
+  "Start editing a news article to be sent."
+  (interactive)
+  (let ((pop-up-windows t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(same-window-buffer-names nil)
+	(same-window-regexps nil))
+    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+  (message-setup `((Newsgroups . ,(or newsgroups "")) 
+		   (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news-other-frame (&optional newsgroups subject)
+  "Start editing a news article to be sent."
+  (interactive)
+  (let ((pop-up-frames t)
+	(special-display-buffer-names nil)
+	(special-display-regexps nil)
+	(same-window-buffer-names nil)
+	(same-window-regexps nil))
+    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+  (message-setup `((Newsgroups . ,(or newsgroups "")) 
+		   (Subject . ,(or subject "")))))
+
+;;; underline.el
+
+;; This code should be moved to underline.el (from which it is stolen). 
+
+;;;###autoload
+(defun bold-region (start end)
+  "Bold all nonblank characters in the region.
+Works by overstriking characters.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  (interactive "r")
+  (save-excursion
+   (let ((end1 (make-marker)))
+     (move-marker end1 (max start end))
+     (goto-char (min start end))
+     (while (< (point) end1)
+       (or (looking-at "[_\^@- ]")
+	   (insert (following-char) "\b"))
+       (forward-char 1)))))
+
+;;;###autoload
+(defun unbold-region (start end)
+  "Remove all boldness (overstruck characters) in the region.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  (interactive "r")
+  (save-excursion
+   (let ((end1 (make-marker)))
+     (move-marker end1 (max start end))
+     (goto-char (min start end)) 
+     (while (re-search-forward "\b" end1 t)
+       (if (eq (following-char) (char-after (- (point) 2)))
+	   (delete-char -2))))))
+
+(fset 'message-exchange-point-and-mark 'exchange-point-and-mark)
+
+;; Support for toolbar
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+  (require 'messagexmas))
+
+;;; Group name completion.
+
+(defvar message-newgroups-header-regexp
+  "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):"
+  "Regexp that match headers that lists groups.")
+
+(defun message-tab ()
+  "Expand group names in Newsgroups and Followup-To headers.
+Do a `tab-to-tab-stop' if not in those headers."
+  (interactive)
+  (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
+	(mail-abbrev-in-expansion-header-p))
+      (message-expand-group)
+    (tab-to-tab-stop)))
+
+(defvar gnus-active-hashtb)
+(defun message-expand-group ()
+  (let* ((b (save-excursion (skip-chars-backward "^, :\t\n") (point)))
+	 (completion-ignore-case t)
+	 (string (buffer-substring b (point)))
+	 (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
+	 (completions (all-completions string hashtb))
+	 (cur (current-buffer))
+	 comp)
+    (delete-region b (point))
+    (cond 
+     ((= (length completions) 1)
+      (if (string= (car completions) string)
+	  (progn
+	    (insert string)
+	    (message "Only matching group"))
+	(insert (car completions))))
+     ((and (setq comp (try-completion string hashtb))
+	   (not (string= comp string)))
+      (insert comp))
+     (t
+      (insert string)
+      (if (not comp)
+	  (message "No matching groups")
+	(pop-to-buffer "*Completions*")
+	(buffer-disable-undo (current-buffer))
+	(let ((buffer-read-only nil))
+	  (erase-buffer)
+	  (let ((standard-output (current-buffer)))
+	    (display-completion-list (sort completions 'string<)))
+	  (goto-char (point-min))
+	  (pop-to-buffer cur)))))))
+
+;;; Help stuff.
+
+(defmacro message-y-or-n-p (question show &rest text)
+  "Ask QUESTION, displaying the rest of the arguments in a temporary buffer."
+  `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
+
+(defun message-talkative-question (ask question show &rest text)
+  "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.  
+The following arguments may contain lists of values."
+  (if (and show
+	   (setq text (message-flatten-list text)))
+      (save-window-excursion
+	(save-excursion
+	  (with-output-to-temp-buffer " *MESSAGE information message*"
+	    (set-buffer " *MESSAGE information message*")
+	    (mapcar 'princ text)
+	    (goto-char (point-min))))
+	(funcall ask question))
+    (funcall ask question)))
+
+(defun message-flatten-list (&rest list)
+  (message-flatten-list-1 list))
+
+(defun message-flatten-list-1 (list)
+  (cond ((consp list) 
+	 (apply 'append (mapcar 'message-flatten-list-1 list)))
+	(list
+	 (list list))))
+
+(run-hooks 'message-load-hook)
+
+(provide 'message)
+
+;;; message.el ends here
diff --git a/lisp/nndb.el b/lisp/nndb.el
new file mode 100644
index 00000000000..15d82ec4f1c
--- /dev/null
+++ b/lisp/nndb.el
@@ -0,0 +1,229 @@
+;;; nndb.el --- nndb access for Gnus
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; I have shamelessly snarfed the code of nntp.el from sgnus.
+;;              Kai
+
+
+;;-
+;; Register nndb with known select methods.
+
+(setq gnus-valid-select-methods
+      (cons '("nndb" mail address respool prompt-address)
+            gnus-valid-select-methods))
+
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nntp)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (unless (fboundp 'open-network-stream)
+    (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (autoload 'news-setup "rnewspost")
+  (autoload 'news-reply-mode "rnewspost")
+  (autoload 'cancel-timer "timer")
+  (autoload 'telnet "telnet" nil t)
+  (autoload 'telnet-send-input "telnet" nil t)
+  (autoload 'timezone-parse-date "timezone"))
+
+;; Declare nndb as derived from nntp
+
+(nnoo-declare nndb nntp)
+
+;; Variables specific to nndb
+
+;;- currently not used but just in case...
+(defvoo nndb-deliver-program "nndel"
+  "*The program used to put a message in an NNDB group.")
+
+;; Variables copied from nntp
+
+(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
+  "Like nntp-server-opened-hook."
+  nntp-server-opened-hook)
+
+;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000")
+;  "*Parameters to nndb-open-login.  Like nntp-rlogin-parameters."
+;  nntp-rlogin-parameters)
+
+;(defvoo nndb-rlogin-user-name nil
+;  "*User name for rlogin connect method."
+;  nntp-rlogin-user-name)
+
+(defvoo nndb-address "localhost"
+  "*The name of the NNDB server."
+  nntp-address)
+
+(defvoo nndb-port-number 9000
+  "*Port number to connect to."
+  nntp-port-number)
+
+;(defvoo nndb-current-group ""
+;  "Like nntp-current-group."
+;  nntp-current-group)
+
+(defvoo nndb-status-string nil "" nntp-status-string)
+
+
+
+(defconst nndb-version "nndb 0.3"
+  "Version numbers of this version of NNDB.")
+
+
+;;; Interface functions.
+
+(nnoo-define-basics nndb)
+
+;; Import other stuff from nntp as is.
+
+(nnoo-import nndb
+  (nntp))
+
+;;- maybe this should be mail??
+;;-(defun nndb-request-type (group &optional article)
+;;-  'news)
+
+;;------------------------------------------------------------------
+;;- only new stuff below
+
+; nndb-request-update-info does not exist and is not needed
+
+; nndb-request-update-mark does not exist and is not needed
+
+; nndb-request-scan does not exist
+; get new mail from somewhere -- maybe this is not needed?
+; --> todo
+
+(deffoo nndb-request-create-group (group &optional server)
+  "Creates a group if it doesn't exist yet."
+  (nntp-send-command "^[23].*\n" "MKGROUP" group))
+
+; todo -- use some other time than the creation time of the article
+; best is time since article has been marked as expirable
+(deffoo nndb-request-expire-articles
+  (articles &optional group server force)
+  "Expires ARTICLES from GROUP on SERVER.
+If FORCE, delete regardless of exiration date, otherwise use normal
+expiry mechanism."
+  (let (msg art)
+    (nntp-possibly-change-server group server) ;;-
+    (while articles
+      (setq art (pop articles))
+      (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
+      (setq msg (nndb-status-message))
+      ;; CCC we shouldn't be using the variable nndb-status-string?
+      (if (string-match "^423" (nnheader-get-report 'nndb))
+          ()
+        (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
+            (error "Not a valid response for DATE command: %s"
+                   msg))
+        (if (nnmail-expired-article-p
+             group
+             (list (string-to-int
+                    (substring msg (match-beginning 1) (match-end 1)))
+                   (string-to-int
+                    (substring msg (match-beginning 2) (match-end 2))))
+             force)
+            (nnheader-message 5 "Deleting article %s in %s..."
+                              art group)
+          (nntp-send-command "^[23].*\n" "DELETE" art))))))
+
+(deffoo nndb-request-move-article
+  (article group server accept-form &optional last)
+  "Move ARTICLE (a number) from GROUP on SERVER.
+Evals ACCEPT-FORM in current buffer, where the article is.
+Optional LAST is ignored."
+  (let ((artbuf (get-buffer-create " *nndb move*"))
+	result)
+    (and
+     (nndb-request-article article group server artbuf)
+     (save-excursion
+       (set-buffer artbuf)
+       (setq result (eval accept-form))
+       (kill-buffer (current-buffer))
+       result)
+     (nndb-request-expire-articles (list article)
+                                   group
+                                   server
+                                   t))
+    result))
+  
+(deffoo nndb-request-accept-article (group server &optional last)
+  "The article in the current buffer is put into GROUP."
+  (nntp-possibly-change-server group server) ;;-
+  (let (art statmsg)
+    (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
+      (nnheader-insert "")
+      (nntp-encode-text)
+      (nntp-send-region-to-server (point-min) (point-max))
+      ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+      ;;  appended to end of the status message.
+      (nntp-wait-for-response "^[23].*\n")
+      (setq statmsg (nntp-status-message))
+      (or (string-match "^\\([0-9]+\\)" statmsg)
+          (error "nndb: %s" statmsg))
+      (setq art (substring statmsg
+                           (match-beginning 1)
+                           (match-end 1)))
+      (message "nndb: accepted %s" art)
+      (list art))))
+
+(deffoo nndb-request-replace-article (article group buffer)
+  "ARTICLE is the number of the article in GROUP to be replaced 
+with the contents of the BUFFER."
+  (set-buffer buffer)
+  (let (art statmsg)
+    (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
+      (nnheader-insert "")
+      (nntp-encode-text)
+      (nntp-send-region-to-server (point-min) (point-max))
+      ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+      ;;  appended to end of the status message.
+      (nntp-wait-for-response "^[23].*\n")
+;      (setq statmsg (nntp-status-message))
+;      (or (string-match "^\\([0-9]+\\)" statmsg)
+;          (error "nndb: %s" statmsg))
+;      (setq art (substring statmsg
+;                           (match-beginning 1)
+;                           (match-end 1)))
+;      (message "nndb: replaced %s" art)
+      (list (int-to-string article)))))
+
+; nndb-request-delete-group does not exist
+; todo -- maybe later
+
+; nndb-request-rename-group does not exist
+; todo -- maybe later
+
+(provide 'nndb)
+
+
diff --git a/lisp/nnheaderems.el b/lisp/nnheaderems.el
new file mode 100644
index 00000000000..14ce490bb17
--- /dev/null
+++ b/lisp/nnheaderems.el
@@ -0,0 +1,201 @@
+;;; nnheaderems.el --- making Gnus backends work under different Emacsen
+;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(defun nnheader-xmas-run-at-time (time repeat function &rest args)
+  (start-itimer
+   "nnheader-run-at-time"
+   `(lambda ()
+      (,function ,@args))
+   time repeat))
+
+(defun nnheader-xmas-cancel-timer (timer)
+  (delete-itimer timer))
+
+;; Written by Erik Naggum <erik@naggum.no>.
+;; Saved by Steve Baur <steve@miranova.com>.
+(defun nnheader-xmas-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-xmas-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-ms-strip-cr ()
+  "Strip ^M from the end of all lines."
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "\r$" nil t)
+      (delete-backward-char 1))))
+
+(eval-and-compile
+  (cond 
+   ;; Do XEmacs function bindings.
+   ((string-match "XEmacs\\|Lucid" emacs-version)
+    (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
+    (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
+    (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect)
+    (fset 'nnheader-insert-file-contents-literally
+	  (if (fboundp 'insert-file-contents-literally)
+	      'insert-file-contents-literally
+	    'nnheader-xmas-insert-file-contents-literally)))
+   ;; Do Emacs function bindings.
+   (t
+    (fset 'nnheader-run-at-time 'run-at-time)
+    (fset 'nnheader-cancel-timer 'cancel-timer)
+    (fset 'nnheader-find-file-noselect 'find-file-noselect)
+    (fset 'nnheader-insert-file-contents-literally
+	  'insert-file-contents-literally)
+    ))
+  (when (memq system-type '(windows-nt))
+    (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr)))
+
+(provide 'nnheaderems)
+
+;;; nnheaderems.el ends here.
diff --git a/lisp/nnoo.el b/lisp/nnoo.el
new file mode 100644
index 00000000000..cddba4ae564
--- /dev/null
+++ b/lisp/nnoo.el
@@ -0,0 +1,251 @@
+;;; nnoo.el --- OO Gnus Backends
+;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar nnoo-definition-alist nil)
+(defvar nnoo-state-alist nil)
+
+(defmacro defvoo (var init &optional doc &rest map)
+  "The same as `defvar', only takes list of variables to MAP to."
+  `(prog1
+       ,(if doc
+	    `(defvar ,var ,init ,doc)
+	  `(defvar ,var ,init))
+     (nnoo-define ',var ',map)))
+(put 'defvoo 'lisp-indent-function 2)
+(put 'defvoo 'lisp-indent-hook 2)
+(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
+
+(defmacro deffoo (func args &rest forms)
+  "The same as `defun', only register FUNC."
+  `(prog1
+       (defun ,func ,args ,@forms)
+     (nnoo-register-function ',func)))
+(put 'deffoo 'lisp-indent-function 2)
+(put 'deffoo 'lisp-indent-hook 2)
+(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
+
+(defun nnoo-register-function (func)
+  (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) 
+				nnoo-definition-alist))))
+    (unless funcs
+      (error "%s belongs to a backend that hasn't been declared" func))
+    (setcar funcs (cons func (car funcs)))))
+
+(defmacro nnoo-declare (backend &rest parents)
+  `(eval-and-compile
+     (push (list ',backend 
+		 (mapcar (lambda (p) (list p)) ',parents)
+		 nil nil)
+	   nnoo-definition-alist)))
+(put 'nnoo-declare 'lisp-indent-function 1)
+(put 'nnoo-declare 'lisp-indent-hook 1)
+
+(defun nnoo-parents (backend)
+  (nth 1 (assoc backend nnoo-definition-alist)))
+
+(defun nnoo-variables (backend)
+  (nth 2 (assoc backend nnoo-definition-alist)))
+
+(defun nnoo-functions (backend)
+  (nth 3 (assoc backend nnoo-definition-alist)))
+
+(defmacro nnoo-import (backend &rest imports)
+  `(nnoo-import-1 ',backend ',imports))
+(put 'nnoo-import 'lisp-indent-function 1)
+(put 'nnoo-import 'lisp-indent-hook 1)
+
+(defun nnoo-import-1 (backend imports)
+  (let ((call-function
+	 (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
+	imp functions function)
+    (while (setq imp (pop imports))
+      (setq functions
+	    (or (cdr imp)
+		(nnoo-functions (car imp))))
+      (while functions
+	(unless (fboundp (setq function
+			       (nnoo-symbol backend (nnoo-rest-symbol
+							 (car functions)))))
+	  (eval `(deffoo ,function (&rest args)
+		   (,call-function ',backend ',(car functions) args))))
+	(pop functions)))))
+
+(defun nnoo-parent-function (backend function args)
+  (let* ((pbackend (nnoo-backend function)))
+    (nnoo-change-server pbackend (nnoo-current-server backend)
+			(cdr (assq pbackend (nnoo-parents backend))))
+    (apply function args)))
+
+(defun nnoo-execute (backend function &rest args)
+  "Execute FUNCTION on behalf of BACKEND."
+  (let* ((pbackend (nnoo-backend function)))
+    (nnoo-change-server pbackend (nnoo-current-server backend)
+			(cdr (assq pbackend (nnoo-parents backend))))
+    (apply function args)))
+
+(defmacro nnoo-map-functions (backend &rest maps)
+  `(nnoo-map-functions-1 ',backend ',maps))
+(put 'nnoo-map-functions 'lisp-indent-function 1)
+(put 'nnoo-map-functions 'lisp-indent-hook 1)
+
+(defun nnoo-map-functions-1 (backend maps)
+  (let (m margs i)
+    (while (setq m (pop maps))
+      (setq i 0
+	    margs nil)
+      (while (< i (length (cdr m)))
+	(if (numberp (nth i (cdr m)))
+	    (push `(nth ,i args) margs)
+	  (push (nth i (cdr m)) margs))
+	(incf i))
+      (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
+		 (&rest args)
+	       (nnoo-parent-function ',backend ',(car m) 
+				     ,(cons 'list (nreverse margs))))))))
+  
+(defun nnoo-backend (symbol)
+  (string-match "^[^-]+-" (symbol-name symbol))
+  (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
+
+(defun nnoo-rest-symbol (symbol)
+  (string-match "^[^-]+-" (symbol-name symbol))
+  (intern (substring (symbol-name symbol) (match-end 0))))
+
+(defun nnoo-symbol (backend symbol)
+  (intern (format "%s-%s" backend symbol)))
+
+(defun nnoo-define (var map)
+  (let* ((backend (nnoo-backend var))
+	 (def (assq backend nnoo-definition-alist))
+	 (parents (nth 1 def)))
+    (unless def
+      (error "%s belongs to a backend that hasn't been declared." var))
+    (setcar (nthcdr 2 def) 
+	    (delq (assq var (nth 2 def)) (nth 2 def)))
+    (setcar (nthcdr 2 def)
+	    (cons (cons var (symbol-value var))
+		  (nth 2 def)))
+    (while map
+      (nconc (assq (nnoo-backend (car map)) parents)
+	     (list (list (pop map) var))))))
+
+(defun nnoo-change-server (backend server defs)
+  (let* ((bstate (cdr (assq backend nnoo-state-alist)))
+	 (sdefs (assq backend nnoo-definition-alist))
+	 (current (car bstate))
+	 (parents (nnoo-parents backend))
+	 state)
+    (unless bstate
+      (push (setq bstate (list backend nil))
+	    nnoo-state-alist)
+      (pop bstate))
+    (if (equal server current)
+	t
+      (nnoo-push-server backend current)
+      (setq state (or (cdr (assoc server (cddr bstate)))
+		      (nnoo-variables backend)))
+      (while state
+	(set (caar state) (cdar state))
+	(pop state))
+      (setcar bstate server)
+      (unless (cdr (assoc server (cddr bstate)))
+	(while defs
+	  (set (caar defs) (cadar defs))
+	  (pop defs)))
+      (while parents
+	(nnoo-change-server 
+	 (caar parents) server 
+	 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
+		 (cdar parents)))
+	(pop parents))))
+  t)
+
+(defun nnoo-push-server (backend current)
+  (let ((bstate (assq backend nnoo-state-alist))
+	(defs (nnoo-variables backend)))
+    ;; Remove the old definition.
+    (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
+    (let (state)
+      (while defs
+	(push (cons (caar defs) (symbol-value (caar defs)))
+	      state)
+	(pop defs))
+      (nconc bstate (list (cons current state))))))
+
+(defun nnoo-current-server-p (backend server)
+  (equal (nnoo-current-server backend) server))
+
+(defun nnoo-current-server (backend)
+  (nth 1 (assq backend nnoo-state-alist)))
+
+(defun nnoo-close-server (backend &optional server)
+  (unless server
+    (setq server (nnoo-current-server backend)))
+  (when server
+    (let* ((bstate (cdr (assq backend nnoo-state-alist)))
+	   (defs (assoc server (cdr bstate))))
+      (when bstate
+	(setcar bstate nil)
+	(setcdr bstate (delq defs (cdr bstate)))
+	(pop defs)
+	(while defs
+	  (set (car (pop defs)) nil)))))
+  t)
+
+(defun nnoo-close (backend)
+  (setq nnoo-state-alist
+	(delq (assq backend nnoo-state-alist)
+	      nnoo-state-alist))
+  t)
+
+(defun nnoo-status-message (backend server)
+  (nnheader-get-report backend))
+
+(defun nnoo-server-opened (backend server)
+  (and (nnoo-current-server-p backend server)
+       nntp-server-buffer
+       (buffer-name nntp-server-buffer)))
+
+(defmacro nnoo-define-basics (backend)
+  `(eval-and-compile
+     (nnoo-define-basics-1 ',backend)))
+
+(defun nnoo-define-basics-1 (backend)
+  (let ((functions '(close-server server-opened status-message)))
+    (while functions
+      (eval `(deffoo ,(nnoo-symbol backend (car functions)) 
+		 (&optional server)
+	       (,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
+  (eval `(deffoo ,(nnoo-symbol backend 'open-server)
+	     (server &optional defs)
+	   (nnoo-change-server ',backend server defs))))
+
+(provide 'nnoo)
+
+;;; nnoo.el ends here.
diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el
new file mode 100644
index 00000000000..03e80fef9ab
--- /dev/null
+++ b/lisp/nnsoup.el
@@ -0,0 +1,747 @@
+;;; nnsoup.el --- SOUP access for Gnus
+;; Copyright (C) 1995,96 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'nnheader)
+(require 'nnmail)
+(require 'gnus-soup)
+(require 'gnus-msg)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
+
+(nnoo-declare nnsoup)
+
+(defvoo nnsoup-directory "~/SOUP/"
+  "*SOUP packet directory.")
+
+(defvoo nnsoup-tmp-directory "/tmp/"
+  "*Where nnsoup will store temporary files.")
+
+(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/")
+  "*Directory where outgoing packets will be composed.")
+
+(defvoo nnsoup-replies-format-type ?n
+  "*Format of the replies packages.")
+
+(defvoo nnsoup-replies-index-type ?n
+  "*Index type of the replies packages.")
+
+(defvoo nnsoup-active-file (concat nnsoup-directory "active")
+  "Active file.")
+
+(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
+  "Format string command for packing a SOUP packet.
+The SOUP files will be inserted where the %s is in the string.
+This string MUST contain both %s and %d. The file number will be
+inserted where %d appears.")
+
+(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
+  "*Format string command for unpacking a SOUP packet.
+The SOUP packet file name will be inserted at the %s.")
+
+(defvoo nnsoup-packet-directory "~/"
+  "*Where nnsoup will look for incoming packets.")
+
+(defvoo nnsoup-packet-regexp "Soupout"
+  "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
+
+
+
+(defconst nnsoup-version "nnsoup 0.0"
+  "nnsoup version.")
+
+(defvoo nnsoup-status-string "")
+(defvoo nnsoup-group-alist nil)
+(defvoo nnsoup-current-prefix 0)
+(defvoo nnsoup-replies-list nil)
+(defvoo nnsoup-buffers nil)
+(defvoo nnsoup-current-group nil)
+(defvoo nnsoup-group-alist-touched nil)
+
+
+
+;;; Interface functions.
+
+(nnoo-define-basics nnsoup)
+
+(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
+  (nnsoup-possibly-change-group group)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
+	  (articles sequence)
+	  (use-nov t)
+	  useful-areas this-area-seq msg-buf)
+      (if (stringp (car sequence))
+	  ;; We don't support fetching by Message-ID.
+	  'headers
+	;; We go through all the areas and find which files the
+	;; articles in SEQUENCE come from.
+	(while (and areas sequence)
+	  ;; Peel off areas that are below sequence.
+	  (while (and areas (< (cdaar areas) (car sequence)))
+	    (setq areas (cdr areas)))
+	  (when areas
+	    ;; This is a useful area.
+	    (push (car areas) useful-areas)
+	    (setq this-area-seq nil)
+	    ;; We take note whether this MSG has a corresponding IDX
+	    ;; for later use.
+	    (when (or (= (gnus-soup-encoding-index 
+			  (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
+		      (not (file-exists-p
+			    (nnsoup-file
+			     (gnus-soup-area-prefix (nth 1 (car areas)))))))
+	      (setq use-nov nil))
+	    ;; We assign the portion of `sequence' that is relevant to
+	    ;; this MSG packet to this packet.
+	    (while (and sequence (<= (car sequence) (cdaar areas)))
+	      (push (car sequence) this-area-seq)
+	      (setq sequence (cdr sequence)))
+	    (setcar useful-areas (cons (nreverse this-area-seq)
+				       (car useful-areas)))))
+
+	;; We now have a list of article numbers and corresponding
+	;; areas. 
+	(setq useful-areas (nreverse useful-areas))
+
+	;; Two different approaches depending on whether all the MSG
+	;; files have corresponding IDX files.  If they all do, we
+	;; simply return the relevant IDX files and let Gnus sort out
+	;; what lines are relevant.  If some of the IDX files are
+	;; missing, we must return HEADs for all the articles.
+	(if use-nov
+	    ;; We have IDX files for all areas.
+	    (progn
+	      (while useful-areas
+		(goto-char (point-max))
+		(let ((b (point))
+		      (number (car (nth 1 (car useful-areas))))
+		      (index-buffer (nnsoup-index-buffer
+				     (gnus-soup-area-prefix
+				      (nth 2 (car useful-areas))))))
+		  (when index-buffer
+		    (insert-buffer-substring index-buffer)
+		    (goto-char b)
+		    ;; We have to remove the index number entires and
+		    ;; insert article numbers instead.
+		    (while (looking-at "[0-9]+")
+		      (replace-match (int-to-string number) t t)
+		      (incf number)
+		      (forward-line 1))))
+		(setq useful-areas (cdr useful-areas)))
+	      'nov)
+	  ;; We insert HEADs.
+	  (while useful-areas
+	    (setq articles (caar useful-areas)
+		  useful-areas (cdr useful-areas))
+	    (while articles
+	      (when (setq msg-buf
+			  (nnsoup-narrow-to-article 
+			   (car articles) (cdar useful-areas) 'head))
+		(goto-char (point-max))
+		(insert (format "221 %d Article retrieved.\n" (car articles)))
+		(insert-buffer-substring msg-buf)
+		(goto-char (point-max))
+		(insert ".\n"))
+	      (setq articles (cdr articles))))
+
+	  (nnheader-fold-continuation-lines)
+	  'headers)))))
+
+(deffoo nnsoup-open-server (server &optional defs)
+  (nnoo-change-server 'nnsoup server defs)
+  (when (not (file-exists-p nnsoup-directory))
+    (condition-case ()
+	(make-directory nnsoup-directory t)
+      (error t)))
+  (cond 
+   ((not (file-exists-p nnsoup-directory))
+    (nnsoup-close-server)
+    (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
+   ((not (file-directory-p (file-truename nnsoup-directory)))
+    (nnsoup-close-server)
+    (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
+   (t
+    (nnsoup-read-active-file)
+    (nnheader-report 'nnsoup "Opened server %s using directory %s"
+		     server nnsoup-directory)
+    t)))
+
+(deffoo nnsoup-request-close ()
+  (nnsoup-write-active-file)
+  (nnsoup-write-replies)
+  (gnus-soup-save-areas)
+  ;; Kill all nnsoup buffers.
+  (let (buffer)
+    (while nnsoup-buffers
+      (setq buffer (cdr (pop nnsoup-buffers)))
+      (and buffer
+	   (buffer-name buffer)
+	   (kill-buffer buffer))))
+  (setq nnsoup-group-alist nil
+	nnsoup-group-alist-touched nil
+	nnsoup-current-group nil
+	nnsoup-replies-list nil)
+  (nnoo-close-server 'nnoo)
+  t)
+
+(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
+  (nnsoup-possibly-change-group newsgroup)
+  (let (buf)
+    (save-excursion
+      (set-buffer (or buffer nntp-server-buffer))
+      (erase-buffer)
+      (when (and (not (stringp id))
+		 (setq buf (nnsoup-narrow-to-article id)))
+	(insert-buffer-substring buf)
+	t))))
+
+(deffoo nnsoup-request-group (group &optional server dont-check)
+  (nnsoup-possibly-change-group group)
+  (if dont-check 
+      t
+    (let ((active (cadr (assoc group nnsoup-group-alist))))
+      (if (not active)
+	  (nnheader-report 'nnsoup "No such group: %s" group)
+	(nnheader-insert 
+	 "211 %d %d %d %s\n" 
+	 (max (1+ (- (cdr active) (car active))) 0) 
+	 (car active) (cdr active) group)))))
+
+(deffoo nnsoup-request-type (group &optional article)
+  (nnsoup-possibly-change-group group)
+  (if (not article)
+      'unknown
+    (let ((kind (gnus-soup-encoding-kind 
+		 (gnus-soup-area-encoding
+		  (nth 1 (nnsoup-article-to-area
+			  article nnsoup-current-group))))))
+      (cond ((= kind ?m) 'mail)
+	    ((= kind ?n) 'news)
+	    (t 'unknown)))))
+
+(deffoo nnsoup-close-group (group &optional server)
+  ;; Kill all nnsoup buffers.
+  (let ((buffers nnsoup-buffers)
+	elem)
+    (while buffers
+      (when (equal (car (setq elem (pop buffers))) group)
+	(setq nnsoup-buffers (delq elem nnsoup-buffers))
+	(and (cdr elem) (buffer-name (cdr elem))
+	     (kill-buffer (cdr elem))))))
+  t)
+
+(deffoo nnsoup-request-list (&optional server)
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (erase-buffer)
+    (unless nnsoup-group-alist
+      (nnsoup-read-active-file))
+    (let ((alist nnsoup-group-alist)
+	  (standard-output (current-buffer))
+	  entry)
+      (while (setq entry (pop alist))
+	(insert (car entry) " ")
+	(princ (cdadr entry))
+	(insert " ")
+	(princ (caadr entry))
+	(insert " y\n"))
+      t)))
+
+(deffoo nnsoup-request-scan (group &optional server)
+  (nnsoup-unpack-packets))
+
+(deffoo nnsoup-request-newgroups (date &optional server)
+  (nnsoup-request-list))
+
+(deffoo nnsoup-request-list-newsgroups (&optional server)
+  nil)
+
+(deffoo nnsoup-request-post (&optional server)
+  (nnsoup-store-reply "news")
+  t)
+
+(deffoo nnsoup-request-mail (&optional server)
+  (nnsoup-store-reply "mail")
+  t)
+
+(deffoo nnsoup-request-expire-articles (articles group &optional server force)
+  (nnsoup-possibly-change-group group)
+  (let* ((total-infolist (assoc group nnsoup-group-alist))
+	 (active (cadr total-infolist))
+	 (infolist (cddr total-infolist))
+	 info range-list mod-time prefix)
+    (while infolist
+      (setq info (pop infolist)
+	    range-list (gnus-uncompress-range (car info))
+	    prefix (gnus-soup-area-prefix (nth 1 info)))
+      (when ;; All the articles in this file are marked for expiry.
+	  (and (or (setq mod-time (nth 5 (file-attributes
+					  (nnsoup-file prefix))))
+		   (setq mod-time (nth 5 (file-attributes
+					  (nnsoup-file prefix t)))))
+	       (gnus-sublist-p articles range-list)
+	       ;; This file is old enough. 
+	       (nnmail-expired-article-p group mod-time force))
+	;; Ok, we delete this file.
+	(when (condition-case nil
+		  (progn
+		    (nnheader-message 
+		     5 "Deleting %s in group %s..." (nnsoup-file prefix)
+		     group)
+		    (when (file-exists-p (nnsoup-file prefix))
+		      (delete-file (nnsoup-file prefix)))
+		    (nnheader-message 
+		     5 "Deleting %s in group %s..." (nnsoup-file prefix t)
+		     group)
+		    (when (file-exists-p (nnsoup-file prefix t))
+		      (delete-file (nnsoup-file prefix t)))
+		    t)
+		(error nil))
+	  (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
+	  (setq articles (gnus-sorted-complement articles range-list))))
+      (when (not mod-time)
+	(setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
+    (if (cddr total-infolist)
+	(setcar active (caaadr (cdr total-infolist)))
+      (setcar active (1+ (cdr active))))
+    (nnsoup-write-active-file t)
+    ;; Return the articles that weren't expired.
+    articles))
+
+
+;;; Internal functions
+
+(defun nnsoup-possibly-change-group (group &optional force)
+  (if group
+      (setq nnsoup-current-group group)
+    t))
+
+(defun nnsoup-read-active-file ()
+  (setq nnsoup-group-alist nil)
+  (when (file-exists-p nnsoup-active-file)
+    (condition-case ()
+	(load nnsoup-active-file t t t)
+      (error nil))
+    ;; Be backwards compatible.
+    (when (and nnsoup-group-alist
+	       (not (atom (caadar nnsoup-group-alist))))
+      (let ((alist nnsoup-group-alist)
+	    entry e min max)
+	(while (setq e (cdr (setq entry (pop alist))))
+	  (setq min (caaar e))
+	  (while (cdr e)
+	    (setq e (cdr e)))
+	  (setq max (cdaar e))
+	  (setcdr entry (cons (cons min max) (cdr entry)))))
+      (setq nnsoup-group-alist-touched t))
+    nnsoup-group-alist))
+
+(defun nnsoup-write-active-file (&optional force)
+  (when (and nnsoup-group-alist
+	     (or force 
+		 nnsoup-group-alist-touched))
+    (setq nnsoup-group-alist-touched nil)
+    (nnheader-temp-write nnsoup-active-file
+      (let ((standard-output (current-buffer)))
+	(prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
+	(insert "\n")
+	(prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
+	(insert "\n")))))
+
+(defun nnsoup-next-prefix ()
+  "Return the next free prefix."
+  (let (prefix)
+    (while (or (file-exists-p 
+		(nnsoup-file (setq prefix (int-to-string
+					   nnsoup-current-prefix))))
+	       (file-exists-p (nnsoup-file prefix t)))
+      (incf nnsoup-current-prefix))
+    (incf nnsoup-current-prefix)
+    prefix))
+
+(defun nnsoup-read-areas ()
+  (save-excursion
+    (set-buffer nntp-server-buffer)
+    (let ((areas (gnus-soup-parse-areas (concat nnsoup-tmp-directory "AREAS")))
+	  entry number area lnum cur-prefix file)
+      ;; Go through all areas in the new AREAS file.
+      (while (setq area (pop areas))
+	;; Change the name to the permanent name and move the files.
+	(setq cur-prefix (nnsoup-next-prefix))
+	(message "Incorporating file %s..." cur-prefix)
+	(when (file-exists-p 
+	       (setq file (concat nnsoup-tmp-directory
+				  (gnus-soup-area-prefix area) ".IDX")))
+	  (rename-file file (nnsoup-file cur-prefix)))
+	(when (file-exists-p 
+	       (setq file (concat nnsoup-tmp-directory 
+				  (gnus-soup-area-prefix area) ".MSG")))
+	  (rename-file file (nnsoup-file cur-prefix t))
+	  (gnus-soup-set-area-prefix area cur-prefix)
+	  ;; Find the number of new articles in this area.
+	  (setq number (nnsoup-number-of-articles area))
+	  (if (not (setq entry (assoc (gnus-soup-area-name area)
+				      nnsoup-group-alist)))
+	      ;; If this is a new area (group), we just add this info to
+	      ;; the group alist. 
+	      (push (list (gnus-soup-area-name area)
+			  (cons 1 number)
+			  (list (cons 1 number) area))
+		    nnsoup-group-alist)
+	    ;; There are already articles in this group, so we add this
+	    ;; info to the end of the entry.
+	    (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
+					   (+ lnum number))
+				     area)))
+	    (setcdr (cadr entry) (+ lnum number))))))
+    (nnsoup-write-active-file t)
+    (delete-file (concat nnsoup-tmp-directory "AREAS"))))
+
+(defun nnsoup-number-of-articles (area)
+  (save-excursion
+    (cond 
+     ;; If the number is in the area info, we just return it.
+     ((gnus-soup-area-number area)
+      (gnus-soup-area-number area))
+     ;; If there is an index file, we just count the lines.
+     ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
+      (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
+      (count-lines (point-min) (point-max)))
+     ;; We do it the hard way - re-searching through the message
+     ;; buffer. 
+     (t
+      (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
+      (goto-char (point-min))
+      (let ((regexp (nnsoup-header (gnus-soup-encoding-format 
+				    (gnus-soup-area-encoding area))))
+	    (num 0))
+	(while (re-search-forward regexp nil t)
+	  (setq num (1+ num)))
+	num)))))
+
+(defun nnsoup-index-buffer (prefix &optional message)
+  (let* ((file (concat prefix (if message ".MSG" ".IDX")))
+	 (buffer-name (concat " *nnsoup " file "*")))
+    (or (get-buffer buffer-name)	; File aready loaded.
+	(when (file-exists-p (concat nnsoup-directory file))
+	  (save-excursion			; Load the file.
+	    (set-buffer (get-buffer-create buffer-name))
+	    (buffer-disable-undo (current-buffer))
+	    (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
+	    (insert-file-contents (concat nnsoup-directory file))
+	    (current-buffer))))))
+
+(defun nnsoup-file (prefix &optional message)
+  (expand-file-name
+   (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))))
+
+(defun nnsoup-message-buffer (prefix)
+  (nnsoup-index-buffer prefix 'msg))
+
+(defun nnsoup-unpack-packets ()
+  "Unpack all packets in `nnsoup-packet-directory'."
+  (let ((packets (directory-files
+		  nnsoup-packet-directory t nnsoup-packet-regexp))
+	packet)
+    (while (setq packet (pop packets))
+      (message (format "nnsoup: unpacking %s..." packet))
+      (if (not (gnus-soup-unpack-packet 
+		nnsoup-tmp-directory nnsoup-unpacker packet))
+	  (message "Couldn't unpack %s" packet)
+	(delete-file packet)
+	(nnsoup-read-areas)
+	(message "Unpacking...done")))))
+
+(defun nnsoup-narrow-to-article (article &optional area head)
+  (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
+	 (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
+	 (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
+	 beg end)
+    (when area
+      (save-excursion
+	(cond
+	 ;; There is no MSG file.
+	 ((null msg-buf)
+	  nil)
+       
+	 ;; We use the index file to find out where the article begins and ends. 
+	 ((and (= (gnus-soup-encoding-index 
+		   (gnus-soup-area-encoding (nth 1 area)))
+		  ?c)
+	       (file-exists-p (nnsoup-file prefix)))
+	  (set-buffer (nnsoup-index-buffer prefix))
+	  (widen)
+	  (goto-char (point-min))
+	  (forward-line (- article (caar area)))
+	  (setq beg (read (current-buffer)))
+	  (forward-line 1)
+	  (if (looking-at "[0-9]+")
+	      (progn
+		(setq end (read (current-buffer)))
+		(set-buffer msg-buf)
+		(widen)
+		(let ((format (gnus-soup-encoding-format
+			       (gnus-soup-area-encoding (nth 1 area)))))
+		  (goto-char end)
+		  (if (or (= format ?n) (= format ?m))
+		      (setq end (progn (forward-line -1) (point))))))
+	    (set-buffer msg-buf))
+	  (widen)
+	  (narrow-to-region beg (or end (point-max))))
+	 (t
+	  (set-buffer msg-buf)
+	  (widen)
+	  (goto-char (point-min))
+	  (let ((header (nnsoup-header 
+			 (gnus-soup-encoding-format 
+			  (gnus-soup-area-encoding (nth 1 area))))))
+	    (re-search-forward header nil t (- article (caar area)))
+	    (narrow-to-region
+	     (match-beginning 0)
+	     (if (re-search-forward header nil t)
+		 (match-beginning 0)
+	       (point-max))))))
+	(goto-char (point-min))
+	(if (not head)
+	    ()
+	  (narrow-to-region
+	   (point-min)
+	   (if (search-forward "\n\n" nil t)
+	       (1- (point))
+	     (point-max))))
+	msg-buf))))
+
+(defun nnsoup-header (format)
+  (cond 
+   ((= format ?n)
+    "^#! *rnews +[0-9]+ *$")
+   ((= format ?m)
+    (concat "^" message-unix-mail-delimiter))
+   ((= format ?M)
+    "^\^A\^A\^A\^A\n")
+   (t
+    (error "Unknown format: %c" format))))
+
+;;;###autoload
+(defun nnsoup-pack-replies ()
+  "Make an outbound package of SOUP replies."
+  (interactive)
+  ;; Write all data buffers.
+  (gnus-soup-save-areas)
+  ;; Write the active file.
+  (nnsoup-write-active-file)
+  ;; Write the REPLIES file.
+  (nnsoup-write-replies)
+  ;; Pack all these files into a SOUP packet.
+  (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
+
+(defun nnsoup-write-replies ()
+  "Write the REPLIES file."
+  (when nnsoup-replies-list
+    (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
+    (setq nnsoup-replies-list nil)))
+
+(defun nnsoup-article-to-area (article group)
+  "Return the area that ARTICLE in GROUP is located in."
+  (let ((areas (cddr (assoc group nnsoup-group-alist))))
+    (while (and areas (< (cdaar areas) article))
+      (setq areas (cdr areas)))
+    (and areas (car areas))))
+
+(defvar nnsoup-old-functions
+  (list message-send-mail-function message-send-news-function))
+
+;;;###autoload
+(defun nnsoup-set-variables ()
+  "Use the SOUP methods for posting news and mailing mail."
+  (interactive)
+  (setq message-send-news-function 'nnsoup-request-post)
+  (setq message-send-mail-function 'nnsoup-request-mail))
+
+;;;###autoload
+(defun nnsoup-revert-variables ()
+  "Revert posting and mailing methods to the standard Emacs methods."
+  (interactive)
+  (setq message-send-mail-function (car nnsoup-old-functions))
+  (setq message-send-news-function (cadr nnsoup-old-functions)))
+
+(defun nnsoup-store-reply (kind)
+  ;; Mostly stolen from `message.el'.
+  (require 'mail-utils)
+  (let ((tembuf (generate-new-buffer " message temp"))
+	(case-fold-search nil)
+	(news (message-news-p))
+	(resend-to-addresses (mail-fetch-field "resent-to"))
+	delimline
+	(mailbuf (current-buffer)))
+    (unwind-protect
+	(save-excursion
+	  (save-restriction
+	    (message-narrow-to-headers)
+	    (if (equal kind "mail")
+		(message-generate-headers message-required-mail-headers)
+	      (message-generate-headers message-required-news-headers)))
+	  (set-buffer tembuf)
+	  (erase-buffer)
+	  (insert-buffer-substring mailbuf)
+	  ;; Remove some headers.
+	  (save-restriction
+	    (message-narrow-to-headers)
+	    ;; Remove some headers.
+	    (message-remove-header message-ignored-mail-headers t))
+	  (goto-char (point-max))
+	  ;; require one newline at the end.
+	  (or (= (preceding-char) ?\n)
+	      (insert ?\n))
+	  (when (and news
+		     (equal kind "mail")
+		     (or (mail-fetch-field "cc")
+			 (mail-fetch-field "to")))
+	    (message-insert-courtesy-copy))
+	  (let ((case-fold-search t))
+	    ;; Change header-delimiter to be what sendmail expects.
+	    (goto-char (point-min))
+	    (re-search-forward
+	     (concat "^" (regexp-quote mail-header-separator) "\n"))
+	    (replace-match "\n")
+	    (backward-char 1)
+	    (setq delimline (point-marker))
+	    ;; Insert an extra newline if we need it to work around
+	    ;; Sun's bug that swallows newlines.
+	    (goto-char (1+ delimline))
+	    (when (eval message-mailer-swallows-blank-line)
+	      (newline))
+	    (let ((msg-buf
+		   (gnus-soup-store 
+		    nnsoup-replies-directory 
+		    (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
+		    nnsoup-replies-index-type))
+		  (num 0))
+	      (when (and msg-buf (bufferp msg-buf))
+		(save-excursion
+		  (set-buffer msg-buf)
+		  (goto-char (point-min))
+		  (while (re-search-forward "^#! *rnews" nil t)
+		    (incf num)))
+		(message "Stored %d messages" num)))
+	    (nnsoup-write-replies)
+	    (kill-buffer tembuf))))))
+
+(defun nnsoup-kind-to-prefix (kind)
+  (unless nnsoup-replies-list
+    (setq nnsoup-replies-list
+	  (gnus-soup-parse-replies 
+	   (concat nnsoup-replies-directory "REPLIES"))))
+  (let ((replies nnsoup-replies-list))
+    (while (and replies 
+		(not (string= kind (gnus-soup-reply-kind (car replies)))))
+      (setq replies (cdr replies)))
+    (if replies
+	(gnus-soup-reply-prefix (car replies))
+      (setq nnsoup-replies-list
+	    (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
+			  kind 
+			  (format "%c%c%c"
+				  nnsoup-replies-format-type
+				  nnsoup-replies-index-type
+				  (if (string= kind "news")
+				      ?n ?m)))
+		  nnsoup-replies-list))
+      (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
+
+(defun nnsoup-make-active ()
+  "(Re-)create the SOUP active file."
+  (interactive)
+  (let ((files (sort (directory-files nnsoup-directory t "IDX$")
+		     (lambda (f1 f2)
+		       (< (progn (string-match "/\\([0-9]+\\)\\." f1)
+				 (string-to-int (match-string 1 f1)))
+			  (progn (string-match "/\\([0-9]+\\)\\." f2)
+				 (string-to-int (match-string 1 f2)))))))
+	active group lines ident elem min)
+    (set-buffer (get-buffer-create " *nnsoup work*"))
+    (buffer-disable-undo (current-buffer))
+    (while files
+      (message "Doing %s..." (car files))
+      (erase-buffer)
+      (insert-file-contents (car files))
+      (goto-char (point-min))
+      (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
+	  (setq group "unknown")
+	(setq group (match-string 2)))
+      (setq lines (count-lines (point-min) (point-max)))
+      (setq ident (progn (string-match
+			  "/\\([0-9]+\\)\\." (car files))
+			 (substring 
+			  (car files) (match-beginning 1)
+			  (match-end 1))))
+      (if (not (setq elem (assoc group active)))
+	  (push (list group (cons 1 lines)
+		      (list (cons 1 lines) 
+			    (vector ident group "ncm" "" lines)))
+		active)
+	(nconc elem
+	       (list
+		(list (cons (1+ (setq min (cdadr elem)))
+			    (+ min lines))
+		      (vector ident group "ncm" "" lines))))
+	(setcdr (cadr elem) (+ min lines)))
+      (setq files (cdr files)))
+    (message "")
+    (setq nnsoup-group-alist active)
+    (nnsoup-write-active-file t)))
+
+(defun nnsoup-delete-unreferenced-message-files ()
+  "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
+  (interactive)
+  (let* ((known (apply 'nconc (mapcar 
+			       (lambda (ga)
+				 (mapcar
+				  (lambda (area)
+				    (gnus-soup-area-prefix (cadr area)))
+				  (cddr ga)))
+			       nnsoup-group-alist)))
+	 (regexp "\\.MSG$\\|\\.IDX$")
+	 (files (directory-files nnsoup-directory nil regexp))
+	 non-files file)
+    ;; Find all files that aren't known by nnsoup.
+    (while (setq file (pop files))
+      (string-match regexp file)
+      (unless (member (substring file 0 (match-beginning 0)) known)
+	(push file non-files)))
+    ;; Sort and delete the files.
+    (setq non-files (sort non-files 'string<))
+    (map-y-or-n-p "Delete file %s? "
+		  (lambda (file) (delete-file (concat nnsoup-directory file)))
+		  non-files)))
+
+(provide 'nnsoup)
+
+;;; nnsoup.el ends here