aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love2001-02-11 21:31:57 +0000
committerDave Love2001-02-11 21:31:57 +0000
commit36fd8e1761464aa3a557cf9cc70bf91f8331c4db (patch)
treeb84c441eebae15d6de1bc533c4bc0dbccf193c10
parent4756109ef463bbf7464702fb090a3b27ec7d9980 (diff)
downloademacs-36fd8e1761464aa3a557cf9cc70bf91f8331c4db.tar.gz
emacs-36fd8e1761464aa3a557cf9cc70bf91f8331c4db.zip
Doc fixes.
(shadow) <defgroup>: Add :link. (shadowfile-unload-hook): New function. (shadow-initialize): Use defalias, not fset. (shadow-define-cluster, shadow-define-literal-group) (shadow-define-regexp-group, shadow-initialize): Add autoload cookie.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/shadowfile.el254
2 files changed, 140 insertions, 124 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d82b3796fa7..4f8cca24c0b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,17 @@
12001-02-11 Dave Love <fx@gnu.org> 12001-02-11 Dave Love <fx@gnu.org>
2 2
3 * shadowfile.el: Doc fixes.
4 (shadow) <defgroup>: Add :link.
5 (shadowfile-unload-hook): New function.
6 (shadow-initialize): Use defalias, not fset.
7 (shadow-define-cluster, shadow-define-literal-group)
8 (shadow-define-regexp-group, shadow-initialize): Add autoload
9 cookie.
10
3 * international/mule.el: Doc and message fixes. 11 * international/mule.el: Doc and message fixes.
4 12
13 * international/ccl.el (define-ccl-program): Doc fix.
14
52001-02-11 Kenichi Handa <handa@etl.go.jp> 152001-02-11 Kenichi Handa <handa@etl.go.jp>
6 16
7 * faces.el (mode-line): Set :line-width property to -1. 17 * faces.el (mode-line): Set :line-width property to -1.
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 1cc343672c8..4fc3243b0d9 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,9 +1,9 @@
1;;; shadowfile.el --- automatic file copying for Emacs 19 1;;; shadowfile.el --- automatic file copying
2 2
3;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1994, 2001 Free Software Foundation, Inc.
4 4
5;; Author: Boris Goldowsky <boris@gnu.org> 5;; Author: Boris Goldowsky <boris@gnu.org>
6;; Keywords: comm 6;; Keywords: comm files
7 7
8;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
9 9
@@ -22,7 +22,7 @@
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA. 23;; Boston, MA 02111-1307, USA.
24 24
25;; Commentary: 25;;; Commentary:
26 26
27;; This package helps you to keep identical copies of files in more than one 27;; This package helps you to keep identical copies of files in more than one
28;; place - possibly on different machines. When you save a file, it checks 28;; place - possibly on different machines. When you save a file, it checks
@@ -31,11 +31,10 @@
31 31
32;; Installation & Use: 32;; Installation & Use:
33 33
34;; Put (require 'shadowfile) in your .emacs; add clusters (if necessary) 34;; Add clusters (if necessary) and file groups with shadow-define-cluster,
35;; and file groups with shadow-define-cluster,
36;; shadow-define-literal-group, and shadow-define-regexp-group (see the 35;; shadow-define-literal-group, and shadow-define-regexp-group (see the
37;; documentation for these functions for information on how and when to 36;; documentation for these functions for information on how and when to use
38;; use them). After doing this once, everything should be automatic. 37;; them). After doing this once, everything should be automatic.
39 38
40;; The lists of clusters and shadows are saved in a file called .shadows, 39;; The lists of clusters and shadows are saved in a file called .shadows,
41;; so that they can be remembered from one emacs session to another, even 40;; so that they can be remembered from one emacs session to another, even
@@ -74,9 +73,9 @@
74;; Please report any bugs to me (boris@gnu.org). Also let me know 73;; Please report any bugs to me (boris@gnu.org). Also let me know
75;; if you have suggestions or would like to be informed of updates. 74;; if you have suggestions or would like to be informed of updates.
76 75
76
77;;; Code: 77;;; Code:
78 78
79(provide 'shadowfile)
80(require 'ange-ftp) 79(require 'ange-ftp)
81 80
82;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 81;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -86,6 +85,7 @@
86(defgroup shadow nil 85(defgroup shadow nil
87 "Automatic file copying when saving a file." 86 "Automatic file copying when saving a file."
88 :prefix "shadow-" 87 :prefix "shadow-"
88 :link '(emacs-commentary-link "shadowfile")
89 :group 'files) 89 :group 'files)
90 90
91(defcustom shadow-noquery nil 91(defcustom shadow-noquery nil
@@ -101,15 +101,15 @@ is no buffer currently visiting the file."
101 :group 'shadow) 101 :group 'shadow)
102 102
103(defcustom shadow-inhibit-overload nil 103(defcustom shadow-inhibit-overload nil
104 "If nonnil, shadowfile won't redefine C-x C-c. 104 "If nonnil, shadowfile won't redefine \\[save-buffers-kill-emacs].
105Normally it overloads the function `save-buffers-kill-emacs' to check 105Normally it overloads the function `save-buffers-kill-emacs' to check
106for files have been changed and need to be copied to other systems." 106for files have been changed and need to be copied to other systems."
107 :type 'boolean 107 :type 'boolean
108 :group 'shadow) 108 :group 'shadow)
109 109
110(defcustom shadow-info-file nil 110(defcustom shadow-info-file nil
111 "File to keep shadow information in. 111 "File to keep shadow information in.
112The shadow-info-file should be shadowed to all your accounts to 112The `shadow-info-file' should be shadowed to all your accounts to
113ensure consistency. Default: ~/.shadows" 113ensure consistency. Default: ~/.shadows"
114 :type '(choice (const nil) file) 114 :type '(choice (const nil) file)
115 :group 'shadow) 115 :group 'shadow)
@@ -117,8 +117,8 @@ ensure consistency. Default: ~/.shadows"
117(defcustom shadow-todo-file nil 117(defcustom shadow-todo-file nil
118 "File to store the list of uncopied shadows in. 118 "File to store the list of uncopied shadows in.
119This means that if a remote system is down, or for any reason you cannot or 119This means that if a remote system is down, or for any reason you cannot or
120decide not to copy your shadow files at the end of one emacs session, it will 120decide not to copy your shadow files at the end of one Emacs session, it will
121remember and ask you again in your next emacs session. 121remember and ask you again in your next Emacs session.
122This file must NOT be shadowed to any other system, it is host-specific. 122This file must NOT be shadowed to any other system, it is host-specific.
123Default: ~/.shadow_todo" 123Default: ~/.shadow_todo"
124 :type '(choice (const nil) file) 124 :type '(choice (const nil) file)
@@ -140,7 +140,7 @@ Default: ~/.shadow_todo"
140;;; 140;;;
141 141
142(defvar shadow-clusters nil 142(defvar shadow-clusters nil
143 "List of host clusters \(see shadow-define-cluster).") 143 "List of host clusters \(see `shadow-define-cluster').")
144 144
145(defvar shadow-literal-groups nil 145(defvar shadow-literal-groups nil
146 "List of files that are shared between hosts. 146 "List of files that are shared between hosts.
@@ -149,8 +149,8 @@ shadow-define-group.")
149 149
150(defvar shadow-regexp-groups nil 150(defvar shadow-regexp-groups nil
151 "List of file types that are shared between hosts. 151 "List of file types that are shared between hosts.
152This list contains shadow structures with regexps matching filenames, 152This list contains shadow structures with regexps matching filenames,
153created by shadow-define-regexp-group.") 153created by `shadow-define-regexp-group'.")
154 154
155;;; 155;;;
156;;; Other internal variables: 156;;; Other internal variables:
@@ -169,8 +169,7 @@ created by shadow-define-regexp-group.")
169;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 169;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
170 170
171(defun shadow-union (a b) 171(defun shadow-union (a b)
172 "Add members of list A to list B 172 "Add members of list A to list B if not equal to items already in B."
173if they are not equal to items already in B."
174 (if (null a) 173 (if (null a)
175 b 174 b
176 (if (member (car a) b) 175 (if (member (car a) b)
@@ -178,8 +177,7 @@ if they are not equal to items already in B."
178 (shadow-union (cdr a) (cons (car a) b))))) 177 (shadow-union (cdr a) (cons (car a) b)))))
179 178
180(defun shadow-find (func list) 179(defun shadow-find (func list)
181 "If FUNC applied to some element of LIST is nonnil, 180 "If FUNC applied to some element of LIST is nonnil, return first such element."
182return the first such element."
183 (while (and list (not (funcall func (car list)))) 181 (while (and list (not (funcall func (car list))))
184 (setq list (cdr list))) 182 (setq list (cdr list)))
185 (car list)) 183 (car list))
@@ -200,8 +198,8 @@ Nondestructive; actually returns a copy of the list with the elements removed."
200 ((concat (car strings) " " (shadow-join (cdr strings) sep))))) 198 ((concat (car strings) " " (shadow-join (cdr strings) sep)))))
201 199
202(defun shadow-regexp-superquote (string) 200(defun shadow-regexp-superquote (string)
203 "Like regexp-quote, but includes the ^ and $ 201 "Like `regexp-quote', but includes the ^ and $.
204to make sure regexp matches nothing but STRING." 202This makes sure regexp matches nothing but STRING."
205 (concat "^" (regexp-quote string) "$")) 203 (concat "^" (regexp-quote string) "$"))
206 204
207(defun shadow-suffix (prefix string) 205(defun shadow-suffix (prefix string)
@@ -223,12 +221,12 @@ PREFIX."
223;;; either. 221;;; either.
224 222
225(defun shadow-make-cluster (name primary regexp) 223(defun shadow-make-cluster (name primary regexp)
226 "Creates a shadow cluster 224 "Create a shadow cluster.
227called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the 225It is called NAME, uses the PRIMARY hostname and REGEXP matching all
228cluster. The variable shadow-clusters associates the names of clusters to 226hosts in the cluster. The variable `shadow-clusters' associates the
229these structures. 227names of clusters to these structures. This function is for program
230 This function is for program use: to create clusters interactively, use 228use: to create clusters interactively, use `shadow-define-cluster'
231shadow-define-cluster instead." 229instead."
232 (list name primary regexp)) 230 (list name primary regexp))
233 231
234(defmacro shadow-cluster-name (cluster) 232(defmacro shadow-cluster-name (cluster)
@@ -244,14 +242,14 @@ shadow-define-cluster instead."
244 (list 'elt cluster 2)) 242 (list 'elt cluster 2))
245 243
246(defun shadow-set-cluster (name primary regexp) 244(defun shadow-set-cluster (name primary regexp)
247 "Put cluster NAME on the list of clusters, 245 "Put cluster NAME on the list of clusters.
248replacing old definition if any. PRIMARY and REGEXP are the 246Replace old definition, if any. PRIMARY and REGEXP are the
249information defining the cluster. For interactive use, call 247information defining the cluster. For interactive use, call
250shadow-define-cluster instead." 248`shadow-define-cluster' instead."
251 (let ((rest (shadow-remove-if 249 (let ((rest (shadow-remove-if
252 (function (lambda (x) (equal name (car x)))) 250 (function (lambda (x) (equal name (car x))))
253 shadow-clusters))) 251 shadow-clusters)))
254 (setq shadow-clusters 252 (setq shadow-clusters
255 (cons (shadow-make-cluster name primary regexp) 253 (cons (shadow-make-cluster name primary regexp)
256 rest)))) 254 rest))))
257 255
@@ -269,8 +267,7 @@ shadow-define-cluster instead."
269;;; SITES 267;;; SITES
270 268
271(defun shadow-site-cluster (site) 269(defun shadow-site-cluster (site)
272 "Given a SITE \(hostname or cluster name), return the cluster 270 "Given a SITE \(hostname or cluster name), return cluster it is in, or nil."
273that it is in, or nil."
274 (or (assoc site shadow-clusters) 271 (or (assoc site shadow-clusters)
275 (shadow-find 272 (shadow-find
276 (function (lambda (x) 273 (function (lambda (x)
@@ -287,7 +284,7 @@ that it is in, or nil."
287 ans))) 284 ans)))
288 285
289(defun shadow-site-match (site1 site2) 286(defun shadow-site-match (site1 site2)
290 "Nonnil iff SITE1 is or includes SITE2. 287 "Nonnil iff SITE1 is or includes SITE2.
291Each may be a host or cluster name; if they are clusters, regexp of site1 will 288Each may be a host or cluster name; if they are clusters, regexp of site1 will
292be matched against the primary of site2." 289be matched against the primary of site2."
293 (or (string-equal site1 site2) ; quick check 290 (or (string-equal site1 site2) ; quick check
@@ -298,7 +295,7 @@ be matched against the primary of site2."
298 (string-equal site1 primary2))))) 295 (string-equal site1 primary2)))))
299 296
300(defun shadow-get-user (site) 297(defun shadow-get-user (site)
301 "Returns the default username for a site." 298 "Return the default username for a SITE."
302 (ange-ftp-get-user (shadow-site-primary site))) 299 (ange-ftp-get-user (shadow-site-primary site)))
303 300
304;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 301;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -306,9 +303,9 @@ be matched against the primary of site2."
306;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 303;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
307 304
308(defun shadow-parse-fullpath (fullpath) 305(defun shadow-parse-fullpath (fullpath)
309 "Parse PATH into \(site user path) list, 306 "Parse FULLPATH into \(site user path) list.
310or leave it alone if it already is one. Returns nil if the argument is not a 307Leave it alone if it already is one. Returns nil if the argument is
311full ange-ftp pathname." 308not a full ange-ftp pathname."
312 (if (listp fullpath) 309 (if (listp fullpath)
313 fullpath 310 fullpath
314 (ange-ftp-ftp-name fullpath))) 311 (ange-ftp-ftp-name fullpath)))
@@ -324,7 +321,7 @@ Argument can be a simple path, full ange-ftp path, or already a hup list."
324(defsubst shadow-make-fullpath (host user path) 321(defsubst shadow-make-fullpath (host user path)
325 "Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH. 322 "Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH.
326This is probably not as general as it ought to be." 323This is probably not as general as it ought to be."
327 (concat "/" 324 (concat "/"
328 (if user (concat user "@")) 325 (if user (concat user "@"))
329 host ":" 326 host ":"
330 path)) 327 path))
@@ -335,9 +332,9 @@ This is probably not as general as it ought to be."
335 (shadow-make-fullpath (nth 0 hup) (nth 1 hup) newpath))) 332 (shadow-make-fullpath (nth 0 hup) (nth 1 hup) newpath)))
336 333
337(defun shadow-local-file (file) 334(defun shadow-local-file (file)
338 "If FILENAME is at this site, 335 "If FILE is at this site, remove /user@host part.
339remove /user@host part. If refers to a different system or a different user on 336If refers to a different system or a different user on this system,
340this system, return nil." 337return nil."
341 (let ((hup (shadow-parse-fullpath file))) 338 (let ((hup (shadow-parse-fullpath file)))
342 (cond ((null hup) file) 339 (cond ((null hup) file)
343 ((and (shadow-site-match (nth 0 hup) shadow-system-name) 340 ((and (shadow-site-match (nth 0 hup) shadow-system-name)
@@ -346,9 +343,8 @@ this system, return nil."
346 (t nil)))) 343 (t nil))))
347 344
348(defun shadow-expand-cluster-in-file-name (file) 345(defun shadow-expand-cluster-in-file-name (file)
349 "If hostname part of FILE is a cluster, expand it 346 "If hostname part of FILE is a cluster, expand it to cluster's primary hostname.
350into the cluster's primary hostname. Will return the pathname bare if it is 347Will return the pathname bare if it is a local file."
351a local file."
352 (let ((hup (shadow-parse-path file)) 348 (let ((hup (shadow-parse-path file))
353 cluster) 349 cluster)
354 (cond ((null hup) file) 350 (cond ((null hup) file)
@@ -362,14 +358,15 @@ a local file."
362 (file-truename (expand-file-name file default))) 358 (file-truename (expand-file-name file default)))
363 359
364(defun shadow-contract-file-name (file) 360(defun shadow-contract-file-name (file)
365 "Simplify FILENAME 361 "Simplify FILE.
366by replacing (when possible) home directory with ~, and hostname with cluster 362Do so by replacing (when possible) home directory with ~, and hostname
367name that includes it. Filename should be absolute and true." 363with cluster name that includes it. Filename should be absolute and
364true."
368 (let* ((hup (shadow-parse-path file)) 365 (let* ((hup (shadow-parse-path file))
369 (homedir (if (shadow-local-file hup) 366 (homedir (if (shadow-local-file hup)
370 shadow-homedir 367 shadow-homedir
371 (file-name-as-directory 368 (file-name-as-directory
372 (nth 2 (shadow-parse-fullpath 369 (nth 2 (shadow-parse-fullpath
373 (expand-file-name 370 (expand-file-name
374 (shadow-make-fullpath 371 (shadow-make-fullpath
375 (nth 0 hup) (nth 1 hup) "~"))))))) 372 (nth 0 hup) (nth 1 hup) "~")))))))
@@ -380,7 +377,7 @@ name that includes it. Filename should be absolute and true."
380 (shadow-cluster-name cluster) 377 (shadow-cluster-name cluster)
381 (nth 0 hup)) 378 (nth 0 hup))
382 (nth 1 hup) 379 (nth 1 hup)
383 (if suffix 380 (if suffix
384 (concat "~/" suffix) 381 (concat "~/" suffix)
385 (nth 2 hup))))) 382 (nth 2 hup)))))
386 383
@@ -397,7 +394,7 @@ local filename."
397 (string-equal (nth 1 pattern-sup) (nth 1 file-sup)))))) 394 (string-equal (nth 1 pattern-sup) (nth 1 file-sup))))))
398 395
399(defun shadow-file-match (pattern file &optional regexp) 396(defun shadow-file-match (pattern file &optional regexp)
400 "Returns t if PATTERN matches FILE. 397 "Return t if PATTERN matches FILE.
401If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular 398If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular
402expression, otherwise it must match exactly. The sites and usernames must 399expression, otherwise it must match exactly. The sites and usernames must
403match---see shadow-same-site. The pattern must be in full ange-ftp format, but 400match---see shadow-same-site. The pattern must be in full ange-ftp format, but
@@ -406,7 +403,7 @@ expansion or contraction, you must do that yourself first."
406 (let* ((pattern-sup (shadow-parse-fullpath pattern)) 403 (let* ((pattern-sup (shadow-parse-fullpath pattern))
407 (file-sup (shadow-parse-path file))) 404 (file-sup (shadow-parse-path file)))
408 (and (shadow-same-site pattern-sup file-sup) 405 (and (shadow-same-site pattern-sup file-sup)
409 (if regexp 406 (if regexp
410 (string-match (nth 2 pattern-sup) (nth 2 file-sup)) 407 (string-match (nth 2 pattern-sup) (nth 2 file-sup))
411 (string-equal (nth 2 pattern-sup) (nth 2 file-sup)))))) 408 (string-equal (nth 2 pattern-sup) (nth 2 file-sup))))))
412 409
@@ -414,8 +411,9 @@ expansion or contraction, you must do that yourself first."
414;;; User-level Commands 411;;; User-level Commands
415;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 412;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
416 413
414;;;###autoload
417(defun shadow-define-cluster (name) 415(defun shadow-define-cluster (name)
418 "Edit \(or create) the definition of a cluster. 416 "Edit \(or create) the definition of a cluster NAME.
419This is a group of hosts that share directories, so that copying to or from 417This is a group of hosts that share directories, so that copying to or from
420one of them is sufficient to update the file on all of them. Clusters are 418one of them is sufficient to update the file on all of them. Clusters are
421defined by a name, the network address of a primary host \(the one we copy 419defined by a name, the network address of a primary host \(the one we copy
@@ -424,13 +422,13 @@ in the cluster."
424 (interactive (list (completing-read "Cluster name: " shadow-clusters () ()))) 422 (interactive (list (completing-read "Cluster name: " shadow-clusters () ())))
425 (let* ((old (shadow-get-cluster name)) 423 (let* ((old (shadow-get-cluster name))
426 (primary (read-string "Primary host: " 424 (primary (read-string "Primary host: "
427 (if old (shadow-cluster-primary old) 425 (if old (shadow-cluster-primary old)
428 name))) 426 name)))
429 (regexp (let (try-regexp) 427 (regexp (let (try-regexp)
430 (while (not 428 (while (not
431 (string-match 429 (string-match
432 (setq try-regexp 430 (setq try-regexp
433 (read-string 431 (read-string
434 "Regexp matching all host names: " 432 "Regexp matching all host names: "
435 (if old (shadow-cluster-regexp old) 433 (if old (shadow-cluster-regexp old)
436 (shadow-regexp-superquote primary)))) 434 (shadow-regexp-superquote primary))))
@@ -438,8 +436,8 @@ in the cluster."
438 (message "Regexp doesn't include the primary host!") 436 (message "Regexp doesn't include the primary host!")
439 (sit-for 2)) 437 (sit-for 2))
440 try-regexp)) 438 try-regexp))
441; (username (read-no-blanks-input 439; (username (read-no-blanks-input
442; (format "Username [default: %s]: " 440; (format "Username [default: %s]: "
443; (shadow-get-user primary)) 441; (shadow-get-user primary))
444; (if old (or (shadow-cluster-username old) "") 442; (if old (or (shadow-cluster-username old) "")
445; (user-login-name)))) 443; (user-login-name))))
@@ -447,13 +445,14 @@ in the cluster."
447; (if (string-equal "" username) (setq username nil)) 445; (if (string-equal "" username) (setq username nil))
448 (shadow-set-cluster name primary regexp))) 446 (shadow-set-cluster name primary regexp)))
449 447
448;;;###autoload
450(defun shadow-define-literal-group () 449(defun shadow-define-literal-group ()
451 "Declare a single file to be shared between sites. 450 "Declare a single file to be shared between sites.
452It may have different filenames on each site. When this file is edited, the 451It may have different filenames on each site. When this file is edited, the
453new version will be copied to each of the other locations. Sites can be 452new version will be copied to each of the other locations. Sites can be
454specific hostnames, or names of clusters \(see shadow-define-cluster)." 453specific hostnames, or names of clusters \(see `shadow-define-cluster')."
455 (interactive) 454 (interactive)
456 (let* ((hup (shadow-parse-fullpath 455 (let* ((hup (shadow-parse-fullpath
457 (shadow-contract-file-name (buffer-file-name)))) 456 (shadow-contract-file-name (buffer-file-name))))
458 (path (nth 2 hup)) 457 (path (nth 2 hup))
459 user site group) 458 user site group)
@@ -461,7 +460,7 @@ specific hostnames, or names of clusters \(see shadow-define-cluster)."
461 (setq user (read-string (format "Username [default %s]: " 460 (setq user (read-string (format "Username [default %s]: "
462 (shadow-get-user site))) 461 (shadow-get-user site)))
463 path (read-string "Filename: " path)) 462 path (read-string "Filename: " path))
464 (setq group (cons (shadow-make-fullpath site 463 (setq group (cons (shadow-make-fullpath site
465 (if (string-equal "" user) 464 (if (string-equal "" user)
466 (shadow-get-user site) 465 (shadow-get-user site)
467 user) 466 user)
@@ -470,16 +469,17 @@ specific hostnames, or names of clusters \(see shadow-define-cluster)."
470 (setq shadow-literal-groups (cons group shadow-literal-groups))) 469 (setq shadow-literal-groups (cons group shadow-literal-groups)))
471 (shadow-write-info-file)) 470 (shadow-write-info-file))
472 471
472;;;###autoload
473(defun shadow-define-regexp-group () 473(defun shadow-define-regexp-group ()
474 "Make each of a group of files be shared between hosts. 474 "Make each of a group of files be shared between hosts.
475Prompts for regular expression; files matching this are shared between a list 475Prompts for regular expression; files matching this are shared between a list
476of sites, which are also prompted for. The filenames must be identical on all 476of sites, which are also prompted for. The filenames must be identical on all
477hosts \(if they aren't, use shadow-define-group instead of this function). 477hosts \(if they aren't, use shadow-define-group instead of this function).
478Each site can be either a hostname or the name of a cluster \(see 478Each site can be either a hostname or the name of a cluster \(see
479shadow-define-cluster)." 479`shadow-define-cluster')."
480 (interactive) 480 (interactive)
481 (let ((regexp (read-string 481 (let ((regexp (read-string
482 "Filename regexp: " 482 "Filename regexp: "
483 (if (buffer-file-name) 483 (if (buffer-file-name)
484 (shadow-regexp-superquote 484 (shadow-regexp-superquote
485 (nth 2 485 (nth 2
@@ -489,11 +489,11 @@ shadow-define-cluster)."
489 site sites usernames) 489 site sites usernames)
490 (while (setq site (shadow-read-site)) 490 (while (setq site (shadow-read-site))
491 (setq sites (cons site sites)) 491 (setq sites (cons site sites))
492 (setq usernames 492 (setq usernames
493 (cons (read-string (format "Username for %s: " site) 493 (cons (read-string (format "Username for %s: " site)
494 (shadow-get-user site)) 494 (shadow-get-user site))
495 usernames))) 495 usernames)))
496 (setq shadow-regexp-groups 496 (setq shadow-regexp-groups
497 (cons (shadow-make-group regexp sites usernames) 497 (cons (shadow-make-group regexp sites usernames)
498 shadow-regexp-groups)) 498 shadow-regexp-groups))
499 (shadow-write-info-file))) 499 (shadow-write-info-file)))
@@ -506,16 +506,16 @@ shadow-define-cluster)."
506 (shadow-shadows-of (buffer-file-name))) 506 (shadow-shadows-of (buffer-file-name)))
507 " "))) 507 " ")))
508 (message "%s" 508 (message "%s"
509 (if (zerop (length msg)) 509 (if (zerop (length msg))
510 "No shadows." 510 "No shadows."
511 msg)))) 511 msg))))
512 512
513(defun shadow-copy-files (&optional arg) 513(defun shadow-copy-files (&optional arg)
514 "Copy all pending shadow files. 514 "Copy all pending shadow files.
515With prefix argument, copy all pending files without query. 515With prefix argument, copy all pending files without query.
516Pending copies are stored in variable shadow-files-to-copy, and in 516Pending copies are stored in variable `shadow-files-to-copy', and in
517shadow-todo-file if necessary. This function is invoked by 517`shadow-todo-file' if necessary. This function is invoked by
518shadow-save-buffers-kill-emacs, so it is not usually necessary to 518`shadow-save-buffers-kill-emacs', so it is not usually necessary to
519call it manually." 519call it manually."
520 (interactive "P") 520 (interactive "P")
521 (if (and (not shadow-files-to-copy) (interactive-p)) 521 (if (and (not shadow-files-to-copy) (interactive-p))
@@ -534,17 +534,17 @@ call it manually."
534 "Cancel the instruction to copy some files. 534 "Cancel the instruction to copy some files.
535Prompts for which copy operations to cancel. You will not be asked to copy 535Prompts for which copy operations to cancel. You will not be asked to copy
536them again, unless you make more changes to the files. To cancel a shadow 536them again, unless you make more changes to the files. To cancel a shadow
537permanently, remove the group from shadow-literal-groups or 537permanently, remove the group from `shadow-literal-groups' or
538shadow-regexp-groups." 538`shadow-regexp-groups'."
539 (interactive) 539 (interactive)
540 (map-y-or-n-p (function (lambda (pair) 540 (map-y-or-n-p (function (lambda (pair)
541 (format "Cancel copying %s to %s? " 541 (format "Cancel copying %s to %s? "
542 (car pair) (cdr pair)))) 542 (car pair) (cdr pair))))
543 (function (lambda (pair) 543 (function (lambda (pair)
544 (shadow-remove-from-todo pair))) 544 (shadow-remove-from-todo pair)))
545 shadow-files-to-copy 545 shadow-files-to-copy
546 '("shadow" "shadows" "cancel copy")) 546 '("shadow" "shadows" "cancel copy"))
547 (message "There are %d shadows to be updated." 547 (message "There are %d shadows to be updated."
548 (length shadow-files-to-copy)) 548 (length shadow-files-to-copy))
549 (shadow-write-todo-file)) 549 (shadow-write-todo-file))
550 550
@@ -553,7 +553,7 @@ shadow-regexp-groups."
553;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 553;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
554 554
555(defun shadow-make-group (regexp sites usernames) 555(defun shadow-make-group (regexp sites usernames)
556 "Makes a description of a file group--- 556 "Make a description of a file group---
557actually a list of regexp ange-ftp file names---from REGEXP \(name of file to 557actually a list of regexp ange-ftp file names---from REGEXP \(name of file to
558be shadowed), list of SITES, and corresponding list of USERNAMES for each 558be shadowed), list of SITES, and corresponding list of USERNAMES for each
559site." 559site."
@@ -564,18 +564,18 @@ site."
564 564
565(defun shadow-copy-file (s) 565(defun shadow-copy-file (s)
566 "Copy one shadow file." 566 "Copy one shadow file."
567 (let* ((buffer 567 (let* ((buffer
568 (cond ((get-file-buffer 568 (cond ((get-file-buffer
569 (abbreviate-file-name (shadow-expand-file-name (car s))))) 569 (abbreviate-file-name (shadow-expand-file-name (car s)))))
570 ((not (file-readable-p (car s))) 570 ((not (file-readable-p (car s)))
571 (if (y-or-n-p 571 (if (y-or-n-p
572 (format "Cannot find file %s--cancel copy request?" 572 (format "Cannot find file %s--cancel copy request? "
573 (car s))) 573 (car s)))
574 (shadow-remove-from-todo s)) 574 (shadow-remove-from-todo s))
575 nil) 575 nil)
576 ((or (eq t shadow-noquery) 576 ((or (eq t shadow-noquery)
577 (y-or-n-p 577 (y-or-n-p
578 (format "No buffer for %s -- update shadow anyway?" 578 (format "No buffer for %s -- update shadow anyway? "
579 (car s)))) 579 (car s))))
580 (find-file-noselect (car s))))) 580 (find-file-noselect (car s)))))
581 (to (shadow-expand-cluster-in-file-name (cdr s)))) 581 (to (shadow-expand-cluster-in-file-name (cdr s))))
@@ -583,15 +583,15 @@ site."
583 (set-buffer buffer) 583 (set-buffer buffer)
584 (save-restriction 584 (save-restriction
585 (widen) 585 (widen)
586 (condition-case i 586 (condition-case i
587 (progn 587 (progn
588 (write-region (point-min) (point-max) to) 588 (write-region (point-min) (point-max) to)
589 (shadow-remove-from-todo s)) 589 (shadow-remove-from-todo s))
590 (error (message "Shadow %s not updated!" (cdr s)))))))) 590 (error (message "Shadow %s not updated!" (cdr s))))))))
591 591
592(defun shadow-shadows-of (file) 592(defun shadow-shadows-of (file)
593 "Returns copy operations needed to update FILE. 593 "Return copy operations needed to update FILE.
594Filename should have clusters expanded, but otherwise can have any format. 594Filename should have clusters expanded, but otherwise can have any format.
595Return value is a list of dotted pairs like \(from . to), where from 595Return value is a list of dotted pairs like \(from . to), where from
596and to are absolute file names." 596and to are absolute file names."
597 (or (symbol-value (intern-soft file shadow-hashtable)) 597 (or (symbol-value (intern-soft file shadow-hashtable))
@@ -599,7 +599,7 @@ and to are absolute file names."
599 (or (shadow-local-file file) file) 599 (or (shadow-local-file file) file)
600 shadow-homedir)) 600 shadow-homedir))
601 (canonical-file (shadow-contract-file-name absolute-file)) 601 (canonical-file (shadow-contract-file-name absolute-file))
602 (shadows 602 (shadows
603 (mapcar (function (lambda (shadow) 603 (mapcar (function (lambda (shadow)
604 (cons absolute-file shadow))) 604 (cons absolute-file shadow)))
605 (append 605 (append
@@ -610,29 +610,28 @@ and to are absolute file names."
610 (set (intern file shadow-hashtable) shadows)))) 610 (set (intern file shadow-hashtable) shadows))))
611 611
612(defun shadow-shadows-of-1 (file groups regexp) 612(defun shadow-shadows-of-1 (file groups regexp)
613 "Return list of FILE's shadows in GROUPS, 613 "Return list of FILE's shadows in GROUPS.
614which are considered as regular expressions if third arg REGEXP is true." 614Consider them as regular expressions if third arg REGEXP is true."
615 (if groups 615 (if groups
616 (let ((nonmatching 616 (let ((nonmatching
617 (shadow-remove-if 617 (shadow-remove-if
618 (function (lambda (x) (shadow-file-match x file regexp))) 618 (function (lambda (x) (shadow-file-match x file regexp)))
619 (car groups)))) 619 (car groups))))
620 (append (cond ((equal nonmatching (car groups)) nil) 620 (append (cond ((equal nonmatching (car groups)) nil)
621 (regexp 621 (regexp
622 (let ((realpath (nth 2 (shadow-parse-fullpath file)))) 622 (let ((realpath (nth 2 (shadow-parse-fullpath file))))
623 (mapcar 623 (mapcar
624 (function 624 (function
625 (lambda (x) 625 (lambda (x)
626 (shadow-replace-path-component x realpath))) 626 (shadow-replace-path-component x realpath)))
627 nonmatching))) 627 nonmatching)))
628 (t nonmatching)) 628 (t nonmatching))
629 (shadow-shadows-of-1 file (cdr groups) regexp))))) 629 (shadow-shadows-of-1 file (cdr groups) regexp)))))
630 630
631(defun shadow-add-to-todo () 631(defun shadow-add-to-todo ()
632 "If current buffer has shadows, add them to the list 632 "If current buffer has shadows, add them to the list needing to be copied."
633of files needing to be copied." 633 (let ((shadows (shadow-shadows-of
634 (let ((shadows (shadow-shadows-of 634 (shadow-expand-file-name
635 (shadow-expand-file-name
636 (buffer-file-name (current-buffer)))))) 635 (buffer-file-name (current-buffer))))))
637 (when shadows 636 (when shadows
638 (setq shadow-files-to-copy 637 (setq shadow-files-to-copy
@@ -645,15 +644,15 @@ of files needing to be copied."
645 nil) ; Return nil for write-file-hooks 644 nil) ; Return nil for write-file-hooks
646 645
647(defun shadow-remove-from-todo (pair) 646(defun shadow-remove-from-todo (pair)
648 "Remove PAIR from shadow-files-to-copy. 647 "Remove PAIR from `shadow-files-to-copy'.
649PAIR must be (eq to) one of the elements of that list." 648PAIR must be (eq to) one of the elements of that list."
650 (setq shadow-files-to-copy 649 (setq shadow-files-to-copy
651 (shadow-remove-if (function (lambda (s) (eq s pair))) 650 (shadow-remove-if (function (lambda (s) (eq s pair)))
652 shadow-files-to-copy))) 651 shadow-files-to-copy)))
653 652
654(defun shadow-read-files () 653(defun shadow-read-files ()
655 "Visits and loads shadow-info-file and shadow-todo-file, 654 "Visit and load `shadow-info-file' and `shadow-todo-file'.
656thus restoring shadowfile's state from your last emacs session. 655Thus restores shadowfile's state from your last Emacs session.
657Returns t unless files were locked; then returns nil." 656Returns t unless files were locked; then returns nil."
658 (interactive) 657 (interactive)
659 (if (and (fboundp 'file-locked-p) 658 (if (and (fboundp 'file-locked-p)
@@ -672,18 +671,18 @@ Returns t unless files were locked; then returns nil."
672 (file-newer-than-file-p (make-auto-save-file-name) 671 (file-newer-than-file-p (make-auto-save-file-name)
673 shadow-info-file)) 672 shadow-info-file))
674 (erase-buffer) 673 (erase-buffer)
675 (message "Data recovered from %s." 674 (message "Data recovered from %s."
676 (car (insert-file-contents (make-auto-save-file-name)))) 675 (car (insert-file-contents (make-auto-save-file-name))))
677 (sit-for 1)) 676 (sit-for 1))
678 (eval-current-buffer)) 677 (eval-current-buffer))
679 (when shadow-todo-file 678 (when shadow-todo-file
680 (set-buffer (setq shadow-todo-buffer 679 (set-buffer (setq shadow-todo-buffer
681 (find-file-noselect shadow-todo-file))) 680 (find-file-noselect shadow-todo-file)))
682 (when (and (not (buffer-modified-p)) 681 (when (and (not (buffer-modified-p))
683 (file-newer-than-file-p (make-auto-save-file-name) 682 (file-newer-than-file-p (make-auto-save-file-name)
684 shadow-todo-file)) 683 shadow-todo-file))
685 (erase-buffer) 684 (erase-buffer)
686 (message "Data recovered from %s." 685 (message "Data recovered from %s."
687 (car (insert-file-contents (make-auto-save-file-name)))) 686 (car (insert-file-contents (make-auto-save-file-name))))
688 (sit-for 1)) 687 (sit-for 1))
689 (eval-current-buffer nil)) 688 (eval-current-buffer nil))
@@ -691,9 +690,9 @@ Returns t unless files were locked; then returns nil."
691 t)) 690 t))
692 691
693(defun shadow-write-info-file () 692(defun shadow-write-info-file ()
694 "Write out information to shadow-info-file. 693 "Write out information to `shadow-info-file'.
695Also clears shadow-hashtable, since when there are new shadows defined, the old 694Also clear `shadow-hashtable', since when there are new shadows
696hashtable info is invalid." 695defined, the old hashtable info is invalid."
697 (shadow-invalidate-hashtable) 696 (shadow-invalidate-hashtable)
698 (if shadow-info-file 697 (if shadow-info-file
699 (save-excursion 698 (save-excursion
@@ -706,7 +705,7 @@ hashtable info is invalid."
706 (shadow-insert-var 'shadow-regexp-groups)))) 705 (shadow-insert-var 'shadow-regexp-groups))))
707 706
708(defun shadow-write-todo-file (&optional save) 707(defun shadow-write-todo-file (&optional save)
709 "Write out information to shadow-todo-file. 708 "Write out information to shadow-todo-file.
710With nonnil argument also saves the buffer." 709With nonnil argument also saves the buffer."
711 (save-excursion 710 (save-excursion
712 (if (not shadow-todo-buffer) 711 (if (not shadow-todo-buffer)
@@ -720,7 +719,7 @@ With nonnil argument also saves the buffer."
720 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) 719 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
721 (save-excursion 720 (save-excursion
722 (set-buffer shadow-todo-buffer) 721 (set-buffer shadow-todo-buffer)
723 (condition-case nil ; have to continue even in case of 722 (condition-case nil ; have to continue even in case of
724 (basic-save-buffer) ; error, otherwise kill-emacs might 723 (basic-save-buffer) ; error, otherwise kill-emacs might
725 (error ; not work! 724 (error ; not work!
726 (message "WARNING: Can't save shadow todo file; it is locked!") 725 (message "WARNING: Can't save shadow todo file; it is locked!")
@@ -736,7 +735,7 @@ SYMBOL must be the name of a variable whose value is a list."
736 (let ((standard-output (current-buffer))) 735 (let ((standard-output (current-buffer)))
737 (insert (format "(setq %s" variable)) 736 (insert (format "(setq %s" variable))
738 (cond ((consp (eval variable)) 737 (cond ((consp (eval variable))
739 (insert "\n '(") 738 (insert "\n '(")
740 (prin1 (car (eval variable))) 739 (prin1 (car (eval variable)))
741 (let ((rest (cdr (eval variable)))) 740 (let ((rest (cdr (eval variable))))
742 (while rest 741 (while rest
@@ -787,7 +786,7 @@ look for files that have been changed and need to be copied to other systems."
787 (kill-emacs))) 786 (kill-emacs)))
788 787
789;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 788;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
790;;; Lucid Emacs compatibility 789;;; Lucid Emacs compatibility
791;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 790;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
792 791
793;; This is on hold until someone tells me about a working version of 792;; This is on hold until someone tells me about a working version of
@@ -798,7 +797,7 @@ look for files that have been changed and need to be copied to other systems."
798; (require 'ange-ftp) 797; (require 'ange-ftp)
799; (require 'map-ynp) 798; (require 'map-ynp)
800; (if (not (fboundp 'file-truename)) 799; (if (not (fboundp 'file-truename))
801; (fset 'shadow-expand-file-name 800; (fset 'shadow-expand-file-name
802; (symbol-function 'symlink-expand-file-name))) 801; (symbol-function 'symlink-expand-file-name)))
803; (if (not (fboundp 'ange-ftp-ftp-name)) 802; (if (not (fboundp 'ange-ftp-ftp-name))
804; (fset 'ange-ftp-ftp-name 803; (fset 'ange-ftp-ftp-name
@@ -808,19 +807,18 @@ look for files that have been changed and need to be copied to other systems."
808;;; Hook us up 807;;; Hook us up
809;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 808;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
810 809
811;;; File shadowing is activated at load time, unless this this file is 810;;;###autoload
812;;; being preloaded, in which case it is added to after-init-hook.
813;;; Thanks to Richard Caley for this scheme.
814
815(defun shadow-initialize () 811(defun shadow-initialize ()
812 "Set up file shadowing."
813 (interactive)
816 (if (null shadow-homedir) 814 (if (null shadow-homedir)
817 (setq shadow-homedir 815 (setq shadow-homedir
818 (file-name-as-directory (shadow-expand-file-name "~")))) 816 (file-name-as-directory (shadow-expand-file-name "~"))))
819 (if (null shadow-info-file) 817 (if (null shadow-info-file)
820 (setq shadow-info-file 818 (setq shadow-info-file
821 (shadow-expand-file-name "~/.shadows"))) 819 (shadow-expand-file-name "~/.shadows")))
822 (if (null shadow-todo-file) 820 (if (null shadow-todo-file)
823 (setq shadow-todo-file 821 (setq shadow-todo-file
824 (shadow-expand-file-name "~/.shadow_todo"))) 822 (shadow-expand-file-name "~/.shadow_todo")))
825 (if (not (shadow-read-files)) 823 (if (not (shadow-read-files))
826 (progn 824 (progn
@@ -829,11 +827,19 @@ look for files that have been changed and need to be copied to other systems."
829 (sit-for 3)) 827 (sit-for 3))
830 (when (and (not shadow-inhibit-overload) 828 (when (and (not shadow-inhibit-overload)
831 (not (fboundp 'shadow-orig-save-buffers-kill-emacs))) 829 (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
832 (fset 'shadow-orig-save-buffers-kill-emacs 830 (defalias 'shadow-orig-save-buffers-kill-emacs
833 (symbol-function 'save-buffers-kill-emacs)) 831 (symbol-function 'save-buffers-kill-emacs))
834 (fset 'save-buffers-kill-emacs 832 (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs))
835 (symbol-function 'shadow-save-buffers-kill-emacs)))
836 (add-hook 'write-file-hooks 'shadow-add-to-todo) 833 (add-hook 'write-file-hooks 'shadow-add-to-todo)
837 (define-key ctl-x-4-map "s" 'shadow-copy-files))) 834 (define-key ctl-x-4-map "s" 'shadow-copy-files)))
838 835
836(defun shadowfile-unload-hook ()
837 (if (fboundp 'shadow-orig-save-buffers-kill-emacs)
838 (fset 'save-buffers-kill-emacs
839 (symbol-function 'shadow-orig-save-buffers-kill-emacs)))
840 (remove-hook 'write-file-hooks 'shadow-add-to-todo))
841
842(provide 'shadowfile)
843
839;;; shadowfile.el ends here 844;;; shadowfile.el ends here
845