aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Hansen2004-11-26 21:39:27 +0000
committerLars Hansen2004-11-26 21:39:27 +0000
commitc82c5727248e19bc0ef4603aa436e36f37772fa0 (patch)
treefca23f1dca18be54c2cd9a9356046e7d29f9298b
parent3a0ab7ecf334c68fe2c63af2e5b36967a758f251 (diff)
downloademacs-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/ChangeLog21
-rw-r--r--lisp/net/tramp.el465
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 @@
12004-11-26 Lars Hansen <larsh@math.ku.dk> 12004-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
222004-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); 1551if (($stat[2] & 0170000) == 0120000)
1552if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; } 1552{
1553elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; } 1553 $type = readlink($ARGV[0]);
1554else { $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]); 1556elsif (($stat[2] & 0170000) == 040000)
1557printf(\"(%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);" 1560else
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]) . \"\\\"\";
1566printf(
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'
1562on the remote file system.") 1584on the remote file system.")
1563 1585
1586(defconst tramp-perl-directory-files-and-attributes "\
1587chdir($ARGV[0]);
1588opendir(DIR,\".\");
1589@list = readdir(DIR);
1590closedir(DIR);
1591$n = scalar(@list);
1592printf(\"(\\n\");
1593for($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}
1632printf(\")\\n\");"
1633 "Perl script implementing `directory-files-attributes' as Lisp `read'able
1634output.")
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
2280The Perl command is sent to the remote machine when the connection
2281is 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.
2298If 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.
4774Only send the definition if it has not already been done.
4775Function 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.
6525Convert file mode bits to string and set virtual device number.
6526Return 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.
6537If 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."