# HG changeset patch # User Richard M. Stallman # Date 754038040 0 # Node ID bf9e7676a73ef50cf050dfb0acd0bc766b1d7356 # Parent eec34ce70181a569359a4d28158779cf40bb688a Initial revision diff -r eec34ce70181 -r bf9e7676a73e etc/tasks.texi --- /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 diff -r eec34ce70181 -r bf9e7676a73e lisp/avoid.el --- /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 +;; 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 + diff -r eec34ce70181 -r bf9e7676a73e lisp/shadowfile.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 +;;; 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