[Emacs-diffs] Changes to emacs/lisp/shadowfile.el

[Miles Bader]

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