diff options
| author | Michael Albinus | 2014-02-28 09:41:24 +0100 |
|---|---|---|
| committer | Michael Albinus | 2014-02-28 09:41:24 +0100 |
| commit | 245aa73efeb4c2ef67c531033d67402c8204dda4 (patch) | |
| tree | e247df8ac70e53121de492567c4b60e36874919a | |
| parent | 48e15d641dd7b6b43a0bd9bbe3b86a8e148a5d17 (diff) | |
| download | emacs-245aa73efeb4c2ef67c531033d67402c8204dda4.tar.gz emacs-245aa73efeb4c2ef67c531033d67402c8204dda4.zip | |
* net/tramp-adb.el (tramp-adb-parse-device-names):
Use `accept-process-output'.
(tramp-adb-handle-file-truename): Cache the localname only.
(tramp-adb-handle-make-directory)
(tramp-adb-handle-delete-directory): Flush file properties correctly.
(tramp-adb-handle-set-file-modes): Do not raise an error when file
modes cannot be changed.
* net/tramp-cache.el (tramp-flush-directory-property): Remove also
file properties of symlinks.
| -rw-r--r-- | lisp/ChangeLog | 13 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 175 | ||||
| -rw-r--r-- | lisp/net/tramp-cache.el | 11 |
3 files changed, 111 insertions, 88 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 263c29c7af9..08960c85f04 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,16 @@ | |||
| 1 | 2014-02-28 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | * net/tramp-adb.el (tramp-adb-parse-device-names): | ||
| 4 | Use `accept-process-output'. | ||
| 5 | (tramp-adb-handle-file-truename): Cache the localname only. | ||
| 6 | (tramp-adb-handle-make-directory) | ||
| 7 | (tramp-adb-handle-delete-directory): Flush file properties correctly. | ||
| 8 | (tramp-adb-handle-set-file-modes): Do not raise an error when file | ||
| 9 | modes cannot be changed. | ||
| 10 | |||
| 11 | * net/tramp-cache.el (tramp-flush-directory-property): Remove also | ||
| 12 | file properties of symlinks. | ||
| 13 | |||
| 1 | 2014-02-28 Per Starbäck <starback@stp.lingfil.uu.se> | 14 | 2014-02-28 Per Starbäck <starback@stp.lingfil.uu.se> |
| 2 | 15 | ||
| 3 | * textmodes/bibtex.el (bibtex-biblatex-entry-alist): Update | 16 | * textmodes/bibtex.el (bibtex-biblatex-entry-alist): Update |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4480e4a7189..27f20dea754 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -186,7 +186,8 @@ pass to the OPERATION." | |||
| 186 | result) | 186 | result) |
| 187 | (tramp-compat-set-process-query-on-exit-flag p nil) | 187 | (tramp-compat-set-process-query-on-exit-flag p nil) |
| 188 | (while (eq 'run (process-status p)) | 188 | (while (eq 'run (process-status p)) |
| 189 | (sleep-for 0.1)) | 189 | (accept-process-output p 0.1)) |
| 190 | (accept-process-output p 0.1) | ||
| 190 | (goto-char (point-min)) | 191 | (goto-char (point-min)) |
| 191 | (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t) | 192 | (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t) |
| 192 | (add-to-list 'result (list nil (match-string 1)))) | 193 | (add-to-list 'result (list nil (match-string 1)))) |
| @@ -227,83 +228,90 @@ pass to the OPERATION." | |||
| 227 | ;; code could be shared? | 228 | ;; code could be shared? |
| 228 | (defun tramp-adb-handle-file-truename (filename) | 229 | (defun tramp-adb-handle-file-truename (filename) |
| 229 | "Like `file-truename' for Tramp files." | 230 | "Like `file-truename' for Tramp files." |
| 230 | (with-parsed-tramp-file-name (expand-file-name filename) nil | 231 | (format |
| 231 | (with-tramp-file-property v localname "file-truename" | 232 | "%s%s" |
| 232 | (let ((result nil)) ; result steps in reverse order | 233 | (with-parsed-tramp-file-name (expand-file-name filename) nil |
| 233 | (tramp-message v 4 "Finding true name for `%s'" filename) | 234 | (tramp-make-tramp-file-name |
| 234 | (let* ((directory-sep-char ?/) | 235 | method user host |
| 235 | (steps (tramp-compat-split-string localname "/")) | 236 | (with-tramp-file-property v localname "file-truename" |
| 236 | (localnamedir (tramp-run-real-handler | 237 | (let ((result nil)) ; result steps in reverse order |
| 237 | 'file-name-as-directory (list localname))) | 238 | (tramp-message v 4 "Finding true name for `%s'" filename) |
| 238 | (is-dir (string= localname localnamedir)) | 239 | (let* ((directory-sep-char ?/) |
| 239 | (thisstep nil) | 240 | (steps (tramp-compat-split-string localname "/")) |
| 240 | (numchase 0) | 241 | (localnamedir (tramp-run-real-handler |
| 241 | ;; Don't make the following value larger than | 242 | 'file-name-as-directory (list localname))) |
| 242 | ;; necessary. People expect an error message in a | 243 | (is-dir (string= localname localnamedir)) |
| 243 | ;; timely fashion when something is wrong; otherwise | 244 | (thisstep nil) |
| 244 | ;; they might think that Emacs is hung. Of course, | 245 | (numchase 0) |
| 245 | ;; correctness has to come first. | 246 | ;; Don't make the following value larger than |
| 246 | (numchase-limit 20) | 247 | ;; necessary. People expect an error message in a |
| 247 | symlink-target) | 248 | ;; timely fashion when something is wrong; otherwise |
| 248 | (while (and steps (< numchase numchase-limit)) | 249 | ;; they might think that Emacs is hung. Of course, |
| 249 | (setq thisstep (pop steps)) | 250 | ;; correctness has to come first. |
| 250 | (tramp-message | 251 | (numchase-limit 20) |
| 251 | v 5 "Check %s" | 252 | symlink-target) |
| 252 | (mapconcat 'identity | 253 | (while (and steps (< numchase numchase-limit)) |
| 253 | (append '("") (reverse result) (list thisstep)) | 254 | (setq thisstep (pop steps)) |
| 254 | "/")) | 255 | (tramp-message |
| 255 | (setq symlink-target | 256 | v 5 "Check %s" |
| 256 | (nth 0 (file-attributes | 257 | (mapconcat 'identity |
| 257 | (tramp-make-tramp-file-name | 258 | (append '("") (reverse result) (list thisstep)) |
| 258 | method user host | 259 | "/")) |
| 259 | (mapconcat 'identity | 260 | (setq symlink-target |
| 260 | (append '("") | 261 | (nth 0 (file-attributes |
| 261 | (reverse result) | 262 | (tramp-make-tramp-file-name |
| 262 | (list thisstep)) | 263 | method user host |
| 263 | "/"))))) | 264 | (mapconcat 'identity |
| 264 | (cond ((string= "." thisstep) | 265 | (append '("") |
| 265 | (tramp-message v 5 "Ignoring step `.'")) | 266 | (reverse result) |
| 266 | ((string= ".." thisstep) | 267 | (list thisstep)) |
| 267 | (tramp-message v 5 "Processing step `..'") | 268 | "/"))))) |
| 268 | (pop result)) | 269 | (cond ((string= "." thisstep) |
| 269 | ((stringp symlink-target) | 270 | (tramp-message v 5 "Ignoring step `.'")) |
| 270 | ;; It's a symlink, follow it. | 271 | ((string= ".." thisstep) |
| 271 | (tramp-message v 5 "Follow symlink to %s" symlink-target) | 272 | (tramp-message v 5 "Processing step `..'") |
| 272 | (setq numchase (1+ numchase)) | 273 | (pop result)) |
| 273 | (when (file-name-absolute-p symlink-target) | 274 | ((stringp symlink-target) |
| 274 | (setq result nil)) | 275 | ;; It's a symlink, follow it. |
| 275 | ;; If the symlink was absolute, we'll get a string | 276 | (tramp-message v 5 "Follow symlink to %s" symlink-target) |
| 276 | ;; like "/user@host:/some/target"; extract the | 277 | (setq numchase (1+ numchase)) |
| 277 | ;; "/some/target" part from it. | 278 | (when (file-name-absolute-p symlink-target) |
| 278 | (when (tramp-tramp-file-p symlink-target) | 279 | (setq result nil)) |
| 279 | (unless (tramp-equal-remote filename symlink-target) | 280 | ;; If the symlink was absolute, we'll get a string |
| 280 | (tramp-error | 281 | ;; like "/user@host:/some/target"; extract the |
| 281 | v 'file-error | 282 | ;; "/some/target" part from it. |
| 282 | "Symlink target `%s' on wrong host" symlink-target)) | 283 | (when (tramp-tramp-file-p symlink-target) |
| 283 | (setq symlink-target localname)) | 284 | (unless (tramp-equal-remote filename symlink-target) |
| 284 | (setq steps | 285 | (tramp-error |
| 285 | (append (tramp-compat-split-string | 286 | v 'file-error |
| 286 | symlink-target "/") | 287 | "Symlink target `%s' on wrong host" symlink-target)) |
| 287 | steps))) | 288 | (setq symlink-target localname)) |
| 288 | (t | 289 | (setq steps |
| 289 | ;; It's a file. | 290 | (append (tramp-compat-split-string |
| 290 | (setq result (cons thisstep result))))) | 291 | symlink-target "/") |
| 291 | (when (>= numchase numchase-limit) | 292 | steps))) |
| 292 | (tramp-error | 293 | (t |
| 293 | v 'file-error | 294 | ;; It's a file. |
| 294 | "Maximum number (%d) of symlinks exceeded" numchase-limit)) | 295 | (setq result (cons thisstep result))))) |
| 295 | (setq result (reverse result)) | 296 | (when (>= numchase numchase-limit) |
| 296 | ;; Combine list to form string. | 297 | (tramp-error |
| 297 | (setq result | 298 | v 'file-error |
| 298 | (if result | 299 | "Maximum number (%d) of symlinks exceeded" numchase-limit)) |
| 299 | (mapconcat 'identity (cons "" result) "/") | 300 | (setq result (reverse result)) |
| 300 | "/")) | 301 | ;; Combine list to form string. |
| 301 | (when (and is-dir (or (string= "" result) | 302 | (setq result |
| 302 | (not (string= (substring result -1) "/")))) | 303 | (if result |
| 303 | (setq result (concat result "/")))) | 304 | (mapconcat 'identity (cons "" result) "/") |
| 304 | 305 | "/")) | |
| 305 | (tramp-message v 4 "True name of `%s' is `%s'" filename result) | 306 | (when (and is-dir (or (string= "" result) |
| 306 | (tramp-make-tramp-file-name method user host result))))) | 307 | (not (string= (substring result -1) "/")))) |
| 308 | (setq result (concat result "/")))) | ||
| 309 | |||
| 310 | (tramp-message v 4 "True name of `%s' is `%s'" localname result) | ||
| 311 | result)))) | ||
| 312 | |||
| 313 | ;; Preserve trailing "/". | ||
| 314 | (if (string-equal (file-name-nondirectory filename) "") "/" ""))) | ||
| 307 | 315 | ||
| 308 | (defun tramp-adb-handle-file-attributes (filename &optional id-format) | 316 | (defun tramp-adb-handle-file-attributes (filename &optional id-format) |
| 309 | "Like `file-attributes' for Tramp files." | 317 | "Like `file-attributes' for Tramp files." |
| @@ -483,14 +491,12 @@ Emacs dired can't find files." | |||
| 483 | (tramp-adb-barf-unless-okay | 491 | (tramp-adb-barf-unless-okay |
| 484 | v (format "mkdir %s" (tramp-shell-quote-argument localname)) | 492 | v (format "mkdir %s" (tramp-shell-quote-argument localname)) |
| 485 | "Couldn't make directory %s" dir) | 493 | "Couldn't make directory %s" dir) |
| 486 | (tramp-flush-directory-property v (file-name-directory localname)))) | 494 | (tramp-flush-file-property v (file-name-directory localname)) |
| 495 | (tramp-flush-directory-property v localname))) | ||
| 487 | 496 | ||
| 488 | (defun tramp-adb-handle-delete-directory (directory &optional recursive) | 497 | (defun tramp-adb-handle-delete-directory (directory &optional recursive) |
| 489 | "Like `delete-directory' for Tramp files." | 498 | "Like `delete-directory' for Tramp files." |
| 490 | (setq directory (expand-file-name directory)) | 499 | (setq directory (expand-file-name directory)) |
| 491 | (with-parsed-tramp-file-name (file-truename directory) nil | ||
| 492 | (tramp-flush-file-property v (file-name-directory localname)) | ||
| 493 | (tramp-flush-directory-property v localname)) | ||
| 494 | (with-parsed-tramp-file-name directory nil | 500 | (with-parsed-tramp-file-name directory nil |
| 495 | (tramp-flush-file-property v (file-name-directory localname)) | 501 | (tramp-flush-file-property v (file-name-directory localname)) |
| 496 | (tramp-flush-directory-property v localname) | 502 | (tramp-flush-directory-property v localname) |
| @@ -621,9 +627,8 @@ But handle the case, if the \"test\" command is not available." | |||
| 621 | "Like `set-file-modes' for Tramp files." | 627 | "Like `set-file-modes' for Tramp files." |
| 622 | (with-parsed-tramp-file-name filename nil | 628 | (with-parsed-tramp-file-name filename nil |
| 623 | (tramp-flush-file-property v localname) | 629 | (tramp-flush-file-property v localname) |
| 624 | (tramp-adb-barf-unless-okay | 630 | (tramp-adb-send-command-and-check |
| 625 | v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname) | 631 | v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname)))) |
| 626 | "Error while changing file's mode %s" filename))) | ||
| 627 | 632 | ||
| 628 | (defun tramp-adb-handle-set-file-times (filename &optional time) | 633 | (defun tramp-adb-handle-set-file-times (filename &optional time) |
| 629 | "Like `set-file-times' for Tramp files." | 634 | "Like `set-file-times' for Tramp files." |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 825731c5ce8..be66f18d9e4 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -168,7 +168,7 @@ Returns VALUE." | |||
| 168 | ;;;###tramp-autoload | 168 | ;;;###tramp-autoload |
| 169 | (defun tramp-flush-file-property (key file) | 169 | (defun tramp-flush-file-property (key file) |
| 170 | "Remove all properties of FILE in the cache context of KEY." | 170 | "Remove all properties of FILE in the cache context of KEY." |
| 171 | ;; Remove file property of symlinks. | 171 | ;; Remove file properties of symlinks. |
| 172 | (let ((truename (tramp-get-file-property key file "file-truename" nil))) | 172 | (let ((truename (tramp-get-file-property key file "file-truename" nil))) |
| 173 | (when (and (stringp truename) | 173 | (when (and (stringp truename) |
| 174 | (not (string-equal file truename))) | 174 | (not (string-equal file truename))) |
| @@ -183,8 +183,13 @@ Returns VALUE." | |||
| 183 | (defun tramp-flush-directory-property (key directory) | 183 | (defun tramp-flush-directory-property (key directory) |
| 184 | "Remove all properties of DIRECTORY in the cache context of KEY. | 184 | "Remove all properties of DIRECTORY in the cache context of KEY. |
| 185 | Remove also properties of all files in subdirectories." | 185 | Remove also properties of all files in subdirectories." |
| 186 | (let ((directory (tramp-run-real-handler | 186 | (let* ((directory (tramp-run-real-handler |
| 187 | 'directory-file-name (list directory)))) | 187 | 'directory-file-name (list directory))) |
| 188 | (truename (tramp-get-file-property key directory "file-truename" nil))) | ||
| 189 | ;; Remove file properties of symlinks. | ||
| 190 | (when (and (stringp truename) | ||
| 191 | (not (string-equal directory truename))) | ||
| 192 | (tramp-flush-directory-property key truename)) | ||
| 188 | (tramp-message key 8 "%s" directory) | 193 | (tramp-message key 8 "%s" directory) |
| 189 | (maphash | 194 | (maphash |
| 190 | (lambda (key _value) | 195 | (lambda (key _value) |