From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Lars Hansen Newsgroups: gmane.emacs.devel Subject: [patch] Tramp and file attributes Date: Sun, 14 Nov 2004 13:32:29 +0100 Message-ID: <4197505D.7060401@math.ku.dk> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------070308080705060102060805" X-Trace: sea.gmane.org 1100435633 21146 80.91.229.6 (14 Nov 2004 12:33:53 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 14 Nov 2004 12:33:53 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Nov 14 13:33:33 2004 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1CTJZG-0008Sv-00 for ; Sun, 14 Nov 2004 13:33:20 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CTJht-00062i-0e for ged-emacs-devel@m.gmane.org; Sun, 14 Nov 2004 07:42:13 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1CTJhj-00062S-Gq for emacs-devel@gnu.org; Sun, 14 Nov 2004 07:42:03 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1CTJhi-00062G-Hi for emacs-devel@gnu.org; Sun, 14 Nov 2004 07:42:03 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CTJhi-00062D-FB for emacs-devel@gnu.org; Sun, 14 Nov 2004 07:42:02 -0500 Original-Received: from [130.225.103.32] (helo=imf.math.ku.dk) by monty-python.gnu.org with esmtp (Exim 4.34) id 1CTJYd-00064R-3M for emacs-devel@gnu.org; Sun, 14 Nov 2004 07:32:39 -0500 Original-Received: by imf.math.ku.dk (Postfix, from userid 73) id 07F2D23BFBC; Sun, 14 Nov 2004 13:32:36 +0100 (CET) Original-Received: from imf (localhost [127.0.0.1]) by spamwall (Postfix) with ESMTP id 91F0223BF3B; Sun, 14 Nov 2004 13:32:31 +0100 (CET) Original-Received: from localhost ([127.0.0.1]) by imf.math.ku.dk (MailMonitor for SMTP v1.2.2 ) ; Sun, 14 Nov 2004 13:32:31 +0100 (CET) Original-Received: from math.ku.dk (shannon.math.ku.dk [130.225.103.12]) by imf.math.ku.dk (Postfix) with ESMTP id 8EACB23BF3B; Sun, 14 Nov 2004 13:32:29 +0100 (CET) User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.6) Gecko/20040114 X-Accept-Language: da, en-us, en Original-To: Michael Albinus , =?ISO-8859-1?Q?Kai_Gro=DF?= =?ISO-8859-1?Q?johann?= X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:29808 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:29808 This is a multi-part message in MIME format. --------------070308080705060102060805 Content-Type: text/plain; charset=us-ascii; format=flowed Content-Transfer-Encoding: 7bit About a year ago I added the parameter id-format to the primitives file-attributes and directory-files-and-attributes so that one can get uid and gid as a string. I did that primarily because I like ls-lisp very much and would like to use it together with tramp. However, ls-lisp uses directory-files-and-attributes and tramp does not implement it. I never got around to do anything about that, but now I finally have made a patch (attached). Please take a look at it before I install it. Thank you! Description of changes: 1. New function tramp-handle-directory-files-and-attributes with perl script tramp-perl-directory-files-and-attributes. In order to not slow down login process, the script is sent only if needed. A new function tramp-maybe-send-perl-script handles that. Connection property "perl-scripts" holds a list of scripts sent. With tramp-maybe-send-perl-script it is easy for a user to implement his own "remote procedure" with perl. 2. tramp-handle-file-attributes-with-perl now uses tramp-maybe-send-perl-script, the script is no longer sent by tramp-post-connection. This should speed up initialization a bit. 3. Conversion of file mode bits to a string and and assignment of virtual device number is collected a new function tramp-convert-file-attributes. This function also adds tramp prefix to symlinks if they are absolute -- that was not done before. tramp-convert-file-attributes is used in tramp-handle-file-attributes and tramp-handle-directory-files-and-attributes. 4. tramp-perl-file-attributes did not surround uid and gid by double quotes when they were supposed to be a string. That is corrected. 5. Name and semantics of parameter nonnumeric is changed to id-format in functions tramp-perl-file-attributes, tramp-handle-file-attributes-with-perl and tramp-handle-file-attributes-with-ls. 6. tramp-handle-insert-directory now runs the real handler when ls-lisp is in use. 7. file-directory-files is deleted from tramp-file-name-handler-alist, there is no such primitive and no tramp handler. So I guess it is a mistake. --------------070308080705060102060805 Content-Type: text/x-patch; name="file-attributes.patch" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="file-attributes.patch" *** tramp.1.56.el Sun Nov 14 10:04:02 2004 --- /home/lh/cvsroot/emacs/lisp/net/tramp.el Sun Nov 14 12:27:22 2004 *************** *** 1547,1566 **** ;; The device number is returned as "-1", because there will be a virtual ;; device number set in `tramp-handle-file-attributes' (defconst tramp-perl-file-attributes "\ ! \($f, $n) = @ARGV; ! @s = lstat($f); ! if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; } ! elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; } ! else { $l = \"nil\" }; ! $u = ($n eq \"nil\") ? $s[4] : getpwuid($s[4]); ! $g = ($n eq \"nil\") ? $s[5] : getgrgid($s[5]); ! printf(\"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", ! $l, $s[3], $u, $g, $s[8] >> 16 & 0xffff, $s[8] & 0xffff, ! $s[9] >> 16 & 0xffff, $s[9] & 0xffff, $s[10] >> 16 & 0xffff, $s[10] & 0xffff, ! $s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1] & 0xffff);" "Perl script to produce output suitable for use with `file-attributes' on the remote file system.") ;; ;; These two use uu encoding. ;; (defvar tramp-perl-encode "%s -e'\ ;; print qq(begin 644 xxx\n); --- 1547,1638 ---- ;; The device number is returned as "-1", because there will be a virtual ;; device number set in `tramp-handle-file-attributes' (defconst tramp-perl-file-attributes "\ ! @stat = lstat($ARGV[0]); ! if (($stat[2] & 0170000) == 0120000) ! { ! $type = readlink($ARGV[0]); ! $type = \"\\\"$type\\\"\"; ! } ! elsif (($stat[2] & 0170000) == 040000) ! { ! $type = \"t\"; ! } ! else ! { ! $type = \"nil\" ! }; ! $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; ! $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; ! printf( ! \"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", ! $type, ! $stat[3], ! $uid, ! $gid, ! $stat[8] >> 16 & 0xffff, ! $stat[8] & 0xffff, ! $stat[9] >> 16 & 0xffff, ! $stat[9] & 0xffff, ! $stat[10] >> 16 & 0xffff, ! $stat[10] & 0xffff, ! $stat[7], ! $stat[2], ! $stat[1] >> 16 & 0xffff, ! $stat[1] & 0xffff ! );" "Perl script to produce output suitable for use with `file-attributes' on the remote file system.") + (defconst tramp-perl-directory-files-and-attributes "\ + chdir($ARGV[0]); + opendir(DIR,\".\"); + @list = readdir(DIR); + closedir(DIR); + $n = scalar(@list); + printf(\"(\\n\"); + for($i = 0; $i < $n; $i++) + { + $filename = $list[$i]; + @stat = lstat($filename); + if (($stat[2] & 0170000) == 0120000) + { + $type = readlink($filename); + $type = \"\\\"$type\\\"\"; + } + elsif (($stat[2] & 0170000) == 040000) + { + $type = \"t\"; + } + else + { + $type = \"nil\" + }; + $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; + $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; + printf( + \"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\", + $filename, + $type, + $stat[3], + $uid, + $gid, + $stat[8] >> 16 & 0xffff, + $stat[8] & 0xffff, + $stat[9] >> 16 & 0xffff, + $stat[9] & 0xffff, + $stat[10] >> 16 & 0xffff, + $stat[10] & 0xffff, + $stat[7], + $stat[2], + $stat[1] >> 16 & 0xffff, + $stat[1] & 0xffff, + $stat[0] >> 16 & 0xffff, + $stat[0] & 0xffff); + } + printf(\")\\n\");" + "Perl script implementing `directory-files-attributes' as Lisp `read'able + output.") + ;; ;; These two use uu encoding. ;; (defvar tramp-perl-encode "%s -e'\ ;; print qq(begin 644 xxx\n); *************** *** 1759,1766 **** (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-attributes . tramp-handle-file-attributes) (file-modes . tramp-handle-file-modes) - (file-directory-files . tramp-handle-file-directory-files) (directory-files . tramp-handle-directory-files) (file-name-all-completions . tramp-handle-file-name-all-completions) (file-name-completion . tramp-handle-file-name-completion) (add-name-to-file . tramp-handle-add-name-to-file) --- 1831,1838 ---- (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-attributes . tramp-handle-file-attributes) (file-modes . tramp-handle-file-modes) (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) (file-name-all-completions . tramp-handle-file-name-all-completions) (file-name-completion . tramp-handle-file-name-completion) (add-name-to-file . tramp-handle-add-name-to-file) *************** *** 2170,2195 **** ;; Daniel Pittman (defun tramp-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for tramp files." ! (let ((nonnumeric (and id-format (equal id-format 'string))) ! result) (with-parsed-tramp-file-name filename nil ! (when (file-exists-p filename) ! ;; file exists, find out stuff ! (save-excursion ! (if (tramp-get-remote-perl multi-method method user host) ! (setq result ! (tramp-handle-file-attributes-with-perl ! multi-method method user host localname nonnumeric)) ! (setq result ! (tramp-handle-file-attributes-with-ls ! multi-method method user host localname nonnumeric))) ! ;; set virtual device number ! (setcar (nthcdr 11 result) ! (tramp-get-device multi-method method user host))))) ! result)) (defun tramp-handle-file-attributes-with-ls ! (multi-method method user host localname &optional nonnumeric) "Implement `file-attributes' for tramp files using the ls(1) command." (let (symlinkp dirp res-inode res-filemodes res-numlinks --- 2242,2262 ---- ;; Daniel Pittman (defun tramp-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for tramp files." ! (when (file-exists-p filename) ! ;; file exists, find out stuff ! (unless id-format (setq id-format 'integer)) (with-parsed-tramp-file-name filename nil ! (save-excursion ! (tramp-convert-file-attributes ! multi-method method user host ! (if (tramp-get-remote-perl multi-method method user host) ! (tramp-handle-file-attributes-with-perl multi-method method user host ! localname id-format) ! (tramp-handle-file-attributes-with-ls multi-method method user host ! localname id-format))))))) (defun tramp-handle-file-attributes-with-ls ! (multi-method method user host localname &optional id-format) "Implement `file-attributes' for tramp files using the ls(1) command." (let (symlinkp dirp res-inode res-filemodes res-numlinks *************** *** 2202,2208 **** multi-method method user host (format "%s %s %s" (tramp-get-ls-command multi-method method user host) ! (if nonnumeric "-ild" "-ildn") (tramp-shell-quote-argument localname))) (tramp-wait-for-output) ;; parse `ls -l' output ... --- 2269,2275 ---- multi-method method user host (format "%s %s %s" (tramp-get-ls-command multi-method method user host) ! (if (eq id-format 'integer) "-ildn" "-ild") (tramp-shell-quote-argument localname))) (tramp-wait-for-output) ;; parse `ls -l' output ... *************** *** 2229,2235 **** ;; ... uid and gid (setq res-uid (read (current-buffer))) (setq res-gid (read (current-buffer))) ! (unless nonnumeric (unless (numberp res-uid) (setq res-uid -1)) (unless (numberp res-gid) (setq res-gid -1))) ;; ... size --- 2296,2302 ---- ;; ... uid and gid (setq res-uid (read (current-buffer))) (setq res-gid (read (current-buffer))) ! (when (eq id-format 'integer) (unless (numberp res-uid) (setq res-uid -1)) (unless (numberp res-gid) (setq res-gid -1))) ;; ... size *************** *** 2274,2306 **** ))) (defun tramp-handle-file-attributes-with-perl ! (multi-method method user host localname &optional nonnumeric) ! "Implement `file-attributes' for tramp files using a Perl script. ! ! The Perl command is sent to the remote machine when the connection ! is initially created and is kept cached by the remote shell." (tramp-message-for-buffer multi-method method user host 10 "file attributes with perl: %s" (tramp-make-tramp-file-name multi-method method user host localname)) ! (tramp-send-command ! multi-method method user host ! (format "tramp_file_attributes %s %s" ! (tramp-shell-quote-argument localname) nonnumeric)) (tramp-wait-for-output) ! (let ((result (read (current-buffer)))) ! (setcar (nthcdr 8 result) ! (tramp-file-mode-from-int (nth 8 result))) ! result)) ! ! (defun tramp-get-device (multi-method method user host) ! "Returns the virtual device number. ! If it doesn't exist, generate a new one." ! (let ((string (tramp-make-tramp-file-name multi-method method user host ""))) ! (unless (assoc string tramp-devices) ! (add-to-list 'tramp-devices ! (list string (length tramp-devices)))) ! (list -1 (nth 1 (assoc string tramp-devices))))) (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for tramp files." --- 2341,2360 ---- ))) (defun tramp-handle-file-attributes-with-perl ! (multi-method method user host localname &optional id-format) ! "Implement `file-attributes' for tramp files using a Perl script." (tramp-message-for-buffer multi-method method user host 10 "file attributes with perl: %s" (tramp-make-tramp-file-name multi-method method user host localname)) ! (tramp-maybe-send-perl-script tramp-perl-file-attributes ! "tramp_file_attributes" ! multi-method method user host) ! (tramp-send-command multi-method method user host ! (format "tramp_file_attributes %s %s" ! (tramp-shell-quote-argument localname) id-format)) (tramp-wait-for-output) ! (read (current-buffer))) (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for tramp files." *************** *** 2628,2633 **** --- 2682,2719 ---- (push item result))))))) result))) + (defun tramp-handle-directory-files-and-attributes + (directory &optional full match nosort id-format) + "Like `directory-files-and-attributes' for tramp files." + (when (tramp-handle-file-exists-p directory) + (save-excursion + (setq directory (tramp-handle-expand-file-name directory)) + (with-parsed-tramp-file-name directory nil + (tramp-maybe-send-perl-script tramp-perl-directory-files-and-attributes + "tramp_directory_files_and_attributes" + multi-method method user host) + (tramp-send-command multi-method method user host + (format "tramp_directory_files_and_attributes %s %s" + (tramp-shell-quote-argument localname) + (or id-format 'integer))) + (tramp-wait-for-output) + (let* ((root (cons nil (read (current-buffer)))) + (cell root)) + (while (cdr cell) + (if (and match (not (string-match match (caadr cell)))) + ;; Remove from list + (setcdr cell (cddr cell)) + ;; Include in list + (setq cell (cdr cell)) + (let ((l (car cell))) + (tramp-convert-file-attributes multi-method method user host + (cdr l)) + ;; If FULL, make file name absolute + (when full (setcar l (concat directory "/" (car l))))))) + (if nosort + (cdr root) + (sort (cdr root) (lambda (x y) (string< (car x) (car y)))))))))) + ;; 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 *************** *** 3186,3268 **** (defun tramp-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for tramp files." ! ;; For the moment, we assume that the remote "ls" program does not ! ;; grok "--dired". In the future, we should detect this on ! ;; connection setup. ! (when (string-match "^--dired\\s-+" switches) ! (setq switches (replace-match "" nil t switches))) ! (setq filename (expand-file-name filename)) ! (with-parsed-tramp-file-name filename nil ! (tramp-message-for-buffer ! multi-method method user host 10 ! "Inserting directory `ls %s %s', wildcard %s, fulldir %s" ! switches filename (if wildcard "yes" "no") ! (if full-directory-p "yes" "no")) ! (when wildcard ! (setq wildcard (file-name-nondirectory localname)) ! (setq localname (file-name-directory localname))) ! (when (listp switches) ! (setq switches (mapconcat 'identity switches " "))) ! (unless full-directory-p ! (setq switches (concat "-d " switches))) ! (when wildcard ! (setq switches (concat switches " " wildcard))) ! (save-excursion ! ;; If `full-directory-p', we just say `ls -l FILENAME'. ! ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. ! (if full-directory-p ! (tramp-send-command ! multi-method method user host ! (format "%s %s %s" ! (tramp-get-ls-command multi-method method user host) ! switches ! (if wildcard ! localname ! (tramp-shell-quote-argument (concat localname "."))))) ! (tramp-barf-unless-okay ! multi-method method user host ! (format "cd %s" (tramp-shell-quote-argument ! (file-name-directory localname))) ! nil 'file-error ! "Couldn't `cd %s'" ! (tramp-shell-quote-argument (file-name-directory localname))) ! (tramp-send-command ! multi-method method user host ! (format "%s %s %s" ! (tramp-get-ls-command multi-method method user host) ! switches ! (if wildcard ! localname ! (tramp-shell-quote-argument ! (file-name-nondirectory localname)))))) ! (sit-for 1) ;needed for rsh but not ssh? ! (tramp-wait-for-output)) ! ;; The following let-binding is used by code that's commented ! ;; out. Let's leave the let-binding in for a while to see ! ;; that the commented-out code is really not needed. Commenting-out ! ;; happened on 2003-03-13. ! (let ((old-pos (point))) ! (insert-buffer-substring ! (tramp-get-buffer multi-method method user host)) ! ;; On XEmacs, we want to call (exchange-point-and-mark t), but ! ;; that doesn't exist on Emacs, so we use this workaround instead. ! ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to ! ;; be safe. Thanks to Daniel Pittman . ! ;; (let ((zmacs-region-stays t)) ! ;; (exchange-point-and-mark)) (save-excursion ! (tramp-send-command multi-method method user host "cd") ! (tramp-wait-for-output)) ! ;; For the time being, the XEmacs kludge is commented out. ! ;; Please test it on various XEmacs versions to see if it works. ! ;; ;; Another XEmacs specialty follows. What's the right way to do ! ;; ;; it? ! ;; (when (and (featurep 'xemacs) ! ;; (eq major-mode 'dired-mode)) ! ;; (save-excursion ! ;; (require 'dired) ! ;; (dired-insert-set-properties old-pos (point)))) ! ))) ;; Continuation of kluge to pacify byte-compiler. ;;(eval-when-compile --- 3272,3358 ---- (defun tramp-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for tramp files." ! (if (and (boundp 'ls-lisp-use-insert-directory-program) ! (not ls-lisp-use-insert-directory-program)) ! (tramp-run-real-handler 'insert-directory ! (list filename switches wildcard full-directory-p)) ! ;; For the moment, we assume that the remote "ls" program does not ! ;; grok "--dired". In the future, we should detect this on ! ;; connection setup. ! (when (string-match "^--dired\\s-+" switches) ! (setq switches (replace-match "" nil t switches))) ! (setq filename (expand-file-name filename)) ! (with-parsed-tramp-file-name filename nil ! (tramp-message-for-buffer ! multi-method method user host 10 ! "Inserting directory `ls %s %s', wildcard %s, fulldir %s" ! switches filename (if wildcard "yes" "no") ! (if full-directory-p "yes" "no")) ! (when wildcard ! (setq wildcard (file-name-nondirectory localname)) ! (setq localname (file-name-directory localname))) ! (when (listp switches) ! (setq switches (mapconcat 'identity switches " "))) ! (unless full-directory-p ! (setq switches (concat "-d " switches))) ! (when wildcard ! (setq switches (concat switches " " wildcard))) (save-excursion ! ;; If `full-directory-p', we just say `ls -l FILENAME'. ! ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. ! (if full-directory-p ! (tramp-send-command ! multi-method method user host ! (format "%s %s %s" ! (tramp-get-ls-command multi-method method user host) ! switches ! (if wildcard ! localname ! (tramp-shell-quote-argument (concat localname "."))))) ! (tramp-barf-unless-okay ! multi-method method user host ! (format "cd %s" (tramp-shell-quote-argument ! (file-name-directory localname))) ! nil 'file-error ! "Couldn't `cd %s'" ! (tramp-shell-quote-argument (file-name-directory localname))) ! (tramp-send-command ! multi-method method user host ! (format "%s %s %s" ! (tramp-get-ls-command multi-method method user host) ! switches ! (if wildcard ! localname ! (tramp-shell-quote-argument ! (file-name-nondirectory localname)))))) ! (sit-for 1) ;needed for rsh but not ssh? ! (tramp-wait-for-output)) ! ;; The following let-binding is used by code that's commented ! ;; out. Let's leave the let-binding in for a while to see ! ;; that the commented-out code is really not needed. Commenting-out ! ;; happened on 2003-03-13. ! (let ((old-pos (point))) ! (insert-buffer-substring ! (tramp-get-buffer multi-method method user host)) ! ;; On XEmacs, we want to call (exchange-point-and-mark t), but ! ;; that doesn't exist on Emacs, so we use this workaround instead. ! ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to ! ;; be safe. Thanks to Daniel Pittman . ! ;; (let ((zmacs-region-stays t)) ! ;; (exchange-point-and-mark)) ! (save-excursion ! (tramp-send-command multi-method method user host "cd") ! (tramp-wait-for-output)) ! ;; For the time being, the XEmacs kludge is commented out. ! ;; Please test it on various XEmacs versions to see if it works. ! ;; ;; Another XEmacs specialty follows. What's the right way to do ! ;; ;; it? ! ;; (when (and (featurep 'xemacs) ! ;; (eq major-mode 'dired-mode)) ! ;; (save-excursion ! ;; (require 'dired) ! ;; (dired-insert-set-properties old-pos (point)))) ! )))) ;; Continuation of kluge to pacify byte-compiler. ;;(eval-when-compile *************** *** 4679,4684 **** --- 4769,4797 ---- ;;; Internal Functions: + (defun tramp-maybe-send-perl-script (script name multi-method method user host) + "Define in remote shell function NAME implemented as perl SCRIPT. + Only send the definition if it has not already been done. + Function may have 0-3 parameters." + (let ((remote-perl (tramp-get-remote-perl multi-method method user host))) + (unless remote-perl (error "No remote perl")) + (let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil + multi-method method user host))) + (unless (memq name perl-scripts) + (with-current-buffer (tramp-get-buffer multi-method method user host) + (tramp-message 5 (concat "Sending the Perl script `" name "'...")) + (tramp-send-string multi-method method user host + (concat name + " () {\n" + remote-perl + " -e '" + script + "' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}")) + (tramp-wait-for-output) + (tramp-set-connection-property "perl-scripts" (cons name perl-scripts) + multi-method method user host) + (tramp-message 5 (concat "Sending the Perl script `" name "'...done."))))))) + (defun tramp-set-auto-save () (when (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)) *************** *** 5859,5864 **** --- 5972,5978 ---- (tramp-wait-for-output) ;; Find a `perl'. (erase-buffer) + (tramp-set-connection-property "perl-scripts" nil multi-method method user host) (let ((tramp-remote-perl (or (tramp-find-executable multi-method method user host "perl5" tramp-remote-path nil) *************** *** 5867,5914 **** (when tramp-remote-perl (tramp-set-connection-property "perl" tramp-remote-perl multi-method method user host) ! ;; Set up stat in Perl if we can. ! (when tramp-remote-perl ! (tramp-message 5 "Sending the Perl `file-attributes' implementation.") ! (tramp-send-string ! multi-method method user host ! (concat "tramp_file_attributes () {\n" ! tramp-remote-perl ! " -e '" tramp-perl-file-attributes "'" ! " \"$1\" \"$2\" 2>/dev/null\n" ! "}")) ! (tramp-wait-for-output) ! (unless (tramp-method-out-of-band-p multi-method method user host) ! (tramp-message 5 "Sending the Perl `mime-encode' implementations.") ! (tramp-send-string ! multi-method method user host ! (concat "tramp_encode () {\n" ! (format tramp-perl-encode tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output) ! (tramp-send-string ! multi-method method user host ! (concat "tramp_encode_with_module () {\n" ! (format tramp-perl-encode-with-module tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output) ! (tramp-message 5 "Sending the Perl `mime-decode' implementations.") ! (tramp-send-string ! multi-method method user host ! (concat "tramp_decode () {\n" ! (format tramp-perl-decode tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output) ! (tramp-send-string ! multi-method method user host ! (concat "tramp_decode_with_module () {\n" ! (format tramp-perl-decode-with-module tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output))))) ;; Find ln(1) (erase-buffer) (let ((ln (tramp-find-executable multi-method method user host --- 5981,6017 ---- (when tramp-remote-perl (tramp-set-connection-property "perl" tramp-remote-perl multi-method method user host) ! (unless (tramp-method-out-of-band-p multi-method method user host) ! (tramp-message 5 "Sending the Perl `mime-encode' implementations.") ! (tramp-send-string ! multi-method method user host ! (concat "tramp_encode () {\n" ! (format tramp-perl-encode tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output) ! (tramp-send-string ! multi-method method user host ! (concat "tramp_encode_with_module () {\n" ! (format tramp-perl-encode-with-module tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output) ! (tramp-message 5 "Sending the Perl `mime-decode' implementations.") ! (tramp-send-string ! multi-method method user host ! (concat "tramp_decode () {\n" ! (format tramp-perl-decode tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output) ! (tramp-send-string ! multi-method method user host ! (concat "tramp_decode_with_module () {\n" ! (format tramp-perl-decode-with-module tramp-remote-perl) ! " 2>/dev/null" ! "\n}")) ! (tramp-wait-for-output)))) ;; Find ln(1) (erase-buffer) (let ((ln (tramp-find-executable multi-method method user host *************** *** 6417,6422 **** --- 6520,6550 ---- (t (error "Tenth char `%c' must be one of `xtT-'" other-execute-or-sticky))))))) + (defun tramp-convert-file-attributes (multi-method method user host attr) + "Convert file-attributes ATTR generated by perl script or ls. + Convert file mode bits to string, add tramp prefix to absolute symlink + and set virtual device number. Return ATTR." + (unless (stringp (nth 8 attr)) + ;; Convert file mode bits to string. + (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))) + (when (and (stringp (car attr)) (file-name-absolute-p (car attr))) + ;; Add tramp prefix to absolute symlink. + (setcar attr + (tramp-make-tramp-file-name multi-method method user host + (car attr)))) + ;; Set virtual device number. + (setcar (nthcdr 11 attr) + (tramp-get-device multi-method method user host)) + attr) + + (defun tramp-get-device (multi-method method user host) + "Returns the virtual device number. + If it doesn't exist, generate a new one." + (let ((string (tramp-make-tramp-file-name multi-method method user host ""))) + (unless (assoc string tramp-devices) + (add-to-list 'tramp-devices + (list string (length tramp-devices)))) + (list -1 (nth 1 (assoc string tramp-devices))))) (defun tramp-file-mode-from-int (mode) "Turn an integer representing a file mode into an ls(1)-like string." --------------070308080705060102060805 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-devel --------------070308080705060102060805--