diff options
| author | Lars Hansen | 2004-11-26 21:39:27 +0000 |
|---|---|---|
| committer | Lars Hansen | 2004-11-26 21:39:27 +0000 |
| commit | c82c5727248e19bc0ef4603aa436e36f37772fa0 (patch) | |
| tree | fca23f1dca18be54c2cd9a9356046e7d29f9298b | |
| parent | 3a0ab7ecf334c68fe2c63af2e5b36967a758f251 (diff) | |
| download | emacs-c82c5727248e19bc0ef4603aa436e36f37772fa0.tar.gz emacs-c82c5727248e19bc0ef4603aa436e36f37772fa0.zip | |
(tramp-handle-directory-files-and-attributes): New function.
(tramp-perl-directory-files-and-attributes): New constant.
(tramp-file-name-handler-alist): Delete file-directory-files, add directory-files-and-attributes.
(tramp-perl-file-attributes): Surround uid and gid by double quotes.
Change parameter id-format from nonnumeric.
(tramp-convert-file-attributes): New function.
(tramp-handle-file-attributes): Use it.
(tramp-maybe-send-perl-script): New function.
(tramp-handle-file-attributes-with-perl): Use it. Don't convert file mode.
Change parameter id-format from nonnumeric.
(tramp-handle-file-attributes-with-ls): Change parameter id-format from nonnumeric.
(tramp-post-connection): Don't send tramp-perl-file-attributes script.
Reset connection property "perl-scripts".
(tramp-handle-insert-directory): Run real handler when ls-lisp is in use.
| -rw-r--r-- | lisp/ChangeLog | 21 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 465 |
2 files changed, 315 insertions, 171 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 51fb165e182..b5b9ef6cf0d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,26 @@ | |||
| 1 | 2004-11-26 Lars Hansen <larsh@math.ku.dk> | 1 | 2004-11-26 Lars Hansen <larsh@math.ku.dk> |
| 2 | 2 | ||
| 3 | * tramp.el (tramp-handle-directory-files-and-attributes): New | ||
| 4 | function. | ||
| 5 | (tramp-perl-directory-files-and-attributes): New constant. | ||
| 6 | (tramp-file-name-handler-alist): Delete file-directory-files, add | ||
| 7 | directory-files-and-attributes. | ||
| 8 | (tramp-perl-file-attributes): Surround uid and gid by double | ||
| 9 | quotes. Change parameter id-format from nonnumeric. | ||
| 10 | (tramp-convert-file-attributes): New function. | ||
| 11 | (tramp-handle-file-attributes): Use it. | ||
| 12 | (tramp-maybe-send-perl-script): New function. | ||
| 13 | (tramp-handle-file-attributes-with-perl): Use it. Don't convert | ||
| 14 | file mode. Change parameter id-format from nonnumeric. | ||
| 15 | (tramp-handle-file-attributes-with-ls): Change parameter id-format | ||
| 16 | from nonnumeric. | ||
| 17 | (tramp-post-connection): Don't send tramp-perl-file-attributes | ||
| 18 | script. Reset connection property "perl-scripts". | ||
| 19 | (tramp-handle-insert-directory): Run real handler when ls-lisp is | ||
| 20 | in use. | ||
| 21 | |||
| 22 | 2004-11-26 Lars Hansen <larsh@math.ku.dk> | ||
| 23 | |||
| 3 | * desktop.el (desktop-read): Replace mapcar with mapc. | 24 | * desktop.el (desktop-read): Replace mapcar with mapc. |
| 4 | (desktop-create-buffer): Replace mapcar with mapc. Remove | 25 | (desktop-create-buffer): Replace mapcar with mapc. Remove |
| 5 | redundant piece of code. | 26 | redundant piece of code. |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 502dc5e5115..8310995a09b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -1547,20 +1547,92 @@ them we have this shell function.") | |||
| 1547 | ;; The device number is returned as "-1", because there will be a virtual | 1547 | ;; The device number is returned as "-1", because there will be a virtual |
| 1548 | ;; device number set in `tramp-handle-file-attributes' | 1548 | ;; device number set in `tramp-handle-file-attributes' |
| 1549 | (defconst tramp-perl-file-attributes "\ | 1549 | (defconst tramp-perl-file-attributes "\ |
| 1550 | \($f, $n) = @ARGV; | 1550 | @stat = lstat($ARGV[0]); |
| 1551 | @s = lstat($f); | 1551 | if (($stat[2] & 0170000) == 0120000) |
| 1552 | if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; } | 1552 | { |
| 1553 | elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; } | 1553 | $type = readlink($ARGV[0]); |
| 1554 | else { $l = \"nil\" }; | 1554 | $type = \"\\\"$type\\\"\"; |
| 1555 | $u = ($n eq \"nil\") ? $s[4] : getpwuid($s[4]); | 1555 | } |
| 1556 | $g = ($n eq \"nil\") ? $s[5] : getgrgid($s[5]); | 1556 | elsif (($stat[2] & 0170000) == 040000) |
| 1557 | printf(\"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", | 1557 | { |
| 1558 | $l, $s[3], $u, $g, $s[8] >> 16 & 0xffff, $s[8] & 0xffff, | 1558 | $type = \"t\"; |
| 1559 | $s[9] >> 16 & 0xffff, $s[9] & 0xffff, $s[10] >> 16 & 0xffff, $s[10] & 0xffff, | 1559 | } |
| 1560 | $s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1] & 0xffff);" | 1560 | else |
| 1561 | { | ||
| 1562 | $type = \"nil\" | ||
| 1563 | }; | ||
| 1564 | $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; | ||
| 1565 | $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; | ||
| 1566 | printf( | ||
| 1567 | \"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", | ||
| 1568 | $type, | ||
| 1569 | $stat[3], | ||
| 1570 | $uid, | ||
| 1571 | $gid, | ||
| 1572 | $stat[8] >> 16 & 0xffff, | ||
| 1573 | $stat[8] & 0xffff, | ||
| 1574 | $stat[9] >> 16 & 0xffff, | ||
| 1575 | $stat[9] & 0xffff, | ||
| 1576 | $stat[10] >> 16 & 0xffff, | ||
| 1577 | $stat[10] & 0xffff, | ||
| 1578 | $stat[7], | ||
| 1579 | $stat[2], | ||
| 1580 | $stat[1] >> 16 & 0xffff, | ||
| 1581 | $stat[1] & 0xffff | ||
| 1582 | );" | ||
| 1561 | "Perl script to produce output suitable for use with `file-attributes' | 1583 | "Perl script to produce output suitable for use with `file-attributes' |
| 1562 | on the remote file system.") | 1584 | on the remote file system.") |
| 1563 | 1585 | ||
| 1586 | (defconst tramp-perl-directory-files-and-attributes "\ | ||
| 1587 | chdir($ARGV[0]); | ||
| 1588 | opendir(DIR,\".\"); | ||
| 1589 | @list = readdir(DIR); | ||
| 1590 | closedir(DIR); | ||
| 1591 | $n = scalar(@list); | ||
| 1592 | printf(\"(\\n\"); | ||
| 1593 | for($i = 0; $i < $n; $i++) | ||
| 1594 | { | ||
| 1595 | $filename = $list[$i]; | ||
| 1596 | @stat = lstat($filename); | ||
| 1597 | if (($stat[2] & 0170000) == 0120000) | ||
| 1598 | { | ||
| 1599 | $type = readlink($filename); | ||
| 1600 | $type = \"\\\"$type\\\"\"; | ||
| 1601 | } | ||
| 1602 | elsif (($stat[2] & 0170000) == 040000) | ||
| 1603 | { | ||
| 1604 | $type = \"t\"; | ||
| 1605 | } | ||
| 1606 | else | ||
| 1607 | { | ||
| 1608 | $type = \"nil\" | ||
| 1609 | }; | ||
| 1610 | $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; | ||
| 1611 | $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; | ||
| 1612 | printf( | ||
| 1613 | \"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\", | ||
| 1614 | $filename, | ||
| 1615 | $type, | ||
| 1616 | $stat[3], | ||
| 1617 | $uid, | ||
| 1618 | $gid, | ||
| 1619 | $stat[8] >> 16 & 0xffff, | ||
| 1620 | $stat[8] & 0xffff, | ||
| 1621 | $stat[9] >> 16 & 0xffff, | ||
| 1622 | $stat[9] & 0xffff, | ||
| 1623 | $stat[10] >> 16 & 0xffff, | ||
| 1624 | $stat[10] & 0xffff, | ||
| 1625 | $stat[7], | ||
| 1626 | $stat[2], | ||
| 1627 | $stat[1] >> 16 & 0xffff, | ||
| 1628 | $stat[1] & 0xffff, | ||
| 1629 | $stat[0] >> 16 & 0xffff, | ||
| 1630 | $stat[0] & 0xffff); | ||
| 1631 | } | ||
| 1632 | printf(\")\\n\");" | ||
| 1633 | "Perl script implementing `directory-files-attributes' as Lisp `read'able | ||
| 1634 | output.") | ||
| 1635 | |||
| 1564 | ;; ;; These two use uu encoding. | 1636 | ;; ;; These two use uu encoding. |
| 1565 | ;; (defvar tramp-perl-encode "%s -e'\ | 1637 | ;; (defvar tramp-perl-encode "%s -e'\ |
| 1566 | ;; print qq(begin 644 xxx\n); | 1638 | ;; print qq(begin 644 xxx\n); |
| @@ -1759,8 +1831,8 @@ on the FILENAME argument, even if VISIT was a string.") | |||
| 1759 | (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) | 1831 | (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) |
| 1760 | (file-attributes . tramp-handle-file-attributes) | 1832 | (file-attributes . tramp-handle-file-attributes) |
| 1761 | (file-modes . tramp-handle-file-modes) | 1833 | (file-modes . tramp-handle-file-modes) |
| 1762 | (file-directory-files . tramp-handle-file-directory-files) | ||
| 1763 | (directory-files . tramp-handle-directory-files) | 1834 | (directory-files . tramp-handle-directory-files) |
| 1835 | (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) | ||
| 1764 | (file-name-all-completions . tramp-handle-file-name-all-completions) | 1836 | (file-name-all-completions . tramp-handle-file-name-all-completions) |
| 1765 | (file-name-completion . tramp-handle-file-name-completion) | 1837 | (file-name-completion . tramp-handle-file-name-completion) |
| 1766 | (add-name-to-file . tramp-handle-add-name-to-file) | 1838 | (add-name-to-file . tramp-handle-add-name-to-file) |
| @@ -2170,26 +2242,21 @@ target of the symlink differ." | |||
| 2170 | ;; Daniel Pittman <daniel@danann.net> | 2242 | ;; Daniel Pittman <daniel@danann.net> |
| 2171 | (defun tramp-handle-file-attributes (filename &optional id-format) | 2243 | (defun tramp-handle-file-attributes (filename &optional id-format) |
| 2172 | "Like `file-attributes' for tramp files." | 2244 | "Like `file-attributes' for tramp files." |
| 2173 | (let ((nonnumeric (and id-format (equal id-format 'string))) | 2245 | (when (file-exists-p filename) |
| 2174 | result) | 2246 | ;; file exists, find out stuff |
| 2247 | (unless id-format (setq id-format 'integer)) | ||
| 2175 | (with-parsed-tramp-file-name filename nil | 2248 | (with-parsed-tramp-file-name filename nil |
| 2176 | (when (file-exists-p filename) | 2249 | (save-excursion |
| 2177 | ;; file exists, find out stuff | 2250 | (tramp-convert-file-attributes |
| 2178 | (save-excursion | 2251 | multi-method method user host |
| 2179 | (if (tramp-get-remote-perl multi-method method user host) | 2252 | (if (tramp-get-remote-perl multi-method method user host) |
| 2180 | (setq result | 2253 | (tramp-handle-file-attributes-with-perl multi-method method user host |
| 2181 | (tramp-handle-file-attributes-with-perl | 2254 | localname id-format) |
| 2182 | multi-method method user host localname nonnumeric)) | 2255 | (tramp-handle-file-attributes-with-ls multi-method method user host |
| 2183 | (setq result | 2256 | localname id-format))))))) |
| 2184 | (tramp-handle-file-attributes-with-ls | ||
| 2185 | multi-method method user host localname nonnumeric))) | ||
| 2186 | ;; set virtual device number | ||
| 2187 | (setcar (nthcdr 11 result) | ||
| 2188 | (tramp-get-device multi-method method user host))))) | ||
| 2189 | result)) | ||
| 2190 | 2257 | ||
| 2191 | (defun tramp-handle-file-attributes-with-ls | 2258 | (defun tramp-handle-file-attributes-with-ls |
| 2192 | (multi-method method user host localname &optional nonnumeric) | 2259 | (multi-method method user host localname &optional id-format) |
| 2193 | "Implement `file-attributes' for tramp files using the ls(1) command." | 2260 | "Implement `file-attributes' for tramp files using the ls(1) command." |
| 2194 | (let (symlinkp dirp | 2261 | (let (symlinkp dirp |
| 2195 | res-inode res-filemodes res-numlinks | 2262 | res-inode res-filemodes res-numlinks |
| @@ -2202,7 +2269,7 @@ target of the symlink differ." | |||
| 2202 | multi-method method user host | 2269 | multi-method method user host |
| 2203 | (format "%s %s %s" | 2270 | (format "%s %s %s" |
| 2204 | (tramp-get-ls-command multi-method method user host) | 2271 | (tramp-get-ls-command multi-method method user host) |
| 2205 | (if nonnumeric "-ild" "-ildn") | 2272 | (if (eq id-format 'integer) "-ildn" "-ild") |
| 2206 | (tramp-shell-quote-argument localname))) | 2273 | (tramp-shell-quote-argument localname))) |
| 2207 | (tramp-wait-for-output) | 2274 | (tramp-wait-for-output) |
| 2208 | ;; parse `ls -l' output ... | 2275 | ;; parse `ls -l' output ... |
| @@ -2229,7 +2296,7 @@ target of the symlink differ." | |||
| 2229 | ;; ... uid and gid | 2296 | ;; ... uid and gid |
| 2230 | (setq res-uid (read (current-buffer))) | 2297 | (setq res-uid (read (current-buffer))) |
| 2231 | (setq res-gid (read (current-buffer))) | 2298 | (setq res-gid (read (current-buffer))) |
| 2232 | (unless nonnumeric | 2299 | (when (eq id-format 'integer) |
| 2233 | (unless (numberp res-uid) (setq res-uid -1)) | 2300 | (unless (numberp res-uid) (setq res-uid -1)) |
| 2234 | (unless (numberp res-gid) (setq res-gid -1))) | 2301 | (unless (numberp res-gid) (setq res-gid -1))) |
| 2235 | ;; ... size | 2302 | ;; ... size |
| @@ -2274,33 +2341,20 @@ target of the symlink differ." | |||
| 2274 | ))) | 2341 | ))) |
| 2275 | 2342 | ||
| 2276 | (defun tramp-handle-file-attributes-with-perl | 2343 | (defun tramp-handle-file-attributes-with-perl |
| 2277 | (multi-method method user host localname &optional nonnumeric) | 2344 | (multi-method method user host localname &optional id-format) |
| 2278 | "Implement `file-attributes' for tramp files using a Perl script. | 2345 | "Implement `file-attributes' for tramp files using a Perl script." |
| 2279 | |||
| 2280 | The Perl command is sent to the remote machine when the connection | ||
| 2281 | is initially created and is kept cached by the remote shell." | ||
| 2282 | (tramp-message-for-buffer multi-method method user host 10 | 2346 | (tramp-message-for-buffer multi-method method user host 10 |
| 2283 | "file attributes with perl: %s" | 2347 | "file attributes with perl: %s" |
| 2284 | (tramp-make-tramp-file-name | 2348 | (tramp-make-tramp-file-name |
| 2285 | multi-method method user host localname)) | 2349 | multi-method method user host localname)) |
| 2286 | (tramp-send-command | 2350 | (tramp-maybe-send-perl-script tramp-perl-file-attributes |
| 2287 | multi-method method user host | 2351 | "tramp_file_attributes" |
| 2288 | (format "tramp_file_attributes %s %s" | 2352 | multi-method method user host) |
| 2289 | (tramp-shell-quote-argument localname) nonnumeric)) | 2353 | (tramp-send-command multi-method method user host |
| 2354 | (format "tramp_file_attributes %s %s" | ||
| 2355 | (tramp-shell-quote-argument localname) id-format)) | ||
| 2290 | (tramp-wait-for-output) | 2356 | (tramp-wait-for-output) |
| 2291 | (let ((result (read (current-buffer)))) | 2357 | (read (current-buffer))) |
| 2292 | (setcar (nthcdr 8 result) | ||
| 2293 | (tramp-file-mode-from-int (nth 8 result))) | ||
| 2294 | result)) | ||
| 2295 | |||
| 2296 | (defun tramp-get-device (multi-method method user host) | ||
| 2297 | "Returns the virtual device number. | ||
| 2298 | If it doesn't exist, generate a new one." | ||
| 2299 | (let ((string (tramp-make-tramp-file-name multi-method method user host ""))) | ||
| 2300 | (unless (assoc string tramp-devices) | ||
| 2301 | (add-to-list 'tramp-devices | ||
| 2302 | (list string (length tramp-devices)))) | ||
| 2303 | (list -1 (nth 1 (assoc string tramp-devices))))) | ||
| 2304 | 2358 | ||
| 2305 | (defun tramp-handle-set-visited-file-modtime (&optional time-list) | 2359 | (defun tramp-handle-set-visited-file-modtime (&optional time-list) |
| 2306 | "Like `set-visited-file-modtime' for tramp files." | 2360 | "Like `set-visited-file-modtime' for tramp files." |
| @@ -2628,6 +2682,38 @@ if the remote host can't provide the modtime." | |||
| 2628 | (push item result))))))) | 2682 | (push item result))))))) |
| 2629 | result))) | 2683 | result))) |
| 2630 | 2684 | ||
| 2685 | (defun tramp-handle-directory-files-and-attributes | ||
| 2686 | (directory &optional full match nosort id-format) | ||
| 2687 | "Like `directory-files-and-attributes' for tramp files." | ||
| 2688 | (when (tramp-handle-file-exists-p directory) | ||
| 2689 | (save-excursion | ||
| 2690 | (setq directory (tramp-handle-expand-file-name directory)) | ||
| 2691 | (with-parsed-tramp-file-name directory nil | ||
| 2692 | (tramp-maybe-send-perl-script tramp-perl-directory-files-and-attributes | ||
| 2693 | "tramp_directory_files_and_attributes" | ||
| 2694 | multi-method method user host) | ||
| 2695 | (tramp-send-command multi-method method user host | ||
| 2696 | (format "tramp_directory_files_and_attributes %s %s" | ||
| 2697 | (tramp-shell-quote-argument localname) | ||
| 2698 | (or id-format 'integer))) | ||
| 2699 | (tramp-wait-for-output) | ||
| 2700 | (let* ((root (cons nil (read (current-buffer)))) | ||
| 2701 | (cell root)) | ||
| 2702 | (while (cdr cell) | ||
| 2703 | (if (and match (not (string-match match (caadr cell)))) | ||
| 2704 | ;; Remove from list | ||
| 2705 | (setcdr cell (cddr cell)) | ||
| 2706 | ;; Include in list | ||
| 2707 | (setq cell (cdr cell)) | ||
| 2708 | (let ((l (car cell))) | ||
| 2709 | (tramp-convert-file-attributes multi-method method user host | ||
| 2710 | (cdr l)) | ||
| 2711 | ;; If FULL, make file name absolute | ||
| 2712 | (when full (setcar l (concat directory "/" (car l))))))) | ||
| 2713 | (if nosort | ||
| 2714 | (cdr root) | ||
| 2715 | (sort (cdr root) (lambda (x y) (string< (car x) (car y)))))))))) | ||
| 2716 | |||
| 2631 | ;; This function should return "foo/" for directories and "bar" for | 2717 | ;; This function should return "foo/" for directories and "bar" for |
| 2632 | ;; files. We use `ls -ad' to get a list of files (including | 2718 | ;; files. We use `ls -ad' to get a list of files (including |
| 2633 | ;; directories), and `find . -type d \! -name . -prune' to get a list | 2719 | ;; directories), and `find . -type d \! -name . -prune' to get a list |
| @@ -3186,83 +3272,87 @@ This is like `dired-recursive-delete-directory' for tramp files." | |||
| 3186 | (defun tramp-handle-insert-directory | 3272 | (defun tramp-handle-insert-directory |
| 3187 | (filename switches &optional wildcard full-directory-p) | 3273 | (filename switches &optional wildcard full-directory-p) |
| 3188 | "Like `insert-directory' for tramp files." | 3274 | "Like `insert-directory' for tramp files." |
| 3189 | ;; For the moment, we assume that the remote "ls" program does not | 3275 | (if (and (boundp 'ls-lisp-use-insert-directory-program) |
| 3190 | ;; grok "--dired". In the future, we should detect this on | 3276 | (not ls-lisp-use-insert-directory-program)) |
| 3191 | ;; connection setup. | 3277 | (tramp-run-real-handler 'insert-directory |
| 3192 | (when (string-match "^--dired\\s-+" switches) | 3278 | (list filename switches wildcard full-directory-p)) |
| 3193 | (setq switches (replace-match "" nil t switches))) | 3279 | ;; For the moment, we assume that the remote "ls" program does not |
| 3194 | (setq filename (expand-file-name filename)) | 3280 | ;; grok "--dired". In the future, we should detect this on |
| 3195 | (with-parsed-tramp-file-name filename nil | 3281 | ;; connection setup. |
| 3196 | (tramp-message-for-buffer | 3282 | (when (string-match "^--dired\\s-+" switches) |
| 3197 | multi-method method user host 10 | 3283 | (setq switches (replace-match "" nil t switches))) |
| 3198 | "Inserting directory `ls %s %s', wildcard %s, fulldir %s" | 3284 | (setq filename (expand-file-name filename)) |
| 3199 | switches filename (if wildcard "yes" "no") | 3285 | (with-parsed-tramp-file-name filename nil |
| 3200 | (if full-directory-p "yes" "no")) | 3286 | (tramp-message-for-buffer |
| 3201 | (when wildcard | 3287 | multi-method method user host 10 |
| 3202 | (setq wildcard (file-name-nondirectory localname)) | 3288 | "Inserting directory `ls %s %s', wildcard %s, fulldir %s" |
| 3203 | (setq localname (file-name-directory localname))) | 3289 | switches filename (if wildcard "yes" "no") |
| 3204 | (when (listp switches) | 3290 | (if full-directory-p "yes" "no")) |
| 3205 | (setq switches (mapconcat 'identity switches " "))) | 3291 | (when wildcard |
| 3206 | (unless full-directory-p | 3292 | (setq wildcard (file-name-nondirectory localname)) |
| 3207 | (setq switches (concat "-d " switches))) | 3293 | (setq localname (file-name-directory localname))) |
| 3208 | (when wildcard | 3294 | (when (listp switches) |
| 3209 | (setq switches (concat switches " " wildcard))) | 3295 | (setq switches (mapconcat 'identity switches " "))) |
| 3210 | (save-excursion | 3296 | (unless full-directory-p |
| 3211 | ;; If `full-directory-p', we just say `ls -l FILENAME'. | 3297 | (setq switches (concat "-d " switches))) |
| 3212 | ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. | 3298 | (when wildcard |
| 3213 | (if full-directory-p | 3299 | (setq switches (concat switches " " wildcard))) |
| 3214 | (tramp-send-command | ||
| 3215 | multi-method method user host | ||
| 3216 | (format "%s %s %s" | ||
| 3217 | (tramp-get-ls-command multi-method method user host) | ||
| 3218 | switches | ||
| 3219 | (if wildcard | ||
| 3220 | localname | ||
| 3221 | (tramp-shell-quote-argument (concat localname "."))))) | ||
| 3222 | (tramp-barf-unless-okay | ||
| 3223 | multi-method method user host | ||
| 3224 | (format "cd %s" (tramp-shell-quote-argument | ||
| 3225 | (file-name-directory localname))) | ||
| 3226 | nil 'file-error | ||
| 3227 | "Couldn't `cd %s'" | ||
| 3228 | (tramp-shell-quote-argument (file-name-directory localname))) | ||
| 3229 | (tramp-send-command | ||
| 3230 | multi-method method user host | ||
| 3231 | (format "%s %s %s" | ||
| 3232 | (tramp-get-ls-command multi-method method user host) | ||
| 3233 | switches | ||
| 3234 | (if wildcard | ||
| 3235 | localname | ||
| 3236 | (tramp-shell-quote-argument | ||
| 3237 | (file-name-nondirectory localname)))))) | ||
| 3238 | (sit-for 1) ;needed for rsh but not ssh? | ||
| 3239 | (tramp-wait-for-output)) | ||
| 3240 | ;; The following let-binding is used by code that's commented | ||
| 3241 | ;; out. Let's leave the let-binding in for a while to see | ||
| 3242 | ;; that the commented-out code is really not needed. Commenting-out | ||
| 3243 | ;; happened on 2003-03-13. | ||
| 3244 | (let ((old-pos (point))) | ||
| 3245 | (insert-buffer-substring | ||
| 3246 | (tramp-get-buffer multi-method method user host)) | ||
| 3247 | ;; On XEmacs, we want to call (exchange-point-and-mark t), but | ||
| 3248 | ;; that doesn't exist on Emacs, so we use this workaround instead. | ||
| 3249 | ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to | ||
| 3250 | ;; be safe. Thanks to Daniel Pittman <daniel@danann.net>. | ||
| 3251 | ;; (let ((zmacs-region-stays t)) | ||
| 3252 | ;; (exchange-point-and-mark)) | ||
| 3253 | (save-excursion | 3300 | (save-excursion |
| 3254 | (tramp-send-command multi-method method user host "cd") | 3301 | ;; If `full-directory-p', we just say `ls -l FILENAME'. |
| 3255 | (tramp-wait-for-output)) | 3302 | ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. |
| 3256 | ;; For the time being, the XEmacs kludge is commented out. | 3303 | (if full-directory-p |
| 3257 | ;; Please test it on various XEmacs versions to see if it works. | 3304 | (tramp-send-command |
| 3258 | ;; ;; Another XEmacs specialty follows. What's the right way to do | 3305 | multi-method method user host |
| 3259 | ;; ;; it? | 3306 | (format "%s %s %s" |
| 3260 | ;; (when (and (featurep 'xemacs) | 3307 | (tramp-get-ls-command multi-method method user host) |
| 3261 | ;; (eq major-mode 'dired-mode)) | 3308 | switches |
| 3262 | ;; (save-excursion | 3309 | (if wildcard |
| 3263 | ;; (require 'dired) | 3310 | localname |
| 3264 | ;; (dired-insert-set-properties old-pos (point)))) | 3311 | (tramp-shell-quote-argument (concat localname "."))))) |
| 3265 | ))) | 3312 | (tramp-barf-unless-okay |
| 3313 | multi-method method user host | ||
| 3314 | (format "cd %s" (tramp-shell-quote-argument | ||
| 3315 | (file-name-directory localname))) | ||
| 3316 | nil 'file-error | ||
| 3317 | "Couldn't `cd %s'" | ||
| 3318 | (tramp-shell-quote-argument (file-name-directory localname))) | ||
| 3319 | (tramp-send-command | ||
| 3320 | multi-method method user host | ||
| 3321 | (format "%s %s %s" | ||
| 3322 | (tramp-get-ls-command multi-method method user host) | ||
| 3323 | switches | ||
| 3324 | (if wildcard | ||
| 3325 | localname | ||
| 3326 | (tramp-shell-quote-argument | ||
| 3327 | (file-name-nondirectory localname)))))) | ||
| 3328 | (sit-for 1) ;needed for rsh but not ssh? | ||
| 3329 | (tramp-wait-for-output)) | ||
| 3330 | ;; The following let-binding is used by code that's commented | ||
| 3331 | ;; out. Let's leave the let-binding in for a while to see | ||
| 3332 | ;; that the commented-out code is really not needed. Commenting-out | ||
| 3333 | ;; happened on 2003-03-13. | ||
| 3334 | (let ((old-pos (point))) | ||
| 3335 | (insert-buffer-substring | ||
| 3336 | (tramp-get-buffer multi-method method user host)) | ||
| 3337 | ;; On XEmacs, we want to call (exchange-point-and-mark t), but | ||
| 3338 | ;; that doesn't exist on Emacs, so we use this workaround instead. | ||
| 3339 | ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to | ||
| 3340 | ;; be safe. Thanks to Daniel Pittman <daniel@danann.net>. | ||
| 3341 | ;; (let ((zmacs-region-stays t)) | ||
| 3342 | ;; (exchange-point-and-mark)) | ||
| 3343 | (save-excursion | ||
| 3344 | (tramp-send-command multi-method method user host "cd") | ||
| 3345 | (tramp-wait-for-output)) | ||
| 3346 | ;; For the time being, the XEmacs kludge is commented out. | ||
| 3347 | ;; Please test it on various XEmacs versions to see if it works. | ||
| 3348 | ;; ;; Another XEmacs specialty follows. What's the right way to do | ||
| 3349 | ;; ;; it? | ||
| 3350 | ;; (when (and (featurep 'xemacs) | ||
| 3351 | ;; (eq major-mode 'dired-mode)) | ||
| 3352 | ;; (save-excursion | ||
| 3353 | ;; (require 'dired) | ||
| 3354 | ;; (dired-insert-set-properties old-pos (point)))) | ||
| 3355 | )))) | ||
| 3266 | 3356 | ||
| 3267 | ;; Continuation of kluge to pacify byte-compiler. | 3357 | ;; Continuation of kluge to pacify byte-compiler. |
| 3268 | ;;(eval-when-compile | 3358 | ;;(eval-when-compile |
| @@ -4679,6 +4769,29 @@ User may be nil." | |||
| 4679 | 4769 | ||
| 4680 | ;;; Internal Functions: | 4770 | ;;; Internal Functions: |
| 4681 | 4771 | ||
| 4772 | (defun tramp-maybe-send-perl-script (script name multi-method method user host) | ||
| 4773 | "Define in remote shell function NAME implemented as perl SCRIPT. | ||
| 4774 | Only send the definition if it has not already been done. | ||
| 4775 | Function may have 0-3 parameters." | ||
| 4776 | (let ((remote-perl (tramp-get-remote-perl multi-method method user host))) | ||
| 4777 | (unless remote-perl (error "No remote perl")) | ||
| 4778 | (let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil | ||
| 4779 | multi-method method user host))) | ||
| 4780 | (unless (memq name perl-scripts) | ||
| 4781 | (with-current-buffer (tramp-get-buffer multi-method method user host) | ||
| 4782 | (tramp-message 5 (concat "Sending the Perl script `" name "'...")) | ||
| 4783 | (tramp-send-string multi-method method user host | ||
| 4784 | (concat name | ||
| 4785 | " () {\n" | ||
| 4786 | remote-perl | ||
| 4787 | " -e '" | ||
| 4788 | script | ||
| 4789 | "' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}")) | ||
| 4790 | (tramp-wait-for-output) | ||
| 4791 | (tramp-set-connection-property "perl-scripts" (cons name perl-scripts) | ||
| 4792 | multi-method method user host) | ||
| 4793 | (tramp-message 5 (concat "Sending the Perl script `" name "'...done."))))))) | ||
| 4794 | |||
| 4682 | (defun tramp-set-auto-save () | 4795 | (defun tramp-set-auto-save () |
| 4683 | (when (and (buffer-file-name) | 4796 | (when (and (buffer-file-name) |
| 4684 | (tramp-tramp-file-p (buffer-file-name)) | 4797 | (tramp-tramp-file-p (buffer-file-name)) |
| @@ -5859,6 +5972,7 @@ locale to C and sets up the remote shell search path." | |||
| 5859 | (tramp-wait-for-output) | 5972 | (tramp-wait-for-output) |
| 5860 | ;; Find a `perl'. | 5973 | ;; Find a `perl'. |
| 5861 | (erase-buffer) | 5974 | (erase-buffer) |
| 5975 | (tramp-set-connection-property "perl-scripts" nil multi-method method user host) | ||
| 5862 | (let ((tramp-remote-perl | 5976 | (let ((tramp-remote-perl |
| 5863 | (or (tramp-find-executable multi-method method user host | 5977 | (or (tramp-find-executable multi-method method user host |
| 5864 | "perl5" tramp-remote-path nil) | 5978 | "perl5" tramp-remote-path nil) |
| @@ -5867,48 +5981,37 @@ locale to C and sets up the remote shell search path." | |||
| 5867 | (when tramp-remote-perl | 5981 | (when tramp-remote-perl |
| 5868 | (tramp-set-connection-property "perl" tramp-remote-perl | 5982 | (tramp-set-connection-property "perl" tramp-remote-perl |
| 5869 | multi-method method user host) | 5983 | multi-method method user host) |
| 5870 | ;; Set up stat in Perl if we can. | 5984 | (unless (tramp-method-out-of-band-p multi-method method user host) |
| 5871 | (when tramp-remote-perl | 5985 | (tramp-message 5 "Sending the Perl `mime-encode' implementations.") |
| 5872 | (tramp-message 5 "Sending the Perl `file-attributes' implementation.") | 5986 | (tramp-send-string |
| 5873 | (tramp-send-string | 5987 | multi-method method user host |
| 5874 | multi-method method user host | 5988 | (concat "tramp_encode () {\n" |
| 5875 | (concat "tramp_file_attributes () {\n" | 5989 | (format tramp-perl-encode tramp-remote-perl) |
| 5876 | tramp-remote-perl | 5990 | " 2>/dev/null" |
| 5877 | " -e '" tramp-perl-file-attributes "'" | 5991 | "\n}")) |
| 5878 | " \"$1\" \"$2\" 2>/dev/null\n" | 5992 | (tramp-wait-for-output) |
| 5879 | "}")) | 5993 | (tramp-send-string |
| 5880 | (tramp-wait-for-output) | 5994 | multi-method method user host |
| 5881 | (unless (tramp-method-out-of-band-p multi-method method user host) | 5995 | (concat "tramp_encode_with_module () {\n" |
| 5882 | (tramp-message 5 "Sending the Perl `mime-encode' implementations.") | 5996 | (format tramp-perl-encode-with-module tramp-remote-perl) |
| 5883 | (tramp-send-string | 5997 | " 2>/dev/null" |
| 5884 | multi-method method user host | 5998 | "\n}")) |
| 5885 | (concat "tramp_encode () {\n" | 5999 | (tramp-wait-for-output) |
| 5886 | (format tramp-perl-encode tramp-remote-perl) | 6000 | (tramp-message 5 "Sending the Perl `mime-decode' implementations.") |
| 5887 | " 2>/dev/null" | 6001 | (tramp-send-string |
| 5888 | "\n}")) | 6002 | multi-method method user host |
| 5889 | (tramp-wait-for-output) | 6003 | (concat "tramp_decode () {\n" |
| 5890 | (tramp-send-string | 6004 | (format tramp-perl-decode tramp-remote-perl) |
| 5891 | multi-method method user host | 6005 | " 2>/dev/null" |
| 5892 | (concat "tramp_encode_with_module () {\n" | 6006 | "\n}")) |
| 5893 | (format tramp-perl-encode-with-module tramp-remote-perl) | 6007 | (tramp-wait-for-output) |
| 5894 | " 2>/dev/null" | 6008 | (tramp-send-string |
| 5895 | "\n}")) | 6009 | multi-method method user host |
| 5896 | (tramp-wait-for-output) | 6010 | (concat "tramp_decode_with_module () {\n" |
| 5897 | (tramp-message 5 "Sending the Perl `mime-decode' implementations.") | 6011 | (format tramp-perl-decode-with-module tramp-remote-perl) |
| 5898 | (tramp-send-string | 6012 | " 2>/dev/null" |
| 5899 | multi-method method user host | 6013 | "\n}")) |
| 5900 | (concat "tramp_decode () {\n" | 6014 | (tramp-wait-for-output)))) |
| 5901 | (format tramp-perl-decode tramp-remote-perl) | ||
| 5902 | " 2>/dev/null" | ||
| 5903 | "\n}")) | ||
| 5904 | (tramp-wait-for-output) | ||
| 5905 | (tramp-send-string | ||
| 5906 | multi-method method user host | ||
| 5907 | (concat "tramp_decode_with_module () {\n" | ||
| 5908 | (format tramp-perl-decode-with-module tramp-remote-perl) | ||
| 5909 | " 2>/dev/null" | ||
| 5910 | "\n}")) | ||
| 5911 | (tramp-wait-for-output))))) | ||
| 5912 | ;; Find ln(1) | 6015 | ;; Find ln(1) |
| 5913 | (erase-buffer) | 6016 | (erase-buffer) |
| 5914 | (let ((ln (tramp-find-executable multi-method method user host | 6017 | (let ((ln (tramp-find-executable multi-method method user host |
| @@ -6417,6 +6520,26 @@ If `tramp-discard-garbage' is nil, just erase buffer." | |||
| 6417 | (t (error "Tenth char `%c' must be one of `xtT-'" | 6520 | (t (error "Tenth char `%c' must be one of `xtT-'" |
| 6418 | other-execute-or-sticky))))))) | 6521 | other-execute-or-sticky))))))) |
| 6419 | 6522 | ||
| 6523 | (defun tramp-convert-file-attributes (multi-method method user host attr) | ||
| 6524 | "Convert file-attributes ATTR generated by perl script or ls. | ||
| 6525 | Convert file mode bits to string and set virtual device number. | ||
| 6526 | Return ATTR." | ||
| 6527 | (unless (stringp (nth 8 attr)) | ||
| 6528 | ;; Convert file mode bits to string. | ||
| 6529 | (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))) | ||
| 6530 | ;; Set virtual device number. | ||
| 6531 | (setcar (nthcdr 11 attr) | ||
| 6532 | (tramp-get-device multi-method method user host)) | ||
| 6533 | attr) | ||
| 6534 | |||
| 6535 | (defun tramp-get-device (multi-method method user host) | ||
| 6536 | "Returns the virtual device number. | ||
| 6537 | If it doesn't exist, generate a new one." | ||
| 6538 | (let ((string (tramp-make-tramp-file-name multi-method method user host ""))) | ||
| 6539 | (unless (assoc string tramp-devices) | ||
| 6540 | (add-to-list 'tramp-devices | ||
| 6541 | (list string (length tramp-devices)))) | ||
| 6542 | (list -1 (nth 1 (assoc string tramp-devices))))) | ||
| 6420 | 6543 | ||
| 6421 | (defun tramp-file-mode-from-int (mode) | 6544 | (defun tramp-file-mode-from-int (mode) |
| 6422 | "Turn an integer representing a file mode into an ls(1)-like string." | 6545 | "Turn an integer representing a file mode into an ls(1)-like string." |