/[emacs]/emacs/lisp/net/tramp.el
ViewVC logotype

Diff of /emacs/lisp/net/tramp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by kai, Mon Jun 17 11:47:23 2002 UTC revision 1.2 by kai, Tue Jun 25 18:15:03 2002 UTC
# Line 52  Line 52 
52  ;; the same directory.  ;; the same directory.
53  ;;  ;;
54  ;; There's a mailing list for this, as well.  Its name is:  ;; There's a mailing list for this, as well.  Its name is:
55  ;;                tramp-devel@lists.sourceforge.net  ;;                tramp-devel@mail.freesoftware.fsf.org
56  ;; Send a mail with `help' in the subject (!) to the administration  ;; Send a mail with `help' in the subject (!) to the administration
57  ;; address for instructions on joining the list.  The administration  ;; address for instructions on joining the list.  The administration
58  ;; address is:  ;; address is:
59  ;;            tramp-devel-request@lists.sourceforge.net  ;;            tramp-devel-request@mail.freesoftware.fsf.org
60  ;; You can also use the Web to subscribe, under the following URL:  ;; You can also use the Web to subscribe, under the following URL:
61  ;;            http://lists.sourceforge.net/lists/listinfo/tramp-devel  ;;            http://mail.freesoftware.fsf.org/mailman/listinfo/tramp-devel
62  ;;  ;;
63  ;; For the adventurous, the current development sources are available  ;; For the adventurous, the current development sources are available
64  ;; via CVS.  You can find instructions about this at the following URL:  ;; via CVS.  You can find instructions about this at the following URL:
65  ;;            http://sourceforge.net/projects/tramp/  ;;            http://savannah.gnu.org/projects/tramp/
66  ;; Click on "CVS" in the navigation bar near the top.  ;; Click on "CVS" in the navigation bar near the top.
67  ;;  ;;
68  ;; Don't forget to put on your asbestos longjohns, first!  ;; Don't forget to put on your asbestos longjohns, first!
69    
70  ;;; Code:  ;;; Code:
71    
72  (defconst tramp-version "2.0.0"  (defconst tramp-version "2.0.1"
73    "This version of tramp.")    "This version of tramp.")
74  (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"  (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
75    "Email address to send bug reports to.")    "Email address to send bug reports to.")
# Line 776  various functions for details." Line 776  various functions for details."
776    
777  (defcustom tramp-default-method "rcp"  (defcustom tramp-default-method "rcp"
778    "*Default method to use for transferring files.    "*Default method to use for transferring files.
779  See `tramp-methods' for possibilities."  See `tramp-methods' for possibilities.
780    Also see `tramp-default-method-alist'."
781      :group 'tramp
782      :type 'string)
783    
784    (defcustom tramp-default-method-alist nil
785      "*Default method to use for specific user/host pairs.
786    This is an alist of items (HOST USER METHOD).  The first matching item
787    specifies the method to use for a file name which does not specify a
788    method.  HOST and USER are regular expressions or nil, which is
789    interpreted as a regular expression which always matches.  If no entry
790    matches, the variable `tramp-default-method' takes effect.
791    
792    If the file name does not specify the user, lookup is done using the
793    empty string for the user name.
794    
795    See `tramp-methods' for a list of possibilities for METHOD."
796      :group 'tramp
797      :type '(repeat (list (regexp :tag "Host regexp")
798                           (regexp :tag "User regexp")
799                           (string :tag "Method"))))
800    
801    (defcustom tramp-ftp-method "ftp"
802      "*When this method name is used, forward all calls to Ange-FTP."
803    :group 'tramp    :group 'tramp
804    :type 'string)    :type 'string)
805    
# Line 840  Some shells send such garbage upon conne Line 863  Some shells send such garbage upon conne
863    :group 'tramp    :group 'tramp
864    :type 'boolean)    :type 'boolean)
865    
866    (defcustom tramp-sh-extra-args '(("/bash\\'" . "--norc"))
867      "*Alist specifying extra arguments to pass to the remote shell.
868    Entries are (REGEXP . ARGS) where REGEXP is a regular expression
869    matching the shell file name and ARGS is a string specifying the
870    arguments.
871    
872    This variable is only used when Tramp needs to start up another shell
873    for tilde expansion.  The extra arguments should typically prevent the
874    shell from reading its init file."
875      :group 'tramp
876      :type '(alist :key-type string :value-type string))
877    
878  ;; File name format.  ;; File name format.
879    
880  (defcustom tramp-file-name-structure  (defcustom tramp-file-name-structure
# Line 1313  own implementation." Line 1348  own implementation."
1348     ((fboundp 'point-at-eol)      (funcall 'point-at-eol))     ((fboundp 'point-at-eol)      (funcall 'point-at-eol))
1349     (t (save-excursion (end-of-line) (point)))))     (t (save-excursion (end-of-line) (point)))))
1350    
1351    (defmacro with-parsed-tramp-file-name (filename var &rest body)
1352      "Parse a Tramp filename and make components available in the body.
1353    
1354    First arg FILENAME is evaluated and dissected into its components.
1355    Second arg VAR is a symbol.  It is used as a variable name to hold
1356    the filename structure.  It is also used as a prefix for the variables
1357    holding the components.  For example, if VAR is the symbol `foo', then
1358    `foo' will be bound to the whole structure, `foo-multi-method' will
1359    be bound to the multi-method component, and so on for `foo-method',
1360    `foo-user', `foo-host', `foo-path'.
1361    
1362    Remaining args are Lisp expressions to be evaluated (inside an implicit
1363    `progn').
1364    
1365    If VAR is nil, then we bind `v' to the structure and `multi-method',
1366    `method', `user', `host', `path' to the components."
1367      `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
1368              (,(if var (intern (concat (symbol-name var) "-multi-method")) 'multi-method)
1369               (tramp-file-name-multi-method ,(or var 'v)))
1370              (,(if var (intern (concat (symbol-name var) "-method")) 'method)
1371               (tramp-file-name-method ,(or var 'v)))
1372              (,(if var (intern (concat (symbol-name var) "-user")) 'user)
1373               (tramp-file-name-user ,(or var 'v)))
1374              (,(if var (intern (concat (symbol-name var) "-host")) 'host)
1375               (tramp-file-name-host ,(or var 'v)))
1376              (,(if var (intern (concat (symbol-name var) "-path")) 'path)
1377               (tramp-file-name-path ,(or var 'v))))
1378         ,@body))
1379    
1380    (put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
1381    
1382  ;;; File Name Handler Functions:  ;;; File Name Handler Functions:
1383    
1384  ;; The following file name handler ops are not implemented (yet?).  ;; The following file name handler ops are not implemented (yet?).
# Line 1320  own implementation." Line 1386  own implementation."
1386  (defun tramp-handle-make-symbolic-link  (defun tramp-handle-make-symbolic-link
1387    (filename linkname &optional ok-if-already-exists)    (filename linkname &optional ok-if-already-exists)
1388    "Like `make-symbolic-link' for tramp files.    "Like `make-symbolic-link' for tramp files.
1389  This function will raise an error if FILENAME and LINKNAME are not  The LINKNAME argument should look like \"/path/to/target\" or
1390  on the same remote host."  \"relative-name\",and not like a Tramp filename."
1391    (unless (or (tramp-tramp-file-p filename)    (error "Not implemented yet")
1392                (tramp-tramp-file-p linkname))    (with-parsed-tramp-file-name linkname l
1393      (tramp-run-real-handler 'make-symbolic-link      (when (tramp-ange-ftp-file-name-p l-multi-method l-method)
1394                              (list filename linkname ok-if-already-exists)))        (tramp-invoke-ange-ftp 'make-symbolic-link
1395    (let* ((file   (tramp-dissect-file-name       filename))                               filename linkname ok-if-already-exists))
1396           (link   (tramp-dissect-file-name       linkname))      (let ((ln (tramp-get-remote-ln l-multi l-method l-user l-host))
1397           (multi  (tramp-file-name-multi-method  file))            (cwd (file-name-directory l-path)))
1398           (method (tramp-file-name-method        file))        (unless ln
1399           (user   (tramp-file-name-user          file))          (signal 'file-error
1400           (host   (tramp-file-name-host          file))                  (list "Making a symbolic link."
1401           (l-multi (tramp-file-name-multi-method link))                        "ln(1) does not exist on the remote host.")))
1402           (l-meth  (tramp-file-name-method       link))  
1403           (l-user  (tramp-file-name-user         link))        ;; Do the 'confirm if exists' thing.
1404           (l-host  (tramp-file-name-host         link))        (when (file-exists-p (expand-file-name filename
1405           (ln     (tramp-get-remote-ln           multi method user host))                                               CCC))
1406           (cwd    (file-name-directory           (tramp-file-name-path file))))          ;; What to do?
1407      (unless ln          (if (or (null ok-if-already-exists) ; not allowed to exist
1408        (signal 'file-error (list "Making a symbolic link."                  (and (numberp ok-if-already-exists)
1409                                  "ln(1) does not exist on the remote host.")))                       (not (yes-or-no-p
1410                               (format
1411      ;; Check that method, user, host are the same.                              "File %s already exists; make it a link anyway? "
1412      (unless (equal host l-host)                              l-path)))))
1413        (signal 'file-error (list "Can't make symlink across hosts" host l-host)))              (signal 'file-already-exists (list "File already exists" l-path))))
     (unless (equal user l-user)  
       (signal 'file-error (list "Can't make symlink for different users"  
                                 user l-user)))  
     (unless (and (equal multi l-multi)  
                  (equal method l-meth))  
       (signal 'file-error (list "Method must be the same for making symlinks"  
                                 multi l-multi method l-meth)))  
   
     ;; Do the 'confirm if exists' thing.  
     (when (file-exists-p (tramp-file-name-path link))  
       ;; What to do?  
       (if (or (null ok-if-already-exists) ; not allowed to exist  
               (and (numberp ok-if-already-exists)  
                    (not (yes-or-no-p  
                          (format "File %s already exists; make it a link anyway? "  
                                  (tramp-file-name-path link))))))  
           (signal 'file-already-exists (list "File already exists"  
                                              (tramp-file-name-path link)))))  
1414            
1415      ;; Right, they are on the same host, regardless of user, method, etc.        ;; Right, they are on the same host, regardless of user, method, etc.
1416      ;; We now make the link on the remote machine. This will occur as the user        ;; We now make the link on the remote machine. This will occur as the user
1417      ;; that FILENAME belongs to.        ;; that FILENAME belongs to.
1418      (zerop        (zerop
1419       (tramp-send-command-and-check         (tramp-send-command-and-check
1420        multi method user host          fn-multi fn-method fn-user fn-host
1421        (format "cd %s && %s -sf %s %s"          (format "cd %s && %s -sf %s %s"
1422                cwd ln                  cwd ln
1423                (tramp-file-name-path file) ; target                  (tramp-file-name-path file) ; target
1424                (tramp-file-name-path link)) ; link name                  (tramp-file-name-path link)) ; link name
1425        t))))                                      t)))))
1426    
1427    
1428  (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)  (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
1429    "Like `load' for tramp files.  Not implemented!"    "Like `load' for tramp files.  Not implemented!"
1430    (unless (file-name-absolute-p file)    (unless (file-name-absolute-p file)
1431      (error "Tramp cannot `load' files without absolute path name"))      (error "Tramp cannot `load' files without absolute path name"))
1432    (unless nosuffix    (with-parsed-tramp-file-name file nil
1433      (cond ((file-exists-p (concat file ".elc"))      (when (tramp-ange-ftp-file-name-p multi-method method)
1434             (setq file (concat file ".elc")))        (tramp-invoke-ange-ftp 'load
1435            ((file-exists-p (concat file ".el"))                               file noerror nomessage nosuffix must-suffix))
1436             (setq file (concat file ".el")))))      (unless nosuffix
1437    (when must-suffix        (cond ((file-exists-p (concat file ".elc"))
1438      ;; The first condition is always true for absolute file names.               (setq file (concat file ".elc")))
1439      ;; Included for safety's sake.              ((file-exists-p (concat file ".el"))
1440      (unless (or (file-name-directory file)               (setq file (concat file ".el")))))
1441                  (string-match "\\.elc?\\'" file))      (when must-suffix
1442        (error "File `%s' does not include a `.el' or `.elc' suffix"        ;; The first condition is always true for absolute file names.
1443               file)))        ;; Included for safety's sake.
1444    (unless noerror        (unless (or (file-name-directory file)
1445      (when (not (file-exists-p file))                    (string-match "\\.elc?\\'" file))
1446        (error "Cannot load nonexistant file `%s'" file)))          (error "File `%s' does not include a `.el' or `.elc' suffix"
1447    (if (not (file-exists-p file))                 file)))
1448        nil      (unless noerror
1449      (unless nomessage        (when (not (file-exists-p file))
1450        (message "Loading %s..." file))          (error "Cannot load nonexistant file `%s'" file)))
1451      (let ((local-copy (file-local-copy file)))      (if (not (file-exists-p file))
1452        ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.          nil
1453        (load local-copy noerror t t)        (unless nomessage
1454        (delete-file local-copy))          (message "Loading %s..." file))
1455      (unless nomessage        (let ((local-copy (file-local-copy file)))
1456        (message "Loading %s...done" file))          ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
1457      t))          (load local-copy noerror t t)
1458            (delete-file local-copy))
1459          (unless nomessage
1460            (message "Loading %s...done" file))
1461          t)))
1462    
1463  ;; Path manipulation functions that grok TRAMP paths...  ;; Path manipulation functions that grok TRAMP paths...
1464  (defun tramp-handle-file-name-directory (file)  (defun tramp-handle-file-name-directory (file)
1465    "Like `file-name-directory' but aware of TRAMP files."    "Like `file-name-directory' but aware of TRAMP files."
1466    ;; everything except the last filename thing is the directory    ;; everything except the last filename thing is the directory
1467    (let* ((v      (tramp-dissect-file-name file))    (with-parsed-tramp-file-name file nil
1468           (multi-method (tramp-file-name-multi-method v))      (when (tramp-ange-ftp-file-name-p multi-method method)
1469           (method (tramp-file-name-method v))        (tramp-invoke-ange-ftp 'file-name-directory file))
          (user   (tramp-file-name-user v))  
          (host   (tramp-file-name-host v))  
          (path   (tramp-file-name-path v)))  
1470      (if (or (string= path "") (string= path "/"))      (if (or (string= path "") (string= path "/"))
1471          ;; For a filename like "/[foo]", we return "/".  The `else'          ;; For a filename like "/[foo]", we return "/".  The `else'
1472          ;; case would return "/[foo]" unchanged.  But if we do that,          ;; case would return "/[foo]" unchanged.  But if we do that,
# Line 1434  on the same remote host." Line 1483  on the same remote host."
1483    
1484  (defun tramp-handle-file-name-nondirectory (file)  (defun tramp-handle-file-name-nondirectory (file)
1485    "Like `file-name-nondirectory' but aware of TRAMP files."    "Like `file-name-nondirectory' but aware of TRAMP files."
1486    (let ((v (tramp-dissect-file-name file)))    (with-parsed-tramp-file-name file nil
1487      (file-name-nondirectory (tramp-file-name-path v))))      (when (tramp-ange-ftp-file-name-p multi-method method)
1488          (tramp-invoke-ange-ftp 'file-name-nondirectory file))
1489        (file-name-nondirectory path)))
1490    
1491  (defun tramp-handle-file-truename (filename &optional counter prev-dirs)  (defun tramp-handle-file-truename (filename &optional counter prev-dirs)
1492    "Like `file-truename' for tramp files."    "Like `file-truename' for tramp files."
1493    (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))    (with-parsed-tramp-file-name filename nil
1494           (multi-method (tramp-file-name-multi-method v))      ;; Ange-FTP does not support truename processing.  It returns the
1495           (method       (tramp-file-name-method v))      ;; file name as-is.  So that's what we do, too.
1496           (user         (tramp-file-name-user v))      (when (tramp-ange-ftp-file-name-p multi-method method)
1497           (host         (tramp-file-name-host v))        filename)
1498           (path         (tramp-file-name-path v))      (let* ((steps        (tramp-split-string path "/"))
1499           (steps        (tramp-split-string path "/"))             (pathdir (let ((directory-sep-char ?/))
1500           (pathdir (let ((directory-sep-char ?/))                        (file-name-as-directory path)))
1501                      (file-name-as-directory path)))             (is-dir (string= path pathdir))
1502           (is-dir (string= path pathdir))             (thisstep nil)
1503           (thisstep nil)             (numchase 0)
1504           (numchase 0)             ;; Don't make the following value larger than necessary.
1505           ;; Don't make the following value larger than necessary.             ;; People expect an error message in a timely fashion when
1506           ;; People expect an error message in a timely fashion when             ;; something is wrong; otherwise they might think that Emacs
1507           ;; something is wrong; otherwise they might think that Emacs             ;; is hung.  Of course, correctness has to come first.
1508           ;; is hung.  Of course, correctness has to come first.             (numchase-limit 20)
1509           (numchase-limit 20)             (result nil)                 ;result steps in reverse order
1510           (result nil)                   ;result steps in reverse order             (curstri "")
1511           (curstri "")             symlink-target)
          symlink-target)  
     (tramp-message-for-buffer  
      multi-method method user host  
      10 "Finding true name for `%s'" filename)  
     (while (and steps (< numchase numchase-limit))  
       (setq thisstep (pop steps))  
1512        (tramp-message-for-buffer        (tramp-message-for-buffer
1513         multi-method method user host         multi-method method user host
1514         10 "Check %s"         10 "Finding true name for `%s'" filename)
1515         (mapconcat 'identity        (while (and steps (< numchase numchase-limit))
1516                    (append '("") (reverse result) (list thisstep))          (setq thisstep (pop steps))
1517                    "/"))          (tramp-message-for-buffer
1518        (setq symlink-target           multi-method method user host
1519              (nth 0 (tramp-handle-file-attributes           10 "Check %s"
1520                      (tramp-make-tramp-file-name           (mapconcat 'identity
1521                       multi-method method user host                      (append '("") (reverse result) (list thisstep))
1522                       (mapconcat 'identity                      "/"))
1523                                  (append '("") (reverse result) (list thisstep))          (setq symlink-target
1524                                  "/")))))                (nth 0 (tramp-handle-file-attributes
1525        (cond ((string= "." thisstep)                        (tramp-make-tramp-file-name
1526               (tramp-message-for-buffer multi-method method user host                         multi-method method user host
1527                                         10 "Ignoring step `.'"))                         (mapconcat 'identity
1528              ((string= ".." thisstep)                                    (append '("") (reverse result) (list thisstep))
1529               (tramp-message-for-buffer multi-method method user host                                    "/")))))
1530                                         10 "Processing step `..'")          (cond ((string= "." thisstep)
1531               (pop result))                 (tramp-message-for-buffer multi-method method user host
1532              ((stringp symlink-target)                                           10 "Ignoring step `.'"))
1533               ;; It's a symlink, follow it.                ((string= ".." thisstep)
1534               (tramp-message-for-buffer                 (tramp-message-for-buffer multi-method method user host
1535                multi-method method user host                                           10 "Processing step `..'")
1536                10 "Follow symlink to %s" symlink-target)                 (pop result))
1537               (setq numchase (1+ numchase))                ((stringp symlink-target)
1538               (when (file-name-absolute-p symlink-target)                 ;; It's a symlink, follow it.
1539                 (setq result nil))                 (tramp-message-for-buffer
1540               (setq steps                  multi-method method user host
1541                     (append (tramp-split-string symlink-target "/") steps)))                  10 "Follow symlink to %s" symlink-target)
1542              (t                 (setq numchase (1+ numchase))
1543               ;; It's a file.                 (when (file-name-absolute-p symlink-target)
1544               (setq result (cons thisstep result)))))                   (setq result nil))
1545      (when (>= numchase numchase-limit)                 (setq steps
1546        (error "Maximum number (%d) of symlinks exceeded" numchase-limit))                       (append (tramp-split-string symlink-target "/") steps)))
1547      (setq result (reverse result))                (t
1548      (tramp-message-for-buffer                 ;; It's a file.
1549       multi-method method user host                 (setq result (cons thisstep result)))))
1550       10 "True name of `%s' is `%s'"        (when (>= numchase numchase-limit)
1551       filename (mapconcat 'identity (cons "" result) "/"))          (error "Maximum number (%d) of symlinks exceeded" numchase-limit))
1552      (tramp-make-tramp-file-name        (setq result (reverse result))
1553       multi-method method user host        (tramp-message-for-buffer
1554       (concat (mapconcat 'identity (cons "" result) "/")         multi-method method user host
1555               (if is-dir "/" "")))))         10 "True name of `%s' is `%s'"
1556           filename (mapconcat 'identity (cons "" result) "/"))
1557          (tramp-make-tramp-file-name
1558           multi-method method user host
1559           (concat (mapconcat 'identity (cons "" result) "/")
1560                   (if is-dir "/" ""))))))
1561    
1562  ;; Basic functions.  ;; Basic functions.
1563    
1564  (defun tramp-handle-file-exists-p (filename)  (defun tramp-handle-file-exists-p (filename)
1565    "Like `file-exists-p' for tramp files."    "Like `file-exists-p' for tramp files."
1566    (let ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))    (with-parsed-tramp-file-name filename nil
1567          multi-method method user host path)      (when (tramp-ange-ftp-file-name-p multi-method method)
1568      (setq multi-method (tramp-file-name-multi-method v))        (tramp-invoke-ange-ftp 'file-exists-p filename))
     (setq method (tramp-file-name-method v))  
     (setq user (tramp-file-name-user v))  
     (setq host (tramp-file-name-host v))  
     (setq path (tramp-file-name-path v))  
1569      (save-excursion      (save-excursion
1570        (zerop (tramp-send-command-and-check        (zerop (tramp-send-command-and-check
1571                multi-method method user host                multi-method method user host
1572                (format                (format
1573                 (tramp-get-file-exists-command multi-method method user host)                 (tramp-get-file-exists-command multi-method method user host)
1574                 (tramp-shell-quote-argument path)))))))                 (tramp-shell-quote-argument path)))))))
1575    
1576  ;; CCC: This should check for an error condition and signal failure  ;; CCC: This should check for an error condition and signal failure
1577  ;;      when something goes wrong.  ;;      when something goes wrong.
# Line 1537  rather than as numbers." Line 1583  rather than as numbers."
1583    (if (tramp-handle-file-exists-p filename)    (if (tramp-handle-file-exists-p filename)
1584        ;; file exists, find out stuff        ;; file exists, find out stuff
1585        (save-excursion        (save-excursion
1586          (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))          (with-parsed-tramp-file-name filename nil
1587                 (multi-method (tramp-file-name-multi-method v))            (when (tramp-ange-ftp-file-name-p multi-method method)
1588                 (method (tramp-file-name-method v))              (tramp-invoke-ange-ftp 'file-attributes file))
                (user (tramp-file-name-user v))  
                (host (tramp-file-name-host v))  
                (path (tramp-file-name-path v)))  
1589            (if (tramp-get-remote-perl multi-method method user host)            (if (tramp-get-remote-perl multi-method method user host)
1590                (tramp-handle-file-attributes-with-perl multi-method method user host path nonnumeric)                (tramp-handle-file-attributes-with-perl
1591              (tramp-handle-file-attributes-with-ls multi-method method user host path nonnumeric))))                 multi-method method user host path nonnumeric)
1592                (tramp-handle-file-attributes-with-ls
1593                 multi-method method user host path nonnumeric))))
1594      nil))                               ; no file      nil))                               ; no file
1595    
1596    
# Line 1653  is initially created and is kept cached Line 1698  is initially created and is kept cached
1698             (buffer-name)))             (buffer-name)))
1699    (when time-list    (when time-list
1700      (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))      (tramp-run-real-handler 'set-visited-file-modtime (list time-list)))
1701    (let* ((coding-system-used nil)    (let ((f (buffer-file-name))
1702           (f (buffer-file-name))          (coding-system-used nil))
1703           (v (tramp-dissect-file-name f))      (with-parsed-tramp-file-name f nil
1704           (multi-method (tramp-file-name-multi-method v))        ;; This operation is not handled by Ange-FTP!
1705           (method (tramp-file-name-method v))        (when (tramp-ange-ftp-file-name-p multi-method method)
1706           (user (tramp-file-name-user v))          (throw 'tramp-forward-to-ange-ftp
1707           (host (tramp-file-name-host v))                 (tramp-run-real-handler 'set-visited-file-modtime
1708           (path (tramp-file-name-path v))                                         (list time-list))))
1709           (attr (file-attributes f))        (let* ((attr (file-attributes f))
1710           (modtime (nth 5 attr)))               (modtime (nth 5 attr)))
1711      ;; We use '(0 0) as a don't-know value.  See also          ;; We use '(0 0) as a don't-know value.  See also
1712      ;; `tramp-handle-file-attributes-with-ls'.          ;; `tramp-handle-file-attributes-with-ls'.
1713      (when (boundp 'last-coding-system-used)          (when (boundp 'last-coding-system-used)
1714        (setq coding-system-used last-coding-system-used))            (setq coding-system-used last-coding-system-used))
     (if (not (equal modtime '(0 0)))  
         (tramp-run-real-handler 'set-visited-file-modtime (list modtime))  
       (save-excursion  
         (tramp-send-command  
          multi-method method user host  
          (format "%s -ild %s"  
                  (tramp-get-ls-command multi-method method user host)  
                  (tramp-shell-quote-argument path)))  
         (tramp-wait-for-output)  
         (setq attr (buffer-substring (point)  
                                      (progn (end-of-line) (point)))))  
       (setq tramp-buffer-file-attributes attr))  
     (when (boundp 'last-coding-system-used)  
       (setq last-coding-system-used coding-system-used))  
     nil))  
   
 ;; This function makes the same assumption as  
 ;; `tramp-handle-set-visited-file-modtime'.  
 (defun tramp-handle-verify-visited-file-modtime (buf)  
   "Like `verify-visited-file-modtime' for tramp files."  
   (with-current-buffer buf  
     (let* ((f (buffer-file-name))  
            (v (tramp-dissect-file-name f))  
            (multi-method (tramp-file-name-multi-method v))  
            (method (tramp-file-name-method v))  
            (user (tramp-file-name-user v))  
            (host (tramp-file-name-host v))  
            (path (tramp-file-name-path v))  
            (attr (file-attributes f))  
            (modtime (nth 5 attr)))  
       (if attr  
1715          (if (not (equal modtime '(0 0)))          (if (not (equal modtime '(0 0)))
1716              ;; Why does `file-attributes' return a list (HIGH LOW), but              (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
             ;; `visited-file-modtime' returns a cons (HIGH . LOW)?  
             (let ((mt (visited-file-modtime)))  
               (< (abs (tramp-time-diff modtime (list (car mt) (cdr mt)))) 2))  
1717            (save-excursion            (save-excursion
1718              (tramp-send-command              (tramp-send-command
1719               multi-method method user host               multi-method method user host
# Line 1712  is initially created and is kept cached Line 1723  is initially created and is kept cached
1723              (tramp-wait-for-output)              (tramp-wait-for-output)
1724              (setq attr (buffer-substring (point)              (setq attr (buffer-substring (point)
1725                                           (progn (end-of-line) (point)))))                                           (progn (end-of-line) (point)))))
1726            (equal tramp-buffer-file-attributes attr))            (setq tramp-buffer-file-attributes attr))
1727          ;; If file does not exist, say it is not modified.          (when (boundp 'last-coding-system-used)
1728              (setq last-coding-system-used coding-system-used))
1729          nil))))          nil))))
1730    
1731    ;; CCC continue here
1732    
1733    ;; This function makes the same assumption as
1734    ;; `tramp-handle-set-visited-file-modtime'.
1735    (defun tramp-handle-verify-visited-file-modtime (buf)
1736      "Like `verify-visited-file-modtime' for tramp files."
1737      (with-current-buffer buf
1738        (let ((f (buffer-file-name)))
1739          (with-parsed-tramp-file-name f nil
1740            (when (tramp-ange-ftp-file-name-p f)
1741              ;; This one requires a hack since the file name is not passed
1742              ;; on the arg list.
1743              (let ((buffer-file-name (tramp-make-ange-ftp-file-name
1744                                       user host path)))
1745                (tramp-invoke-ange-ftp 'verify-visited-file-modtime buf)))
1746            (let* ((attr (file-attributes f))
1747                   (modtime (nth 5 attr)))
1748              (cond ((and attr (not (equal modtime '(0 0))))
1749                     ;; Why does `file-attributes' return a list (HIGH
1750                     ;; LOW), but `visited-file-modtime' returns a cons
1751                     ;; (HIGH . LOW)?
1752                     (let ((mt (visited-file-modtime)))
1753                       (< (abs (tramp-time-diff
1754                                modtime (list (car mt) (cdr mt)))) 2)))
1755                    (attr
1756                     (save-excursion
1757                       (tramp-send-command
1758                        multi-method method user host
1759                        (format "%s -ild %s"
1760                                (tramp-get-ls-command multi-method method
1761                                                      user host)
1762                                (tramp-shell-quote-argument path)))
1763                       (tramp-wait-for-output)
1764                       (setq attr (buffer-substring
1765                                   (point) (progn (end-of-line) (point)))))
1766                     (equal tramp-buffer-file-attributes attr))
1767                    ;; If file does not exist, say it is not modified.
1768                    nil))))))
1769    
1770  (defadvice clear-visited-file-modtime (after tramp activate)  (defadvice clear-visited-file-modtime (after tramp activate)
1771    "Set `tramp-buffer-file-attributes' back to nil.    "Set `tramp-buffer-file-attributes' back to nil.
1772  Tramp uses this variable as an emulation for the actual modtime of the file,  Tramp uses this variable as an emulation for the actual modtime of the file,
# Line 1724  if the remote host can't provide the mod Line 1775  if the remote host can't provide the mod
1775    
1776  (defun tramp-handle-set-file-modes (filename mode)  (defun tramp-handle-set-file-modes (filename mode)
1777    "Like `set-file-modes' for tramp files."    "Like `set-file-modes' for tramp files."
1778    (let ((v (tramp-dissect-file-name filename)))    (with-parsed-tramp-file-name filename nil
1779        (when (tramp-ange-ftp-file-name-p multi-method method)
1780          (tramp-invoke-ange-ftp 'set-file-modes filename mode))
1781      (save-excursion      (save-excursion
1782        (unless (zerop (tramp-send-command-and-check        (unless (zerop (tramp-send-command-and-check
1783                        (tramp-file-name-multi-method v)                        multi-method method user host
1784                        (tramp-file-name-method v)                        (format "chmod %s %s"
1785                        (tramp-file-name-user v)                                (tramp-decimal-to-octal mode)
1786                        (tramp-file-name-host v)                                (tramp-shell-quote-argument path))))
                       (format "chmod %s %s"  
                               (tramp-decimal-to-octal mode)  
                               (tramp-shell-quote-argument  
                                (tramp-file-name-path v)))))  
1787          (signal 'file-error          (signal 'file-error
1788                  (list "Doing chmod"                  (list "Doing chmod"
1789                        ;; FIXME: extract the proper text from chmod's stderr.                        ;; FIXME: extract the proper text from chmod's stderr.
# Line 1745  if the remote host can't provide the mod Line 1794  if the remote host can't provide the mod
1794    
1795  (defun tramp-handle-file-executable-p (filename)  (defun tramp-handle-file-executable-p (filename)
1796    "Like `file-executable-p' for tramp files."    "Like `file-executable-p' for tramp files."
1797    (zerop (tramp-run-test "-x" filename)))    (with-parsed-tramp-file-name filename nil
1798        (when (tramp-ange-ftp-file-name-p multi-method method)
1799          (tramp-invoke-ange-ftp 'file-executable-p filename))
1800        (zerop (tramp-run-test "-x" filename))))
1801    
1802  (defun tramp-handle-file-readable-p (filename)  (defun tramp-handle-file-readable-p (filename)
1803    "Like `file-readable-p' for tramp files."    "Like `file-readable-p' for tramp files."
1804    (zerop (tramp-run-test "-r" filename)))    (with-parsed-tramp-file-name filename nil
1805        (when (tramp-ange-ftp-file-name-p multi-method method)
1806          (tramp-invoke-ange-ftp 'file-readable-p filename))
1807        (zerop (tramp-run-test "-r" filename))))
1808    
1809  (defun tramp-handle-file-accessible-directory-p (filename)  (defun tramp-handle-file-accessible-directory-p (filename)
1810    "Like `file-accessible-directory-p' for tramp files."    "Like `file-accessible-directory-p' for tramp files."
1811    (and (zerop (tramp-run-test "-d" filename))    (with-parsed-tramp-file-name filename nil
1812         (zerop (tramp-run-test "-r" filename))      (when (tramp-ange-ftp-file-name-p multi-method method)
1813         (zerop (tramp-run-test "-x" filename))))        (tramp-invoke-ange-ftp 'file-accessible-directory-p filename))
1814        (and (zerop (tramp-run-test "-d" filename))
1815             (zerop (tramp-run-test "-r" filename))
1816             (zerop (tramp-run-test "-x" filename)))))
1817    
1818  ;; When the remote shell is started, it looks for a shell which groks  ;; When the remote shell is started, it looks for a shell which groks
1819  ;; tilde expansion.  Here, we assume that all shells which grok tilde  ;; tilde expansion.  Here, we assume that all shells which grok tilde
# Line 1768  if the remote host can't provide the mod Line 1826  if the remote host can't provide the mod
1826           nil)           nil)
1827          ((not (file-exists-p file2))          ((not (file-exists-p file2))
1828           t)           t)
1829          ;; We are sure both files exist at this point.          ;; We are sure both files exist at this point.  We assume that
1830            ;; both files are Tramp files, otherwise we issue an error
1831            ;; message.  Todo: make a better error message.
1832          (t          (t
1833           (save-excursion           (save-excursion
1834             (let* ((v1 (tramp-dissect-file-name file1))             (with-parsed-tramp-file-name file1 v1
1835                    (mm1 (tramp-file-name-multi-method v1))               (with-parsed-tramp-file-name file2 v2
1836                    (m1 (tramp-file-name-method v1))                 (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
1837                    (u1 (tramp-file-name-user v1))                            (tramp-ange-ftp-file-name-p v2-multi-method v2-method))
1838                    (h1 (tramp-file-name-host v1))                   (tramp-invoke-ange-ftp 'file-newer-than-file-p
1839                    (v2 (tramp-dissect-file-name file2))                                          file1 file2))
1840                    (mm2 (tramp-file-name-multi-method v2))                 (unless (and (equal v1-multi-method v2-multi-method)
1841                    (m2 (tramp-file-name-method v2))                              (equal v1-method v2-method)
1842                    (u2 (tramp-file-name-user v2))                              (equal v1-user v2-user)
1843                    (h2 (tramp-file-name-host v2)))                              (equal v1-host v2-host))
1844               (unless (and (equal mm1 mm2)                   (signal 'file-error
1845                            (equal m1 m2)                           (list "Files must have same method, user, host"
1846                            (equal u1 u2)                                 file1 file2)))
1847                            (equal h1 h2))                 (unless (and (tramp-tramp-file-p file1)
1848                 (signal 'file-error                              (tramp-tramp-file-p file2))
1849                         (list "Files must have same method, user, host"                   (signal 'file-error
1850                               file1 file2)))                           (list "Files must be tramp files on same host"
1851               (unless (and (tramp-tramp-file-p file1)                                 file1 file2)))
1852                            (tramp-tramp-file-p file2))                 (if (tramp-get-test-groks-nt
1853                 (signal 'file-error                      v1-multi-method v1-method v1-user v1-host)
1854                         (list "Files must be tramp files on same host"                     (zerop (tramp-run-test2 "test" file1 file2 "-nt"))
1855                               file1 file2)))                   (zerop (tramp-run-test2 "tramp_test_nt" file1 file2)))))))))
              (if (tramp-get-test-groks-nt mm1 m1 u1 h1)  
                  (zerop (tramp-run-test2 "test" file1 file2 "-nt"))  
                (zerop (tramp-run-test2 "tramp_test_nt" file1 file2))))))))  
1856    
1857  ;; Functions implemented using the basic functions above.  ;; Functions implemented using the basic functions above.
1858    
1859  (defun tramp-handle-file-modes (filename)  (defun tramp-handle-file-modes (filename)
1860    "Like `file-modes' for tramp files."    "Like `file-modes' for tramp files."
1861    (when (file-exists-p filename)    (with-parsed-tramp-file-name filename nil
1862      (tramp-mode-string-to-int      (when (tramp-ange-ftp-file-name-p multi-method method)
1863       (nth 8 (tramp-handle-file-attributes filename)))))        (tramp-invoke-ange-ftp 'file-modes filename))
1864        (when (file-exists-p filename)
1865          (tramp-mode-string-to-int
1866           (nth 8 (tramp-handle-file-attributes filename))))))
1867    
1868  (defun tramp-handle-file-directory-p (filename)  (defun tramp-handle-file-directory-p (filename)
1869    "Like `file-directory-p' for tramp files."    "Like `file-directory-p' for tramp files."
# Line 1815  if the remote host can't provide the mod Line 1875  if the remote host can't provide the mod
1875    ;; we?    ;; we?
1876    ;;    ;;
1877    ;; Alternatives: `cd %s', `test -d %s'    ;; Alternatives: `cd %s', `test -d %s'
1878    (save-excursion    (with-parsed-tramp-file-name filename nil
1879      (let ((v (tramp-dissect-file-name filename)))      (when (tramp-ange-ftp-file-name-p multi-method method)
1880          (tramp-invoke-ange-ftp 'file-directory-p filename))
1881        (save-excursion
1882        (zerop        (zerop
1883         (tramp-send-command-and-check         (tramp-send-command-and-check
1884          (tramp-file-name-multi-method v) (tramp-file-name-method v)          multi-method method user host
1885          (tramp-file-name-user v) (tramp-file-name-host v)          (format "test -d %s"
1886          (format "test -d %s"                  (tramp-shell-quote-argument path))
1887                  (tramp-shell-quote-argument (tramp-file-name-path v)))          t)))))                          ;run command in subshell
         t)))))                          ;run command in subshell  
1888    
1889  (defun tramp-handle-file-regular-p (filename)  (defun tramp-handle-file-regular-p (filename)
1890    "Like `file-regular-p' for tramp files."    "Like `file-regular-p' for tramp files."
1891    (and (tramp-handle-file-exists-p filename)    (with-parsed-tramp-file-name filename nil
1892         (eq ?- (aref (nth 8 (tramp-handle-file-attributes filename)) 0))))      (when (tramp-ange-ftp-file-name-p multi-method method)
1893          (tramp-invoke-ange-ftp 'file-regular-p filename))
1894        (and (tramp-handle-file-exists-p filename)
1895             (eq ?- (aref (nth 8 (tramp-handle-file-attributes filename)) 0)))))
1896    
1897  (defun tramp-handle-file-symlink-p (filename)  (defun tramp-handle-file-symlink-p (filename)
1898    "Like `file-symlink-p' for tramp files."    "Like `file-symlink-p' for tramp files."
1899    (let ((x (car (tramp-handle-file-attributes filename))))    (with-parsed-tramp-file-name filename nil
1900      (when (stringp x) x)))      (when (tramp-ange-ftp-file-name-p multi-method method)
1901          (tramp-invoke-ange-ftp 'file-symlink-p filename))
1902        (let ((x (car (tramp-handle-file-attributes filename))))
1903          (when (stringp x) x))))
1904    
1905  (defun tramp-handle-file-writable-p (filename)  (defun tramp-handle-file-writable-p (filename)
1906    "Like `file-writable-p' for tramp files."    "Like `file-writable-p' for tramp files."
1907    (if (tramp-handle-file-exists-p filename)    (with-parsed-tramp-file-name filename nil
1908        ;; Existing files must be writable.      (when (tramp-ange-ftp-file-name-p multi-method method)
1909        (zerop (tramp-run-test "-w" filename))        (tramp-invoke-ange-ftp 'file-writable-p filename))
1910      ;; If file doesn't exist, check if directory is writable.      (if (tramp-handle-file-exists-p filename)
1911      (and (zerop (tramp-run-test "-d" (tramp-handle-file-name-directory filename)))          ;; Existing files must be writable.
1912           (zerop (tramp-run-test "-w" (tramp-handle-file-name-directory filename))))))          (zerop (tramp-run-test "-w" filename))
1913          ;; If file doesn't exist, check if directory is writable.
1914          (and (zerop (tramp-run-test
1915                       "-d" (tramp-handle-file-name-directory filename)))
1916               (zerop (tramp-run-test
1917                       "-w" (tramp-handle-file-name-directory filename)))))))
1918    
1919  (defun tramp-handle-file-ownership-preserved-p (filename)  (defun tramp-handle-file-ownership-preserved-p (filename)
1920    "Like `file-ownership-preserved-p' for tramp files."    "Like `file-ownership-preserved-p' for tramp files."
1921    (or (not (tramp-handle-file-exists-p filename))    (with-parsed-tramp-file-name filename nil
1922        ;; Existing files must be writable.      (when (tramp-ange-ftp-file-name-p multi-method method)
1923        (zerop (tramp-run-test "-O" filename))))        (tramp-invoke-ange-ftp 'file-ownership-preserved-p filename))
1924        (or (not (tramp-handle-file-exists-p filename))
1925            ;; Existing files must be writable.
1926            (zerop (tramp-run-test "-O" filename)))))
1927    
1928  ;; Other file name ops.  ;; Other file name ops.
1929    
# Line 1863  if the remote host can't provide the mod Line 1938  if the remote host can't provide the mod
1938  ;; Philippe Troin <phil@fifi.org>  ;; Philippe Troin <phil@fifi.org>
1939  (defun tramp-handle-directory-file-name (directory)  (defun tramp-handle-directory-file-name (directory)
1940    "Like `directory-file-name' for tramp files."    "Like `directory-file-name' for tramp files."
1941    (let ((directory-length-1 (1- (length directory))))    (with-parsed-tramp-file-name directory nil
1942      (save-match-data      (when (tramp-ange-ftp-file-name-p multi-method method)
1943        (if (and (eq (aref directory directory-length-1) ?/)        (tramp-invoke-ange-ftp 'directory-file-name directory))
1944                 (eq (string-match tramp-file-name-regexp directory) 0)      (let ((directory-length-1 (1- (length directory))))
1945                 (/= (match-end 0) directory-length-1))        (save-match-data
1946            (substring directory 0 directory-length-1)          (if (and (eq (aref directory directory-length-1) ?/)
1947          directory))))                   (eq (string-match tramp-file-name-regexp directory) 0)
1948                     (/= (match-end 0) directory-length-1))
1949                (substring directory 0 directory-length-1)
1950              directory)))))
1951    
1952  ;; Directory listings.  ;; Directory listings.
1953    
1954  (defun tramp-handle-directory-files (directory &optional full match nosort)  (defun tramp-handle-directory-files (directory &optional full match nosort)
1955    "Like `directory-files' for tramp files."    "Like `directory-files' for tramp files."
1956    (let ((v (tramp-dissect-file-name (tramp-handle-expand-file-name directory)))    (with-parsed-tramp-file-name directory nil
1957          multi-method method user host path result x)      (when (tramp-ange-ftp-file-name-p multi-method method)
1958      (setq multi-method (tramp-file-name-multi-method v))        (tramp-invoke-ange-ftp 'directory-files
1959      (setq method (tramp-file-name-method v))                               directory full match nosort))
1960      (setq user (tramp-file-name-user v))      (let (result x)
     (setq host (tramp-file-name-host v))  
     (setq path (tramp-file-name-path v))  
     (save-excursion  
       (tramp-barf-unless-okay multi-method method user host  
                               (concat "cd " (tramp-shell-quote-argument path))  
                               nil  
                               'file-error  
                               "tramp-handle-directory-files: couldn't `cd %s'"  
                               (tramp-shell-quote-argument path))  
       (tramp-send-command  
        multi-method method user host  
        (concat (tramp-get-ls-command multi-method method user host)  
                " -a | cat"))  
       (tramp-wait-for-output)  
       (goto-char (point-max))  
       (while (zerop (forward-line -1))  
         (setq x (buffer-substring (point)  
                                   (tramp-line-end-position)))  
         (when (or (not match) (string-match match x))  
           (if full  
               (push (concat (file-name-as-directory directory)  
                             x)  
                     result)  
             (push x result))))  
       (tramp-send-command multi-method method user host "cd")  
       (tramp-wait-for-output))  
     result))  
   
 ;; This function should return "foo/" for directories and "bar" for  
 ;; files.  We use `ls -ad' to get a list of files (including  
 ;; directories), and `find . -type d \! -name . -prune' to get a list  
 ;; of directories.  
 (defun tramp-handle-file-name-all-completions (filename directory)  
   "Like `file-name-all-completions' for tramp files."  
   (unless (save-match-data (string-match "/" filename))  
     (let* ((v           (tramp-dissect-file-name directory))  
            (multi-method        (tramp-file-name-multi-method v))  
            (method      (tramp-file-name-method v))  
            (user                (tramp-file-name-user v))  
            (host                (tramp-file-name-host v))  
            (path                (tramp-file-name-path v))  
            (nowild        tramp-completion-without-shell-p)  
            result)  
1961        (save-excursion        (save-excursion
1962          (tramp-barf-unless-okay          (tramp-barf-unless-okay
1963           multi-method method user host           multi-method method user host
1964           (format "cd %s" (tramp-shell-quote-argument path))           (concat "cd " (tramp-shell-quote-argument path))
1965           nil 'file-error           nil
1966           "tramp-handle-file-name-all-completions: Couldn't `cd %s'"           'file-error
1967             "tramp-handle-directory-files: couldn't `cd %s'"
1968           (tramp-shell-quote-argument path))           (tramp-shell-quote-argument path))
   
         ;; Get a list of directories and files, including reliably  
         ;; tagging the directories with a trailing '/'.  Because I  
         ;; rock.  --daniel@danann.net  
1969          (tramp-send-command          (tramp-send-command
1970           multi-method method user host           multi-method method user host
1971           (format (concat "%s -a %s 2>/dev/null | while read f; do "           (concat (tramp-get-ls-command multi-method method user host)
1972                           "if test -d \"$f\" 2>/dev/null; "                   " -a | cat"))
                          "then echo \"$f/\"; else echo \"$f\"; fi; done")  
                  (tramp-get-ls-command multi-method method user host)  
                  (if (or nowild (zerop (length filename)))  
                      ""  
                    (format "-d %s*" (tramp-shell-quote-argument filename)))))  
   
         ;; Now grab the output.  
1973          (tramp-wait-for-output)          (tramp-wait-for-output)
1974          (goto-char (point-max))          (goto-char (point-max))
1975          (while (zerop (forward-line -1))          (while (zerop (forward-line -1))
1976            (push (buffer-substring (point)            (setq x (buffer-substring (point)
1977                                    (tramp-line-end-position))                                      (tramp-line-end-position)))
1978                  result))            (when (or (not match) (string-match match x))
1979                        (if full
1980                    (push (concat (file-name-as-directory directory)
1981                                  x)
1982                          result)
1983                  (push x result))))
1984          (tramp-send-command multi-method method user host "cd")          (tramp-send-command multi-method method user host "cd")
1985          (tramp-wait-for-output)          (tramp-wait-for-output))
1986          result)))
1987    
1988    ;; This function should return "foo/" for directories and "bar" for
1989    ;; files.  We use `ls -ad' to get a list of files (including
1990    ;; directories), and `find . -type d \! -name . -prune' to get a list
1991    ;; of directories.
1992    (defun tramp-handle-file-name-all-completions (filename directory)
1993      "Like `file-name-all-completions' for tramp files."
1994      (with-parsed-tramp-file-name directory nil
1995        (when (tramp-ange-ftp-file-name-p multi-method method)
1996          (tramp-invoke-ange-ftp 'file-name-all-completions
1997                                 filename directory))
1998        (unless (save-match-data (string-match "/" filename))
1999          (let* ((nowild tramp-completion-without-shell-p)
2000                 result)
2001            (save-excursion
2002              (tramp-barf-unless-okay
2003               multi-method method user host
2004               (format "cd %s" (tramp-shell-quote-argument path))
2005               nil 'file-error
2006               "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
2007               (tramp-shell-quote-argument path))
2008    
2009              ;; Get a list of directories and files, including reliably
2010              ;; tagging the directories with a trailing '/'.  Because I
2011              ;; rock.  --daniel@danann.net
2012              (tramp-send-command
2013               multi-method method user host
2014               (format (concat "%s -a %s 2>/dev/null | while read f; do "
2015                               "if test -d \"$f\" 2>/dev/null; "
2016                               "then echo \"$f/\"; else echo \"$f\"; fi; done")
2017                       (tramp-get-ls-command multi-method method user host)
2018                       (if (or nowild (zerop (length filename)))
2019                           ""
2020                         (format "-d %s*"
2021                                 (tramp-shell-quote-argument filename)))))
2022    
2023              ;; Now grab the output.
2024              (tramp-wait-for-output)
2025              (goto-char (point-max))
2026              (while (zerop (forward-line -1))
2027                (push (buffer-substring (point)
2028                                        (tramp-line-end-position))
2029                      result))
2030            
2031              (tramp-send-command multi-method method user host "cd")
2032              (tramp-wait-for-output)
2033    
2034          ;; Return the list.            ;; Return the list.
2035          (if nowild            (if nowild
2036              (all-completions filename (mapcar 'list result))                (all-completions filename (mapcar 'list result))
2037            result)))))              result))))))
2038    
2039    
2040  ;; The following isn't needed for Emacs 20 but for 19.34?  ;; The following isn't needed for Emacs 20 but for 19.34?
# Line 1968  if the remote host can't provide the mod Line 2044  if the remote host can't provide the mod
2044      (error      (error
2045       "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"       "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
2046       directory))       directory))
2047    ;(setq directory (tramp-handle-expand-file-name directory))    (with-parsed-tramp-file-name directory nil
2048    (try-completion      (when (tramp-ange-ftp-file-name-p multi-method method)
2049     filename        (tramp-invoke-ange-ftp 'file-name-completion
2050     (mapcar (lambda (x) (cons x nil))                               filename directory))
2051             (tramp-handle-file-name-all-completions filename directory))))      (try-completion
2052         filename
2053         (mapcar (lambda (x) (cons x nil))
2054                 (tramp-handle-file-name-all-completions filename directory)))))
2055    
2056  ;; cp, mv and ln  ;; cp, mv and ln
2057    
2058  (defun tramp-handle-add-name-to-file  (defun tramp-handle-add-name-to-file
2059    (filename newname &optional ok-if-already-exists)    (filename newname &optional ok-if-already-exists)
2060    "Like `add-name-to-file' for tramp files."    "Like `add-name-to-file' for tramp files."
2061    (let* ((v1 (when (tramp-tramp-file-p filename)    (with-parsed-tramp-file-name filename v1
2062                 (tramp-dissect-file-name (tramp-handle-expand-file-name filename))))      (with-parsed-tramp-file-name newname v2
2063           (v2 (when (tramp-tramp-file-p newname)        (let ((ln (when v1 (tramp-get-remote-ln
2064                 (tramp-dissect-file-name (tramp-handle-expand-file-name newname))))                            v1-multi-method v1-method v1-user v1-host))))
2065           (mmeth1 (when v1 (tramp-file-name-multi-method v1)))          (unless (and v1-method v2-method v1-user v2-user v1-host v2-host
2066           (mmeth2 (when v2 (tramp-file-name-multi-method v2)))                       (equal v1-multi-method v2-multi-method)
2067           (meth1  (when v1 (tramp-file-name-method v1)))                       (equal v1-method v2-method)
2068           (meth2  (when v2 (tramp-file-name-method v2)))                       (equal v1-user v2-user)
2069           (user1  (when v1 (tramp-file-name-user v1)))                       (equal v1-host v2-host))
2070           (user2  (when v2 (tramp-file-name-user v2)))            (error "add-name-to-file: %s"
2071           (host1  (when v1 (tramp-file-name-host v1)))                   "only implemented for same method, same user, same host"))
2072           (host2  (when v2 (tramp-file-name-host v2)))          (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
2073           (path1  (when v1 (tramp-file-name-path v1)))                     (tramp-ange-ftp-file-name-p v2-multi-method v2-method))
2074           (path2  (when v2 (tramp-file-name-path v2)))            (tramp-invoke-ange-ftp 'add-name-to-file
2075           (ln     (when v1 (tramp-get-remote-ln mmeth1 meth1 user1 host1))))                                   filename newname ok-if-already-exists))
2076      (unless (and meth1 meth2 user1 user2 host1 host2          (when (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
2077                   (equal mmeth1 mmeth2)            (tramp-invoke-ange-ftp 'add-name-to-file
2078                   (equal meth1 meth2)                                   filename newname ok-if-already-exists))
2079                   (equal user1 user2)          (when (tramp-ange-ftp-file-name-p v2-multi-method v2-method)
2080                   (equal host1 host2))            (tramp-invoke-ange-ftp 'add-name-to-file
2081        (error "add-name-to-file: %s"                                   filename newname ok-if-already-exists))
2082               "only implemented for same method, same user, same host"))          (when (and (not ok-if-already-exists)
2083      (when (and (not ok-if-already-exists)                     (file-exists-p newname)
2084                 (file-exists-p newname)                     (not (numberp ok-if-already-exists))
2085                 (not (numberp ok-if-already-exists))                     (y-or-n-p
2086                 (y-or-n-p                      (format
2087                  (format                       "File %s already exists; make it a new name anyway? "
2088                   "File %s already exists; make it a new name anyway? "                       newname)))
2089                   newname)))            (error "add-name-to-file: file %s already exists" newname))
2090        (error "add-name-to-file: file %s already exists" newname))          (tramp-barf-unless-okay
2091      (tramp-barf-unless-okay           v1-multi-method v1-method v1-user v1-host
2092       mmeth1 meth1 user1 host1           (format "%s %s %s" ln (tramp-shell-quote-argument v1-path)
2093       (format "%s %s %s" ln (tramp-shell-quote-argument path1)                   (tramp-shell-quote-argument v2-path))
2094               (tramp-shell-quote-argument path2))           nil 'file-error
2095       nil 'file-error           "error with add-name-to-file, see buffer `%s' for details"
2096       "error with add-name-to-file, see buffer `%s' for details"           (buffer-name))))))
      (buffer-name))))  
2097    
2098  (defun tramp-handle-copy-file  (defun tramp-handle-copy-file
2099    (filename newname &optional ok-if-already-exists keep-date)    (filename newname &optional ok-if-already-exists keep-date)
# Line 2067  and `rename'.  FILENAME and NEWNAME must Line 2145  and `rename'.  FILENAME and NEWNAME must
2145      (when (file-exists-p newname)      (when (file-exists-p newname)
2146        (signal 'file-already-exists        (signal 'file-already-exists
2147                (list newname))))                (list newname))))
2148    (let* ((v1 (when (tramp-tramp-file-p filename)    (with-parsed-tramp-file-name filename v1
2149                 (tramp-dissect-file-name (tramp-handle-expand-file-name filename))))      (with-parsed-tramp-file-name newname v2
2150           (v2 (when (tramp-tramp-file-p newname)        (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method)
2151                 (tramp-dissect-file-name (tramp-handle-expand-file-name newname))))                   (tramp-ange-ftp-file-name-p v2-multi-method v2-method))
2152           (mmeth1 (when v1 (tramp-file-name-multi-method v1)))          (tramp-invoke-ange-ftp
2153           (mmeth2 (when v2 (tramp-file-name-multi-method v2)))                                 (if (eq op 'copy) 'copy-file 'rename-file)
2154           (meth1 (when v1 (tramp-file-name-method v1)))                                 filename newname ok-if-already-exists keep-date))
2155           (meth2 (when v2 (tramp-file-name-method v2)))        (let* ((mmeth (tramp-file-name-multi-method (or v1 v2)))
2156           (mmeth (tramp-file-name-multi-method (or v1 v2)))               (meth (tramp-file-name-method (or v1 v2)))
2157           (meth (tramp-file-name-method (or v1 v2)))               (rcp-program (tramp-get-rcp-program mmeth meth))
2158           (rcp-program (tramp-get-rcp-program mmeth meth))               (rcp-args (tramp-get-rcp-args mmeth meth))
2159           (rcp-args (tramp-get-rcp-args mmeth meth))               (trampbuf (get-buffer-create "*tramp output*")))
2160           (trampbuf (get-buffer-create "*tramp output*")))          ;; Check if we can use a shortcut.
2161      ;; Check if we can use a shortcut.          (if (and v1-method v2-method
2162      (if (and meth1 meth2 (equal mmeth1 mmeth2) (equal meth1 meth2)                   (equal v1-multi-method v2-multi-method)
2163               (equal (tramp-file-name-host v1)                   (equal v1-method v2-method)
2164                      (tramp-file-name-host v2))                   (equal v1-host v2-host)
2165               (equal (tramp-file-name-user v1)                   (equal v1-user v2-user))
2166                      (tramp-file-name-user v2)))              ;; Shortcut: if method, host, user are the same for both
2167          ;; Shortcut: if method, host, user are the same for both              ;; files, we invoke `cp' or `mv' on the remote host directly.
2168          ;; files, we invoke `cp' or `mv' on the remote host directly.              (tramp-do-copy-or-rename-file-directly
2169          (tramp-do-copy-or-rename-file-directly               op
2170           op               v1-multi-method v1-method v1-user v1-host v1-path v2-path
2171           (tramp-file-name-multi-method v1)               keep-date)
2172           (tramp-file-name-method v1)            ;; New algorithm: copy file first.  Then, if operation is
2173           (tramp-file-name-user v1)            ;; `rename', go back and delete the original file if the copy
2174           (tramp-file-name-host v1)            ;; was successful.
2175           (tramp-file-name-path v1) (tramp-file-name-path v2)            (if rcp-program
2176           keep-date)                ;; The following code uses a tramp program to copy the file.
2177        ;; New algorithm: copy file first.  Then, if operation is                (let ((f1 (if (not v1)
2178        ;; `rename', go back and delete the original file if the copy                              filename
2179        ;; was successful.                            (tramp-make-rcp-program-file-name
2180        (if rcp-program                             v1-user v1-host
2181            ;; The following code uses a tramp program to copy the file.                             (tramp-shell-quote-argument v1-path))))
2182            (let ((f1 (if (not v1)                      (f2 (if (not v2)
2183                          filename                              newname
2184                        (tramp-make-rcp-program-file-name                            (tramp-make-rcp-program-file-name
2185                         (tramp-file-name-user v1)                             v2-user v2-host
2186                         (tramp-file-name-host v1)                             (tramp-shell-quote-argument v2-path))))
2187                         (tramp-shell-quote-argument (tramp-file-name-path v1)))))                      (default-directory
2188                  (f2 (if (not v2)                        (if (tramp-tramp-file-p default-directory)
2189                          newname                            (tramp-temporary-file-directory)
2190                        (tramp-make-rcp-program-file-name                          default-directory)))
2191                         (tramp-file-name-user v2)                  (when keep-date
2192                         (tramp-file-name-host v2)                    (add-to-list 'rcp-args
2193                         (tramp-shell-quote-argument (tramp-file-name-path v2)))))                                 (tramp-get-rcp-keep-date-arg mmeth meth)))
2194                  (default-directory                  (save-excursion (set-buffer trampbuf) (erase-buffer))
2195                    (if (tramp-tramp-file-p default-directory)                  (unless (equal 0 (apply #'call-process
2196                        (tramp-temporary-file-directory)                                          (tramp-get-rcp-program mmeth meth)
2197                      default-directory)))                                          nil trampbuf nil
2198              (when keep-date                                          (append rcp-args (list f1 f2))))
2199                (add-to-list 'rcp-args (tramp-get-rcp-keep-date-arg mmeth meth)))                    (pop-to-buffer trampbuf)
2200              (save-excursion (set-buffer trampbuf) (erase-buffer))                    (error (concat "tramp-do-copy-or-rename-file: %s"
2201              (unless                                   " didn't work, see buffer `%s' for details")
2202                  (equal 0 (apply #'call-process (tramp-get-rcp-program mmeth meth)                           (tramp-get-rcp-program mmeth meth) trampbuf)))
2203                                  nil trampbuf nil (append rcp-args (list f1 f2))))              ;; The following code uses an inline method for copying.
2204                (pop-to-buffer trampbuf)              ;; Let's start with a simple-minded approach: we create a new
2205                (error (concat "tramp-do-copy-or-rename-file: %s"              ;; buffer, insert the contents of the source file into it,
2206                               " didn't work, see buffer `%s' for details")              ;; then write out the buffer.  This should work fine, whether
2207                       (tramp-get-rcp-program mmeth meth) trampbuf)))              ;; the source or the target files are tramp files.
2208          ;; The following code uses an inline method for copying.              ;; CCC TODO: error checking
2209          ;; Let's start with a simple-minded approach: we create a new              (when keep-date
2210          ;; buffer, insert the contents of the source file into it,                (tramp-message
2211          ;; then write out the buffer.  This should work fine, whether                 1 (concat "Warning: cannot preserve file time stamp"
2212          ;; the source or the target files are tramp files.                           " with inline copying across machines")))
2213          ;; CCC TODO: error checking              (save-excursion
2214          (when keep-date                (set-buffer trampbuf) (erase-buffer)
2215            (tramp-message 1 (concat "Warning: cannot preserve file time stamp"                (insert-file-contents-literally filename)
2216                                   " with inline copying across machines")))                (let ((coding-system-for-write 'no-conversion))
2217          (save-excursion                  (write-region (point-min) (point-max) newname))))
2218            (set-buffer trampbuf) (erase-buffer)  
2219            (insert-file-contents-literally filename)            ;; If the operation was `rename', delete the original file.
2220            (let ((coding-system-for-write 'no-conversion))            (unless (eq op 'copy)
2221              (write-region (point-min) (point-max) newname))))              (delete-file filename)))))))
   
       ;; If the operation was `rename', delete the original file.  
       (unless (eq op 'copy)  
         (delete-file filename)))))  
2222    
2223  (defun tramp-do-copy-or-rename-file-directly  (defun tramp-do-copy-or-rename-file-directly
2224    (op multi-method method user host path1 path2 keep-date)    (op multi-method method user host path1 path2 keep-date)
# Line 2174  If KEEP-DATE is non-nil, preserve the ti Line 2248  If KEEP-DATE is non-nil, preserve the ti
2248  ;; mkdir  ;; mkdir
2249  (defun tramp-handle-make-directory (dir &optional parents)  (defun tramp-handle-make-directory (dir &optional parents)
2250    "Like `make-directory' for tramp files."    "Like `make-directory' for tramp files."
2251    (let ((v (tramp-dissect-file-name (tramp-handle-expand-file-name dir))))    (with-parsed-tramp-file-name dir nil
2252        (when (tramp-ange-ftp-file-name-p multi-method method)
2253          (tramp-invoke-ange-ftp 'make-directory dir parents))
2254      (tramp-barf-unless-okay      (tramp-barf-unless-okay
2255       (tramp-file-name-multi-method v) (tramp-file-name-method v)       multi-method method user host
      (tramp-file-name-user v) (tramp-file-name-host v)  
2256       (format " %s %s"       (format " %s %s"
2257               (if parents "mkdir -p" "mkdir")               (if parents "mkdir -p" "mkdir")
2258               (tramp-shell-quote-argument (tramp-file-name-path v)))               (tramp-shell-quote-argument path))
2259       nil 'file-error       nil 'file-error
2260       "Couldn't make directory %s" dir)))       "Couldn't make directory %s" dir)))
2261    
2262  ;; CCC error checking?  ;; CCC error checking?
2263  (defun tramp-handle-delete-directory (directory)  (defun tramp-handle-delete-directory (directory)
2264    "Like `delete-directory' for tramp files."    "Like `delete-directory' for tramp files."
2265    (let ((v (tramp-dissect-file-name (tramp-handle-expand-file-name directory))))    (with-parsed-tramp-file-name directory nil
2266        (when (tramp-ange-ftp-file-name-p multi-method method)
2267          (tramp-invoke-ange-ftp 'delete-directory directory))
2268      (save-excursion      (save-excursion
2269        (tramp-send-command        (tramp-send-command
2270         (tramp-file-name-multi-method v) (tramp-file-name-method v)         multi-method method user host
        (tramp-file-name-user v) (tramp-file-name-host v)  
2271         (format "rmdir %s ; echo ok"         (format "rmdir %s ; echo ok"
2272                 (tramp-shell-quote-argument (tramp-file-name-path v))))                 (tramp-shell-quote-argument path)))
2273        (tramp-wait-for-output))))        (tramp-wait-for-output))))
2274    
2275  (defun tramp-handle-delete-file (filename)  (defun tramp-handle-delete-file (filename)
2276    "Like `delete-file' for tramp files."    "Like `delete-file' for tramp files."
2277    (let ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename))))    (with-parsed-tramp-file-name filename nil
2278      (save-excursion      (with-tramp-calling-ange-ftp
2279        (unless (zerop (tramp-send-command-and-check          nil 'delete-file (list filename)
2280                        (tramp-file-name-multi-method v)        (save-excursion
2281                        (tramp-file-name-method v)          (unless (zerop (tramp-send-command-and-check
2282                        (tramp-file-name-user v)                          multi-method method user host
2283                        (tramp-file-name-host v)                          (format "rm -f %s"
2284                        (format "rm -f %s"                                  (tramp-shell-quote-argument path))))
2285                                (tramp-shell-quote-argument            (signal 'file-error "Couldn't delete Tramp file"))))))
                                (tramp-file-name-path v)))))  
         (signal 'file-error "Couldn't delete Tramp file")))))  
2286    
2287  ;; Dired.  ;; Dired.
2288    
# Line 2217  If KEEP-DATE is non-nil, preserve the ti Line 2291  If KEEP-DATE is non-nil, preserve the ti
2291  (defun tramp-handle-dired-recursive-delete-directory (filename)  (defun tramp-handle-dired-recursive-delete-directory (filename)
2292    "Recursively delete the directory given.    "Recursively delete the directory given.
2293  This is like `dired-recursive-delete-directory' for tramp files."  This is like `dired-recursive-delete-directory' for tramp files."
2294    (let* ((v      (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))    (with-parsed-tramp-file-name filename nil
2295           (multi-method (tramp-file-name-multi-method v))      (when (tramp-ange-ftp-file-name-p multi-method method)
2296           (method (tramp-file-name-method v))        (tramp-invoke-ange-ftp 'dired-recursive-delete-directory
2297           (user   (tramp-file-name-user v))                               filename))
          (host   (tramp-file-name-host v))  
          (path   (tramp-file-name-path v)))  
2298      ;; run a shell command 'rm -r <path>'      ;; run a shell command 'rm -r <path>'
2299      ;; Code shamelessly stolen for the dired implementation and, um, hacked :)      ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
2300      (or (tramp-handle-file-exists-p filename)      (or (tramp-handle-file-exists-p filename)
# Line 2231  This is like `dired-recursive-delete-dir Line 2303  This is like `dired-recursive-delete-dir
2303           (list "Removing old file name" "no such directory" filename)))           (list "Removing old file name" "no such directory" filename)))
2304      ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)      ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>)
2305      (tramp-send-command multi-method method user host      (tramp-send-command multi-method method user host
2306                        (format "rm -r %s" (tramp-shell-quote-argument path)))                          (format "rm -r %s" (tramp-shell-quote-argument path)))
2307      ;; Wait for the remote system to return to us...      ;; Wait for the remote system to return to us...
2308      ;; This might take a while, allow it plenty of time.      ;; This might take a while, allow it plenty of time.
2309      (tramp-wait-for-output 120)      (tramp-wait-for-output 120)
# Line 2242  This is like `dired-recursive-delete-dir Line 2314  This is like `dired-recursive-delete-dir
2314    
2315  (defun tramp-handle-dired-call-process (program discard &rest arguments)  (defun tramp-handle-dired-call-process (program discard &rest arguments)
2316    "Like `dired-call-process' for tramp files."    "Like `dired-call-process' for tramp files."
2317    (let ((v (tramp-dissect-file-name    (with-parsed-tramp-file-name default-directory nil
2318              (tramp-handle-expand-file-name default-directory)))      (when (tramp-ange-ftp-file-name-p multi-method method)
2319          multi-method method user host path)        (let ((default-directory
2320      (setq multi-method (tramp-file-name-multi-method v))                (tramp-make-ange-ftp-file-name user host path)))
2321      (setq method (tramp-file-name-method v))          (tramp-invoke-ange-ftp 'dired-call-process
2322      (setq user (tramp-file-name-user v))                                 program discard arguments)))
     (setq host (tramp-file-name-host v))  
     (setq path (tramp-file-name-path v))  
2323      (save-excursion      (save-excursion
2324        (tramp-barf-unless-okay        (tramp-barf-unless-okay
2325         multi-method method user host         multi-method method user host
# Line 2285  This is like `dired-recursive-delete-dir Line 2355  This is like `dired-recursive-delete-dir
2355  (defun tramp-handle-insert-directory  (defun tramp-handle-insert-directory
2356    (filename switches &optional wildcard full-directory-p)    (filename switches &optional wildcard full-directory-p)
2357    "Like `insert-directory' for tramp files."    "Like `insert-directory' for tramp files."
2358    (let ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))    (with-parsed-tramp-file-name filename nil
2359           multi-method method user host path)      (when (tramp-ange-ftp-file-name-p multi-method method)
2360      (setq multi-method (tramp-file-name-multi-method v))        (tramp-invoke-ange-ftp 'insert-directory
2361      (setq method (tramp-file-name-method v))                               filename switches wildcard full-directory-p))
     (setq user (tramp-file-name-user v))  
     (setq host (tramp-file-name-host v))  
     (setq path (tramp-file-name-path v))  
2362      (tramp-message-for-buffer      (tramp-message-for-buffer
2363       multi-method method user host 10       multi-method method user host 10
2364       "Inserting directory `ls %s %s', wildcard %s, fulldir %s"       "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
# Line 2310  This is like `dired-recursive-delete-dir Line 2377  This is like `dired-recursive-delete-dir
2377        ;; If `full-directory-p', we just say `ls -l FILENAME'.        ;; If `full-directory-p', we just say `ls -l FILENAME'.
2378        ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.        ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
2379        (if full-directory-p        (if full-directory-p
2380            (tramp-send-command            (tramp-send-command
2381             multi-method method user host             multi-method method user host
2382             (format "%s %s %s"             (format "%s %s %s"
2383                     (tramp-get-ls-command multi-method method user host)                     (tramp-get-ls-command multi-method method user host)
2384                     switches                     switches
2385                     (if wildcard                     (if wildcard
2386                         path                         path
2387                       (tramp-shell-quote-argument (concat path ".")))))                       (tramp-shell-quote-argument (concat path ".")))))
2388          (tramp-barf-unless-okay          (tramp-barf-unless-okay
2389           multi-method method user host           multi-method method user host
2390           (format "cd %s" (tramp-shell-quote-argument           (format "cd %s" (tramp-shell-quote-argument
2391                            (file-name-directory path)))                            (file-name-directory path)))
2392           nil 'file-error           nil 'file-error
2393           "Couldn't `cd %s'"           "Couldn't `cd %s'"
2394           (tramp-shell-quote-argument (file-name-directory path)))           (tramp-shell-quote-argument (file-name-directory path)))
2395          (tramp-send-command          (tramp-send-command
2396           multi-method method user host           multi-method method user host
2397           (format "%s %s %s"           (format "%s %s %s"
2398                   (tramp-get-ls-command multi-method method user host)                   (tramp-get-ls-command multi-method method user host)
2399                   switches                   switches
2400                   (if full-directory-p                   (if full-directory-p
2401                       ;; Add "/." to make sure we got complete dir                       ;; Add "/." to make sure we got complete dir
2402                       ;; listing for symlinks, too.                       ;; listing for symlinks, too.
2403                       (concat (file-name-as-directory                       (concat (file-name-as-directory
2404                                (file-name-nondirectory path)) ".")                                (file-name-nondirectory path)) ".")
2405                     (file-name-nondirectory path)))))                     (file-name-nondirectory path)))))
2406        (sit-for 1)                       ;needed for rsh but not ssh?        (sit-for 1)                       ;needed for rsh but not ssh?
2407        (tramp-wait-for-output))        (tramp-wait-for-output))
2408      (insert-buffer (tramp-get-buffer multi-method method user host))      (insert-buffer (tramp-get-buffer multi-method method user host))
2409      ;; On XEmacs, we want to call (exchange-point-and-mark t), but      ;; On XEmacs, we want to call (exchange-point-and-mark t), but
# Line 2351  This is like `dired-recursive-delete-dir Line 2418  This is like `dired-recursive-delete-dir
2418      ;; Another XEmacs specialty follows.  What's the right way to do      ;; Another XEmacs specialty follows.  What's the right way to do
2419      ;; it?      ;; it?
2420      (when (and (featurep 'xemacs)      (when (and (featurep 'xemacs)
2421                 (eq major-mode 'dired-mode))                 (eq major-mode 'dired-mode))
2422        (save-excursion        (save-excursion
2423          (require 'dired)          (require 'dired)
2424          (dired-insert-set-properties (point) (mark t))))))          (dired-insert-set-properties (point) (mark t))))))
2425    
2426  ;; Continuation of kluge to pacify byte-compiler.  ;; Continuation of kluge to pacify byte-compiler.
2427  ;;(eval-when-compile  ;;(eval-when-compile
# Line 2364  This is like `dired-recursive-delete-dir Line 2431  This is like `dired-recursive-delete-dir
2431  ;; CCC is this the right thing to do?  ;; CCC is this the right thing to do?
2432  (defun tramp-handle-unhandled-file-name-directory (filename)  (defun tramp-handle-unhandled-file-name-directory (filename)
2433    "Like `unhandled-file-name-directory' for tramp files."    "Like `unhandled-file-name-directory' for tramp files."
2434    (expand-file-name "~/"))    (with-parsed-tramp-file-name filename nil
2435        (when (tramp-ange-ftp-file-name-p multi-method method)
2436          (tramp-invoke-ange-ftp 'unhandled-file-name-directory
2437                                 filename))
2438        (expand-file-name "~/")))
2439    
2440  ;; Canonicalization of file names.  ;; Canonicalization of file names.
2441    
# Line 2396  Doesn't do anything if the NAME does not Line 2467  Doesn't do anything if the NAME does not
2467        (tramp-run-real-handler 'expand-file-name        (tramp-run-real-handler 'expand-file-name
2468                                (list name nil))                                (list name nil))
2469      ;; Dissect NAME.      ;; Dissect NAME.
2470      (let* ((v (tramp-dissect-file-name name))      (with-parsed-tramp-file-name name nil
2471             (multi-method (tramp-file-name-multi-method v))        (when (tramp-ange-ftp-file-name-p multi-method method)
2472             (method (tramp-file-name-method v))          (tramp-invoke-ange-ftp 'expand-file-name name nil))
            (user (tramp-file-name-user v))  
            (host (tramp-file-name-host v))  
            (path (tramp-file-name-path v)))  
2473        (unless (file-name-absolute-p path)        (unless (file-name-absolute-p path)
2474          (setq path (concat "~/" path)))          (setq path (concat "~/" path)))
2475        (save-excursion        (save-excursion
# Line 2441  Doesn't do anything if the NAME does not Line 2509  Doesn't do anything if the NAME does not
2509  This will break if COMMAND prints a newline, followed by the value of  This will break if COMMAND prints a newline, followed by the value of
2510  `tramp-end-of-output', followed by another newline."  `tramp-end-of-output', followed by another newline."
2511    (if (tramp-tramp-file-p default-directory)    (if (tramp-tramp-file-p default-directory)
2512        (let* ((v (tramp-dissect-file-name        (with-parsed-tramp-file-name default-directory nil
2513                   (tramp-handle-expand-file-name default-directory)))          (when (tramp-ange-ftp-file-name-p multi-method method)
2514               (multi-method (tramp-file-name-multi-method v))            (let ((default-directory (tramp-make-ange-ftp-file-name
2515               (method (tramp-file-name-method v))                                      user host path)))
2516               (user (tramp-file-name-user v))              (tramp-invoke-ange-ftp 'shell-command
2517               (host (tramp-file-name-host v))                                     command output-buffer error-buffer)))
2518               (path (tramp-file-name-path v))          (let (status)
2519               status)            (when (string-match "&[ \t]*\\'" command)
2520          (when (string-match "&[ \t]*\\'" command)              (error "Tramp doesn't grok asynchronous shell commands, yet"))
2521            (error "Tramp doesn't grok asynchronous shell commands, yet"))            (when error-buffer
2522          (when error-buffer              (error "Tramp doesn't grok optional third arg ERROR-BUFFER, yet"))
2523            (error "Tramp doesn't grok optional third arg ERROR-BUFFER, yet"))            (save-excursion
2524          (save-excursion              (tramp-barf-unless-okay
2525            (tramp-barf-unless-okay               multi-method method user host
2526             multi-method method user host               (format "cd %s" (tramp-shell-quote-argument path))
2527             (format "cd %s" (tramp-shell-quote-argument path))               nil 'file-error
2528             nil 'file-error               "tramp-handle-shell-command: Couldn't `cd %s'"
2529             "tramp-handle-shell-command: Couldn't `cd %s'"               (tramp-shell-quote-argument path))
2530             (tramp-shell-quote-argument path))              (tramp-send-command multi-method method user host
2531            (tramp-send-command multi-method method user host                                  (concat command "; tramp_old_status=$?"))
2532                                (concat command "; tramp_old_status=$?"))              ;; This will break if the shell command prints "/////"
2533            ;; This will break if the shell command prints "/////"              ;; somewhere.  Let's just hope for the best...
2534            ;; somewhere.  Let's just hope for the best...              (tramp-wait-for-output))
2535            (tramp-wait-for-output))            (unless output-buffer
2536          (unless output-buffer              (setq output-buffer (get-buffer-create "*Shell Command Output*"))
2537            (setq output-buffer (get-buffer-create "*Shell Command Output*"))              (set-buffer output-buffer)
2538            (set-buffer output-buffer)              (erase-buffer))
2539            (erase-buffer))            (unless (bufferp output-buffer)
2540          (unless (bufferp output-buffer)              (setq output-buffer (current-buffer)))
2541            (setq output-buffer (current-buffer)))            (set-buffer output-buffer)
2542          (set-buffer output-buffer)            (insert-buffer (tramp-get-buffer multi-method method user host))
2543          (insert-buffer (tramp-get-buffer multi-method method user host))            (save-excursion
2544          (save-excursion              (tramp-send-command multi-method method user host "cd")
2545            (tramp-send-command multi-method method user host "cd")              (tramp-wait-for-output)
2546            (tramp-wait-for-output)              (tramp-send-command
2547            (tramp-send-command               multi-method method user host
2548             multi-method method user host               (concat "tramp_set_exit_status $tramp_old_status;"
2549             "tramp_set_exit_status $tramp_old_status; echo tramp_exit_status $?")                       " echo tramp_exit_status $?"))
2550            (tramp-wait-for-output)              (tramp-wait-for-output)
2551            (goto-char (point-max))              (goto-char (point-max))
2552            (unless (search-backward "tramp_exit_status " nil t)              (unless (search-backward "tramp_exit_status " nil t)
2553              (error "Couldn't find exit status of `%s'" command))                (error "Couldn't find exit status of `%s'" command))
2554            (skip-chars-forward "^ ")              (skip-chars-forward "^ ")
2555            (setq status (read (current-buffer))))              (setq status (read (current-buffer))))
2556          (unless (zerop (buffer-size))            (unless (zerop (buffer-size))
2557            (pop-to-buffer output-buffer))              (pop-to-buffer output-buffer))
2558          status)            status)))
2559      ;; The following is only executed if something strange was    ;; The following is only executed if something strange was
2560      ;; happening.  Emit a helpful message and do it anyway.    ;; happening.  Emit a helpful message and do it anyway.
2561      (message "tramp-handle-shell-command called with non-tramp directory: `%s'"    (message "tramp-handle-shell-command called with non-tramp directory: `%s'"
2562               default-directory)             default-directory)
2563      (tramp-run-real-handler 'shell-command    (tramp-run-real-handler 'shell-command
2564                              (list command output-buffer error-buffer))))                            (list command output-buffer error-buffer)))
2565    
2566  ;; File Editing.  ;; File Editing.
2567    
# Line 2504  This will break if COMMAND prints a newl Line 2572  This will break if COMMAND prints a newl
2572    
2573  (defun tramp-handle-file-local-copy (filename)  (defun tramp-handle-file-local-copy (filename)
2574    "Like `file-local-copy' for tramp files."    "Like `file-local-copy' for tramp files."
2575    (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))    (with-parsed-tramp-file-name filename nil
2576           (multi-method (tramp-file-name-multi-method v))      (when (tramp-ange-ftp-file-name-p multi-method method)
2577           (method (tramp-file-name-method v))        (tramp-invoke-ange-ftp 'file-local-copy filename))
2578           (user (tramp-file-name-user v))      (let ((trampbuf (get-buffer-create "*tramp output*"))
2579           (host (tramp-file-name-host v))            tmpfil)
2580           (path (tramp-file-name-path v))        (unless (file-exists-p filename)
2581           (trampbuf (get-buffer-create "*tramp output*"))          (error "Cannot make local copy of non-existing file `%s'"
2582           tmpfil)                 filename))
2583      (unless (file-exists-p filename)        (setq tmpfil (tramp-make-temp-file))
2584        (error "Cannot make local copy of non-existing file `%s'"        (cond ((tramp-get-rcp-program multi-method method)
2585               filename))               ;; Use tramp-like program for file transfer.
2586      (setq tmpfil (tramp-make-temp-file))               (tramp-message-for-buffer
2587      (cond ((tramp-get-rcp-program multi-method method)                multi-method method user host
2588             ;; Use tramp-like program for file transfer.                5 "Fetching %s to tmp file %s..." filename tmpfil)
2589             (tramp-message-for-buffer               (save-excursion (set-buffer trampbuf) (erase-buffer))
2590              multi-method method user host               (unless (equal
2591              5 "Fetching %s to tmp file %s..." filename tmpfil)                        0
2592             (save-excursion (set-buffer trampbuf) (erase-buffer))                        (apply #'call-process
2593             (unless (equal 0                               (tramp-get-rcp-program multi-method method)
2594                            (apply #'call-process                               nil trampbuf nil
2595                                   (tramp-get-rcp-program multi-method method)                               (append (tramp-get-rcp-args multi-method method)
2596                                   nil trampbuf nil                                       (list
2597                                   (append (tramp-get-rcp-args multi-method method)                                        (tramp-make-rcp-program-file-name
2598                                           (list                                         user host
2599                                            (tramp-make-rcp-program-file-name                                         (tramp-shell-quote-argument path))
2600                                             user host                                        tmpfil))))
2601                                             (tramp-shell-quote-argument path))                 (pop-to-buffer trampbuf)
2602                                            tmpfil))))                 (error
2603               (pop-to-buffer trampbuf)                  (concat "tramp-handle-file-local-copy: `%s' didn't work, "
2604               (error (concat "tramp-handle-file-local-copy: `%s' didn't work, "                          "see buffer `%s' for details")
2605                              "see buffer `%s' for details")                  (tramp-get-rcp-program multi-method method) trampbuf))
2606                      (tramp-get-rcp-program multi-method method) trampbuf))               (tramp-message-for-buffer
2607             (tramp-message-for-buffer                multi-method method user host
2608              multi-method method user host                5 "Fetching %s to tmp file %s...done" filename tmpfil))
2609              5 "Fetching %s to tmp file %s...done" filename tmpfil))              ((and (tramp-get-encoding-command multi-method method)
           ((and (tramp-get-encoding-command multi-method method)  
                 (tramp-get-decoding-command multi-method method))  
            ;; Use inline encoding for file transfer.  
            (save-excursion  
              ;; Following line for setting tramp-current-method,  
              ;; tramp-current-user, tramp-current-host.  
              (set-buffer (tramp-get-buffer multi-method method user host))  
              (tramp-message 5 "Encoding remote file %s..." filename)  
              (tramp-barf-unless-okay  
               multi-method method user host  
               (concat (tramp-get-encoding-command multi-method method)  
                       " < " (tramp-shell-quote-argument path))  
               nil 'file-error  
               "Encoding remote file failed, see buffer `%s' for details"  
               (tramp-get-buffer multi-method method user host))  
              ;; Remove trailing status code  
              (goto-char (point-max))  
              (delete-region (point) (progn (forward-line -1) (point)))  
   
              (tramp-message 5 "Decoding remote file %s..." filename)  
              (if (and (tramp-get-decoding-function multi-method method)  
                       (fboundp (tramp-get-decoding-function multi-method method)))  
                  ;; If tramp-decoding-function is defined for this  
                  ;; method, we call it.  
                  (let ((tmpbuf (get-buffer-create " *tramp tmp*")))  
                    (set-buffer tmpbuf)  
                    (erase-buffer)  
                    (insert-buffer (tramp-get-buffer multi-method method  
                                                     user host))  
                    (tramp-message-for-buffer  
                     multi-method method user host  
                     6 "Decoding remote file %s with function %s..."  
                     filename  
                     (tramp-get-decoding-function multi-method method))  
                    (set-buffer tmpbuf)  
                    (let ((coding-system-for-write 'no-conversion))  
                      (funcall (tramp-get-decoding-function multi-method method)  
                               (point-min)  
                               (point-max))  
                      (write-region (point-min) (point-max) tmpfil))  
                    (kill-buffer tmpbuf))  
                ;; If tramp-decoding-function is not defined for this  
                ;; method, we invoke tramp-decoding-command instead.  
                (let ((tmpfil2 (tramp-make-temp-file)))  
                  (write-region (point-min) (point-max) tmpfil2)  
                  (tramp-message  
                   6 "Decoding remote file %s with command %s..."  
                   filename  
2610                    (tramp-get-decoding-command multi-method method))                    (tramp-get-decoding-command multi-method method))
2611                   (call-process               ;; Use inline encoding for file transfer.
2612                    tramp-sh-program               (save-excursion
2613                    tmpfil2               ;input                 ;; Following line for setting tramp-current-method,
2614                    nil                   ;output                 ;; tramp-current-user, tramp-current-host.
2615                    nil                   ;display                 (set-buffer (tramp-get-buffer multi-method method user host))
2616                    "-c" (concat (tramp-get-decoding-command multi-method method)                 (tramp-message 5 "Encoding remote file %s..." filename)
2617                                 " > " tmpfil))                 (tramp-barf-unless-okay
2618                   (delete-file tmpfil2)))                  multi-method method user host
2619               (tramp-message-for-buffer                  (concat (tramp-get-encoding-command multi-method method)
2620                multi-method method user host                          " < " (tramp-shell-quote-argument path))
2621                5 "Decoding remote file %s...done" filename)))                  nil 'file-error
2622                    "Encoding remote file failed, see buffer `%s' for details"
2623                    (tramp-get-buffer multi-method method user host))
2624                   ;; Remove trailing status code
2625                   (goto-char (point-max))
2626                   (delete-region (point) (progn (forward-line -1) (point)))
2627    
2628                   (tramp-message 5 "Decoding remote file %s..." filename)
2629                   (if (and (tramp-get-decoding-function multi-method method)
2630                            (fboundp (tramp-get-decoding-function
2631                                      multi-method method)))
2632                       ;; If tramp-decoding-function is defined for this
2633                       ;; method, we call it.
2634                       (let ((tmpbuf (get-buffer-create " *tramp tmp*")))
2635                         (set-buffer tmpbuf)
2636                         (erase-buffer)
2637                         (insert-buffer (tramp-get-buffer multi-method method
2638                                                          user host))
2639                         (tramp-message-for-buffer
2640                          multi-method method user host
2641                          6 "Decoding remote file %s with function %s..."
2642                          filename
2643                          (tramp-get-decoding-function multi-method method))
2644                         (set-buffer tmpbuf)
2645                         (let ((coding-system-for-write 'no-conversion))
2646                           (funcall (tramp-get-decoding-function
2647                                     multi-method method)
2648                                    (point-min)
2649                                    (point-max))
2650                           (write-region (point-min) (point-max) tmpfil))
2651                         (kill-buffer tmpbuf))
2652                     ;; If tramp-decoding-function is not defined for this
2653                     ;; method, we invoke tramp-decoding-command instead.
2654                     (let ((tmpfil2 (tramp-make-temp-file)))
2655                       (write-region (point-min) (point-max) tmpfil2)
2656                       (tramp-message
2657                        6 "Decoding remote file %s with command %s..."
2658                        filename
2659                        (tramp-get-decoding-command multi-method method))
2660                       (call-process
2661                        tramp-sh-program
2662                        tmpfil2             ;input
2663                        nil                 ;output
2664                        nil                 ;display
2665                        "-c" (concat (tramp-get-decoding-command
2666                                      multi-method method)
2667                                     " > " tmpfil))
2668                       (delete-file tmpfil2)))
2669                   (tramp-message-for-buffer
2670                    multi-method method user host
2671                    5 "Decoding remote file %s...done" filename)))
2672    
2673            (t (error "Wrong method specification for `%s'" method)))              (t (error "Wrong method specification for `%s'" method)))
2674      tmpfil))        tmpfil)))
2675    
2676    
2677  (defun tramp-handle-insert-file-contents  (defun tramp-handle-insert-file-contents
# Line 2609  This will break if COMMAND prints a newl Line 2679  This will break if COMMAND prints a newl
2679    "Like `insert-file-contents' for tramp files."    "Like `insert-file-contents' for tramp files."
2680    (barf-if-buffer-read-only)    (barf-if-buffer-read-only)
2681    (setq filename (expand-file-name filename))    (setq filename (expand-file-name filename))
2682    (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name filename)))    (with-parsed-tramp-file-name filename nil
2683           (multi-method (tramp-file-name-multi-method v))      (when (tramp-ange-ftp-file-name-p multi-method method)
2684           (method (tramp-file-name-method v))        (tramp-invoke-ange-ftp 'insert-file-contents
2685           (user (tramp-file-name-user v))                               filename visit beg end replace))
          (host (tramp-file-name-host v))  
          (path (tramp-file-name-path v)))  
2686      (if (not (tramp-handle-file-exists-p filename))      (if (not (tramp-handle-file-exists-p filename))
2687          (progn          (progn
2688            (when visit            (when visit
# Line 2654  This will break if COMMAND prints a newl Line 2722  This will break if COMMAND prints a newl
2722    (unless (eq append nil)    (unless (eq append nil)
2723      (error "Cannot append to file using tramp (`%s')" filename))      (error "Cannot append to file using tramp (`%s')" filename))
2724    (setq filename (expand-file-name filename))    (setq filename (expand-file-name filename))
2725  ;; Following part commented out because we don't know what to do about    ;; Following part commented out because we don't know what to do about
2726  ;; file locking, and it does not appear to be a problem to ignore it.    ;; file locking, and it does not appear to be a problem to ignore it.
2727  ;; Ange-ftp ignores it, too.    ;; Ange-ftp ignores it, too.
2728  ;  (when (and lockname (stringp lockname))    ;;  (when (and lockname (stringp lockname))
2729  ;    (setq lockname (expand-file-name lockname)))    ;;    (setq lockname (expand-file-name lockname)))
2730  ;  (unless (or (eq lockname nil)    ;;  (unless (or (eq lockname nil)
2731  ;              (string= lockname filename))    ;;              (string= lockname filename))
2732  ;    (error "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))    ;;    (error
2733      ;;     "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
2734    ;; XEmacs takes a coding system as the sevent argument, not `confirm'    ;; XEmacs takes a coding system as the sevent argument, not `confirm'
2735    (when (and (not (featurep 'xemacs))    (when (and (not (featurep 'xemacs))
2736                    confirm (file-exists-p filename))               confirm (file-exists-p filename))
2737      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
2738                                filename))                                filename))
2739        (error "File not overwritten")))        (error "File not overwritten")))
2740    (let* ((curbuf (current-buffer))    (with-parsed-tramp-file-name filename nil
2741           (v (tramp-dissect-file-name filename))      (when (tramp-ange-ftp-file-name-p multi-method method)
2742           (multi-method (tramp-file-name-multi-method v))        (tramp-invoke-ange-ftp 'write-region
2743           (method (tramp-file-name-method v))                               start end filename append visit lockname confirm))
2744           (user (tramp-file-name-user v))      (let ((curbuf (current-buffer))
2745           (host (tramp-file-name-host v))            (rcp-program (tramp-get-rcp-program multi-method method))
2746           (path (tramp-file-name-path v))            (rcp-args (tramp-get-rcp-args multi-method method))
2747           (rcp-program (tramp-get-rcp-program multi-method method))            (encoding-command (tramp-get-encoding-command multi-method  method))
2748           (rcp-args (tramp-get-rcp-args multi-method method))            (encoding-function
2749           (encoding-command (tramp-get-encoding-command multi-method  method))             (tramp-get-encoding-function multi-method method))
2750           (encoding-function (tramp-get-encoding-function multi-method method))            (decoding-command (tramp-get-decoding-command multi-method method))
2751           (decoding-command (tramp-get-decoding-command multi-method method))            (trampbuf (get-buffer-create "*tramp output*"))
2752           (trampbuf (get-buffer-create "*tramp output*"))            ;; We use this to save the value of `last-coding-system-used'
2753           ;; We use this to save the value of `last-coding-system-used'            ;; after writing the tmp file.  At the end of the function,
2754           ;; after writing the tmp file.  At the end of the function,            ;; we set `last-coding-system-used' to this saved value.
2755           ;; we set `last-coding-system-used' to this saved value.            ;; This way, any intermediary coding systems used while
2756           ;; This way, any intermediary coding systems used while            ;; talking to the remote shell or suchlike won't hose this
2757           ;; talking to the remote shell or suchlike won't hose this            ;; variable.  This approach was snarfed from ange-ftp.el.
2758           ;; variable.  This approach was snarfed from ange-ftp.el.            coding-system-used
2759           coding-system-used            tmpfil)
2760           tmpfil)        ;; Write region into a tmp file.  This isn't really needed if we
2761      ;; Write region into a tmp file.  This isn't really needed if we        ;; use an encoding function, but currently we use it always
2762      ;; use an encoding function, but currently we use it always        ;; because this makes the logic simpler.
2763      ;; because this makes the logic simpler.        (setq tmpfil (tramp-make-temp-file))
2764      (setq tmpfil (tramp-make-temp-file))        ;; We say `no-message' here because we don't want the visited file
2765      ;; We say `no-message' here because we don't want the visited file        ;; modtime data to be clobbered from the temp file.  We call
2766      ;; modtime data to be clobbered from the temp file.  We call        ;; `set-visited-file-modtime' ourselves later on.
2767      ;; `set-visited-file-modtime' ourselves later on.        (tramp-run-real-handler
2768      (tramp-run-real-handler         'write-region
2769       'write-region         (if confirm ; don't pass this arg unless defined for backward compat.
2770       (if confirm ; don't pass this arg unless defined for backward compat.             (list start end tmpfil append 'no-message lockname confirm)
2771           (list start end tmpfil append 'no-message lockname confirm)           (list start end tmpfil append 'no-message lockname)))
2772         (list start end tmpfil append 'no-message lockname)))        ;; Now, `last-coding-system-used' has the right value.  Remember it.
2773      ;; Now, `last-coding-system-used' has the right value.  Remember it.        (when (boundp 'last-coding-system-used)
2774      (when (boundp 'last-coding-system-used)          (setq coding-system-used last-coding-system-used))
2775        (setq coding-system-used last-coding-system-used))        ;; This is a bit lengthy due to the different methods possible for
2776      ;; This is a bit lengthy due to the different methods possible for        ;; file transfer.  First, we check whether the method uses an rcp
2777      ;; file transfer.  First, we check whether the method uses an rcp        ;; program.  If so, we call it.  Otherwise, both encoding and
2778      ;; program.  If so, we call it.  Otherwise, both encoding and        ;; decoding command must be specified.  However, if the method
2779      ;; decoding command must be specified.  However, if the method        ;; _also_ specifies an encoding function, then that is used for
2780      ;; _also_ specifies an encoding function, then that is used for        ;; encoding the contents of the tmp file.
2781      ;; encoding the contents of the tmp file.        (cond (rcp-program
2782      (cond (rcp-program               ;; use rcp-like program for file transfer
2783             ;; use rcp-like program for file transfer               (let ((argl (append rcp-args
2784             (let ((argl (append rcp-args                                   (list
2785                                 (list                                    tmpfil
2786                                  tmpfil                                    (tramp-make-rcp-program-file-name
2787                                  (tramp-make-rcp-program-file-name                                     user host
2788                                   user host                                     (tramp-shell-quote-argument path))))))
2789                                   (tramp-shell-quote-argument path))))))                 (tramp-message-for-buffer
2790               (tramp-message-for-buffer                  multi-method method user host
2791                multi-method method user host                  6 "Writing tmp file using `%s'..." rcp-program)
2792                6 "Writing tmp file using `%s'..." rcp-program)                 (save-excursion (set-buffer trampbuf) (erase-buffer))
2793               (save-excursion (set-buffer trampbuf) (erase-buffer))                 (when tramp-debug-buffer
2794               (when tramp-debug-buffer                   (save-excursion
2795                 (save-excursion                     (set-buffer (tramp-get-debug-buffer multi-method
2796                   (set-buffer (tramp-get-debug-buffer multi-method                                                         method user host))
2797                                                     method user host))                     (goto-char (point-max))
2798                   (goto-char (point-max))                     (tramp-insert-with-face
2799                   (tramp-insert-with-face                      'bold (format "$ %s %s\n" rcp-program
2800                    'bold (format "$ %s %s\n" rcp-program                                    (mapconcat 'identity argl " ")))))
2801                                  (mapconcat 'identity argl " ")))))                 (unless (equal 0
2802               (unless (equal 0                                (apply #'call-process
2803                              (apply #'call-process                                       rcp-program nil trampbuf nil argl))
2804                                     rcp-program nil trampbuf nil argl))                   (pop-to-buffer trampbuf)
2805                 (pop-to-buffer trampbuf)                   (error
2806                 (error "Cannot write region to file `%s', command `%s' failed"                    "Cannot write region to file `%s', command `%s' failed"
2807                        filename rcp-program))                    filename rcp-program))
2808               (tramp-message-for-buffer multi-method method user host                 (tramp-message-for-buffer
2809                                       6 "Transferring file using `%s'...done"                  multi-method method user host
2810                                       rcp-program)))                  6 "Transferring file using `%s'...done"
2811            ((and encoding-command decoding-command)                  rcp-program)))
2812             ;; Use inline file transfer              ((and encoding-command decoding-command)
2813             (let ((tmpbuf (get-buffer-create " *tramp file transfer*")))               ;; Use inline file transfer
2814               (save-excursion               (let ((tmpbuf (get-buffer-create " *tramp file transfer*")))
2815                 ;; Encode tmpfil into tmpbuf                 (save-excursion
2816                 (tramp-message-for-buffer multi-method method user host                   ;; Encode tmpfil into tmpbuf
2817                                         5 "Encoding region...")                   (tramp-message-for-buffer multi-method method user host
2818                 (set-buffer tmpbuf)                                             5 "Encoding region...")
2819                 (erase-buffer)                   (set-buffer tmpbuf)
2820                 ;; Use encoding function or command.                   (erase-buffer)
2821                 (if (and encoding-function                   ;; Use encoding function or command.
2822                          (fboundp encoding-function))                   (if (and encoding-function
2823                     (progn                            (fboundp encoding-function))
2824                       (tramp-message-for-buffer                       (progn
2825                        multi-method method user host                         (tramp-message-for-buffer
2826                        6 "Encoding region using function...")                          multi-method method user host
2827                       (insert-file-contents-literally tmpfil)                          6 "Encoding region using function...")
2828                       ;; CCC.  The following `let' is a workaround for                         (insert-file-contents-literally tmpfil)
2829                       ;; the base64.el that comes with pgnus-0.84.  If                         ;; CCC.  The following `let' is a workaround for
2830                       ;; both of the following conditions are                         ;; the base64.el that comes with pgnus-0.84.  If
2831                       ;; satisfied, it tries to write to a local file                         ;; both of the following conditions are
2832                       ;; in default-directory, but at this point,                         ;; satisfied, it tries to write to a local file
2833                       ;; default-directory is remote.                         ;; in default-directory, but at this point,
2834                       ;; (CALL-PROCESS-REGION can't write to remote                         ;; default-directory is remote.
2835                       ;; files, it seems.)  The file in question is a                         ;; (CALL-PROCESS-REGION can't write to remote
2836                       ;; tmp file anyway.                         ;; files, it seems.)  The file in question is a
2837                       (let ((default-directory (tramp-temporary-file-directory)))                         ;; tmp file anyway.
2838                         (funcall encoding-function (point-min) (point-max)))                         (let ((default-directory
2839                       (goto-char (point-max))                                 (tramp-temporary-file-directory)))
2840                       (unless (bolp)                           (funcall encoding-function (point-min) (point-max)))
2841                         (newline)))                         (goto-char (point-max))
2842                   (tramp-message-for-buffer multi-method method user host                         (unless (bolp)
2843                                           6 "Encoding region using command...")                           (newline)))
2844                   (unless (equal 0                     (tramp-message-for-buffer
2845                                  (call-process                      multi-method method user host
2846                                   tramp-sh-program                      6 "Encoding region using command...")
2847                                   tmpfil ;input = local tmp file                     (unless (equal 0
2848                                   t      ;output is current buffer                                    (call-process
2849                                   nil    ;don't redisplay                                     tramp-sh-program
2850                                   "-c"                                     tmpfil ;input = local tmp file
2851                                   encoding-command))                                     t    ;output is current buffer
2852                     (pop-to-buffer trampbuf)                                     nil  ;don't redisplay
2853                     (error (concat "Cannot write to `%s', local encoding"                                     "-c"
2854                                    " command `%s' failed")                                     encoding-command))
2855                            filename encoding-command)))                       (pop-to-buffer trampbuf)
2856                 ;; Send tmpbuf into remote decoding command which                       (error (concat "Cannot write to `%s', local encoding"
2857                 ;; writes to remote file.  Because this happens on the                                      " command `%s' failed")
2858                 ;; remote host, we cannot use the function.                              filename encoding-command)))
2859                 (tramp-message-for-buffer                   ;; Send tmpbuf into remote decoding command which
2860                  multi-method method user host                   ;; writes to remote file.  Because this happens on the
2861                  5 "Decoding region into remote file %s..." filename)                   ;; remote host, we cannot use the function.
2862                 (tramp-send-command                   (tramp-message-for-buffer
2863                  multi-method method user host                    multi-method method user host
2864                  (format "%s >%s <<'EOF'"                    5 "Decoding region into remote file %s..." filename)
2865                          decoding-command                   (tramp-send-command
2866                          (tramp-shell-quote-argument path)))                    multi-method method user host
2867                 (set-buffer tmpbuf)                    (format "%s >%s <<'EOF'"
2868                 (tramp-message-for-buffer                            decoding-command
2869                  multi-method method user host                            (tramp-shell-quote-argument path)))
2870                  6 "Sending data to remote host...")                   (set-buffer tmpbuf)
2871                 (tramp-send-region multi-method method user host                   (tramp-message-for-buffer
2872                                  (point-min) (point-max))                    multi-method method user host
2873                 ;; wait for remote decoding to complete                    6 "Sending data to remote host...")
2874                 (tramp-message-for-buffer                   (tramp-send-region multi-method method user host
2875                  multi-method method user host 6 "Sending end of data token...")                                      (point-min) (point-max))
2876                 (tramp-send-command                   ;; wait for remote decoding to complete
2877                  multi-method method user host "EOF")                   (tramp-message-for-buffer
2878                 (tramp-message-for-buffer                    multi-method method user host
2879                  multi-method method user host 6                    6 "Sending end of data token...")
2880                  "Waiting for remote host to process data...")                   (tramp-send-command
2881                 (set-buffer (tramp-get-buffer multi-method method user host))                    multi-method method user host "EOF")
2882                 (tramp-wait-for-output)                   (tramp-message-for-buffer
2883                 (tramp-barf-unless-okay                    multi-method method user host 6
2884                  multi-method method user host nil nil 'file-error                    "Waiting for remote host to process data...")
2885                  (concat "Couldn't write region to `%s',"                   (set-buffer (tramp-get-buffer multi-method method user host))
2886                          " decode using `%s' failed")                   (tramp-wait-for-output)
2887                  filename decoding-command)                   (tramp-barf-unless-okay
2888                 (tramp-message 5 "Decoding region into remote file %s...done"                    multi-method method user host nil nil 'file-error
2889                              filename)                    (concat "Couldn't write region to `%s',"
2890                 (kill-buffer tmpbuf))))                            " decode using `%s' failed")
2891            (t                    filename decoding-command)
2892             (error                   (tramp-message 5 "Decoding region into remote file %s...done"
2893              (concat "Method `%s' should specify both encoding and "                                  filename)
2894                      "decoding command or an rcp program")                   (kill-buffer tmpbuf))))
2895              method)))              (t
2896      (delete-file tmpfil)               (error
2897      (unless (equal curbuf (current-buffer))                (concat "Method `%s' should specify both encoding and "
2898        (error "Buffer has changed from `%s' to `%s'"                        "decoding command or an rcp program")
2899               curbuf (current-buffer)))                method)))
2900      (when (eq visit t)        (delete-file tmpfil)
2901        (set-visited-file-modtime))        (unless (equal curbuf (current-buffer))
2902      ;; Make `last-coding-system-used' have the right value.          (error "Buffer has changed from `%s' to `%s'"
2903      (when (boundp 'last-coding-system-used)                 curbuf (current-buffer)))
2904        (setq last-coding-system-used coding-system-used))        (when (eq visit t)
2905      (when (or (eq visit t)          (set-visited-file-modtime))
2906                (eq visit nil)        ;; Make `last-coding-system-used' have the right value.
2907                (stringp visit))        (when (boundp 'last-coding-system-used)
2908        (message "Wrote %s" filename))))          (setq last-coding-system-used coding-system-used))
2909          (when (or (eq visit t)
2910                    (eq visit nil)
2911                    (stringp visit))
2912            (message "Wrote %s" filename)))))
2913    
2914  ;; Call down to the real handler.  ;; Call down to the real handler.
2915  ;; Because EFS does not play nicely with TRAMP (both systems match an  ;; Because EFS does not play nicely with TRAMP (both systems match an
# Line 2871  This will break if COMMAND prints a newl Line 2944  This will break if COMMAND prints a newl
2944    
2945  (defun tramp-run-real-handler (operation args)  (defun tramp-run-real-handler (operation args)
2946    "Invoke normal file name handler for OPERATION.    "Invoke normal file name handler for OPERATION.
2947  First arg specifies the OPERATION, remaining ARGS are passed to the  First arg specifies the OPERATION, second arg is a list of arguments to
2948  OPERATION."  pass to the OPERATION."
2949    (let ((inhibit-file-name-handlers    (let ((inhibit-file-name-handlers
2950           (list 'tramp-file-name-handler           (list 'tramp-file-name-handler
2951                 (and (eq inhibit-file-name-operation operation)                 (and (eq inhibit-file-name-operation operation)
# Line 2880  OPERATION." Line 2953  OPERATION."
2953          (inhibit-file-name-operation operation))          (inhibit-file-name-operation operation))
2954      (apply operation args)))      (apply operation args)))
2955    
   
2956  ;; Main function.  ;; Main function.
2957  ;;;###autoload  ;;;###autoload
2958  (defun tramp-file-name-handler (operation &rest args)  (defun tramp-file-name-handler (operation &rest args)
2959    "Invoke tramp file name handler.    "Invoke tramp file name handler.
2960  Falls back to normal file name handler if no tramp file name handler exists."  Falls back to normal file name handler if no tramp file name handler exists."
2961    (let ((fn (assoc operation tramp-file-name-handler-alist)))    (let ((fn (assoc operation tramp-file-name-handler-alist)))
     ;(message "Handling %s using %s" operation fn)  
2962      (if fn      (if fn
2963          (save-match-data          (catch 'tramp-forward-to-ange-ftp
2964            (apply (cdr fn) args))            (save-match-data (apply (cdr fn) args)))
2965        (tramp-run-real-handler operation args))))        (tramp-run-real-handler operation args))))
2966    
2967  ;; Register in file name handler alist  ;; Register in file name handler alist
# Line 2906  Falls back to normal file name handler i Line 2977  Falls back to normal file name handler i
2977      (setq file-name-handler-alist      (setq file-name-handler-alist
2978            (cons jka (delete jka file-name-handler-alist)))))            (cons jka (delete jka file-name-handler-alist)))))
2979    
2980    (defun tramp-invoke-ange-ftp (operation &rest args)
2981      "Invoke the Ange-FTP handler function and throw."
2982      (let ((ange-ftp-name-format
2983             (list (nth 0 tramp-file-name-structure)
2984                   (nth 3 tramp-file-name-structure)
2985                   (nth 2 tramp-file-name-structure)
2986                   (nth 4 tramp-file-name-structure))))
2987        (throw 'tramp-forward-to-ange-ftp
2988               (apply 'ange-ftp-hook-function operation args))))
2989    
2990    (defun tramp-ange-ftp-file-name-p (multi-method method)
2991      "Check if it's a filename that should be forwarded to Ange-FTP."
2992      (and (null multi-method) (string= method tramp-ftp-method)))
2993    
2994    
2995  ;;; Interactions with other packages:  ;;; Interactions with other packages:
2996    
2997  ;; -- complete.el --  ;; -- complete.el --
# Line 2913  Falls back to normal file name handler i Line 2999  Falls back to normal file name handler i
2999  ;; This function contributed by Ed Sabol  ;; This function contributed by Ed Sabol
3000  (defun tramp-handle-expand-many-files (name)  (defun tramp-handle-expand-many-files (name)
3001    "Like `PC-expand-many-files' for tramp files."    "Like `PC-expand-many-files' for tramp files."
3002    (save-match-data    (with-parsed-tramp-file-name name nil
3003      (if (or (string-match "\\*" name)      (when (tramp-ange-ftp-file-name-p multi-method method)
3004              (string-match "\\?" name)        (tramp-invoke-ange-ftp 'expand-many-files name))
3005              (string-match "\\[.*\\]" name))      (save-match-data
3006          (save-excursion        (if (or (string-match "\\*" name)
3007            ;; Dissect NAME.                (string-match "\\?" name)
3008            (let* ((v (tramp-dissect-file-name name))                (string-match "\\[.*\\]" name))
3009                   (multi-method (tramp-file-name-multi-method v))            (save-excursion
3010                   (method (tramp-file-name-method v))              ;; Dissect NAME.
3011                   (user (tramp-file-name-user v))              (let (bufstr)
3012                   (host (tramp-file-name-host v))                ;; Perhaps invoke Ange-FTP.
3013                   (path (tramp-file-name-path v))                (when (string= method tramp-ftp-method)
3014                   bufstr)                  (signal 'tramp-run-ange-ftp (list 0)))
3015              ;; CCC: To do it right, we should quote certain characters                ;; CCC: To do it right, we should quote certain characters
3016              ;; in the file name, but since the echo command is going to                ;; in the file name, but since the echo command is going to
3017              ;; break anyway when there are spaces in the file names, we                ;; break anyway when there are spaces in the file names, we
3018              ;; don't bother.                ;; don't bother.
3019              ;;-(let ((comint-file-name-quote-list                ;;-(let ((comint-file-name-quote-list
3020              ;;-       (set-difference tramp-file-name-quote-list                ;;-       (set-difference tramp-file-name-quote-list
3021              ;;-                       '(?\* ?\? ?[ ?]))))                ;;-                       '(?\* ?\? ?[ ?]))))
3022              ;;-  (tramp-send-command                ;;-  (tramp-send-command
3023              ;;-   multi-method method user host                ;;-   multi-method method user host
3024              ;;-   (format "echo %s" (comint-quote-filename path)))                ;;-   (format "echo %s" (comint-quote-filename path)))
3025              ;;-  (tramp-wait-for-output))                ;;-  (tramp-wait-for-output))
3026              (tramp-send-command multi-method method user host                (tramp-send-command multi-method method user host
3027                                (format "echo %s" path))                                    (format "echo %s" path))
3028              (tramp-wait-for-output)                (tramp-wait-for-output)
3029              (setq bufstr (buffer-substring (point-min)                (setq bufstr (buffer-substring (point-min)
3030                                             (tramp-line-end-position)))                                               (tramp-line-end-position)))
3031              (goto-char (point-min))                (goto-char (point-min))
3032              (if (string-equal path bufstr)                (if (string-equal path bufstr)
3033                  nil                    nil
3034                (insert "(\"")                  (insert "(\"")
3035                (while (search-forward " " nil t)                  (while (search-forward " " nil t)
3036                  (delete-backward-char 1)                    (delete-backward-char 1)
3037                  (insert "\" \""))                    (insert "\" \""))
3038                (goto-char (point-max))                  (goto-char (point-max))
3039                (delete-backward-char 1)                  (delete-backward-char 1)
3040                (insert "\")")                  (insert "\")")
3041                (goto-char (point-min))                  (goto-char (point-min))
3042                (mapcar                  (mapcar
3043                 (function (lambda (x)                   (function (lambda (x)
3044                             (tramp-make-tramp-file-name multi-method method                               (tramp-make-tramp-file-name multi-method method
3045                                                     user host x)))                                                           user host x)))
3046                 (read (current-buffer))))))                   (read (current-buffer))))))
3047        (list (tramp-handle-expand-file-name name)))))          (list (tramp-handle-expand-file-name name))))))
3048    
3049  ;; Check for complete.el and override PC-expand-many-files if appropriate.  ;; Check for complete.el and override PC-expand-many-files if appropriate.
3050  (eval-when-compile  (eval-when-compile
# Line 3202  file exists and nonzero exit status othe Line 3288  file exists and nonzero exit status othe
3288       ((string-match "^~root$" (buffer-string))       ((string-match "^~root$" (buffer-string))
3289        (setq shell        (setq shell
3290              (or (tramp-find-executable multi-method method user host              (or (tramp-find-executable multi-method method user host
3291                                       "bash"  tramp-remote-path t)                                         "bash"  tramp-remote-path t)
3292                  (tramp-find-executable multi-method method user host                  (tramp-find-executable multi-method method user host
3293                                       "ksh" tramp-remote-path t)))                                         "ksh" tramp-remote-path t)))
3294        (unless shell        (unless shell
3295          (error "Couldn't find a shell which groks tilde expansion"))          (error "Couldn't find a shell which groks tilde expansion"))
3296        ;; Hack: avoid reading of ~/.bashrc.  What we should do is have an        ;; Find arguments for this shell.
3297        ;; alist for extra args to give to each shell...        (let ((alist tramp-sh-extra-args)
3298        (when (string-match "/bash\\'" shell)              item extra-args)
3299          (setq shell (concat shell " --norc")))          (while (and alist (null extra-args))
3300              (setq item (pop alist))
3301              (when (string-match (car item) shell)
3302                (setq extra-args (cdr item))))
3303            (when extra-args (setq shell (concat shell " " extra-args))))
3304        (tramp-message        (tramp-message
3305         5 "Starting remote shell `%s' for tilde expansion..." shell)         5 "Starting remote shell `%s' for tilde expansion..." shell)
3306        (tramp-send-command        (tramp-send-command
3307         multi-method method user host         multi-method method user host
3308         (concat "PS1='$ ' ; exec " shell))         (concat "PS1='$ ' ; exec " shell)) ;
3309        (unless (tramp-wait-for-regexp        (unless (tramp-wait-for-regexp
3310                 (get-buffer-process (current-buffer))                 (get-buffer-process (current-buffer))
3311                 60 (format "\\(\\$ *\\|\\(%s\\)\\'\\)" shell-prompt-pattern))                 60 (format "\\(\\$ *\\|\\(%s\\)\\'\\)" shell-prompt-pattern))
# Line 3236  file exists and nonzero exit status othe Line 3326  file exists and nonzero exit status othe
3326                   shell (buffer-name))))                   shell (buffer-name))))
3327        (tramp-message 5 "Waiting for remote `%s' to start up...done" shell))        (tramp-message 5 "Waiting for remote `%s' to start up...done" shell))
3328       (t (tramp-message 5 "Remote `%s' groks tilde expansion, good"       (t (tramp-message 5 "Remote `%s' groks tilde expansion, good"
3329                       (tramp-get-remote-sh multi-method method))))))                         (tramp-get-remote-sh multi-method method))))))
3330    
3331  (defun tramp-check-ls-command (multi-method method user host cmd)  (defun tramp-check-ls-command (multi-method method user host cmd)
3332    "Checks whether the given `ls' executable groks `-n'.    "Checks whether the given `ls' executable groks `-n'.
# Line 4486  remote path name." Line 4576  remote path name."
4576      (save-match-data      (save-match-data
4577        (unless (string-match (nth 0 tramp-file-name-structure) name)        (unless (string-match (nth 0 tramp-file-name-structure) name)
4578          (error "Not a tramp file name: %s" name))          (error "Not a tramp file name: %s" name))
4579        (setq method (or (match-string (nth 1 tramp-file-name-structure) name)        (setq method (match-string (nth 1 tramp-file-name-structure) name))
4580                         tramp-default-method))        (if (and method (member method tramp-multi-methods))
       (if (member method tramp-multi-methods)  
4581            ;; If it's a multi method, the file name structure contains            ;; If it's a multi method, the file name structure contains
4582            ;; arrays of method, user and host.            ;; arrays of method, user and host.
4583            (tramp-dissect-multi-file-name name)            (tramp-dissect-multi-file-name name)
4584          ;; Normal method.          ;; Normal method.  First, find out default method.
4585          (make-tramp-file-name          (let ((user (match-string (nth 2 tramp-file-name-structure) name))
4586           :multi-method nil                (host (match-string (nth 3 tramp-file-name-structure) name))
4587           :method method                (path (match-string (nth 4 tramp-file-name-structure) name)))
4588           :user (or (match-string (nth 2 tramp-file-name-structure) name)            (when (not method)
4589                     nil)              (setq method (tramp-find-default-method user host)))
4590           :host (match-string (nth 3 tramp-file-name-structure) name)            (make-tramp-file-name
4591           :path (match-string (nth 4 tramp-file-name-structure) name))))))             :multi-method nil
4592               :method method
4593               :user (or user nil)
4594               :host host
4595               :path path))))))
4596    
4597    (defun tramp-find-default-method (user host)
4598      "Look up the right method to use in `tramp-default-method-alist'."
4599      (let ((choices tramp-default-method-alist)
4600            (method tramp-default-method)
4601            item)
4602        (while choices
4603          (setq item (pop choices))
4604          (when (and (string-match (nth 0 item) host)
4605                     (string-match (nth 1 item) (or user "")))
4606            (setq method (nth 2 item))
4607            (setq choices nil)))
4608        method))
4609        
4610  ;; HHH: Not Changed.  Multi method.  Will probably not handle the case where  ;; HHH: Not Changed.  Multi method.  Will probably not handle the case where
4611  ;;      a user name is not provided in the "file name" very well.  ;;      a user name is not provided in the "file name" very well.
4612  (defun tramp-dissect-multi-file-name (name)  (defun tramp-dissect-multi-file-name (name)
# Line 4581  remote path name." Line 4687  remote path name."
4687          (incf i)))          (incf i)))
4688      (concat prefix hops path)))      (concat prefix hops path)))
4689    
 ;; HHH: Changed.  Handles the case where no user name is given in the  
 ;;      file name.  
4690  (defun tramp-make-rcp-program-file-name (user host path)  (defun tramp-make-rcp-program-file-name (user host path)
4691    "Create a file name suitable to be passed to `rcp'."    "Create a file name suitable to be passed to `rcp'."
4692    (if user    (if user
4693        (format "%s@%s:%s" user host path)        (format "%s@%s:%s" user host path)
4694      (format "%s:%s" host path)))      (format "%s:%s" host path)))
4695    
4696    (defun tramp-make-ange-ftp-file-name (user host path)
4697      "Given user, host, and path, return an Ange-FTP filename."
4698      (if user
4699          (format "/%s@%s:%s" user host path)
4700        (format "/%s:%s" host path)))
4701    
4702  (defun tramp-method-out-of-band-p (multi-method method)  (defun tramp-method-out-of-band-p (multi-method method)
4703    "Return t if this is an out-of-band method, nil otherwise.    "Return t if this is an out-of-band method, nil otherwise.
4704  It is important to check for this condition, since it is not possible  It is important to check for this condition, since it is not possible
# Line 5047  TRAMP. Line 5157  TRAMP.
5157    
5158  ;;; TODO:  ;;; TODO:
5159    
5160    ;; * Revise the comments near the beginning of the file.
5161  ;; * Cooperate with PCL-CVS.  It uses start-process, which doesn't  ;; * Cooperate with PCL-CVS.  It uses start-process, which doesn't
5162  ;;   work for remote files.  ;;   work for remote files.
5163  ;; * Allow /[method/user@host:port] syntax for the ssh "-p" argument.  ;; * Allow /[method/user@host:port] syntax for the ssh "-p" argument.

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26