-;; Copyright (C) 1993, 1994, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; 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
;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
Normally it overloads the function `save-buffers-kill-emacs' to check
for files have been changed and need to be copied to other systems."
:type 'boolean
Normally it overloads the function `save-buffers-kill-emacs' to check
for files have been changed and need to be copied to other systems."
:type 'boolean
(defvar shadow-literal-groups nil
"List of files that are shared between hosts.
This list contains shadow structures with literal filenames, created by
(defvar shadow-literal-groups nil
"List of files that are shared between hosts.
This list contains shadow structures with literal filenames, created by
(defun shadow-suffix (prefix string)
"If PREFIX begins STRING, return the rest.
(defun shadow-suffix (prefix string)
"If PREFIX begins STRING, return the rest.
- "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."
+ "Non-nil 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)))
(or (string-equal site1 site2) ; quick check
(let* ((cluster1 (shadow-get-cluster site1))
(primary2 (shadow-site-primary site2)))
- (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)
+ (if (listp fullname)
+ fullname
+ (ange-ftp-ftp-name fullname)))
+
+(defun shadow-parse-name (name)
+ "Parse any NAME into \(site user name) list.
+Argument can be a simple name, full ange-ftp name, or already a hup list."
+ (or (shadow-parse-fullname name)
-(defsubst shadow-make-fullpath (host user path)
- "Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH.
+(defsubst shadow-make-fullname (host user name)
+ "Make an ange-ftp style fullname out of HOST, USER (optional), and NAME.
-(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-replace-name-component (fullname newname)
+ "Return FULLNAME with the name component changed to NEWNAME."
+ (let ((hup (shadow-parse-fullname fullname)))
+ (shadow-make-fullname (nth 0 hup) (nth 1 hup) newname)))
(defun shadow-local-file (file)
"If FILE is at this site, remove /user@host part.
If refers to a different system or a different user on this system,
return nil."
(defun shadow-local-file (file)
"If FILE is at this site, remove /user@host part.
If refers to a different system or a different user on this system,
return nil."
(cond ((null hup) file)
((and (shadow-site-match (nth 0 hup) shadow-system-name)
(string-equal (nth 1 hup) (user-login-name)))
(cond ((null hup) file)
((and (shadow-site-match (nth 0 hup) shadow-system-name)
(string-equal (nth 1 hup) (user-login-name)))
(defun shadow-expand-cluster-in-file-name (file)
"If hostname part of FILE is a cluster, expand it to cluster's primary hostname.
(defun shadow-expand-cluster-in-file-name (file)
"If hostname part of FILE is a cluster, expand it to cluster's primary hostname.
Do so by replacing (when possible) home directory with ~, and hostname
with cluster name that includes it. Filename should be absolute and
true."
Do so by replacing (when possible) home directory with ~, and hostname
with cluster name that includes it. Filename should be absolute and
true."
(nth 0 hup) (nth 1 hup) "~")))))))
(suffix (shadow-suffix homedir (nth 2 hup)))
(cluster (shadow-site-cluster (nth 0 hup))))
(nth 0 hup) (nth 1 hup) "~")))))))
(suffix (shadow-suffix homedir (nth 2 hup)))
(cluster (shadow-site-cluster (nth 0 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
(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
+be lists of host, user, name, or ange-ftp file names. FILE may also be just a
the file can be any valid filename. This function does not do any filename
expansion or contraction, you must do that yourself first."
the file can be any valid filename. This function does not do any filename
expansion or contraction, you must do that yourself first."
(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))))))
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; User-level Commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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)
"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
"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
(let ((standard-output (current-buffer)))
(insert (format "(setq %s" variable))
(cond ((consp (eval variable))
(let ((standard-output (current-buffer)))
(insert (format "(setq %s" variable))
(cond ((consp (eval variable))
- (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)
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
; (symbol-function 'symlink-expand-file-name)))
; (if (not (fboundp 'ange-ftp-ftp-name))
; (fset 'ange-ftp-ftp-name
; (symbol-function 'symlink-expand-file-name)))
; (if (not (fboundp 'ange-ftp-ftp-name))
; (fset 'ange-ftp-ftp-name
(symbol-function 'shadow-orig-save-buffers-kill-emacs)))
(remove-hook 'write-file-hooks 'shadow-add-to-todo))
(symbol-function 'shadow-orig-save-buffers-kill-emacs)))
(remove-hook 'write-file-hooks 'shadow-add-to-todo))