Anonymous avatar Anonymous committed ce22462

Created

Comments (0)

Files changed (11)

+1998-01-12  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package interface.
+
+1998-01-05  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Created.
+# Makefile for net-utils lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION = 1.01
+PACKAGE = net-utils
+PKG_TYPE = single-file
+REQUIRES = w3 efs mail-lib xemacs-base
+CATEGORY = comm
+
+ELCS = browse-cltl2.elc emacsbug.elc feedmail.elc metamail.elc \
+	rcompile.elc shadowfile.elc webjump.elc webster-www.elc
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+; -*- Mode: Emacs-Lisp -*- 
+;;; browse-cltl2.el --- browse the hypertext-version of 
+;;;                     "Common Lisp the Language, 2nd. Edition"
+
+;; Revision 1.1.2
+;; last edited on 18.2.1997
+
+;; Copyright (C) 1997 Holger Schauer
+
+;; Author: Holger Schauer <Holger.Schauer@gmd.de>
+;; Keywords: utils lisp ilisp www
+
+;; This file is not part of Emacs.
+
+;; Developed under XEmacs 19.14. Also tested on Emacs 19.32 and
+;; XEmacs 19.11. Should work with newer versions, too.
+;; Required: browse-url.el
+;; Recommended: url.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+;; This gives you two top-level-functions useful when programming lisp:
+;; cltl2-view-function-definition and cltl2-view-index
+;; cltl2-view-function-definition asks you for a name of a lisp
+;; function (or variable) and will open up your favourite browser
+;; (as specified by `browse-url-browser-function') loading the page
+;; which documents it.
+
+;;; Installation: (as usual)
+;; Put browse-cltl2.el somewhere where emacs can find it.
+;; browse-cltl2.el requires a working browse-url, url and cl.
+;; Insert the following lines in your .emacs:
+;;
+;;      (autoload 'cltl2-view-function-definition "browse-cltl2")
+;;      (autoload 'cltl2-view-index "browse-cltl2")
+;;      (autoload 'cltl2-lisp-mode-install "browse-cltl2")
+;;      (add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
+;;      (add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
+;;
+;; This should also add the needed hooks to lisp-mode (and ilisp-mode).
+
+;; Gnu Emacs:
+;; For Gnu Emacs there doesn't seem to be a lisp-mode-hook so you're
+;; on your own with the key-settings.
+;; No url.el:
+;; If you don't have url.el set *cltl2-use-url* to nil
+;; and set *cltl2-fetch-method* to 'local or 'local-index-only.
+;; This implies that you need a local copy of the index page of
+;; CLtL2 (which you can get from the normal hypertext-version at CMU),
+;; so you need to point *cltl2-local-file-pos* and *cltl2-index-file-name*
+;; to the place where you put it.
+;; Old versions of Emacs (XEmacs 19.11 for example):
+;; When you want to use a local copy (or a local copy of the index file)
+;; check the documentation on find-file-noselect. If it doesn't mention
+;; an option called RAWFILE set *cltl2-old-find-file-noselect* to 't.
+
+
+;;; Customization:
+;; By default, browse-cltl2 will use a local copy of CLtL2, looking
+;; for it in /usr/doc/html/cltl. This can be modified with the help
+;; of the following variables:
+;; *cltl2-fetch-method*, *cltl2-url*, *cltl-local-file-pos*
+;; See the documentation on this variables for more info.
+;;
+;;; TODO:
+;; In this version we can't separate between functions, variables, 
+;; constants and loop clauses. This is not that hard to change,
+;; but it is more difficult to distinguish what the user is
+;; looking for. Until I receive several requests for it, I won't
+;; implement it, because there are not that much constructs like * and + 
+;; which have two (or more) semantics.
+
+;;; Changes:
+;; 28-01-97: HS: now we're using cl-puthash all over the place because
+;;          this is common on XEmacs 19.11 and upwards and Gnu Emacs.
+;;          Added information on how to install without url.el
+;;
+;; 29-01-97 HS: included conditionalized versions of the required
+;;         functions match-string and buffer-live-p. 
+;;         Suggested by Simon Marshall <Simon.Marshall@esrin.esa.it>.
+;;         Included new variable *cltl2-use-url* with which one can
+;;         specify if he has url.el or not. Introduced variable
+;;         *cltl2-old-find-file-noselect*.
+;;
+;; 05-02-97 HS: added two variables for the key-bindings,
+;;         *cltl2-vfd-key* *cltl2-vi-key*.
+;;
+;; 18-02-97 HS: use compatible keybindings that work on Gnu Emacs and XEmacs.
+;;         Made cltl2-lisp-mode-install an interactive function.
+(defvar *cltl2-use-url* 'nil
+ "Enables or disables retrieval of the index-file via WWW (or more
+ exactly by the use of the function url-retrieve from url.el).
+ Default is 't.")
+
+;; needed things
+(require 'cl)
+(require 'browse-url)
+
+(when (not *cltl2-use-url*)
+   (require 'url))
+
+;;; ******************************
+;;; Some variable and constant definitions
+;;; ******************************
+(defvar *cltl2-fetch-method* 'local
+ "This sets the method by which the index-file will be fetched. Three
+  methods are possible: 'local assumes that all files are local. 
+  'local-index-only assumes that just the index-file is locally but
+  all other files will be fetched via www. 'www means that the index-file
+  will be fetched via WWW, too. Don't change the value of this variable
+  after loading.")
+
+(defvar *cltl2-url* 
+ "http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
+ "The url where the hypertext-version of Common Lisp the Language
+ can be found. Note that this assumes to be the top-level of the
+ directory structure which should be the same as in the hypertext
+ version as provided by the CMU AI Repository. Defaults to
+ http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
+ Note the / at the end.")
+
+(defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
+ "A directory where the CLtl2 can be found. Note that this assumes
+ to be the top-level of the directory structure which should be the
+ same as in the hypertext version as provided by the CMU AI Repository.
+ Defaults to /usr/doc/html/cltl/ Note the / at the end.")
+
+(defconst *cltl2-index-file-name* "clm/index.html"
+ "The name of the index-file, typically with directory on front. 
+  Defaults to clm/index.html, as this is the momentary position from
+  the top-level directory of the CLtL2-home. Defaults to clm/index.html.
+  Note that there is no leading /.")
+
+(defvar *cltl2-index-home* 
+  (concatenate 'string
+     (case *cltl2-fetch-method*
+       ('local *cltl2-local-file-pos*)
+       ('local-index-only *cltl2-local-file-pos*)
+       ('www *cltl2-url*))
+     *cltl2-index-file-name*)
+ "The absolute path which will be used to fetch the index.")
+
+(defvar *cltl2-home*
+  (concatenate 
+   'string
+   (case *cltl2-fetch-method*
+     ('local *cltl2-local-file-pos*)
+     ('local-index-only *cltl2-url*)
+     ('www *cltl2-url*))
+     "clm/")
+  "This specifies the home-position of the CLtL2. The value of this variable
+  will be concatenated with the name of the nodes of the CLtL2.")
+
+(defvar *cltl2-index-buffer-name* "*cltl2-index*"
+ "The name of the buffer which holds the index for CLtL2.")
+
+(defvar *cltl2-old-find-file-noselect* 'nil
+ "Older versions of Emacs (at least XEmacs 19.11) don't support the
+ option RAWFILE with the function FIND-FILE-NO-SELECT. Set this variable
+ to 't if you have such an old version. It will cause fontification and
+ other useless stuff on the buffer in which the index is fetched. If
+ you don't use a local copy (of the index) this won't bother you.")
+
+(defvar *cltl2-vfd-key* 
+  (if (featurep 'ilisp)
+      '[(control z) h]
+     '[(control c) b])
+ "Shortcut for accessing cltl2-view-function-definition. Use meaningful
+ setting with Ilisp.")
+
+(defvar *cltl2-vi-key* 
+  (if (featurep 'ilisp)
+      '[(control z) H]
+     '[(control c) B])
+ "Shortcut for accessing cltl2-view-index. Use meaningful
+ setting with Ilisp.")
+
+(defvar *browse-cltl2-ht* (make-hash-table 0))
+(defconst *cltl2-search-regexpr* 
+  "<a href=\"\\(.+\\)\"><code>\\(.+\\)</code></a>"
+  "A regular expression how to check for entries in the index-file
+  of CLtL2. Note that you have to modify this and the 
+  prepare-get-entry*-functions if you want to change the search.")
+
+;;; ******************************
+;;; First of all: Compatibility stuff
+;;; ******************************
+; no match-string in old versions
+(if (not (fboundp (function match-string)))
+    (defun match-string (num &optional string)
+      "Return string of text matched by last search.
+ NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+ Zero means the entire text matched by the whole regexp or whole string.
+ STRING should be given if the last search was by `string-match' on STRING."
+      (if (match-beginning num)
+	  (if string
+	      (substring string (match-beginning num) (match-end num))
+	      (buffer-substring 
+	       (match-beginning num) (match-end num))))))
+
+; no buffer-live-p in old versions
+ (if (not (fboundp (function buffer-live-p)))
+     (defun buffer-live-p (buf-or-name)
+       "Checks if BUF-OR-NAME is a live buffer. Returns non-nil
+ if BOF-OR-NAME is an editor buffer which has not been deleted.
+ Imitating a built-in function from newer Emacs versions."
+       (let ((object (if (bufferp buf-or-name) 
+                          buf-or-name
+			(get-buffer buf-or-name))))
+	 (and (bufferp object) (buffer-name object)))))
+
+; no add-submenu in old versions of XEmacs       
+(if (and (string-match "XEmacs\\|Lucid" emacs-version)
+	 (not (fboundp 'add-submenu)))
+    (defun add-submenu (menu-path submenu &optional before)
+  "Add a menu to the menubar or one of its submenus.
+If the named menu exists already, it is changed.
+MENU-PATH identifies the menu under which the new menu should be inserted.
+ It is a list of strings; for example, (\"File\") names the top-level \"File\"
+ menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
+ If MENU-PATH is nil, then the menu will be added to the menubar itself.
+SUBMENU is the new menu to add.
+ See the documentation of `current-menubar' for the syntax.
+BEFORE, if provided, is the name of a menu before which this menu should
+ be added, if this menu is not on its parent already.  If the menu is already
+ present, it will not be moved."
+  (add-menu menu-path (car submenu) (cdr submenu) before)))
+
+; old find-file-noselect has no RAWFILE argument
+(if *cltl2-old-find-file-noselect*
+    (unless (boundp 'cltl2-old-find-file-noselect-func)
+      (setf (symbol-value 'cltl2-old-find-file-noselect-func)
+	    (symbol-function 'find-file-noselect))
+      (setf (symbol-function 'find-file-noselect)
+	    #'(lambda (file &optional nowarn rawfile)
+		(funcall cltl2-old-find-file-noselect-func file nowarn)))))
+  
+;;; ******************************
+;;; Functions for fetching the index file
+;;; ******************************
+(defun cltl2-fetch-index ()
+  "Fetches the index page of the CLtl2 and puts it in its own
+ buffer called *cltl2-index*."
+  ;; if the index isn't here load it into a buffer
+  (when (or (not (get-buffer *cltl2-index-buffer-name*))
+	    (not (buffer-live-p *cltl2-index-buffer-name*)))
+    (message "Fetching the CLtL2 index file ...")
+    (case *cltl2-fetch-method* 
+      ('local 
+       (cltl2-fetch-index-by-file))
+      ('local-index-only
+       (cltl2-fetch-index-by-file))
+      ('www
+       (cltl2-fetch-index-by-www))))
+  
+  (cltl2-prepare-index)
+)
+
+;; fetch methods
+(defun cltl2-fetch-index-by-file ()
+  "Fetch the index from disk."
+  (setf *cltl2-index-buffer-name*
+	(find-file-noselect *cltl2-index-home* 'nil 't))
+)
+
+(defun cltl2-fetch-index-by-www ()
+ "Fetch the index via WWW."
+ (save-excursion
+   (let ((old-url-working-buffer url-working-buffer))
+     (setf url-working-buffer *cltl2-index-buffer-name*)
+     (url-retrieve *cltl2-index-home*)
+     (setf url-working-buffer old-url-working-buffer))))
+
+
+;;; ******************************
+;;; Main functions for viewing
+;;; ******************************
+(defun cltl2-view-function-definition (entry)
+  "First checks if function can be found in the CLtL2-index-file.
+ If it can be found, uses the function browse-url to have a look
+ at the corresponding documentation from CLtL2."
+  (interactive "sCLtL2-Entry to lookup:")
+  (when (cltl2-index-unprepared-p)
+    (cltl2-fetch-index))
+  
+  (let ((entry-url (cltl2-find-url-for-function (intern entry))))
+    (when entry-url
+     (message "Loading found entry for %s into browser.." entry)
+     (browse-url 
+      (concatenate 'string *cltl2-home* entry-url)))))
+
+(defun cltl2-find-url-for-function (entry)
+  "Checks if we can find a page for function ENTRY and
+ constructs an URL from it."
+  (let ((entry-url (gethash entry *browse-cltl2-ht*)))
+    (when (not entry-url)
+      (error "No entry in CLtL2 for %s" entry))
+    entry-url))
+
+(defun cltl2-view-index ()
+  "Browse-urls the index file."
+  (interactive)
+  (browse-url *cltl2-index-home*))
+
+;;; ******************************
+;;; Preparing the index (the hashtable)
+;;; ******************************
+(defun cltl2-prepare-index ()
+ "Jumps to the *cltl2-index* buffer and scans it, creating a hashtable
+ for all entries."
+ (message "Preparing CLtL2 index.")
+ (save-excursion
+   (set-buffer *cltl2-index-buffer-name*)
+   (goto-char (point-min))
+
+   ; search for entry
+   (do ((point (re-search-forward 
+                 *cltl2-search-regexpr* 
+		 nil t)
+	       (re-search-forward 
+		*cltl2-search-regexpr* 
+		nil t)))
+       ; until we can't find anymore
+       ((null point)); (format "Index-preparation done."))
+     ; put found entry in hash-table
+     (cl-puthash 
+      (cltl2-prepare-get-entry-name)
+      (cltl2-prepare-get-entry-url)
+      *browse-cltl2-ht*))))
+
+(defun cltl2-prepare-get-entry-name ()
+ "Get the enrty name from the last match of regexp-search for entries."
+ (let ((name-string (intern (match-string 2))))
+   (format "%s" name-string)
+ name-string))
+
+(defun cltl2-prepare-get-entry-url ()
+ "Get the enrty url from the last match of regexp-search for entries."
+ (let ((url (match-string 1)))
+   (format "%s" url)
+   url))
+
+(defun cltl2-index-unprepared-p ()
+ "Check if the index is already prepared."
+ ; If the hashtable has entries the index is prepared.
+ (not (and (hash-table-p *browse-cltl2-ht*)
+	   (>= (hash-table-count *browse-cltl2-ht*) 1))))
+ 
+;;; ******************************
+;;; Hooking into lisp mode and ilisp-mode
+;;; ******************************
+(defun cltl2-lisp-mode-install ()
+ "Adds browse-cltl2 to lisp-mode. If you use ilisp (installed via a hook
+ on lisp-mode) add browse-cltl2 to ilisp. Check the variables *cltl2-vfd-key*
+ and *cltl2-vi-key* for the keybindings. Under XEmacs we will add ourself to
+ the corresponding menus if there exists one."
+ (interactive)
+ ; set key bindings
+ (local-set-key *cltl2-vfd-key* 'cltl2-view-function-definition)
+ (local-set-key *cltl2-vi-key* 'cltl2-view-index)
+ ; under XEmacs hook ourself into the menu if there is one
+ (when (string-match "XEmacs\\|Lucid" emacs-version)
+   (cond ((and (featurep 'ilisp-easy-menu)
+	       ;; this may be redundant:
+	       (featurep 'menubar)
+	       ; this is for the menu as provided by ilisp-easy-menu
+	       (not (null (car (find-menu-item current-menubar '("ILisp"))))))
+	  (add-submenu
+	   '("ILisp" "Documentation")
+	   '("Browse CLtL2"
+	     [ "View entry" cltl2-view-function-definition t]
+	     [ "View index" cltl2-view-index t] )))
+	   ; perhaps an other Ilisp-Menu is there ?
+	 ((not (null (car (find-menu-item current-menubar '("ILisp")))))
+	  (add-submenu
+	   '("Lisp")
+	   '("Browse CLtL2"
+	     [ "View entry" cltl2-view-function-definition t]
+	     [ "View index" cltl2-view-index t] )))
+           ; or at least a Lisp-Menu ?
+	 ((not (null (car (find-menu-item current-menubar '("Lisp")))))
+	  (add-submenu
+	   '("Lisp")
+	   '("Browse CLtL2"
+	     [ "View entry" cltl2-view-function-definition t]
+	     [ "View index" cltl2-view-index t] )))))
+)
+
+(add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
+(add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
+
+;;; Providing ourself. 
+(provide 'ilisp-browse-cltl2)
+;;; browse-cltl2.el ends here.
+;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list.
+
+;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
+
+;; Author: K. Shane Hartman
+;; Maintainer: FSF
+;; Keywords: maint
+
+;; Not fully installed because it can work only on Internet hosts.
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 19.34.
+ 
+;;; Commentary:
+
+;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers
+;; describing a problem.  Here's how it's done...
+
+;;; Code:
+
+;; >> This should be an address which is accessible to your machine,
+;; >> otherwise you can't use this file.  It will only work on the
+;; >> internet with this address.
+
+(require 'sendmail)
+
+;; XEmacs:  Screen for whether a beta version is running and redirect
+;; reports to the beta list instead of the newsgroup.
+(defvar report-emacs-bug-pretest-address "xemacs-beta@xemacs.org"
+  "Address of mailing list for XEmacs beta bugs.")
+
+(defvar bug-gnu-emacs "xemacs@xemacs.org"
+  "Address of site maintaining mailing list for XEmacs bugs.")
+
+(defvar report-emacs-bug-orig-text nil
+  "The automatically-created initial text of bug report.")
+
+;;;###autoload
+(defun report-xemacs-bug (topic)
+  "Report a bug in XEmacs.
+Prompts for bug subject.  Leaves you in a mail buffer."
+  (interactive "sBug Subject: ")
+  (if (mail nil
+	    (if (string-match "\(beta[0-9]+\)" emacs-version)
+		;; If there are four numbers in emacs-version,
+		;; this is a pretest version.
+		report-emacs-bug-pretest-address
+	      bug-gnu-emacs)
+	    topic)
+      (let (user-point)
+	;; The rest of this does not execute
+	;; if the user was asked to confirm and said no.
+	(goto-char (point-min))
+	(re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
+	(insert "In " (emacs-version) "\n")
+	(if (and system-configuration-options
+		 (not (equal system-configuration-options "")))
+	    (insert "configured using `configure "
+		    system-configuration-options "'\n"))
+	(insert "\n")
+	(insert "Please describe exactly what actions triggered the bug\n"
+		"and the precise symptoms of the bug:\n\n") 
+	(setq user-point (point))
+	(insert "\n\n\n"
+		"Recent input:\n")
+	(let ((before-keys (point)))
+	  ;; XEmacs:
+	  (insert (key-description (recent-keys)))
+;	  (insert (mapconcat (lambda (key)
+;			       (if (or (integerp key)
+;				       (symbolp key)
+;				       (listp key))
+;				   (single-key-description key)
+;				 (prin1-to-string key nil)))
+;			     (recent-keys)
+;			     " "))
+	  (save-restriction
+	    (narrow-to-region before-keys (point))
+	    (goto-char before-keys)
+	    (while (progn (move-to-column 50) (not (eobp)))
+	      (search-forward " " nil t)
+	      (insert "\n"))))
+	(let ((message-buf (get-buffer-create " *Message-Log*")))
+	  (if message-buf
+	      (progn
+		(insert "\n\nRecent messages:\n")
+		(insert-buffer-substring message-buf
+					 (save-excursion
+					   (set-buffer message-buf)
+					   (goto-char (point-max))
+					   (forward-line -10)
+					   (point))
+					 (save-excursion
+					   (set-buffer message-buf)
+					   (point-max))))))
+	;; This is so the user has to type something
+	;; in order to send easily.
+	;; XEmacs:  FSF non-abstraction of data?
+	;; (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
+	;; Ghod intended it this way:
+	(use-local-map (let ((map (make-sparse-keymap)))
+			 (set-keymap-parents map (list (current-local-map)))
+			 map))
+	(define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
+	(with-output-to-temp-buffer "*Bug Help*"
+	  (princ (substitute-command-keys
+		  "Type \\[mail-send-and-exit] to send the bug report.\n"))
+	  (princ (substitute-command-keys
+		  "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
+	  (terpri)
+	  (princ (substitute-command-keys "\
+Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
+about when and how to write a bug report, and what information to supply
+so that the bug can be fixed.
+Type `\\[delete-other-windows]' to remove this window.")))
+	;; Make it less likely people will send empty messages.
+	(make-local-variable 'mail-send-hook)
+	(add-hook 'mail-send-hook 'report-emacs-bug-hook)
+	(save-excursion
+	  (goto-char (point-max))
+	  (skip-chars-backward " \t\n")
+	  (make-local-variable 'report-emacs-bug-orig-text)
+	  (setq report-emacs-bug-orig-text
+		(buffer-substring (point-min) (point))))
+	(goto-char user-point))))
+
+;; ;;;###autoload
+;; (defalias 'report-emacs-bug 'report-xemacs-bug)
+
+(defun report-emacs-bug-info ()
+  "Go to the Info node on reporting Emacs bugs."
+  (interactive)
+  (info)
+  (Info-directory)
+  (Info-menu "xemacs")
+  (Info-goto-node "Bugs"))
+
+(defun report-emacs-bug-hook ()
+  (save-excursion
+    (goto-char (point-max))
+    (skip-chars-backward " \t\n")
+    (if (and (= (- (point) (point-min))
+		(length report-emacs-bug-orig-text))
+	     (equal (buffer-substring (point-min) (point))
+		    report-emacs-bug-orig-text))
+	(error "No text entered in bug report"))))
+
+(provide 'emacsbug)
+
+;;; emacsbug.el ends here
+;;; feedmail.el --- outbound mail handling
+
+;; Keywords: mail
+
+;;; Synched up with: Not in FSF.
+
+;;; From: William.J.Carpenter@hos1cad.att.com (Bill C)
+;;; Subject: feedmail.el, patchlevel 2 [repost]
+;;; Date: 8 Jun 91 22:23:00 GMT
+;;; Organization: AT&T Bell Laboratories
+;;;
+;;; 5-may-92  jwz	Conditionalized calling expand-mail-aliases, since that
+;;;			function doesn't exist in Lucid GNU Emacs or when using
+;;;			mail-abbrevs.el.
+;;; 
+;;; Here's the latest version of feedmail.el, a replacement for parts of
+;;; GNUemacs' sendmail.el (specifically, it's what handles your outgoing
+;;; mail after you type C-c C-c in mail mode).   (Sorry if you're seeing
+;;; this a second time.  Looks like my earlier attempt to post it didn't
+;;; get off the local machine.)
+;;; 
+;;; This version contains the following new things:
+;;; 
+;;;    * fix for handling default-case-fold-search
+;;;    * involve user-full-name in default from line
+;;;    * fix for my improper use of mail-strip-quoted-names when
+;;;      addresses contain a mix of "<>" and "()" styles
+;;;    * new feature allowing optional generation of Message-ID
+
+;;; feedmail.el
+;;; LCD record:
+;;; feedmail|Bill Carpenter|william.j.carpenter@att.com|Outbound mail handling|91-05-24|2|feedmail.el
+;;;
+;;; Written by Bill Carpenter <william.j.carpenter@att.com>
+;;; original,      31 March 1991
+;;; patchlevel 1,   5 April 1991
+;;; patchlevel 2,  24 May   1991
+;;;
+;;; As far as I'm concerned, anyone can do anything they want with
+;;; this specific piece of code.  No warranty or promise of support is
+;;; offered.
+;;;
+;;; This stuff does in elisp the stuff that used to be done
+;;; by the separate program "fakemail" for processing outbound email.
+;;; In other words, it takes over after you hit "C-c C-c" in mail mode.
+;;; By appropriate setting of options, you can still use "fakemail",
+;;; or you can even revert to sendmail (which is not too popular
+;;; locally).  See the variables at the top of the elisp for how to
+;;; achieve these effects:
+;;;
+;;;    --- you can get one last look at the prepped outbound message and
+;;;        be prompted for confirmation
+;;;
+;;;    --- removes BCC: headers after getting address info
+;;;
+;;;    --- does smart filling of TO: and CC: headers
+;;;
+;;;    --- processes FCC: lines and removes them
+;;;
+;;;    --- empty headers are removed
+;;;
+;;;    --- can force FROM: or SENDER: line
+;;;
+;;;    --- can generate a Message-ID line
+;;;
+;;;    --- strips comments from address info (both "()" and "<>" are
+;;;        handled via a call to mail-strip-quoted-names); the
+;;;        comments are stripped in the simplified address list given
+;;;        to a subprocess, not in the headers in the mail itself
+;;;        (they are left unchanged, modulo smart filling)
+;;;
+;;;    --- error info is pumped into a normal buffer instead of the
+;;;        minibuffer
+;;;
+;;;    --- just before the optional prompt for confirmation, lets you
+;;;        run a hook on the prepped message and simplified address
+;;;        list
+;;;
+;;;    --- you can specify something other than /bin/mail for the
+;;;        subprocess
+;;;
+;;; After a few options below, you will find the function
+;;; feedmail-send-it.  Everything after that function is just local
+;;; stuff for this file.  There are two ways you can use the stuff in
+;;; this file:
+;;;
+;;; (1)  Put the contents of this file into sendmail.el and change the
+;;; name of feedmail-send-it to sendmail-send-it, replacing that
+;;; function in sendmail.el.
+;;;
+;;;                              or
+;;;
+;;; (2)  Save this file as feedmail.el somewhere on your elisp
+;;; loadpath; byte-compile it.  Put the following lines somewhere in
+;;; your ~/.emacs stuff:
+;;;
+;;;        (setq send-mail-function 'feedmail-send-it)
+;;;        (autoload 'feedmail-send-it "feedmail")
+;;;
+
+(defgroup feedmail nil
+  "Outbound mail handling."
+  :group 'mail)
+
+
+(defcustom feedmail-confirm-outgoing nil
+  "*If non-nil, gives a y-or-n confirmation prompt after prepping,
+before sending mail."
+  :type 'boolean
+  :group 'feedmail)
+
+
+(defcustom feedmail-nuke-bcc t
+  "*Non-nil means get rid of the BCC: lines from the message header
+text before sending the mail.  In any case, the BCC: lines do
+participate in the composed address list.  You probably want to keep
+them if you're using sendmail (see feedmail-buffer-eating-function)."
+  :type 'boolean
+  :group 'feedmail)
+
+
+(defcustom feedmail-fill-to-cc t
+  "*Non-nil means do smart filling (line-wrapping) of TO: and CC: header
+lines.  If nil, the lines are left as-is.  The filling is done after
+mail address alias expansion."
+  :type 'boolean
+  :group 'feedmail)
+
+
+(defcustom feedmail-fill-to-cc-fill-column default-fill-column
+  "*Fill column used when wrapping mail TO: and CC: lines."
+  :type 'integer
+  :group 'feedmail)
+
+
+(defcustom feedmail-nuke-empty-headers t
+  "*If non-nil, headers with no contents are removed from the outgoing
+email.  A completely empty SUBJECT: header is always removed,
+regardless of the setting of this variable.  The only time you would
+want them left in would be if you used some headers whose presence
+indicated something rather than their contents."
+  :type 'boolean
+  :group 'feedmail)
+
+;;; wjc sez:  I think the use of the SENDER: line is pretty pointless,
+;;; but I left it in to be compatible with sendmail.el and because
+;;; maybe some distant mail system needs it.  Really, though, if you
+;;; want a sender line in your mail, just put one in there and don't
+;;; wait for feedmail to do it for you.
+
+(defcustom feedmail-sender-line nil
+  "*If nil, no SENDER: header is forced.  If non-nil and the email
+already has a FROM: header, a SENDER: header is forced with this as
+its contents.  You can probably leave this nil, but if you feel like
+using it, a good value would be a fully-qualified domain name form of
+your address.  For example, william.j.carpenter@att.com.  Don't
+include a trailing newline or the keyword SENDER:.  They're
+automatically provided."
+  :type 'boolean
+  :group 'feedmail)
+
+
+;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
+(defcustom feedmail-from-line
+  (concat (user-login-name) "@" (system-name) " (" (user-full-name) ")")
+  "*If non-nil and the email has no FROM: header, one will be forced
+with this as its contents. A good value would be a fully-qualified
+domain name form of your address.  For example, william.j.carpenter@att.com.
+(The default value of this variable is probably not very good, since
+it doesn't have a domain part.)  Don't include a trailing newline or
+the keyword FROM:.  They're automatically provided."
+  :type '(choice (const nil) string)
+  :group 'feedmail)
+
+
+;;; Here's how I use the GNUS Message-ID generator for mail but not
+;;; for news postings:
+;;;
+;;;   (setq feedmail-message-id-generator 'wjc:gnusish-message-id)
+;;;   (setq gnus-your-domain "hos1cad.ATT.COM")
+;;;   
+;;;   (defun wjc:gnusish-message-id ()
+;;;     (require 'gnuspost)
+;;;     (if (fboundp 'wjc:gnus-inews-message-id)
+;;;   	  (wjc:gnus-inews-message-id)
+;;;   	(gnus-inews-message-id)))
+;;;   
+;;;   (setq news-inews-hook
+;;;   	  '(lambda () 
+;;;   		 (defun gnus-inews-date () nil)
+;;;   		 (fset 'wjc:gnus-inews-message-id (symbol-function 'gnus-inews-message-id))
+;;;   		 (defun gnus-inews-message-id () nil)
+;;;   		 ))
+;;;   
+(defcustom feedmail-message-id-generator nil
+  "*If non-nil, should be a function (called with no arguments) which
+will generate a unique message ID which will be inserted on a
+Message-ID: header.  The message ID should be the return value of the
+function.  Don't include trailing newline, leading space, or the
+keyword MESSAGE-ID.  They're automatically provided.  Do include
+surrounding <> brackets.  For an example of a message ID generating
+function, you could look at the GNUS function gnus-inews-message-id.
+When called, the current buffer is the prepped outgoing mail buffer
+(the function may inspect it, but shouldn't modify it).  If the returned
+value doesn't contain any non-whitespace characters, no message ID
+header is generated, so you could generate them conditionally,
+based on the contents of the mail."
+  :type 'boolean
+  :group 'feedmail)
+
+
+(defun feedmail-confirm-addresses-hook-example ()
+  "An example of a last chance hook that shows the simple addresses
+and gets a confirmation.  Use as (setq feedmail-last-chance-hook
+'feedmail-confirm-addresses-hook-example)."
+  (save-window-excursion 
+	(display-buffer feedmail-address-buffer)
+	(if (not (y-or-n-p "How do you like them apples? "))
+		(error "Sending...gave up in last chance hook"))))
+
+
+(defcustom feedmail-last-chance-hook nil
+  "*User's last opportunity to modify the message on its way out.  It
+has already had all the header prepping from the standard package.
+The next step after running the hook will be to push the buffer into a
+subprocess that mails the mail.  The hook might be interested in these
+buffers:  (1) feedmail-prepped-text-buffer contains the header and body
+of the message, ready to go;  (2) feedmail-address-buffer contains the
+space-separated, simplified list of addresses which is to be given to
+the subprocess (the hook may change them).  feedmail-error-buffer is
+an empty buffer intended to soak up errors for display to the user.
+If the hook allows interactive activity, the user should not send more
+mail while in the hook since some of the internal buffers will be reused."
+  :type 'hook
+  :group 'feedmail)
+
+;; XEmacs change: make the default more sensible.
+(defcustom feedmail-buffer-eating-function
+  (if (and (boundp 'sendmail-program)
+	   (string-match "sendmail" sendmail-program))
+      'feedmail-buffer-to-sendmail
+    'feedmail-buffer-to-binmail)
+  "*Function used to send the prepped buffer to a subprocess.  The
+function's three (mandatory) arguments are: (1) the buffer containing
+the prepped message; (2) a buffer where errors should be directed; and
+(3) a string containing the space-separated list of simplified
+addresses.  Two popular choices for this are 'feedmail-buffer-to-binmail
+and 'feedmail-buffer-to-sendmail.  If you use the sendmail form, you
+probably want to set feedmail-nuke-bcc to nil.  If you use the binmail
+form, check the value of feedmail-binmail-template."
+  :type 'function
+  :group 'feedmail)
+
+
+(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s")
+  "*Command template for the subprocess which will get rid of the
+mail.  It can result in any command understandable by /bin/sh.  The
+single '%s', if present, gets replaced by the space-separated,
+simplified list of addressees.  Used in feedmail-buffer-to-binmail to
+form the shell command which will receive the contents of the prepped
+buffer as stdin.  If you'd like your errors to come back as mail
+instead of immediately in a buffer, try /bin/rmail instead of
+/bin/mail (this can be accomplished by keeping the default nil setting
+of mail-interactive).  You might also like to consult local mail
+experts for any other interesting command line possibilities."
+  :type 'string
+  :group 'feedmail)
+
+
+;; feedmail-buffer-to-binmail and feedmail-buffer-to-sendmail are the
+;; only things provided for values for the variable
+;; feedmail-buffer-eating-function.  It's pretty easy to write your
+;; own, though.
+
+(defun feedmail-buffer-to-binmail (prepped-mail-buffer mail-error-buffer simple-address-list)
+  "Function which actually calls /bin/mail as a subprocess and feeds the buffer to it."
+  (save-excursion
+	(set-buffer prepped-mail-buffer)
+	(apply 'call-process-region
+		   (append (list (point-min) (point-max)
+						 "/bin/sh" nil mail-error-buffer nil "-c"
+						 (format feedmail-binmail-template simple-address-list ))))
+	) ;; save-excursion
+  )
+
+
+(defun feedmail-buffer-to-sendmail (prepped-mail-buffer feedmail-error-buffer simple-address-list)
+  "Function which actually calls sendmail as a subprocess and feeds the buffer to it."
+  (save-excursion
+	(set-buffer prepped-mail-buffer)
+	(apply 'call-process-region
+		   (append (list (point-min) (point-max)
+					   (if (boundp 'sendmail-program)
+						   sendmail-program
+						 "/usr/lib/sendmail")
+					   nil feedmail-error-buffer nil
+					   "-oi" "-t")
+				 ;; Don't say "from root" if running under su.
+				 (and (equal (user-real-login-name) "root")
+					  (list "-f" (user-login-name)))
+				 ;; These mean "report errors by mail"
+				 ;; and "deliver in background".
+				 (if (null mail-interactive) '("-oem" "-odb"))))
+))
+
+
+;; feedmail-send-it is the only "public" function is this file.
+;; All of the others are just little helpers.
+;;;###autoload
+(defun feedmail-send-it ()
+  (let* ((default-case-fold-search t)
+		 (feedmail-error-buffer (get-buffer-create " *Outgoing Email Errors*"))
+		 (feedmail-prepped-text-buffer (get-buffer-create " *Outgoing Email Text*"))
+		 (feedmail-address-buffer (get-buffer-create " *Outgoing Email Address List*"))
+		 (feedmail-raw-text-buffer (current-buffer))
+		 (case-fold-search nil)
+		 end-of-headers-marker)
+
+    (unwind-protect (save-excursion
+		(set-buffer feedmail-prepped-text-buffer) (erase-buffer)
+
+		;; jam contents of user-supplied mail buffer into our scratch buffer
+		(insert-buffer-substring feedmail-raw-text-buffer)
+
+		;; require one newline at the end.
+		(goto-char (point-max))
+		(or (= (preceding-char) ?\n) (insert ?\n))
+
+		;; Change header-delimiter to be what mailers expect (empty line).
+		(goto-char (point-min))
+		(re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
+		(replace-match "\n")
+		;; why was this backward-char here?
+		;;(backward-char 1)
+		(setq end-of-headers-marker (point-marker))
+
+		(if (and (fboundp 'expand-mail-aliases) ; nil = mail-abbrevs.el
+			 mail-aliases)
+		    (expand-mail-aliases (point-min) end-of-headers-marker))
+
+		;; make it pretty
+		(if feedmail-fill-to-cc (feedmail-fill-to-cc-function end-of-headers-marker))
+		;; ignore any blank lines in the header
+		(goto-char (point-min))
+		(while (and (re-search-forward "\n\n\n*" end-of-headers-marker t) (< (point) end-of-headers-marker))
+		  (replace-match "\n"))
+	  
+		(let ((case-fold-search t))
+		  (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) end-of-headers-marker)
+		  (save-excursion (set-buffer feedmail-address-buffer)
+						  (goto-char (point-min))
+						  (if (not (re-search-forward "\\S-" (point-max) t))
+							  (error "Sending...abandoned, no addressees!")))
+
+		  ;; Find and handle any BCC fields.
+		  (if feedmail-nuke-bcc (feedmail-do-bcc end-of-headers-marker))
+
+		  ;; Find and handle any FCC fields.
+		  (goto-char (point-min))
+		  (if (re-search-forward "^FCC:" end-of-headers-marker t)
+			  (mail-do-fcc end-of-headers-marker))
+
+		  (goto-char (point-min))
+		  (if (re-search-forward "^FROM:" end-of-headers-marker t)
+			  
+			  ;; If there is a FROM: and no SENDER:, put in a SENDER:
+			  ;; if requested by user
+			  (if (and feedmail-sender-line
+					   (not (save-excursion (goto-char (point-min))
+						   (re-search-forward "^SENDER:" end-of-headers-marker t))))
+				  (progn (forward-line 1) (insert "Sender: " feedmail-sender-line "\n")))
+
+			;; no FROM: ... force one?
+			(if feedmail-from-line
+				(progn (goto-char (point-min)) (insert "From: " feedmail-from-line "\n")))
+			)
+
+		  ;; don't send out a blank subject line
+		  (goto-char (point-min))
+		  (if (re-search-forward "^Subject:[ \t]*\n" end-of-headers-marker t)
+			  (replace-match ""))
+
+		  ;; don't send out a blank headers of various sorts
+		  (goto-char (point-min))
+		  (and feedmail-nuke-empty-headers  ;; hey, who's an empty-header? 
+			   (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" end-of-headers-marker t)
+				 (replace-match ""))))
+
+		;; message ID generation
+		(if feedmail-message-id-generator
+			(progn
+			  (goto-char (point-min))
+			  (if (re-search-forward "^MESSAGE-ID:[ \t]*\n" end-of-headers-marker t)
+				  (replace-match ""))
+			  (setq feedmail-msgid-part (funcall feedmail-message-id-generator))
+			  (goto-char (point-min))
+			  (and feedmail-msgid-part (string-match "[^ \t]" feedmail-msgid-part)
+				  (insert "Message-ID: " feedmail-msgid-part "\n"))))
+
+
+		(save-excursion (set-buffer feedmail-error-buffer) (erase-buffer))
+
+		(run-hooks 'feedmail-last-chance-hook)
+
+		(if (or (not feedmail-confirm-outgoing) (feedmail-one-last-look feedmail-prepped-text-buffer))
+			(funcall feedmail-buffer-eating-function feedmail-prepped-text-buffer feedmail-error-buffer
+					 (save-excursion (set-buffer feedmail-address-buffer) (buffer-string)))
+		  (error "Sending...abandoned")
+		  )
+		)  ;; unwind-protect body (save-excursion)
+
+	  ;; unwind-protect cleanup forms
+	  (kill-buffer feedmail-prepped-text-buffer)
+	  (kill-buffer feedmail-address-buffer)
+	  (set-buffer feedmail-error-buffer)
+	  (if (zerop (buffer-size))
+		  (kill-buffer feedmail-error-buffer)
+		(progn (display-buffer feedmail-error-buffer)
+			   (error "Sending...failed")))
+	  (set-buffer feedmail-raw-text-buffer))
+	) ;; let
+  )
+
+
+(defun feedmail-do-bcc (header-end)
+  "Delete BCC: and their continuation lines from the header area.
+There may be multiple BCC: lines, and each may have arbitrarily
+many continuation lines."
+  (let ((case-fold-search t))
+	(save-excursion (goto-char (point-min))
+	  ;; iterate over all BCC: lines
+	  (while (re-search-forward "^BCC:" header-end t)
+		(delete-region (match-beginning 0) (progn (forward-line 1) (point)))
+		;; get rid of any continuation lines
+		(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
+		  (replace-match ""))
+		)
+	  ) ;; save-excursion
+	) ;; let
+  )
+
+(defun feedmail-fill-to-cc-function (header-end)
+  "Smart filling of TO: and CC: headers.  The filling tries to avoid
+splitting lines except at commas.  This avoids, in particular,
+splitting within parenthesized comments in addresses."
+  (let ((case-fold-search t)
+		(fill-prefix "\t")
+		(fill-column feedmail-fill-to-cc-fill-column)
+		this-line
+		this-line-end)
+	(save-excursion (goto-char (point-min))
+	  ;; iterate over all TO:/CC: lines
+	  (while (re-search-forward "^\\(TO:\\|CC:\\)" header-end t)
+		(setq this-line (match-beginning 0))
+		(forward-line 1)
+		;; get any continuation lines
+		(while (and (looking-at "^[ \t]+") (< (point) header-end))
+		  (replace-match " ")
+		  (forward-line 1))
+		(setq this-line-end (point-marker))
+
+		;; The general idea is to break only on commas.  Change
+		;; all the blanks to something unprintable; change the
+		;; commas to blanks; fill the region; change it back.
+		(subst-char-in-region this-line this-line-end ?   2 t) ;; blank --> C-b
+		(subst-char-in-region this-line this-line-end ?, ?  t) ;; comma --> blank
+		(fill-region-as-paragraph this-line this-line-end)
+
+		(subst-char-in-region this-line this-line-end ?  ?, t) ;; comma <-- blank
+		(subst-char-in-region this-line this-line-end  2 ?  t) ;; blank <-- C-b
+
+		;; look out for missing commas before continuation lines
+		(save-excursion
+		  (goto-char this-line)
+		  (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
+			(replace-match "\\1,\n\t")))
+		)
+	  ) ;; while
+	) ;; save-excursion
+  )
+
+
+(defun feedmail-deduce-address-list (feedmail-text-buffer header-start header-end)
+  "Get address list suitable for command line use on simple /bin/mail."
+  (require 'mail-utils)  ;; pick up mail-strip-quoted-names
+  (let
+	  ((case-fold-search t)
+	   (simple-address-list "")
+	   this-line
+	   this-line-end)
+	(unwind-protect
+		(save-excursion
+		  (set-buffer feedmail-address-buffer) (erase-buffer)
+		  (insert-buffer-substring feedmail-text-buffer header-start header-end)
+		  (goto-char (point-min))
+		  (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t)
+			(replace-match "")
+			(setq this-line (match-beginning 0))
+			(forward-line 1)
+			;; get any continuation lines
+			(while (and (looking-at "^[ \t]+") (< (point) header-end))
+			  (forward-line 1))
+			(setq this-line-end (point-marker))
+			(setq simple-address-list
+				  (concat simple-address-list " "
+						  (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
+			)
+		  (erase-buffer)
+		  (insert-string simple-address-list)
+		  (subst-char-in-region (point-min) (point-max) 10 ?  t)  ;; newline --> blank
+		  (subst-char-in-region (point-min) (point-max) ?, ?  t)  ;; comma   --> blank
+		  (subst-char-in-region (point-min) (point-max)  9 ?  t)  ;; tab     --> blank
+
+		  (goto-char (point-min))
+		  ;; tidyness in case hook is not robust when it looks at this
+		  (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
+
+		  )
+	  )
+	)
+  )
+
+
+(defun feedmail-one-last-look (feedmail-prepped-text-buffer)
+  "Offer the user one last chance to give it up."
+  (save-excursion (save-window-excursion
+	(switch-to-buffer feedmail-prepped-text-buffer)
+	(y-or-n-p "Send this email? "))))
+
+
+(provide 'feedmail)
+;;; metamail.el --- Metamail interface for GNU Emacs
+
+;; Copyright (C) 1993, 1996  Masanobu UMEDA
+
+;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
+;; Version: $Header$
+;; Keywords: mail, news, mime, multimedia
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 19.34.
+
+;;; Commentary:
+
+;; I trashed all the differences this file had from the FSF version.
+;;  So sue me.  -sb
+
+;; The latest version will be at:
+;;	ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
+
+;; Note: Metamail does not have all options which is compatible with
+;; the environment variables.  For that reason, matamail.el have to
+;; hack the environment variables.  In addition, there is no way to
+;; display all header fields without extra informative body messages
+;; which are suppressed by "-q" option.
+
+;; The following definition is what I'm using with GNUS 4:
+;;(setq gnus-show-mime-method
+;;      (function
+;;       (lambda ()
+;;        (metamail-interpret-header)
+;;        (let ((metamail-switches     ;Suppress header fields in a body.
+;;               (append metamail-switches '("-q"))))
+;;          (metamail-interpret-body)))))
+
+;; The idea of using metamail to process MIME messages is from
+;; gnus-mime.el by Spike <Spike@world.std.com>.
+
+;;; Code:
+
+(defgroup metamail nil
+  "Metamail interface for Emacs."
+  :group 'mail
+  :group 'hypermedia
+  :group 'processes)
+
+(defcustom metamail-program-name "metamail"
+  "*Metamail program name."
+  :type 'string
+  :group 'metamail)
+
+(defcustom metamail-mailer-name "emacs"
+  "*Mailer name set to MM_MAILER environment variable."
+  :type 'string
+  :group 'metamail)
+
+(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
+  "*Environment variables passed to `metamail'.
+It must be a list of strings that have the format ENVVARNAME=VALUE.
+It is not expected to be altered globally by `set' or `setq'.
+Instead, change its value temporary using `let' or `let*' form.")
+
+(defcustom metamail-switches '("-x" "-d" "-z")
+  "*Switches for `metamail' program.
+`-z' is required to remove zap file.
+It is not expected to be altered globally by `set' or `setq'.
+Instead, change its value temporary using `let' or `let*' form.
+`-m MAILER' argument is automatically generated from the
+`metamail-mailer-name' variable."
+  :type '(repeat (string :tag "Switch"))
+  :group 'metamail)
+
+;;;###autoload
+(defun metamail-interpret-header ()
+  "Interpret a header part of a MIME message in current buffer.
+Its body part is not interpreted at all."
+  (interactive)
+  (save-excursion
+    (let* ((buffer-read-only nil)
+	   (metamail-switches           ;Inhibit processing an empty body.
+	    (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
+	   (end (progn
+		  (goto-char (point-min))
+		  (search-forward "\n\n" nil 'move)
+		  ;; An extra newline is inserted by metamail if there
+		  ;; is no body part.  So, insert a dummy body by
+		  ;; itself.
+		  (insert "\n")
+		  (point))))
+      (metamail-region (point-min) end nil nil 'nodisplay)
+      ;; Remove an extra newline inserted by myself.
+      (goto-char (point-min))
+      (if (search-forward "\n\n\n" nil t)
+	  (delete-char -1))
+      )))
+
+;;;###autoload
+(defun metamail-interpret-body (&optional viewmode nodisplay)
+  "Interpret a body part of a MIME message in current buffer.
+Optional argument VIEWMODE specifies the value of the
+EMACS_VIEW_MODE environment variable (defaulted to 1).
+Optional argument NODISPLAY non-nil means buffer is not
+redisplayed as output is inserted.
+Its header part is not interpreted at all."
+  (interactive "p")
+  (save-excursion
+    (let ((contype nil)
+	  (encoding nil)
+         (end (progn
+                (goto-char (point-min))
+                (search-forward "\n\n" nil t)
+                (point))))
+      ;; Find Content-Type and Content-Transfer-Encoding from the header.
+      (save-restriction
+	(narrow-to-region (point-min) end)
+	(setq contype 
+	      (or (mail-fetch-field "Content-Type") "text/plain"))
+	(setq encoding 
+	      (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
+      ;; Interpret the body part only.
+      (let ((metamail-switches         ;Process body part only.
+	     (append metamail-switches
+		     (list "-b" "-c" contype "-E" encoding))))
+	(metamail-region end (point-max) viewmode nil nodisplay))
+      ;; Mode specific hack.
+      (cond ((eq major-mode 'rmail-mode)
+	     ;; Adjust the marker of this message if in Rmail mode buffer.
+	     (set-marker (aref rmail-message-vector (1+ rmail-current-message))
+			 (point-max))))
+      )))
+
+;;;###autoload
+(defun metamail-buffer (&optional viewmode buffer nodisplay)
+  "Process current buffer through `metamail'.
+Optional argument VIEWMODE specifies the value of the
+EMACS_VIEW_MODE environment variable (defaulted to 1).
+Optional argument BUFFER specifies a buffer to be filled (nil
+means current).
+Optional argument NODISPLAY non-nil means buffer is not
+redisplayed as output is inserted."
+  (interactive "p")
+  (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
+
+;;;###autoload
+(defun metamail-region (beg end &optional viewmode buffer nodisplay)
+  "Process current region through 'metamail'.
+Optional argument VIEWMODE specifies the value of the
+EMACS_VIEW_MODE environment variable (defaulted to 1).
+Optional argument BUFFER specifies a buffer to be filled (nil
+means current).
+Optional argument NODISPLAY non-nil means buffer is not
+redisplayed as output is inserted."
+  (interactive "r\np")
+  (let ((curbuf (current-buffer))
+	(buffer-read-only nil)
+	(metafile (make-temp-name "/tmp/metamail"))
+	(option-environment
+	 (list (concat "EMACS_VIEW_MODE=" 
+		       (if (numberp viewmode) viewmode 1)))))
+    (save-excursion
+      ;; Gee!  Metamail does not ouput to stdout if input comes from
+      ;; stdin.
+      (let ((selective-display nil)  ;Disable ^M to nl translation.
+	    (kanji-fileio-code 2)    ;Write in JIS code when nemacs.
+	    (file-coding-system      ;Write in JUNET style when mule.
+	     (if (featurep 'mule) '*junet*))
+	    (coding-system-for-write ;Write in iso-2022-jp style
+	     'iso-2022-jp)           ;	when XEmacs/mule
+	    )
+	(write-region beg end metafile nil 'nomessage))
+      (if buffer
+	  (set-buffer buffer))
+      (setq buffer-read-only nil)
+      ;; Clear destination buffer.
+      (if (eq curbuf (current-buffer))
+	  (delete-region beg end)
+	(delete-region (point-min) (point-max)))
+      ;; We have to pass the environment variable KEYHEADS to display
+      ;; all header fields.  Metamail should have an optional argument
+      ;; to pass such information directly.
+      (let ((process-environment
+	     (append process-environment
+		     metamail-environment option-environment)))
+	;; Specify character coding system.
+	(if (boundp 'NEMACS)
+	    (define-program-kanji-code nil metamail-program-name 2)) ;JIS
+	(if (featurep 'mule)
+	    (if (fboundp 'define-program-coding-system)
+		(define-program-coding-system
+		  nil
+		  metamail-program-name
+		  'junet)
+	      ;; XEmacs with MULE
+	      (setq buffer-file-coding-system 'junet)))
+	(apply (function call-process)
+	       metamail-program-name
+	       nil
+	       t                        ;Output to current buffer
+	       (not nodisplay)          ;Force redisplay
+	       (append metamail-switches
+		       (list "-m" (or metamail-mailer-name "emacs"))
+		       (list metafile))))
+      ;; `metamail' may not delete the temporary file!
+      (condition-case error
+	  (delete-file metafile)
+	(error nil))
+      )))
+
+(provide 'metamail)
+
+;;; metamail.el ends here
+(net-utils
+  (version VERSION
+   description "Miscellaneous Networking Utilities."
+   filename FILENAME
+   md5sum MD5SUM
+   size SIZE
+   provides (ilisp-browse-cltl2 emacsbug feedmail metamail rcompile shadowfile webjump webster-www)
+   requires (REQUIRES)
+   type single
+))
+;;; rcompile.el --- run a compilation on a remote machine
+
+;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+
+;; Author: Albert    <alon@milcse.rtsg.mot.com>
+;; Maintainer: FSF
+;; Created: 1993 Oct 6
+;; Version: 1.1
+;; Keywords: tools, processes
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 19.34.
+
+;;; Commentary:
+
+;; This package is for running a remote compilation and using emacs to parse
+;; the error messages. It works by rsh'ing the compilation to a remote host
+;; and parsing the output. If the file visited at the time remote-compile was
+;; called was loaded remotely (ange-ftp), the host and user name are obtained
+;; by the calling ange-ftp-ftp-name on the current directory. In this case the
+;; next-error command will also ange-ftp the files over. This is achieved
+;; automatically because the compilation-parse-errors function uses
+;; default-directory to build it's file names. If however the file visited was
+;; loaded locally, remote-compile prompts for a host and user and assumes the
+;; files mounted locally (otherwise, how was the visited file loaded).
+
+;; See the user defined variables section for more info.
+
+;; I was contemplating redefining "compile" to "remote-compile" automatically
+;; if the file visited was ange-ftp'ed but decided against it for now. If you
+;; feel this is a good idea, let me know and I'll consider it again.
+
+;;; Installation:
+
+;; To use rcompile, you also need to give yourself permission to connect to
+;; the remote host.  You do this by putting lines like:
+
+;; monopoly alon
+;; vme33
+;;
+;; in a file named .rhosts in the home directory (of the remote machine).
+;; Be careful what you put in this file. A line like:
+;;
+;; +
+;;
+;; Will allow anyone access to your account without a password. I suggest you
+;; read the rhosts(5) manual page before you edit this file (if you are not
+;; familiar with it already) 
+
+;;; Code:
+
+(provide 'rcompile)
+(require 'compile)
+;;; The following should not be needed.
+;;; (eval-when-compile (require 'ange-ftp))
+
+;;;; user defined variables
+
+(defgroup remote-compile nil
+  "Run a compilation on a remote machine"
+  :group 'processes
+  :group 'tools)
+
+
+(defcustom remote-compile-host nil
+  "*Host for remote compilations."
+  :type '(choice string (const nil))
+  :group 'remote-compile)
+
+(defcustom remote-compile-user nil
+  "User for remote compilations.
+nil means use the value returned by \\[user-login-name]."
+  :type '(choice string (const nil))
+  :group 'remote-compile)
+
+(defcustom remote-compile-run-before nil
+  "*Command to run before compilation.
+This can be used for setting up environment variables,
+since rsh does not invoke the shell as a login shell and files like .login
+\(tcsh\) and .bash_profile \(bash\) are not run.
+nil means run no commands."
+  :type '(choice string (const nil))
+  :group 'remote-compile)
+
+(defcustom remote-compile-prompt-for-host nil
+  "*Non-nil means prompt for host if not available from filename."
+  :type 'boolean
+  :group 'remote-compile)
+
+(defcustom remote-compile-prompt-for-user nil
+  "*Non-nil means prompt for user if not available from filename."
+  :type 'boolean
+  :group 'remote-compile)
+
+;;;; internal variables
+
+;; History of remote compile hosts and users
+(defvar remote-compile-host-history nil)
+(defvar remote-compile-user-history nil)
+
+
+;;;; entry point
+
+;;;###autoload
+(defun remote-compile (host user command)
+  "Compile the current buffer's directory on HOST.  Log in as USER.
+See \\[compile]."
+  (interactive
+   (let ((parsed 
+	  ;; XEmacs change
+	  (cond
+	   ((featurep 'efs)
+	    (efs-ftp-path default-directory))
+	   ((featurep 'ange-ftp)
+	    (if (fboundp 'ange-ftp-ftp-name)
+		(ange-ftp-ftp-name default-directory)
+	      (ange-ftp-ftp-path default-directory)))
+	   (t nil)))
+         host user command prompt)
+     (if parsed
+         (setq host (nth 0 parsed)
+               user (nth 1 parsed))
+       (setq prompt (if (stringp remote-compile-host)
+                        (format "Compile on host (default %s): "
+                                remote-compile-host)
+                      "Compile on host: ")
+             host (if (or remote-compile-prompt-for-host
+                          (null remote-compile-host))
+                      (read-from-minibuffer prompt
+                                            "" nil nil
+                                            'remote-compile-host-history)
+                    remote-compile-host)
+             user (if remote-compile-prompt-for-user
+                      (read-from-minibuffer (format
+                                             "Compile by user (default %s)"
+                                             (or remote-compile-user
+                                                 (user-login-name)))
+                                            "" nil nil
+                                            'remote-compile-user-history)
+                    remote-compile-user)))
+     (setq command (read-from-minibuffer "Compile command: "
+                                         compile-command nil nil
+                                         '(compile-history . 1)))
+     (list (if (string= host "") remote-compile-host host)
+           (if (string= user "") remote-compile-user user)
+           command)))
+  (setq compile-command command)
+  (cond (user
+         (setq remote-compile-user user))
+        ((null remote-compile-user)
+         (setq remote-compile-user (user-login-name))))
+  (let* ((parsed
+	  ;; XEmacs change
+	  (cond
+	   ((featurep 'efs)
+	    (efs-ftp-path default-directory))
+	   ((featurep 'ange-ftp)
+	    (if (fboundp 'ange-ftp-ftp-name)
+		(ange-ftp-ftp-name default-directory)
+	      (ange-ftp-ftp-path default-directory)))
+	   (t nil)))
+         (compile-command
+          (format "%s %s -l %s \"(%scd %s; %s)\""
+		  remote-shell-program
+                  host
+                  remote-compile-user
+                  (if remote-compile-run-before
+                      (concat remote-compile-run-before "; ")
+                    "")
+                  (if parsed (nth 2 parsed) default-directory)
+                  compile-command)))
+    (setq remote-compile-host host)
+    (save-some-buffers nil nil)
+    (compile-internal compile-command "No more errors")
+    ;; Set comint-file-name-prefix in the compilation buffer so
+    ;; compilation-parse-errors will find referenced files by ange-ftp.
+    (save-excursion
+      (set-buffer compilation-last-buffer)
+      (setq comint-file-name-prefix (concat "/" user "@" host ":")))))
+
+;;; rcompile.el ends here
+;;; shadowfile.el --- automatic file copying for Emacs 19
+
+;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+
+;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
+;; Keywords: comm
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;; LCD Archive Entry:
+;; shadowfile|Boris Goldowsky|boris@gnu.ai.mit.edu|
+;; Helps you keep identical copies of files in multiple places.|
+;; $Date$ |$Revision$|~/misc/shadowfile.el.Z|
+
+;;; Synched up with: FSF 19.30.
+
+;; Commentary:
+
+;;  This package helps you to keep identical copies of files in more than one
+;;  place - possibly on different machines.  When you save a file, it checks
+;;  whether it is on the list of files with "shadows", and if so, it tries to
+;;  copy it when you exit emacs (or use the shadow-copy-files command).
+
+;; Installation & Use:
+
+;;  Put (require 'shadowfile) in your .emacs; add clusters (if necessary)
+;;  and file groups with shadow-define-cluster,
+;;  shadow-define-literal-group, and shadow-define-regexp-group (see the
+;;  documentation for these functions for information on how and when to
+;;  use them).  After doing this once, everything should be automatic.
+
+;;  The lists of clusters and shadows are saved in a file called .shadows,
+;;  so that they can be remembered from one emacs session to another, even
+;;  (as much as possible) if the emacs session terminates abnormally.  The
+;;  files needing to be copied are stored in .shadow_todo; if a file cannot
+;;  be copied for any reason, it will stay on the list to be tried again
+;;  next time.  The .shadows file should itself have shadows on all your
+;;  accounts so that the information in it is consistent everywhere, but
+;;  .shadow_todo is local information and should have no shadows.
+
+;;  If you do not want to copy a particular file, you can answer "no" and
+;;  be asked again next time you hit C-x 4 s or exit emacs.  If you do not
+;;  want to be asked again, use shadow-cancel, and you will not be asked
+;;  until you change the file and save it again.  If you do not want to
+;;  shadow that file ever again, you can edit it out of the .shadows
+;;  buffer.  Anytime you edit the .shadows buffer, you must type M-x
+;;  shadow-read-files to load in the new information, or your changes will
+;;  be overwritten!
+
+;; Bugs & Warnings:
+;;
+;;  - It is bad to have two emacses both running shadowfile at the same
+;;  time.  It tries to detect this condition, but is not always successful.
+;;
+;;  - You have to be careful not to edit a file in two locations
+;;  before shadowfile has had a chance to copy it; otherwise
+;;  "updating shadows" will overwrite one of the changed versions.
+;;
+;;  - It ought to check modification times of both files to make sure
+;;  it is doing the right thing.  This will have to wait until
+;;  file-newer-than-file-p works between machines.
+;;
+;;  - It will not make directories for you, it just fails to copy files
+;;  that belong in non-existent directories.
+;;
+;;  Please report any bugs to me (boris@gnu.ai.mit.edu).  Also let me know
+;;  if you have suggestions or would like to be informed of updates.
+
+;;; Code:
+
+(provide 'shadowfile)
+(require 'efs-auto)
+
+;;; I don't think this is very cool...  hope it works without the setting.
+(setq find-file-visit-truename t)	; makes life easier with symbolic links
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defgroup shadowfile nil
+  "Keep identical copies of files in more than one place."
+  :group 'files
+  :prefix "shadow")
+
+(defcustom shadow-noquery nil
+  "*If t, always copy shadow files without asking.
+If nil \(the default), always ask.  If not nil and not t, ask only if there
+is no buffer currently visiting the file."
+  :type 'boolean
+  :group 'shadowfile)
+
+(defcustom shadow-inhibit-message nil
+  "*If nonnil, do not display a message when a file needs copying."
+  :type 'boolean
+  :group 'shadowfile)
+
+(defcustom shadow-inhibit-overload nil
+  "If nonnil, shadowfile won't redefine C-x C-c.
+Normally it overloads the function `save-buffers-kill-emacs' to check
+for files have been changed and need to be copied to other systems."
+  :type 'boolean
+  :group 'shadowfile)
+
+(defcustom shadow-info-file nil
+  "File to keep shadow information in.  
+The shadow-info-file should be shadowed to all your accounts to
+ensure consistency.  Default: ~/.xemacs/shadows"
+  :type '(choice (const :tag "Default" nil)
+		 (file))
+  :group 'shadowfile)
+
+(defcustom shadow-todo-file nil
+  "File to store the list of uncopied shadows in.
+This means that if a remote system is down, or for any reason you cannot or
+decide not to copy your shadow files at the end of one emacs session, it will
+remember and ask you again in your next emacs session.
+This file must NOT be shadowed to any other system, it is host-specific.
+Default: ~/.xemacs/shadow_todo"
+  :type '(choice (const :tag "Default" nil)
+		 (file))
+  :group 'shadowfile)
+
+;;; The following two variables should in most cases initialize themselves
+;;; correctly.  They are provided as variables in case the defaults are wrong
+;;; on your machine \(and for efficiency).
+
+(defvar shadow-system-name (system-name)
+  "The complete hostname of this machine.")
+
+(defvar shadow-homedir nil
+  "Your home directory on this machine.")
+
+;;;
+;;; Internal variables whose values are stored in the info and todo files:
+;;;
+
+(defvar shadow-clusters nil
+  "List of host clusters \(see shadow-define-cluster).")
+
+(defvar shadow-literal-groups nil
+  "List of files that are shared between hosts.
+This list contains shadow structures with literal filenames, created by
+shadow-define-group.")
+
+(defvar shadow-regexp-groups nil
+  "List of file types that are shared between hosts.
+This list contains shadow structures with regexps matching filenames, 
+created by shadow-define-regexp-group.")
+
+;;;
+;;; Other internal variables:
+;;;
+
+(defvar shadow-files-to-copy nil)	; List of files that need to
+					; be copied to remote hosts.
+
+(defvar shadow-hashtable nil)		; for speed
+
+(defvar shadow-info-buffer nil)		; buf visiting shadow-info-file
+(defvar shadow-todo-buffer nil)		; buf visiting shadow-todo-file
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Syntactic sugar; General list and string manipulation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro shadow-when (condition &rest body)
+  ;; From cl.el
+  "(shadow-when CONDITION . BODY) => evaluate BODY if CONDITION is true."
+  (` (if (not (, condition))  ()  (,@ body))))
+  
+(defun shadow-union (a b)
+  "Add members of list A to list B
+if they are not equal to items already in B."
+  (if (null a)
+      b
+    (if (member (car a) b)
+	(shadow-union (cdr a) b)
+      (shadow-union (cdr a) (cons (car a) b)))))
+
+(defun shadow-find (func list)
+  "If FUNC applied to some element of LIST is nonnil, 
+return the first such element."
+  (while (and list (not (funcall func (car list))))
+    (setq list (cdr list)))
+  (car list))
+
+(defun shadow-remove-if (func list)
+  "Remove elements satisfying FUNC from LIST.
+Nondestructive; actually returns a copy of the list with the elements removed."
+  (if list
+      (if (funcall func (car list))
+	  (shadow-remove-if func (cdr list))
+	(cons (car list) (shadow-remove-if func (cdr list))))
+    nil))
+
+(defun shadow-join (strings sep)
+  "Concatenate elements of the list of STRINGS with SEP between each."
+  (cond ((null strings) "")
+	((null (cdr strings)) (car strings))
+	((concat (car strings) " " (shadow-join (cdr strings) sep)))))
+
+(defun shadow-regexp-superquote (string)
+  "Like regexp-quote, but includes the ^ and $ 
+to make sure regexp matches nothing but STRING."
+  (concat "^" (regexp-quote string) "$"))
+
+(defun shadow-suffix (prefix string)
+  "If PREFIX begins STRING, return the rest.
+Return value is nonnil if PREFIX and STRING are string= up to the length of
+PREFIX."
+  (let ((lp (length prefix))
+	(ls (length string)))
+    (if (and (>= ls lp)
+	     (string= prefix (substring string 0 lp)))
+	(substring string lp))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Clusters and sites
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; I use the term `site' to refer to a string which may be the name of a
+;;; cluster or a literal hostname.  All user-level commands should accept
+;;; either.
+
+(defun shadow-make-cluster (name primary regexp)
+  "Creates a shadow cluster 
+called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the
+cluster.  The variable shadow-clusters associates the names of clusters to
+these structures. 
+   This function is for program use: to create clusters interactively, use
+shadow-define-cluster instead."
+  (list name primary regexp))
+
+(defmacro shadow-cluster-name (cluster)
+  "Return the name of the CLUSTER."
+  (list 'elt cluster 0))
+
+(defmacro shadow-cluster-primary (cluster)
+  "Return the primary hostname of a CLUSTER."
+  (list 'elt cluster 1))
+
+(defmacro shadow-cluster-regexp (cluster)
+  "Return the regexp matching hosts in a CLUSTER."
+  (list 'elt cluster 2))
+
+(defun shadow-set-cluster (name primary regexp)
+  "Put cluster NAME on the list of clusters,
+replacing old definition if any.  PRIMARY and REGEXP are the
+information defining the cluster.  For interactive use, call
+shadow-define-cluster instead."
+  (let ((rest (shadow-remove-if
+	       (function (lambda (x) (equal name (car x))))
+	       shadow-clusters)))
+    (setq shadow-clusters 
+	  (cons (shadow-make-cluster name primary regexp)
+		rest))))
+
+(defmacro shadow-get-cluster (name)
+  "Return cluster named NAME, or nil."
+  (list 'assoc name 'shadow-clusters))
+
+(defun shadow-site-primary (site)
+  "If SITE is a cluster, return primary host, otherwise return SITE."
+  (let ((c (shadow-get-cluster site)))
+    (if c
+	(shadow-cluster-primary c)
+      site)))
+
+;;; SITES
+
+(defun shadow-site-cluster (site)
+  "Given a SITE \(hostname or cluster name), return the cluster
+that it is in, or nil."
+  (or (assoc site shadow-clusters)
+      (shadow-find
+       (function (lambda (x)
+		   (string-match (shadow-cluster-regexp x)
+				 site)))
+       shadow-clusters)))
+
+(defun shadow-read-site ()
+  "Read a cluster name or hostname from the minibuffer."
+  (let ((ans (completing-read "Host or cluster name [RET when done]: "
+			      shadow-clusters)))
+    (if (equal "" ans)
+	nil
+      ans)))
+
+(defun shadow-site-match (site1 site2)
+  "Nonnil iff SITE1 is or includes SITE2.  
+Each may be a host or cluster name; if they are clusters, regexp of site1 will
+be matched against the primary of site2."
+  (or (string-equal site1 site2) ; quick check
+      (let* ((cluster1 (shadow-get-cluster site1))
+	     (primary2 (shadow-site-primary site2)))
+	(if cluster1
+	    (string-match (shadow-cluster-regexp cluster1) primary2)
+	  (string-equal site1 primary2)))))
+
+(defun shadow-get-user (site)
+  "Returns the default username for a site."
+  (efs-get-user (shadow-site-primary site)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Filename manipulation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun shadow-parse-fullpath (fullpath)
+  "Parse PATH into \(site user path) list,
+or leave it alone if it already is one.  Returns nil if the argument is not a
+full efs ftp pathname."
+  (if (listp fullpath)
+      fullpath
+    (efs-ftp-path fullpath)))
+
+(defun shadow-parse-path (path)
+  "Parse any PATH into \(site user path) list.
+Argument can be a simple path, full efs ftp path, or already a hup list."
+  (or (shadow-parse-fullpath path)
+      (list shadow-system-name
+	    (user-login-name)
+	    path)))
+
+(defsubst shadow-make-fullpath (host user path)
+  "Make an efs style fullpath out of HOST, USER (optional), and PATH.
+This is probably not as general as it ought to be."
+  (concat "/" 
+	  (if user (concat user "@"))
+	  host ":"
+	  path))
+
+(defun shadow-replace-path-component (fullpath newpath)
+  "Return FULLPATH with the pathname component changed to NEWPATH."
+  (let ((hup (shadow-parse-fullpath fullpath)))
+    (shadow-make-fullpath (nth 0 hup) (nth 1 hup) newpath)))
+
+(defun shadow-local-file (file)
+  "If FILENAME is at this site,
+remove /user@host part.  If refers to a different system or a different user on
+this system, return nil."
+  (let ((hup (shadow-parse-fullpath file)))
+    (cond ((null hup) file)
+	  ((and (shadow-site-match (nth 0 hup) shadow-system-name)
+		(string-equal (nth 1 hup) (user-login-name)))
+	   (nth 2 hup))
+	  (t nil))))
+
+(defun shadow-expand-cluster-in-file-name (file)
+  "If hostname part of FILE is a cluster, expand it
+into the cluster's primary hostname.  Will return the pathname bare if it is
+a local file."
+  (let ((hup (shadow-parse-path file))
+	cluster)
+    (cond ((null hup) file)
+	  ((shadow-local-file hup))
+	  ((shadow-make-fullpath (shadow-site-primary (nth 0 hup))
+				 (nth 1 hup)
+				 (nth 2 hup))))))
+
+(defun shadow-expand-file-name (file &optional default)
+  "Expand file name and get file's true name."
+  (file-truename (expand-file-name file default)))
+
+(defun shadow-contract-file-name (file)
+  "Simplify FILENAME
+by replacing (when possible) home directory with ~, and hostname with cluster
+name that includes it.  Filename should be absolute and true."
+  (let* ((hup (shadow-parse-path file))
+	 (homedir (if (shadow-local-file hup)
+		      shadow-homedir
+		    (file-name-as-directory
+		     (nth 2 (shadow-parse-fullpath 
+			     (expand-file-name
+			      (shadow-make-fullpath
+			       (nth 0 hup) (nth 1 hup) "~")))))))
+	 (suffix (shadow-suffix homedir (nth 2 hup)))
+	 (cluster (shadow-site-cluster (nth 0 hup))))
+    (shadow-make-fullpath
+     (if cluster
+	 (shadow-cluster-name cluster)
+       (nth 0 hup))
+     (nth 1 hup)
+     (if suffix 
+	 (concat "~/" suffix)
+       (nth 2 hup)))))
+
+(defun shadow-same-site (pattern file)
+  "True if the site of PATTERN and of FILE are on the same site.
+If usernames are supplied, they must also match exactly.  PATTERN and FILE may
+be lists of host, user, path, or efs ftp pathnames.  FILE may also be just a
+local filename."
+  (let ((pattern-sup (shadow-parse-fullpath pattern))
+	(file-sup    (shadow-parse-path file)))
+    (and
+     (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup))
+     (or (null (nth 1 pattern-sup))
+	 (string-equal (nth 1 pattern-sup) (nth 1 file-sup))))))
+
+(defun shadow-file-match (pattern file &optional regexp)
+ "Returns t if PATTERN matches FILE.
+If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular
+expression, otherwise it must match exactly.  The sites and usernames must
+match---see shadow-same-site.  The pattern must be in full efs ftp format, but
+the file can be any valid filename.  This function does not do any filename
+expansion or contraction, you must do that yourself first."
+ (let* ((pattern-sup (shadow-parse-fullpath pattern))
+	(file-sup (shadow-parse-path file)))
+   (and (shadow-same-site pattern-sup file-sup)
+	(if regexp 
+	    (string-match (nth 2 pattern-sup) (nth 2 file-sup))
+	  (string-equal (nth 2 pattern-sup) (nth 2 file-sup))))))
+ 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; User-level Commands
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun shadow-define-cluster (name)
+  "Edit \(or create) the definition of a cluster.
+This is a group of hosts that share directories, so that copying to or from
+one of them is sufficient to update the file on all of them.  Clusters are
+defined by a name, the network address of a primary host \(the one we copy
+files to), and a regular expression that matches the hostnames of all the sites
+in the cluster."
+  (interactive (list (completing-read "Cluster name: " shadow-clusters () ())))
+  (let* ((old (shadow-get-cluster name))
+	 (primary (read-string "Primary host: "
+			       (if old (shadow-cluster-primary old) 
+				 name)))
+	 (regexp   (let (try-regexp)
+		     (while (not
+			     (string-match 
+			      (setq try-regexp
+				    (read-string 
+				     "Regexp matching all host names: "
+				     (if old (shadow-cluster-regexp old)
+				       (shadow-regexp-superquote primary))))
+			      primary))
+		       (message "Regexp doesn't include the primary host!")
+		       (sit-for 2))
+		     try-regexp))
+;	 (username (read-no-blanks-input 
+;		    (format "Username [default: %s]: " 
+;			    (shadow-get-user primary))
+;		    (if old (or (shadow-cluster-username old) "")
+;		      (user-login-name))))
+	 )
+;    (if (string-equal "" username) (setq username nil))
+    (shadow-set-cluster name primary regexp)))
+
+(defun shadow-define-literal-group ()
+  "Declare a single file to be shared between sites.
+It may have different filenames on each site.  When this file is edited, the
+new version will be copied to each of the other locations.  Sites can be
+specific hostnames, or names of clusters \(see shadow-define-cluster)."
+  (interactive)
+  (let* ((hup (shadow-parse-fullpath 
+	       (shadow-contract-file-name (buffer-file-name))))
+	 (path (nth 2 hup))
+	 user site group)
+    (while (setq site (shadow-read-site))
+      (setq user (read-string (format "Username [default %s]: "
+				      (shadow-get-user site)))
+	    path (read-string "Filename: " path))
+      (setq group (cons (shadow-make-fullpath site 
+					      (if (string-equal "" user)
+						  (shadow-get-user site)
+						user)
+					      path)
+			group)))
+    (setq shadow-literal-groups (cons group shadow-literal-groups)))
+  (shadow-write-info-file))
+
+(defun shadow-define-regexp-group ()
+  "Make each of a group of files be shared between hosts.
+Prompts for regular expression; files matching this are shared between a list
+of sites, which are also prompted for. The filenames must be identical on all
+hosts \(if they aren't, use shadow-define-group instead of this function).
+Each site can be either a hostname or the name of a cluster \(see
+shadow-define-cluster)."
+  (interactive)
+  (let ((regexp (read-string 
+		 "Filename regexp: " 
+		 (if (buffer-file-name)
+		     (shadow-regexp-superquote
+		      (nth 2
+			   (shadow-parse-path
+			    (shadow-contract-file-name
+			     (buffer-file-name))))))))
+	site sites usernames)
+    (while (setq site (shadow-read-site))
+      (setq sites (cons site sites))
+      (setq usernames 
+	    (cons (read-string (format "Username for %s: " site)
+			       (shadow-get-user site))
+		  usernames)))
+    (setq shadow-regexp-groups 
+	  (cons (shadow-make-group regexp sites usernames)
+		shadow-regexp-groups))
+    (shadow-write-info-file)))
+    
+(defun shadow-shadows ()
+  ;; Mostly for debugging.
+  "Interactive function to display shadows of a buffer."
+  (interactive)
+  (let ((msg (shadow-join (mapcar (function cdr)
+				  (shadow-shadows-of (buffer-file-name)))
+			  " ")))
+    (message "%s"
+	     (if (zerop (length msg)) 
+		 "No shadows."
+	       msg))))
+
+(defun shadow-copy-files (&optional arg)
+  "Copy all pending shadow files.
+With prefix argument, copy all pending files without query.
+Pending copies are stored in variable shadow-files-to-copy, and in
+shadow-todo-file if necessary.  This function is invoked by
+shadow-save-buffers-kill-emacs, so it is not usually necessary to
+call it manually."
+  (interactive "P")
+  (if (and (not shadow-files-to-copy) (interactive-p))
+      (message "No files need to be shadowed.")
+    (save-excursion
+      (map-y-or-n-p (function
+		     (lambda (pair)
+		       (or arg shadow-noquery
+			   (format "Copy shadow file %s? " (cdr pair)))))
+		    (function shadow-copy-file)
+		    shadow-files-to-copy
+		    '("shadow" "shadows" "copy"))
+      (shadow-write-todo-file t))))
+
+(defun shadow-cancel ()
+  "Cancel the instruction to copy some files.
+Prompts for which copy operations to cancel.  You will not be asked to copy
+them again, unless you make more changes to the files.  To cancel a shadow
+permanently, remove the group from shadow-literal-groups or
+shadow-regexp-groups."
+  (interactive)
+  (map-y-or-n-p (function (lambda (pair)
+			    (format "Cancel copying %s to %s? " 
+				    (car pair) (cdr pair))))
+		(function (lambda (pair) 
+			    (shadow-remove-from-todo pair)))
+		shadow-files-to-copy
+		'("shadow" "shadows" "cancel copy"))
+  (message "There are %d shadows to be updated." 
+	   (length shadow-files-to-copy))
+  (shadow-write-todo-file))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Internal functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun shadow-make-group (regexp sites usernames)
+  "Makes a description of a file group---
+actually a list of regexp efs ftp file names---from REGEXP \(name of file to
+be shadowed), list of SITES, and corresponding list of USERNAMES for each
+site."
+  (if sites
+      (cons (shadow-make-fullpath (car sites) (car usernames) regexp)
+	    (shadow-make-group regexp (cdr sites) (cdr usernames)))
+    nil))
+
+(defun shadow-copy-file (s)
+  "Copy one shadow file."
+  (let* ((buffer 
+	  (cond ((get-file-buffer 
+		  (abbreviate-file-name (shadow-expand-file-name (car s)))))
+		((not (file-readable-p (car s)))
+		 (if (y-or-n-p
+		      (format "Cannot find file %s--cancel copy request?"
+			      (car s)))
+		     (shadow-remove-from-todo s))
+		 nil)
+		((or (eq t shadow-noquery)
+		     (y-or-n-p 
+		      (format "No buffer for %s -- update shadow anyway?"
+			      (car s))))
+		 (find-file-noselect (car s)))))
+	 (to (shadow-expand-cluster-in-file-name (cdr s))))
+    (shadow-when buffer
+      (set-buffer buffer)
+      (save-restriction
+	(widen)
+	(condition-case i 
+	    (progn
+	      (write-region (point-min) (point-max) to)
+	      (shadow-remove-from-todo s))
+	  (error (message "Shadow %s not updated!" (cdr s))))))))
+
+(defun shadow-shadows-of (file)
+  "Returns copy operations needed to update FILE.
+Filename should have clusters expanded, but otherwise can have any format.  
+Return value is a list of dotted pairs like \(from . to), where from
+and to are absolute file names."
+  (or (symbol-value (intern-soft file shadow-hashtable))
+      (let* ((absolute-file (shadow-expand-file-name
+			     (or (shadow-local-file file) file)
+			     shadow-homedir))
+	     (canonical-file (shadow-contract-file-name absolute-file))
+	     (shadows 
+	      (mapcar (function (lambda (shadow)
+				  (cons absolute-file shadow)))
+		      (append
+		       (shadow-shadows-of-1
+			canonical-file shadow-literal-groups nil)
+		       (shadow-shadows-of-1
+			canonical-file shadow-regexp-groups t)))))
+	(set (intern file shadow-hashtable) shadows))))
+
+(defun shadow-shadows-of-1 (file groups regexp)
+  "Return list of FILE's shadows in GROUPS, 
+which are considered as regular expressions if third arg REGEXP is true."
+  (if groups
+      (let ((nonmatching
+	     (shadow-remove-if 
+	      (function (lambda (x) (shadow-file-match x file regexp)))
+	      (car groups))))
+	(append (cond ((equal nonmatching (car groups)) nil)
+		      (regexp 
+		       (let ((realpath (nth 2 (shadow-parse-fullpath file))))
+			 (mapcar 
+			  (function 
+			   (lambda (x) 
+			     (shadow-replace-path-component x realpath)))
+			  nonmatching)))
+		      (t nonmatching))
+		(shadow-shadows-of-1 file (cdr groups) regexp)))))
+
+(defun shadow-add-to-todo ()
+  "If current buffer has shadows, add them to the list
+of files needing to be copied."
+  (let ((shadows (shadow-shadows-of 
+		  (shadow-expand-file-name 
+		   (buffer-file-name (current-buffer))))))
+    (shadow-when shadows
+      (setq shadow-files-to-copy
+	    (shadow-union shadows shadow-files-to-copy))
+      (shadow-when (not shadow-inhibit-message)
+	(message "%s" (substitute-command-keys
+		       "Use \\[shadow-copy-files] to update shadows."))
+	(sit-for 1))
+      (shadow-write-todo-file)))
+  nil)     ; Return nil for write-file-hooks
+
+(defun shadow-remove-from-todo (pair)
+  "Remove PAIR from shadow-files-to-copy.
+PAIR must be (eq to) one of the elements of that list."
+  (setq shadow-files-to-copy 
+	(shadow-remove-if (function (lambda (s) (eq s pair)))
+			  shadow-files-to-copy)))
+
+(defun shadow-read-files ()
+  "Visits and loads shadow-info-file and shadow-todo-file,
+thus restoring shadowfile's state from your last emacs session.
+Returns t unless files were locked; then returns nil."
+  (interactive)
+  (if (and (fboundp 'file-locked-p)
+	   (or (stringp (file-locked-p shadow-info-file))
+	       (stringp (file-locked-p shadow-todo-file))))
+      (progn
+	(message "Shadowfile is running in another emacs; can't have two.")
+	(beep)
+	(sit-for 3)
+	nil)
+    (save-excursion
+      (shadow-when shadow-info-file
+	(set-buffer (setq shadow-info-buffer
+			  (find-file-noselect shadow-info-file)))
+	(shadow-when (and (not (buffer-modified-p))
+			  (file-newer-than-file-p (make-auto-save-file-name)
+						  shadow-info-file))
+	  (erase-buffer)
+	  (message "Data recovered from %s." 
+		   (car (insert-file-contents (make-auto-save-file-name))))
+	  (sit-for 1))
+	(eval-current-buffer))
+      (shadow-when shadow-todo-file
+	(set-buffer (setq shadow-todo-buffer 
+			  (find-file-noselect shadow-todo-file)))
+	(shadow-when (and (not (buffer-modified-p))
+			  (file-newer-than-file-p (make-auto-save-file-name)
+						  shadow-todo-file))
+	  (erase-buffer)
+	  (message "Data recovered from %s." 
+		   (car (insert-file-contents (make-auto-save-file-name))))
+	  (sit-for 1))
+	(eval-current-buffer nil))
+      (shadow-invalidate-hashtable))
+    t))
+
+(defun shadow-write-info-file ()
+  "Write out information to shadow-info-file.
+Also clears shadow-hashtable, since when there are new shadows defined, the old
+hashtable info is invalid."
+  (shadow-invalidate-hashtable)
+  (if shadow-info-file
+      (save-excursion
+	(if (not shadow-info-buffer)
+	    (setq shadow-info-buffer (find-file-noselect shadow-info-file)))
+	(set-buffer shadow-info-buffer)
+	(delete-region (point-min) (point-max))
+	(shadow-insert-var 'shadow-clusters)
+	(shadow-insert-var 'shadow-literal-groups)
+	(shadow-insert-var 'shadow-regexp-groups))))
+
+(defun shadow-write-todo-file (&optional save)
+  "Write out information to shadow-todo-file.  
+With nonnil argument also saves the buffer."
+  (save-excursion
+    (if (not shadow-todo-buffer)
+	(setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
+    (set-buffer shadow-todo-buffer)
+    (delete-region (point-min) (point-max))
+    (shadow-insert-var 'shadow-files-to-copy)
+    (if save (shadow-save-todo-file))))
+
+(defun shadow-save-todo-file ()
+  (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
+      (save-excursion
+	(set-buffer shadow-todo-buffer)
+	(condition-case nil		; have to continue even in case of 
+	    (basic-save-buffer)		; error, otherwise kill-emacs might
+	  (error			; not work!
+	   (message "WARNING: Can't save shadow todo file; it is locked!")
+	   (sit-for 1))))))
+
+(defun shadow-invalidate-hashtable ()
+  (setq shadow-hashtable (make-vector 37 0)))
+
+(defun shadow-insert-var (variable)
+  "Prettily insert a setq command for VARIABLE.
+which, when later evaluated, will restore it to its current setting.
+SYMBOL must be the name of a variable whose value is a list."
+  (let ((standard-output (current-buffer)))
+    (insert (format "(setq %s" variable))