Mercurial > emacs

changeset 5119:bf9e7676a73e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial revision
author Richard M. Stallman <rms@gnu.org>
date Tue, 23 Nov 1993 07:00:40 +0000
parents eec34ce70181
children 213cb417253b
files etc/tasks.texi lisp/avoid.el lisp/shadowfile.el
diffstat 3 files changed, 1524 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etc/tasks.texi	Tue Nov 23 07:00:40 1993 +0000
@@ -0,0 +1,440 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename tasks.info
+@settitle GNU Task List
+@c UPDATE THIS DATE WHENEVER YOU MAKE CHANGES!
+@set lastupdate 16 July 1993
+@c %**end of header
+
+@setchapternewpage off
+
+@ifinfo
+Copyright (C) 1993 Free Software Foundation
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+@end ignore
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title GNU Task List
+@author Richard Stallman
+@author last updated @value{lastupdate}
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1993 Free Software Foundation
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by Free Software Foundation.
+@end titlepage
+
+@ifinfo
+@node Top, Documentation, (dir), (dir)
+@top Version
+
+Last updated @value{lastupdate}.
+@end ifinfo
+
+Check with gnu@@prep.ai.mit.edu, for a possibly more current copy.
+This task list is not exclusive; any other useful program might be a
+good project--but it might instead be something we already have, so
+check with gnu@@prep before you start writing it.
+
+@menu
+* Documentation::               
+* Unix-related projects::       
+* Kernel-related projects::     
+* Extensions to existing GNU software::  
+* X windows projects::          
+* Other random projects::       
+* Compilers for other batch languages::  
+* Games and recreations::       
+@end menu
+
+If you start working steadily on a project, please let gnu@@prep know.
+We might have information that could help you; we'd also like to send
+you the GNU coding standards.
+
+Because of the natural tendency for most volunteers to write
+programming tools or programming languages, we have a comparative
+shortage of applications useful for non-programmer users.  Therefore,
+we ask you to consider writing such a program.
+
+In general, a new program that does a completely new job advances the
+GNU project more than an improvement to an existing program.
+
+@node Documentation, Unix-related projects, Top, Top
+@chapter Documentation
+
+We very urgently need documentation for some parts of the system
+that already exist or will exist very soon:
+
+@itemize @bullet
+
+@item
+A C reference manual.  (RMS has written half of one which you could
+start with).
+
+@item
+A manual for Ghostscript.
+
+@item
+A manual for CSH.
+
+@item
+A manual for PIC (the graphics formatting language).
+
+@item
+A manual for Perl.  (The manual that exists is not free, and
+is thus not available to be part of the GNU system.)
+
+@item
+A manual for Oleo.
+
+@item
+A book on how GCC works and why various machine descriptions
+are written as they are.
+
+@item
+A manual for programming X-window applications.
+
+@item
+Manuals for various X window managers.
+
+@item
+Reference cards for those manuals that don't have them: Gawk, C
+Compiler, Make, Texinfo, Termcap and maybe the C Library.
+
+@item
+Many utilities need documentation, including @code{grep}, @code{cpio},
+@code{find}, @code{less}, and the other small utilities.
+
+@end itemize
+
+@node Unix-related projects, Kernel-related projects, Documentation, Top
+@chapter Unix-related projects
+
+@itemize
+
+@item
+We could use an emulation of Unix @code{spell}, which would run by
+invoking @code{ispell}.
+
+@item
+Less urgent: @code{diction}, @code{explain}, @code{style}.
+
+@item
+An improved version of the POSIX utility @code{pax}.  There is one on
+the usenet, but it is said to be poorly written.  Talk with
+mib@@gnu.ai.mit.edu about this project.
+
+@item
+Modify the GNU @code{dc} program to use the math routines of GNU
+@code{bc}.
+
+@item
+A @code{grap} preprocessor program for @code{troff}.
+
+@item
+Various other libraries.
+
+@item
+An emulation of SCCS that works using RCS.
+
+@end itemize
+
+@node Kernel-related projects, Extensions to existing GNU software, Unix-related projects, Top
+@chapter Kernel-related projects
+
+@itemize
+
+@item
+An over-the-ethernet debugger that will allow the kernel to be
+debugged from GDB running on another machine.
+
+@item
+A shared memory X11 server to run under MACH is very desirable.  The
+machine specific parts should be kept well separated.
+
+@end itemize
+
+@node Extensions to existing GNU software, X windows projects, Kernel-related projects, Top
+@chapter Extensions to existing GNU software
+
+@itemize
+
+@item
+Enhance GCC.  See files PROJECTS and PROBLEMS in the GCC distribution.
+
+@item
+GNU @code{sed} probably needs to be rewritten completely just to make it
+cleaner.
+
+@item
+Add a few features to GNU @code{diff}, such as handling large input
+files without reading entire files into core.
+
+@item
+Extend GDB with an X-based graphical interface better than @code{xxgdb}.
+
+@item
+An @code{nroff} macro package to simplify @code{texi2roff}.
+
+@item
+A queueing system for the mailer Smail that groups pending work by
+destination rather than by original message.  This makes it possible
+to schedule retries coherently for each destination.  Talk to
+tron@@veritas.com about this.
+
+@item
+Cross-referencing, flow graph, and execution trace programs for C and
+other languages, like @code{cxref}, @code{cflow}, and @code{ctrace}.
+
+@end itemize
+
+@node X windows projects, Other random projects, Extensions to existing GNU software, Top
+@chapter X windows projects
+
+@itemize
+
+@item
+An emulator for Macintosh graphics calls on top of X Windows.
+
+@item
+An emulator for Microsoft windows calls on top of X Windows.  (A
+commercial program to do this took just three months to write.)
+
+@item
+A music playing and editing system.
+
+@item
+A program to edit dance notation (such as labanotation) and display
+dancers moving on the screen.
+
+@item
+A library for displaying circle-shaped menus with X windows.
+
+@item
+A program to display and edit Hypercard stacks.
+
+@item
+An interface-builder program to make it easy to design graphical
+interfaces for applications.  This could work with the dynamic linker
+DLD and C++, loading in the same class definitions that will be used
+by the application program.
+
+@item
+A desktop program with icons and such, for X-windows.
+
+@item
+A paint program, supporting both bitmap-oriented operations and
+component-oriented operations.  @code{xpaint} exists, but isn't very
+usable.
+
+@end itemize
+
+@node Other random projects, Compilers for other batch languages, X windows projects, Top
+@chapter Other random projects
+
+If you think of others that should be added, please
+send them to gnu@@prep.ai.mit.edu.
+
+@itemize
+
+@item
+[This seems to be being done:]
+A program to convert Postscript to plain ASCII text.  Ghostscript will
+soon have a mode to output all the text strings in a document, each with
+its coordinates.  You could write a program to start with this output
+and ``layout the page'' in ASCII.  The program will be both easier and
+more useful if you don't worry pedantically about how the output text
+should be formatted.  Instead, try to make it look reasonable as plain
+ASCII.
+
+@item
+A program to convert compiled programs represented in OSF ANDF
+(``Architecture Neutral Distribution Format'') into ANSI C.
+
+@item
+An imitation of Page Maker or Ventura Publisher.
+
+@item
+An imitation of @code{dbase2} or @code{dbase3} (How dbased!)
+
+@item
+A program to reformat Fortran programs in a way that is pretty.
+
+@item
+A bulletin board system.  There are a few free ones, but they don't have
+all the features that people want in such systems.  It would make sense
+to start with an existing one and add the other features.
+
+@item
+A general ledger program.
+
+@item
+A single command language that could be suitable for use in a shell, in
+GDB for programming debugging commands, in a program like @code{awk}, in
+a calculator like @code{bc}, and so on.  The fact that all these
+programs are similar but different in peculiar details is a great source
+of confusion.  We are stuck with maintaining compatibility with Unix in
+our shell, @code{awk}, and @code{bc}, but nothing prevents us from
+having alternative programs using our new, uniform language.  This would
+make GNU far better for new users.
+
+@item
+A program to typeset C code for printing.
+For ideas on what to do, see the forthcoming book,
+
+@display
+Human Factors and Typography for More Readable Programs,
+Ronald M. Baecker and Aaron Marcus,
+Addison-Wesley, ISBN 0-201-10745-7
+@end display
+
+(I don't quite agree with a few of the details they propose.)
+
+@item
+Speech-generation programs (there is a program from Brown U that you
+could improve).
+
+@item
+Speech-recognition programs (single-speaker, disconnected speech).
+
+@item
+Scientific mathematical subroutines, including clones of SPSS.
+
+@item
+Statistical tools.
+
+@item
+Software to replace card catalogues in libraries.
+
+@item
+Grammar and style checking programs.
+
+@item
+An implementation of the S language.
+
+@item
+A translator from Scheme to C.
+
+@item
+Optical character recognition programs; especially if suitable for
+scanning documents with multiple fonts and capturing font info as well
+as character codes.  This may not be very difficult if you let it
+@emph{train} on part of the individual document to be scanned, so as to
+learn what fonts are in use in that document.  We would particularly
+like to scan the Century Dictionary, an unabridged dictionary now in the
+public domain.
+
+You don't need scanning hardware to work on OCR.  We can send you
+bitmaps you can use as test data.
+
+@item
+A program to scan a line drawing and convert it to Postscript.
+
+@item
+A program to recognize handwriting.
+
+@item
+A pen based interface.
+
+@item
+Software suitable for creating virtual reality user interfaces.
+
+@item
+CAD software, such as a vague imitation of Autocad.
+
+@item
+Software for displaying molecules.
+
+@item
+Software for comparing DNA sequences, and finding matches and
+alignments.
+
+@end itemize
+
+@node Compilers for other batch languages, Games and recreations, Other random projects, Top
+@chapter Compilers for other batch languages
+
+Volunteers are needed to write parsers/front ends for languages such
+as Algol 60, Algol 68, PL/I, or whatever, to be used with the
+code generation phases of the GNU C compiler.  (C++ is done, and
+Ada, Fortran, Pascal and Modula are being worked on.)
+
+@node Games and recreations,  , Compilers for other batch languages, Top
+@chapter Games and recreations
+
+@itemize
+
+@item
+Video-oriented games should work with the X window system.
+
+@item
+Empire (there is a free version but it needs upgrading)
+
+@item
+Imitations of popular video games:
+
+@itemize
+@item
+Space war, Asteroids, Pong, Columns.
+@item
+Defending cities from missiles.
+@item
+Plane shoots at lots of other planes.
+@item
+Wizard fights fanciful monster.
+@item
+A golf game.
+@item
+Program a robot by sticking building blocks together,
+then watch it explore a world.
+@item
+Biomorph evolution (as in Scientific American).
+@item
+A program to display effects of moving at relativistic speeds.
+@end itemize
+
+@item
+Intriguing screen-saver programs to make interesting pictures.
+Other such programs that are simply entertaining to watch.
+For example, an aquarium.
+
+@end itemize
+
+We do not need @code{rogue}, as we have @code{hack}.
+
+@contents
+
+@bye
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/avoid.el	Tue Nov 23 07:00:40 1993 +0000
@@ -0,0 +1,254 @@
+;;; avoid.el -- make mouse pointer stay out of the way of editing.
+
+;;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Boris Goldowsky <boris@cs.rochester.edu>
+;; Keywords: mouse
+;; $Revision: 1.10 $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+;;;
+;;; For those who are annoyed by the mouse pointer obscuring text,
+;;; this mode moves the mouse pointer - either just a little out of
+;;; the way, or all the way to the corner of the frame. 
+;;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
+;;; To set up permanently, put this file on your load-path and put the
+;;; following in your .emacs: 
+;;;
+;;; (cond (window-system
+;;;        (require 'avoid)
+;;;        (mouse-avoidance-mode 'cat-and-mouse)))
+;;;
+;;; The 'animate can be 'jump or 'banish or 'protean if you prefer.
+;;;
+;;; For added silliness, make the animatee animate...
+;;; put something similar to the following into your .emacs:
+;;;
+;;; (cond (window-system
+;;;       (setq x-pointer-shape 
+;;;	     (eval (nth (random 4)
+;;;			'(x-pointer-man x-pointer-spider
+;;;			  x-pointer-gobbler x-pointer-gumby))))
+;;;       (set-mouse-color (cdr (assoc 'mouse-color (frame-parameters))))))
+;;;
+;;; For completely random pointer shape, replace the setq above with:
+;;; (setq x-pointer-shape (mouse-avoidance-random-shape))
+;;; 
+;;; Bugs & Warnings:
+;;;
+;;; - THIS CODE IS FOR USE WITH FSF EMACS 19.21 or later.
+;;;   It can cause earlier versions of emacs to crash, due to a bug in the
+;;;   mouse code. 
+;;;
+;;; - Using this code does slow emacs down.  "banish" mode shouldn't
+;;;   ever be too bad though, and on my workstation even "animate" doesn't
+;;;   seem to have a noticable effect.
+;;;
+;;; - There are some situations where it doesn't do what you expect,
+;;;   notably when there are long wrapped lines in the buffer.  Since
+;;;   there is no low-level command for finding point's position
+;;;   on the screen, it can fail to move the pointer when on such a line.
+;;;
+;;; Copyright (c) 1993 Free Software Foundation
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author or from the Free Software Foundation, Inc., 675
+;;; Mass Ave, Cambridge, MA 02139, USA.
+
+;;; LCD Archive Entry:
+;;; avoid|Boris Goldowsky|boris@cs.rochester.edu|
+;;; Keep mouse pointer away from cursor|
+;;; $Date: 93/11/22 15:34:50 $ |$Revision: 1.10 $||
+
+;;; Credits:
+;;; This code was helped by all those who contributed suggestions, fixes, and 
+;;; additions:
+;;; Joe Harrington (and his advisor), for the original inspiration
+;;; Ken Manheimer, for dreaming up the Protean mode
+;;; Richard Stallman, for the awful cat-and-mouse pun, among other things
+;;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris,
+;;; Simon Marshall, and M.S. Ashton, for their feedback.
+;;;
+;;; Code:
+
+(provide 'avoid)
+
+(defvar mouse-avoidance-mode nil
+  "Value is t or a symbol if the mouse pointer should avoid the cursor.
+See function mouse-avoidance-mode for possible values.  Changing this
+variable is NOT the recommended way to change modes; use the function 
+instead.")
+
+(defvar mouse-avoidance-nudge-dist 4
+  "*Average distance that mouse will be moved when approached by cursor.
+Only applies in mode-avoidance-modes `animate' and `jump'.")
+
+(defvar mouse-avoidance-nudge-var 3
+  "*Variability of mouse-avoidance-nudge-dist (which see).")
+
+(defvar mouse-avoidance-animation-delay .01
+  "Delay between animation steps, in seconds.")
+
+(defvar mouse-avoidance-threshhold 5
+  "*Mouse-pointer's flight distance.
+If the cursor gets closer than this, the mouse pointer will move away.
+Only applies in mouse-avoidance-modes `animate' and `jump'.")
+
+;; Internal variables for mouse-avoidance-random-shape
+(defvar mouse-avoidance-pointer-shapes nil)
+(defvar mouse-avoidance-n-pointer-shapes 0)
+
+;;; Functions:
+
+(defun mouse-avoidance-too-close-p ()
+  ;;  Return t if mouse pointer and point cursor are too close.
+  ;; Acceptable distance is defined by mouse-avoidance-threshhold.
+  (let ((mouse (mouse-position)))
+    (and (car (cdr mouse))
+	 (< (abs (- (car (cdr mouse)) (current-column)))
+	    mouse-avoidance-threshhold)
+	 (< (abs (- (cdr (cdr mouse)) 
+		    (+ (car (cdr (window-edges)))
+		       (count-lines (window-start) (point)))))
+	    mouse-avoidance-threshhold))))
+
+(defun mouse-avoidance-banish-mouse ()
+  ;; Put the mouse pointer in the upper-right corner of the current frame.
+  (set-mouse-position (selected-frame) (1- (frame-width)) 0))
+
+(defun mouse-avoidance-nudge-mouse () 
+  ;; Push the mouse a little way away, possibly animating the move
+  (let* ((cur (mouse-position))
+	 (deltax (* (+ mouse-avoidance-nudge-dist 
+		       (random mouse-avoidance-nudge-var))
+		    (if (zerop (random 2)) 1 -1)))
+	 (deltay (* (+ mouse-avoidance-nudge-dist
+		       (random mouse-avoidance-nudge-var))
+		    (if (zerop (random 2)) 1 -1))))
+    (if (or (eq mouse-avoidance-mode 'animate) 
+	    (eq mouse-avoidance-mode 'proteus))
+	(let ((i 0.0)
+	      (color (cdr (assoc 'mouse-color (frame-parameters)))))
+	  (while (<= i 1)
+	    (set-mouse-position 
+	     (car cur) 
+	     (mod (+ (car (cdr cur)) (round (* i deltax))) (window-width))
+	     (mod (+ (cdr (cdr cur)) (round (* i deltay))) (window-height)))
+	    (setq i (+ i (/ 1.0 mouse-avoidance-nudge-dist)))
+	    (if (eq mouse-avoidance-mode 'proteus)
+		(progn
+		  (setq x-pointer-shape (mouse-avoidance-random-shape))
+		  (set-mouse-color color)))
+	    (sit-for mouse-avoidance-animation-delay)))
+      (set-mouse-position 
+       (car cur)
+       (mod (+ (car (cdr cur)) deltax) (window-width))
+       (mod (+ (cdr (cdr cur)) deltay) (window-height))))))
+
+(defun mouse-avoidance-random-shape ()
+  "Return a random cursor shape.
+This assumes that any variable whose name begins with x-pointer- and
+has an integer value is a valid cursor shape.  You might want to
+redefine this function to suit your own tastes."
+  (if (null mouse-avoidance-pointer-shapes)
+      (progn
+	(setq mouse-avoidance-pointer-shapes
+	      (mapcar '(lambda (x) (symbol-value (intern x)))
+		      (all-completions "x-pointer-" obarray
+				       '(lambda (x) 
+					  (and (boundp x)
+					       (integerp (symbol-value x)))))))
+	(setq mouse-avoidance-n-pointer-shapes 
+	      (length mouse-avoidance-pointer-shapes))))
+  (nth (random mouse-avoidance-n-pointer-shapes)
+       mouse-avoidance-pointer-shapes))
+
+(defun mouse-avoidance-simple-hook ()
+  (if (and (mouse-avoidance-keyboard-command (this-command-keys)))
+      (mouse-avoidance-banish-mouse)))
+
+(defun mouse-avoidance-fancy-hook ()
+  (if (and (mouse-avoidance-keyboard-command (this-command-keys))
+	   (mouse-avoidance-too-close-p))
+      (mouse-avoidance-nudge-mouse)))
+
+(defun mouse-avoidance-keyboard-command (key)
+  "Return t if the KEYSEQENCE is composed of keyboard events only.
+Returns nil if there are any lists in the key sequence."
+  (cond ((null key) nil)		; Null event seems to be
+					; returned occasionally.
+	((not (vectorp key)) t)		; Strings are keyboard events.
+	((catch 'done
+	   (let ((i 0)
+		 (l (length key)))
+	     (while (< i l)
+	       (if (listp (aref key i))
+		   (throw 'done nil))
+	       (setq i (1+ i))))
+	   t))))
+
+(defun mouse-avoidance-mode (&optional mode)
+  "Set cursor avoidance mode to MODE.
+MODE should be one of the symbols `banish', `jump', `animate',
+`cat-and-mouse', or `none'.  `Animate' is the same as `cat-and-mouse'.
+If MODE is nil, toggle mouse avoidance.  Positive numbers and
+symbols other than the above are treated as equivalent to `banish';
+negative numbers and `-' are equivalent to `none'."
+  (interactive
+   (list (intern (completing-read
+		  "Select cursor avoidance technique (SPACE for list): "
+		  '(("banish") ("jump") ("animate") ("cat-and-mouse") 
+		    ("proteus") ("none"))
+		  nil t))))
+  (if (eq mode 'cat-and-mouse)
+      (setq mode 'animate))
+  (setq post-command-hook
+	(delete 'mouse-avoidance-simple-hook (append post-command-hook nil)))
+  (setq post-command-hook
+	(delete 'mouse-avoidance-fancy-hook (append post-command-hook nil)))
+  (cond	((eq mode 'none)
+	 (setq mouse-avoidance-mode nil))
+	((or (eq mode 'jump)
+	     (eq mode 'animate)
+	     (eq mode 'proteus))
+	 (add-hook 'post-command-hook 'mouse-avoidance-fancy-hook)
+	 (setq mouse-avoidance-mode mode))
+	((or (eq mode 'banish) 
+	     (eq mode t)
+	     (and (null mode) (null mouse-avoidance-mode))
+	     (and mode (> (prefix-numeric-value mode) 0)))
+	 (add-hook 'post-command-hook 'mouse-avoidance-simple-hook)
+	 (setq mouse-avoidance-mode 'banish))
+	(t (setq mouse-avoidance-mode nil))))
+
+(or (assq 'mouse-avoidance-mode minor-mode-alist)
+    (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid")
+				 minor-mode-alist)))
+
+;;; End of avoid.el
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/shadowfile.el	Tue Nov 23 07:00:40 1993 +0000
@@ -0,0 +1,830 @@
+;;; shadowfile.el -- automatic file copying for Emacs 19
+
+;;; Author: Boris Goldowsky <boris@cs.rochester.edu>
+;;; Keywords: comm
+
+;;; Copyright (c) 1993 Free Software Foundation
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author or from the Free Software Foundation, Inc., 675
+;;; Mass Ave, Cambridge, MA 02139, USA.
+
+;;; LCD Archive Entry:
+;;; shadowfile|Boris Goldowsky|boris@cs.rochester.edu|
+;;; Helps you keep identical copies of files in multiple places.|
+;;; $Date: 93/11/17 08:46:07 $ |$Revision: 2.8 $|~/misc/shadowfile.el.Z|
+
+;;; 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@cs.rochester.edu).  Also let me know
+;;;  if you have suggestions or would like to be informed of updates.
+
+;;; Code:
+
+(provide 'shadowfile)
+(require 'ange-ftp)
+
+(setq find-file-visit-truename t)	; makes life easier with symbolic links
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar shadow-noquery nil
+  "*If nonnil, always copy shadow files without asking.")
+
+(defvar shadow-inhibit-message nil
+  "*If nonnil, do not display a message when a file needs copying.")
+
+(defvar 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.")
+
+(defvar 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: ~/.shadows")
+
+(defvar 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: ~/.shadow_todo")
+
+;;; 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."
+  (ange-ftp-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 ange-ftp pathname."
+  (if (listp fullpath)
+      fullpath
+    (ange-ftp-ftp-name fullpath)))
+
+(defun shadow-parse-path (path)
+  "Parse any PATH into \(site user path) list.
+Argument can be a simple path, full ange-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 ange-ftp 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 ange-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 ange-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 (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 
+			   (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 (format "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 ange-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 (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)
+		((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 (format "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 (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 (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))
+    (cond ((consp (eval variable))
+	   (insert "\n  '(") 
+	   (prin1 (car (eval variable)))
+	   (let ((rest (cdr (eval variable))))
+	     (while rest
+	       (insert "\n    ")
+	       (prin1 (car rest))
+	       (setq rest (cdr rest)))
+	     (insert "))\n\n")))
+	  (t (insert " ")
+	     (prin1 (eval variable))
+	     (insert ")\n\n")))))
+
+(defun shadow-save-buffers-kill-emacs (&optional arg)
+  "Offer to save each buffer and copy shadows, then kill this Emacs process.
+With prefix arg, silently save all file-visiting buffers, then kill.
+
+Extended by shadowfile to automatically save `shadow-todo-file' and
+look for files that have been changed and need to be copied to other systems."
+  ;; This function is necessary because we need to get control and save
+  ;; the todo file /after/ saving other files, but /before/ the warning
+  ;; message about unsaved buffers (because it can get modified by the
+  ;; action of saving other buffers).  `kill-emacs-hook' is no good
+  ;; because it is not called at the correct time, and also because it is
+  ;; called when the terminal is disconnected and we cannot ask whether
+  ;; to copy files.
+  (interactive "P")
+  (shadow-save-todo-file)
+  (save-some-buffers arg t)
+  (shadow-copy-files)
+  (shadow-save-todo-file)
+  (and (or (not (memq t (mapcar (function
+				 (lambda (buf) (and (buffer-file-name buf)
+						    (buffer-modified-p buf))))
+				(buffer-list))))
+	   (yes-or-no-p "Modified buffers exist; exit anyway? "))
+       (or (not (fboundp 'process-list))
+	   ;; process-list is not defined on VMS.
+	   (let ((processes (process-list))
+		 active)
+	     (while processes
+	       (and (memq (process-status (car processes)) '(run stop open))
+		    (let ((val (process-kill-without-query (car processes))))
+		      (process-kill-without-query (car processes) val)
+		      val)
+		    (setq active t))
+	       (setq processes (cdr processes)))
+	     (or (not active)
+		 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
+       (kill-emacs)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Lucid Emacs compatibility (may not be complete)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(shadow-when (not (fboundp 'file-truename))
+  (require 'symlink-fix)
+  (defun shadow-expand-file-name (file &optional default)
+    (symlink-expand-file-name file default)))
+
+(shadow-when (not (fboundp 'ange-ftp-ftp-name))
+  (require 'ange-ftp)
+  (defun shadow-parse-fullpath (fullpath)
+    (if (listp fullpath)
+	fullpath
+      (ange-ftp-ftp-path fullpath))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Hook us up
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; File shadowing is activated at load time, unless this this file is
+;;; being preloaded, in which case it is added to after-init-hook.
+;;; Thanks to Richard Caley for this scheme.
+
+(defun shadow-initialize ()
+  (if (null shadow-homedir)
+      (setq shadow-homedir
+	    (file-name-as-directory (shadow-expand-file-name "~"))))
+  (if (null shadow-info-file)
+      (setq shadow-info-file 
+	    (shadow-expand-file-name "~/.shadows")))
+  (if (null shadow-todo-file)
+      (setq shadow-todo-file 
+	    (shadow-expand-file-name "~/.shadow_todo")))
+  (if (not (shadow-read-files))
+      (progn
+	(message "Shadowfile information files not found - aborting")
+	(beep)
+	(sit-for 3))
+    (shadow-when (and (not shadow-inhibit-overload)
+		      (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
+      (fset 'shadow-orig-save-buffers-kill-emacs 
+	    (symbol-function 'save-buffers-kill-emacs))
+      (fset 'save-buffers-kill-emacs
+	    (symbol-function 'shadow-save-buffers-kill-emacs)))
+    (add-hook 'write-file-hooks 'shadow-add-to-todo)
+    (define-key ctl-x-4-map "s" 'shadow-copy-files)))
+
+(if noninteractive
+    (add-hook 'after-init-hook 'shadow-initialize)
+  (shadow-initialize))
+
+;;;Local Variables:
+;;;eval:(put 'shadow-when 'lisp-indent-hook 1)
+;;;End:
+
+;;; shadowfile.el ends here