[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/net/tramp.el [lexbind]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/net/tramp.el [lexbind] |
|
Date: |
Wed, 08 Dec 2004 19:21:00 -0500 |
Index: emacs/lisp/net/tramp.el
diff -c emacs/lisp/net/tramp.el:1.34.2.14 emacs/lisp/net/tramp.el:1.34.2.15
*** emacs/lisp/net/tramp.el:1.34.2.14 Fri Nov 12 04:21:18 2004
--- emacs/lisp/net/tramp.el Wed Dec 8 23:36:27 2004
***************
*** 34,40 ****
;;
;; Notes:
;; -----
! ;;
;; This package only works for Emacs 20 and higher, and for XEmacs 21
;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs
;; 19 is reported to have other problems. For XEmacs 21, you need the
--- 34,40 ----
;;
;; Notes:
;; -----
! ;;
;; This package only works for Emacs 20 and higher, and for XEmacs 21
;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs
;; 19 is reported to have other problems. For XEmacs 21, you need the
***************
*** 205,211 ****
gives the same backup policy for Tramp files on their hosts like the
policy for local files."
! :type '(repeat
(list (regexp :tag "File regexp")
(string :tag "Backup Dir")
(set :inline t
--- 205,211 ----
gives the same backup policy for Tramp files on their hosts like the
policy for local files."
! :type '(repeat
(list (regexp :tag "File regexp")
(string :tag "Backup Dir")
(set :inline t
***************
*** 506,512 ****
(tramp-copy-args nil)
(tramp-copy-keep-date-arg "-p")
(tramp-password-end-of-line "xy")) ;see docstring for "xy"
! ("fcp"
(tramp-connection-function tramp-open-connection-rsh)
(tramp-login-program "fsh")
(tramp-copy-program "fcp")
--- 506,512 ----
(tramp-copy-args nil)
(tramp-copy-keep-date-arg "-p")
(tramp-password-end-of-line "xy")) ;see docstring for "xy"
! ("fcp"
(tramp-connection-function tramp-open-connection-rsh)
(tramp-login-program "fsh")
(tramp-copy-program "fcp")
***************
*** 633,639 ****
("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n")
("remsh" tramp-multi-connect-rlogin "remsh %h -l %u%n")
("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n")
! ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
("su" tramp-multi-connect-su "su - %u%n")
("sudo" tramp-multi-connect-su "sudo -u %u -s -p Password:%n"))
"*List of connection functions for multi-hop methods.
--- 633,639 ----
("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n")
("remsh" tramp-multi-connect-rlogin "remsh %h -l %u%n")
("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n")
! ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
("su" tramp-multi-connect-su "su - %u%n")
("sudo" tramp-multi-connect-su "sudo -u %u -s -p Password:%n"))
"*List of connection functions for multi-hop methods.
***************
*** 777,783 ****
"sudo" tramp-completion-function-alist-su)
(tramp-set-completion-function
"multi" nil)
! (tramp-set-completion-function
"scpx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"sshx" tramp-completion-function-alist-ssh)
--- 777,783 ----
"sudo" tramp-completion-function-alist-su)
(tramp-set-completion-function
"multi" nil)
! (tramp-set-completion-function
"scpx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"sshx" tramp-completion-function-alist-ssh)
***************
*** 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)
***************
*** 1984,1990 ****
(setq filename (tramp-file-name-localname
(tramp-dissect-file-name
(expand-file-name filename)))))
!
;; Right, they are on the same host, regardless of user, method, etc.
;; We now make the link on the remote machine. This will occur as the
user
;; that FILENAME belongs to.
--- 2056,2062 ----
(setq filename (tramp-file-name-localname
(tramp-dissect-file-name
(expand-file-name filename)))))
!
;; Right, they are on the same host, regardless of user, method, etc.
;; We now make the link on the remote machine. This will occur as the
user
;; that FILENAME belongs to.
***************
*** 1993,1999 ****
l-multi-method l-method l-user l-host
(format "cd %s && %s -sf %s %s"
cwd ln
! filename
l-localname)
t)))))
--- 2065,2071 ----
l-multi-method l-method l-user l-host
(format "cd %s && %s -sf %s %s"
cwd ln
! filename
l-localname)
t)))))
***************
*** 2170,2195 ****
;; Daniel Pittman <address@hidden>
(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 <address@hidden>
(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."
***************
*** 2352,2358 ****
(let* ((attr (file-attributes f))
(modtime (nth 5 attr))
(mt (visited-file-modtime)))
!
(cond
;; file exists, and has a known modtime.
((and attr (not (equal modtime '(0 0))))
--- 2406,2412 ----
(let* ((attr (file-attributes f))
(modtime (nth 5 attr))
(mt (visited-file-modtime)))
!
(cond
;; file exists, and has a known modtime.
((and attr (not (equal modtime '(0 0))))
***************
*** 2442,2448 ****
(fa2 (file-attributes file2)))
(if (and (not (equal (nth 5 fa1) '(0 0)))
(not (equal (nth 5 fa2) '(0 0))))
! (> 0 (tramp-time-diff (nth 5 fa1) (nth 5 fa2)))
;; If one of them is the dont-know value, then we can
;; still try to run a shell command on the remote host.
;; However, this only works if both files are Tramp
--- 2496,2502 ----
(fa2 (file-attributes file2)))
(if (and (not (equal (nth 5 fa1) '(0 0)))
(not (equal (nth 5 fa2) '(0 0))))
! (< 0 (tramp-time-diff (nth 5 fa1) (nth 5 fa2)))
;; If one of them is the dont-know value, then we can
;; still try to run a shell command on the remote host.
;; However, this only works if both files are Tramp
***************
*** 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
***************
*** 2667,2673 ****
(push (buffer-substring (point)
(tramp-line-end-position))
result))
!
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)
--- 2753,2759 ----
(push (buffer-substring (point)
(tramp-line-end-position))
result))
!
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)
***************
*** 3084,3090 ****
'file-error
(list "Removing old file name" "no such directory" filename)))
;; Which is better, -r or -R? (-r works for me <address@hidden>)
! (tramp-send-command multi-method method user host
(format "rm -r %s" (tramp-shell-quote-argument
localname)))
;; Wait for the remote system to return to us...
;; This might take a while, allow it plenty of time.
--- 3170,3176 ----
'file-error
(list "Removing old file name" "no such directory" filename)))
;; Which is better, -r or -R? (-r works for me <address@hidden>)
! (tramp-send-command multi-method method user host
(format "rm -r %s" (tramp-shell-quote-argument
localname)))
;; Wait for the remote system to return to us...
;; This might take a while, allow it plenty of time.
***************
*** 3092,3098 ****
;; Make sure that it worked...
(and (file-exists-p filename)
(error "Failed to recusively delete %s" filename))))
!
(defun tramp-handle-dired-call-process (program discard &rest arguments)
"Like `dired-call-process' for tramp files."
(with-parsed-tramp-file-name default-directory nil
--- 3178,3184 ----
;; Make sure that it worked...
(and (file-exists-p filename)
(error "Failed to recusively delete %s" filename))))
!
(defun tramp-handle-dired-call-process (program discard &rest arguments)
"Like `dired-call-process' for tramp files."
(with-parsed-tramp-file-name default-directory nil
***************
*** 3114,3120 ****
(tramp-send-command-and-check multi-method method user host nil)
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)))))
!
(defun tramp-handle-dired-compress-file (file &rest ok-flag)
"Like `dired-compress-file' for tramp files."
;; OK-FLAG is valid for XEmacs only, but not implemented.
--- 3200,3206 ----
(tramp-send-command-and-check multi-method method user host nil)
(tramp-send-command multi-method method user host "cd")
(tramp-wait-for-output)))))
!
(defun tramp-handle-dired-compress-file (file &rest ok-flag)
"Like `dired-compress-file' for tramp files."
;; OK-FLAG is valid for XEmacs only, but not implemented.
***************
*** 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 <address@hidden>.
! ;; (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 <address@hidden>.
! ;; (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
***************
*** 3478,3484 ****
(when (and (numberp buffer) (zerop buffer))
(error "Implementation does not handle immediate return"))
(when (consp buffer) (error "Implementation does not handle error files"))
! (shell-command
(mapconcat 'tramp-shell-quote-argument
(cons program args)
" ")
--- 3568,3574 ----
(when (and (numberp buffer) (zerop buffer))
(error "Implementation does not handle immediate return"))
(when (consp buffer) (error "Implementation does not handle error files"))
! (shell-command
(mapconcat 'tramp-shell-quote-argument
(cons program args)
" ")
***************
*** 4160,4166 ****
;; `tramp-completion-file-name-regexp-unified' aren't different.
;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'.
! ;; Using `last-input-event' is a little bit risky, because completing a file
;; might require loading other files, like "~/.netrc", and for them it
;; shouldn't be decided based on that variable. On the other hand, those files
;; shouldn't have partial tramp file name syntax. Maybe another variable
should
--- 4250,4256 ----
;; `tramp-completion-file-name-regexp-unified' aren't different.
;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'.
! ;; Using `last-input-event' is a little bit risky, because completing a file
;; might require loading other files, like "~/.netrc", and for them it
;; shouldn't be decided based on that variable. On the other hand, those files
;; shouldn't have partial tramp file name syntax. Maybe another variable
should
***************
*** 4264,4270 ****
(funcall (nth 0 x) (nth 1 x)))))
(tramp-get-completion-function m))
! (setq result (append result
(mapcar
(lambda (x)
(tramp-get-completion-user-host
--- 4354,4360 ----
(funcall (nth 0 x) (nth 1 x)))))
(tramp-get-completion-function m))
! (setq result (append result
(mapcar
(lambda (x)
(tramp-get-completion-user-host
***************
*** 4305,4311 ****
;; [nil nil "x" nil nil]
;; [nil "x" nil nil nil]
! ;; "/x:" "/x:y" "/x:y:"
;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""]
;; "/[x/" "/[x/y"
;; [nil "x" nil "" nil] [nil "x" nil "y" nil]
--- 4395,4401 ----
;; [nil nil "x" nil nil]
;; [nil "x" nil nil nil]
! ;; "/x:" "/x:y" "/x:y:"
;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""]
;; "/[x/" "/[x/y"
;; [nil "x" nil "" nil] [nil "x" nil "y" nil]
***************
*** 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))
***************
*** 4751,4757 ****
"touch" nil (current-buffer) nil "-t" touch-time file))
(pop-to-buffer (current-buffer))
(error "tramp-touch: touch failed"))))))
!
(defun tramp-buffer-name (multi-method method user host)
"A name for the connection buffer for USER at HOST using METHOD."
(if multi-method
--- 4864,4870 ----
"touch" nil (current-buffer) nil "-t" touch-time file))
(pop-to-buffer (current-buffer))
(error "tramp-touch: touch failed"))))))
!
(defun tramp-buffer-name (multi-method method user host)
"A name for the connection buffer for USER at HOST using METHOD."
(if multi-method
***************
*** 4909,4915 ****
(file-exists-p existing)
(not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
!
;; CCC test ksh or bash found for tilde expansion?
(defun tramp-find-shell (multi-method method user host)
--- 5022,5028 ----
(file-exists-p existing)
(not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
!
;; CCC test ksh or bash found for tilde expansion?
(defun tramp-find-shell (multi-method method user host)
***************
*** 5008,5016 ****
(tramp-check-ls-commands multi-method method user host "gnuls"
tramp-remote-path)
(tramp-check-ls-commands multi-method method user host "gls"
tramp-remote-path)))
! ;; ------------------------------------------------------------
! ;; -- Functions for establishing connection --
! ;; ------------------------------------------------------------
;; The following functions are actions to be taken when seeing certain
;; prompts from the remote host. See the variable
--- 5121,5129 ----
(tramp-check-ls-commands multi-method method user host "gnuls"
tramp-remote-path)
(tramp-check-ls-commands multi-method method user host "gls"
tramp-remote-path)))
! ;; ------------------------------------------------------------
! ;; -- Functions for establishing connection --
! ;; ------------------------------------------------------------
;; The following functions are actions to be taken when seeing certain
;; prompts from the remote host. See the variable
***************
*** 5251,5257 ****
(when multi-method
(error "Cannot multi-connect using telnet connection method"))
(tramp-pre-connection multi-method method user host)
! (tramp-message 7 "Opening connection for address@hidden using %s..."
(or user (user-login-name)) host method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
--- 5364,5370 ----
(when multi-method
(error "Cannot multi-connect using telnet connection method"))
(tramp-pre-connection multi-method method user host)
! (tramp-message 7 "Opening connection for address@hidden using %s..."
(or user (user-login-name)) host method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
***************
*** 5285,5291 ****
p multi-method method user host)
(tramp-post-connection multi-method method user host)))))
!
(defun tramp-open-connection-rsh (multi-method method user host)
"Open a connection using an rsh METHOD.
This starts the command `rsh HOST -l USER'[*], then waits for a remote
--- 5398,5404 ----
p multi-method method user host)
(tramp-post-connection multi-method method user host)))))
!
(defun tramp-open-connection-rsh (multi-method method user host)
"Open a connection using an rsh METHOD.
This starts the command `rsh HOST -l USER'[*], then waits for a remote
***************
*** 5310,5316 ****
(error "Cannot multi-connect using rsh connection method"))
(tramp-pre-connection multi-method method user host)
(if (and user (not (string= user "")))
! (tramp-message 7 "Opening connection for address@hidden using %s..."
user host method)
(tramp-message 7 "Opening connection at %s using %s..." host method))
(let ((process-environment (copy-sequence process-environment))
--- 5423,5429 ----
(error "Cannot multi-connect using rsh connection method"))
(tramp-pre-connection multi-method method user host)
(if (and user (not (string= user "")))
! (tramp-message 7 "Opening connection for address@hidden using %s..."
user host method)
(tramp-message 7 "Opening connection at %s using %s..." host method))
(let ((process-environment (copy-sequence process-environment))
***************
*** 5339,5347 ****
(> emacs-major-version 20))
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
! (apply #'start-process bufnam buf login-program
real-host "-l" user login-args)
! (apply #'start-process bufnam buf login-program
real-host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
--- 5452,5460 ----
(> emacs-major-version 20))
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
! (apply #'start-process bufnam buf login-program
real-host "-l" user login-args)
! (apply #'start-process bufnam buf login-program
real-host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
***************
*** 5411,5420 ****
tramp-actions-before-shell)
(tramp-open-connection-setup-interactive-shell
p multi-method method user host)
! (tramp-post-connection multi-method method
user host)))))
! ;; HHH: Not Changed. Multi method. It is not clear to me how this can
;; handle not giving a user name in the "file name".
;;
;; This is more difficult than for the single-hop method. In the
--- 5524,5533 ----
tramp-actions-before-shell)
(tramp-open-connection-setup-interactive-shell
p multi-method method user host)
! (tramp-post-connection multi-method method
user host)))))
! ;; HHH: Not Changed. Multi method. It is not clear to me how this can
;; handle not giving a user name in the "file name".
;;
;; This is more difficult than for the single-hop method. In the
***************
*** 5484,5490 ****
(tramp-post-connection multi-method method user host)))))
;; HHH: Changed. Multi method. Don't know how to handle this in the case
! ;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-telnet (p method user host command)
--- 5597,5603 ----
(tramp-post-connection multi-method method user host)))))
;; HHH: Changed. Multi method. Don't know how to handle this in the case
! ;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-telnet (p method user host command)
***************
*** 5506,5513 ****
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
! ;; HHH: Changed. Multi method. Don't know how to handle this in the case
! ;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-rlogin (p method user host command)
--- 5619,5626 ----
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
! ;; HHH: Changed. Multi method. Don't know how to handle this in the case
! ;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-rlogin (p method user host command)
***************
*** 5532,5539 ****
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
! ;; HHH: Changed. Multi method. Don't know how to handle this in the case
! ;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-su (p method user host command)
--- 5645,5652 ----
(tramp-process-multi-actions p method user host
tramp-multi-actions)))
! ;; HHH: Changed. Multi method. Don't know how to handle this in the case
! ;; of no user name provided. Hack to make it work as it did before:
;; changed `user' to `(or user (user-login-name))' in the places where
;; the value is actually used.
(defun tramp-multi-connect-su (p method user host command)
***************
*** 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
***************
*** 6173,6179 ****
(tramp-barf-if-no-shell-prompt
nil 30
"Couldn't `%s', see buffer `%s'" command (buffer-name)))
!
(defun tramp-wait-for-output (&optional timeout)
"Wait for output from remote rsh command."
(let ((proc (get-buffer-process (current-buffer)))
--- 6276,6282 ----
(tramp-barf-if-no-shell-prompt
nil 30
"Couldn't `%s', see buffer `%s'" command (buffer-name)))
!
(defun tramp-wait-for-output (&optional timeout)
"Wait for output from remote rsh command."
(let ((proc (get-buffer-process (current-buffer)))
***************
*** 6417,6422 ****
--- 6520,6545 ----
(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 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))))
+ ;; 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."
***************
*** 6486,6494 ****
""))
! ;; ------------------------------------------------------------
! ;; -- TRAMP file names --
! ;; ------------------------------------------------------------
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
--- 6609,6617 ----
""))
! ;; ------------------------------------------------------------
! ;; -- TRAMP file names --
! ;; ------------------------------------------------------------
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
***************
*** 6499,6505 ****
"Return t iff NAME is a tramp file."
(save-match-data
(string-match tramp-file-name-regexp name)))
!
;; HHH: Changed. Used to assign the return value of (user-login-name)
;; to the `user' part of the structure if a user name was not
;; provided, now it assigns nil.
--- 6622,6628 ----
"Return t iff NAME is a tramp file."
(save-match-data
(string-match tramp-file-name-regexp name)))
!
;; HHH: Changed. Used to assign the return value of (user-login-name)
;; to the `user' part of the structure if a user name was not
;; provided, now it assigns nil.
***************
*** 6552,6558 ****
If both MULTI-METHOD and METHOD are nil, do a lookup in
`tramp-default-method-alist'."
(or multi-method method (tramp-find-default-method user host)))
!
;; HHH: Not Changed. Multi method. Will probably not handle the case where
;; a user name is not provided in the "file name" very well.
(defun tramp-dissect-multi-file-name (name)
--- 6675,6681 ----
If both MULTI-METHOD and METHOD are nil, do a lookup in
`tramp-default-method-alist'."
(or multi-method method (tramp-find-default-method user host)))
!
;; HHH: Not Changed. Multi method. Will probably not handle the case where
;; a user name is not provided in the "file name" very well.
(defun tramp-dissect-multi-file-name (name)
***************
*** 6724,6730 ****
(if entry
(second entry)
(symbol-value param))))
!
;; Auto saving to a special directory.
--- 6847,6853 ----
(if entry
(second entry)
(symbol-value param))))
!
;; Auto saving to a special directory.
***************
*** 6916,6924 ****
process flag)))
! ;; ------------------------------------------------------------
! ;; -- Kludges section --
! ;; ------------------------------------------------------------
;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
;; does not deal well with newline characters. Newline is replaced by
--- 7039,7047 ----
process flag)))
! ;; ------------------------------------------------------------
! ;; -- Kludges section --
! ;; ------------------------------------------------------------
;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
;; does not deal well with newline characters. Newline is replaced by
***************
*** 7181,7187 ****
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;; * Add caching for filename completion. (Greg Stark)
! ;; Of course, this has issues with usability (stale cache bites)
;; -- <address@hidden>
;; * Provide a local cache of old versions of remote files for the rsync
;; transfer method to use. (Greg Stark)
--- 7304,7310 ----
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;; * Add caching for filename completion. (Greg Stark)
! ;; Of course, this has issues with usability (stale cache bites)
;; -- <address@hidden>
;; * Provide a local cache of old versions of remote files for the rsync
;; transfer method to use. (Greg Stark)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/net/tramp.el [lexbind],
Miles Bader <=