+2014-02-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-make-symbolic-link): New defun.
+ (tramp-check-cached-permissions): Call `file-attributes' if the
+ cache is empty.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist)
+ [make-symbolic-link]: Use `tramp-handle-make-symbolic-link'.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist)
+ [make-symbolic-link]: Use `tramp-handle-make-symbolic-link'.
+ (tramp-gvfs-maybe-open-connection): Set always connection
+ properties, even if target is mounted already.
+
+ * net/tramp-sh.el (tramp-color-escape-sequence-regexp):
+ Set tramp-autoload cookie.
+ (tramp-get-remote-touch): New defun.
+ (tramp-sh-handle-set-file-times): Use it.
+ (tramp-sh-handle-directory-files-and-attributes):
+ Use `tramp-handle-directory-files-and-attributes' if neither stat
+ nor perl are available on the remote host.
+
+ * net/tramp-smb.el (tramp-smb-handle-insert-directory): Mark trailing
+ "/". Write long listing only when "l" belongs to the switches.
+
+ * net/trampver.el: Update release number.
+
2014-02-19 Juanma Barranquero <lekktu@gmail.com>
* frameset.el (frameset--reuse-frame): Remove workaround for bug#16793.
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
- (make-symbolic-link . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
(set-file-acl . ignore)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
- (make-symbolic-link . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
(set-file-acl . ignore)
;; is marked with the fuse-mountpoint "/". We shall react.
(when (string-equal
(tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
- (tramp-error vec 'file-error "FUSE mount denied"))
-
- ;; In `tramp-check-cached-permissions', the connection
- ;; properties {uig,gid}-{integer,string} are used. We set
- ;; them to their local counterparts.
- (tramp-set-connection-property
- vec "uid-integer" (tramp-get-local-uid 'integer))
- (tramp-set-connection-property
- vec "gid-integer" (tramp-get-local-gid 'integer))
- (tramp-set-connection-property
- vec "uid-string" (tramp-get-local-uid 'string))
- (tramp-set-connection-property
- vec "gid-string" (tramp-get-local-gid 'string))))))
+ (tramp-error vec 'file-error "FUSE mount denied")))))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; {uig,gid}-{integer,string} are used. We set them to their local
+ ;; counterparts.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string)))
(defun tramp-gvfs-send-command (vec command &rest args)
"Send the COMMAND with its ARGS to connection VEC.
:group 'tramp
:type 'string)
+;;;###tramp-autoload
(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m"
"Escape sequences produced by the \"ls\" command.")
"Like `set-file-times' for Tramp files."
(if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v localname)
- (let ((time (if (or (null time) (equal time '(0 0)))
- (current-time)
- time))
- ;; With GNU Emacs, `format-time-string' has an optional
- ;; parameter UNIVERSAL. This is preferred, because we
- ;; could handle the case when the remote host is located
- ;; in a different time zone as the local host.
- (utc (not (featurep 'xemacs))))
- (tramp-send-command-and-check
- v (format "%s touch -t %s %s"
- (if utc "env TZ=UTC" "")
- (if utc
- (format-time-string "%Y%m%d%H%M.%S" time t)
- (format-time-string "%Y%m%d%H%M.%S" time))
- (tramp-shell-quote-argument localname)))))
+ (when (tramp-get-remote-touch v)
+ (tramp-flush-file-property v localname)
+ (let ((time (if (or (null time) (equal time '(0 0)))
+ (current-time)
+ time))
+ ;; With GNU Emacs, `format-time-string' has an
+ ;; optional parameter UNIVERSAL. This is preferred,
+ ;; because we could handle the case when the remote
+ ;; host is located in a different time zone as the
+ ;; local host.
+ (utc (not (featurep 'xemacs))))
+ (tramp-send-command-and-check
+ v (format
+ "%s %s %s %s"
+ (if utc "env TZ=UTC" "")
+ (tramp-get-remote-touch v)
+ (if (tramp-get-connection-property v "touch-t" nil)
+ (format "-t %s"
+ (if utc
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ (format-time-string "%Y%m%d%H%M.%S" time)))
+ "")
+ (tramp-shell-quote-argument localname))))))
;; We handle also the local part, because in older Emacsen,
;; without `set-file-times', this function is an alias for this.
(defun tramp-sh-handle-directory-files-and-attributes
(directory &optional full match nosort id-format)
"Like `directory-files-and-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (when (file-directory-p directory)
- (setq directory (expand-file-name directory))
- (let* ((temp
- (copy-tree
- (with-parsed-tramp-file-name directory nil
- (with-tramp-file-property
- v localname
- (format "directory-files-and-attributes-%s" id-format)
- (save-excursion
- (mapcar
- (lambda (x)
- (cons (car x)
- (tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format)))))))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null match) (string-match match (car item)))
- (when full
- (setcar item (expand-file-name (car item) directory)))
- (push item result)))
-
- (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y))))))))
+ (if (with-parsed-tramp-file-name directory nil
+ (not (or (tramp-get-remote-stat v) (tramp-get-remote-perl v))))
+ (tramp-handle-directory-files-and-attributes
+ directory full match nosort id-format)
+
+ ;; Do it directly.
+ (unless id-format (setq id-format 'integer))
+ (when (file-directory-p directory)
+ (setq directory (expand-file-name directory))
+ (let* ((temp
+ (copy-tree
+ (with-parsed-tramp-file-name directory nil
+ (with-tramp-file-property
+ v localname
+ (format "directory-files-and-attributes-%s" id-format)
+ (save-excursion
+ (mapcar
+ (lambda (x)
+ (cons (car x)
+ (tramp-convert-file-attributes v (cdr x))))
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname id-format)))))))))
+ result item)
+
+ (while temp
+ (setq item (pop temp))
+ (when (or (null match) (string-match match (car item)))
+ (when full
+ (setcar item (expand-file-name (car item) directory)))
+ (push item result)))
+
+ (if nosort
+ result
+ (sort result (lambda (x y) (string< (car x) (car y)))))))))
(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
(tramp-message vec 5 "Finding a suitable `trash' command")
(tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
+(defun tramp-get-remote-touch (vec)
+ (with-tramp-connection-property vec "touch"
+ (tramp-message vec 5 "Finding a suitable `touch' command")
+ (let ((result (tramp-find-executable
+ vec "touch" (tramp-get-remote-path vec)))
+ (tmpfile
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
+ ;; Busyboxes do support the "-t" option only when they have been
+ ;; built with the DESKTOP config option. Let's check it.
+ (when result
+ (tramp-set-connection-property
+ vec "touch-t"
+ (tramp-send-command-and-check
+ vec
+ (format
+ "%s -t %s %s"
+ result
+ (format-time-string "%Y%m%d%H%M.%S" (current-time))
+ (tramp-file-name-handler 'file-remote-p tmpfile 'localname))))
+ (delete-file tmpfile))
+ result)))
+
(defun tramp-get-remote-gvfs-monitor-dir (vec)
(with-tramp-connection-property vec "gvfs-monitor-dir"
(tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command")
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
+ ;; Mark trailing "/".
+ (when (and (zerop (length (file-name-nondirectory filename)))
+ (not full-directory-p))
+ (setq switches (concat switches "F")))
(if full-directory-p
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
(mapc
(lambda (x)
(when (not (zerop (length (nth 0 x))))
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes filename 'string)))))
- (insert
- (format
- "%10s %3d %-8s %-8s %8s %s "
- (or (nth 8 attr) (nth 1 x)) ; mode
- (or (nth 1 attr) 1) ; inode
- (or (nth 2 attr) "nobody") ; uid
- (or (nth 3 attr) "nogroup") ; gid
- (or (nth 7 attr) (nth 2 x)) ; size
- (format-time-string
- (if (tramp-time-less-p
- (tramp-time-subtract (current-time) (nth 3 x))
- tramp-half-a-year)
- "%b %e %R"
- "%b %e %Y")
- (nth 3 x)))) ; date
- ;; We mark the file name. The inserted name could be
- ;; from somewhere else, so we use the relative file
- ;; name of `default-directory'.
- (let ((start (point)))
+ (when (string-match "l" switches)
+ (let ((attr
+ (when (tramp-smb-get-stat-capability v)
+ (ignore-errors
+ (file-attributes filename 'string)))))
(insert
(format
- "%s\n"
- (file-relative-name
- (expand-file-name
- (nth 0 x) (file-name-directory filename)))))
- (put-text-property start (1- (point)) 'dired-filename t))
- (forward-line)
- (beginning-of-line))))
+ "%10s %3d %-8s %-8s %8s %s "
+ (or (nth 8 attr) (nth 1 x)) ; mode
+ (or (nth 1 attr) 1) ; inode
+ (or (nth 2 attr) "nobody") ; uid
+ (or (nth 3 attr) "nogroup") ; gid
+ (or (nth 7 attr) (nth 2 x)) ; size
+ (format-time-string
+ (if (tramp-time-less-p
+ (tramp-time-subtract (current-time) (nth 3 x))
+ tramp-half-a-year)
+ "%b %e %R"
+ "%b %e %Y")
+ (nth 3 x)))))) ; date
+
+ ;; We mark the file name. The inserted name could be
+ ;; from somewhere else, so we use the relative file name
+ ;; of `default-directory'.
+ (let ((start (point)))
+ (insert
+ (format
+ "%s\n"
+ (file-relative-name
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename)))))
+ (put-text-property start (1- (point)) 'dired-filename t))
+ (forward-line)
+ (beginning-of-line)))
entries)))))
(defun tramp-smb-handle-make-directory (dir &optional parents)
(delete-file local-copy)))))
t)))
+(defun tramp-handle-make-symbolic-link
+ (filename linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files."
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p filename) filename linkname) nil
+ (tramp-error v 'file-error "make-symbolic-link not supported")))
+
(defun tramp-handle-shell-command
(command &optional output-buffer error-buffer)
"Like `shell-command' for Tramp files."
(or
result
(let ((file-attr
- (tramp-get-file-property
- vec (tramp-file-name-localname vec)
- (concat "file-attributes-" suffix) nil))
+ (or
+ (tramp-get-file-property
+ vec (tramp-file-name-localname vec)
+ (concat "file-attributes-" suffix) nil)
+ (file-attributes
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-localname vec))
+ suffix)))
(remote-uid
(tramp-get-connection-property
vec (concat "uid-" suffix) nil))
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.9"
+(defconst tramp-version "2.2.9-24.4"
"This version of Tramp.")
;;;###tramp-autoload
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.9 is not fit for %s"
+ (format "Tramp 2.2.9-24.4 is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
projects / emacs.git / commitdiff