[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/shadowfile.el
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/shadowfile.el |
Date: |
Fri, 04 Apr 2003 01:23:01 -0500 |
Index: emacs/lisp/shadowfile.el
diff -c emacs/lisp/shadowfile.el:1.19 emacs/lisp/shadowfile.el:1.20
*** emacs/lisp/shadowfile.el:1.19 Tue Feb 4 07:04:13 2003
--- emacs/lisp/shadowfile.el Thu Apr 3 18:11:06 2003
***************
*** 302,341 ****
;;; Filename manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (defun shadow-parse-fullpath (fullpath)
! "Parse FULLPATH into \(site user path) list.
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 FILE is at this site, remove /address@hidden 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)))
--- 302,341 ----
;;; Filename manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! (defun shadow-parse-fullname (fullname)
! "Parse FULLNAME into \(site user path) list.
Leave it alone if it already is one. Returns nil if the argument is
not a full ange-ftp pathname."
! (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)
(list shadow-system-name
(user-login-name)
! name)))
! (defsubst shadow-make-fullname (host user name)
! "Make an ange-ftp style fullname out of HOST, USER (optional), and NAME.
This is probably not as general as it ought to be."
(concat "/"
(if user (concat user "@"))
host ":"
! name))
! (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 /address@hidden part.
If refers to a different system or a different user on this system,
return nil."
! (let ((hup (shadow-parse-fullname file)))
(cond ((null hup) file)
((and (shadow-site-match (nth 0 hup) shadow-system-name)
(string-equal (nth 1 hup) (user-login-name)))
***************
*** 344,355 ****
(defun shadow-expand-cluster-in-file-name (file)
"If hostname part of FILE is a cluster, expand it to 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))))))
--- 344,355 ----
(defun shadow-expand-cluster-in-file-name (file)
"If hostname part of FILE is a cluster, expand it to cluster's primary
hostname.
! Will return the name bare if it is a local file."
! (let ((hup (shadow-parse-name file))
cluster)
(cond ((null hup) file)
((shadow-local-file hup))
! ((shadow-make-fullname (shadow-site-primary (nth 0 hup))
(nth 1 hup)
(nth 2 hup))))))
***************
*** 362,378 ****
Do so 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))
--- 362,378 ----
Do so 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-name file))
(homedir (if (shadow-local-file hup)
shadow-homedir
(file-name-as-directory
! (nth 2 (shadow-parse-fullname
(expand-file-name
! (shadow-make-fullname
(nth 0 hup) (nth 1 hup) "~")))))))
(suffix (shadow-suffix homedir (nth 2 hup)))
(cluster (shadow-site-cluster (nth 0 hup))))
! (shadow-make-fullname
(if cluster
(shadow-cluster-name cluster)
(nth 0 hup))
***************
*** 384,393 ****
(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))
--- 384,393 ----
(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, name, or ange-ftp file names. FILE may also be just a
local filename."
! (let ((pattern-sup (shadow-parse-fullname pattern))
! (file-sup (shadow-parse-name file)))
(and
(shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup))
(or (null (nth 1 pattern-sup))
***************
*** 395,407 ****
(defun shadow-file-match (pattern file &optional regexp)
"Return 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))
--- 395,407 ----
(defun shadow-file-match (pattern file &optional regexp)
"Return t if PATTERN matches FILE.
! If REGEXP is supplied and non-nil, the file 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-fullname pattern))
! (file-sup (shadow-parse-name file)))
(and (shadow-same-site pattern-sup file-sup)
(if regexp
(string-match (nth 2 pattern-sup) (nth 2 file-sup))
***************
*** 452,470 ****
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))
--- 452,470 ----
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-fullname
(shadow-contract-file-name (buffer-file-name))))
! (name (nth 2 hup))
user site group)
(while (setq site (shadow-read-site))
(setq user (read-string (format "Username [default %s]: "
(shadow-get-user site)))
! name (read-string "Filename: " name))
! (setq group (cons (shadow-make-fullname site
(if (string-equal "" user)
(shadow-get-user site)
user)
! name)
group)))
(setq shadow-literal-groups (cons group shadow-literal-groups)))
(shadow-write-info-file))
***************
*** 483,489 ****
(if (buffer-file-name)
(shadow-regexp-superquote
(nth 2
! (shadow-parse-path
(shadow-contract-file-name
(buffer-file-name))))))))
site sites usernames)
--- 483,489 ----
(if (buffer-file-name)
(shadow-regexp-superquote
(nth 2
! (shadow-parse-name
(shadow-contract-file-name
(buffer-file-name))))))))
site sites usernames)
***************
*** 558,564 ****
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))
--- 558,564 ----
be shadowed), list of SITES, and corresponding list of USERNAMES for each
site."
(if sites
! (cons (shadow-make-fullname (car sites) (car usernames) regexp)
(shadow-make-group regexp (cdr sites) (cdr usernames)))
nil))
***************
*** 619,629 ****
(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)))))
--- 619,629 ----
(car groups))))
(append (cond ((equal nonmatching (car groups)) nil)
(regexp
! (let ((realname (nth 2 (shadow-parse-fullname file))))
(mapcar
(function
(lambda (x)
! (shadow-replace-name-component x realname)))
nonmatching)))
(t nonmatching))
(shadow-shadows-of-1 file (cdr groups) regexp)))))
***************
*** 799,805 ****
; (symbol-function 'symlink-expand-file-name)))
; (if (not (fboundp 'ange-ftp-ftp-name))
; (fset 'ange-ftp-ftp-name
! ; (symbol-function 'ange-ftp-ftp-path))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook us up
--- 799,805 ----
; (symbol-function 'symlink-expand-file-name)))
; (if (not (fboundp 'ange-ftp-ftp-name))
; (fset 'ange-ftp-ftp-name
! ; (symbol-function 'ange-ftp-ftp-name))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook us up