--- /dev/null
+\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
+;;; 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
+;;; 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
projects / emacs.git / commitdiff