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.") |
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 |
|
|
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 |
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?). |
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, |
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. |
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 |
|
|
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 |
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, |
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. |
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 |
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." |
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 |
|
|
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? |
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) |
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) |
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 |
|
|
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) |
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) |
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 |
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" |
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 |
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 |
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 |
|
|
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 |
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 |
|
|
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 |
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 |
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 |
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) |
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 |
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 -- |
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 |
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)) |
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'. |
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) |
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 |
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. |