diff options
| -rw-r--r-- | lisp/ChangeLog | 20 | ||||
| -rw-r--r-- | lisp/net/tramp-cache.el | 39 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 95 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 23 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 55 | ||||
| -rw-r--r-- | lisp/net/trampver.el | 4 |
7 files changed, 131 insertions, 113 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ffd224c9b6c..1b42ae36839 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2012-10-09 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-debug-message): Remove + "tramp-with-progress-reporter" from regexp of ignored functions. + (with-tramp-progress-reporter): Rename from + `tramp-with-progress-reporter'. + (with-tramp-file-property, with-tramp-connection-property): Move + from tramp-cache.el, rename from `with-file-property' and + `with-connection-property', respectively. + + * net/tramp-cache.el: Remove `with-file-property' and + `with-connection-property'. + + * net/tramp.el: + * net/tramp-gvfs.el: + * net/tramp-sh.el: + * net/tramp-smb.el: Adapt callees. + + * net/trampver.el: Update release number. + 2012-10-09 Glenn Morris <rgm@gnu.org> * w32-fns.el (set-message-beep): diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index fe5eb0049d0..e4fca46ce2d 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -139,27 +139,6 @@ Returns VALUE." value)) ;;;###tramp-autoload -(defmacro with-file-property (vec file property &rest body) - "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. -FILE must be a local file name on a connection identified via VEC." - `(if (file-name-absolute-p ,file) - (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass @body as parameter to - ;; `tramp-set-file-property' because it mangles our - ;; debug messages. - (setq value (progn ,@body)) - (tramp-set-file-property ,vec ,file ,property value)) - value) - ,@body)) - -;;;###tramp-autoload -(put 'with-file-property 'lisp-indent-function 3) -(put 'with-file-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-file-property\\>")) - -;;;###tramp-autoload (defun tramp-flush-file-property (vec file) "Remove all properties of FILE in the cache context of VEC." ;; Remove file property of symlinks. @@ -250,24 +229,6 @@ PROPERTY is set persistent when KEY is a vector." value)) ;;;###tramp-autoload -(defmacro with-connection-property (key property &rest body) - "Check in Tramp for property PROPERTY, otherwise executes BODY and set." - `(let ((value (tramp-get-connection-property ,key ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass ,@body as parameter to - ;; `tramp-set-connection-property' because it mangles our debug - ;; messages. - (setq value (progn ,@body)) - (tramp-set-connection-property ,key ,property value)) - value)) - -;;;###tramp-autoload -(put 'with-connection-property 'lisp-indent-function 2) -(put 'with-connection-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-connection-property\\>")) - -;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. KEY identifies the connection, it is either a process or a vector." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f78122ec704..60b39606d86 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -537,7 +537,7 @@ is no information where to trace the message.") "Like `copy-file' for Tramp files." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Copying %s to %s" filename newname) (condition-case err (let ((args @@ -741,7 +741,7 @@ is no information where to trace the message.") "Like `rename-file' for Tramp files." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Renaming %s to %s" filename newname) (condition-case err (rename-file @@ -1056,7 +1056,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (catch 'mounted (dolist (elt - (with-file-property vec "/" "list-mounts" + (with-tramp-file-property vec "/" "list-mounts" (with-tramp-dbus-call-method vec t :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker tramp-gvfs-interface-mounttracker "listMounts")) @@ -1199,7 +1199,7 @@ connection if a previous connection has died for some reason." (tramp-gvfs-object-path (tramp-make-tramp-file-name method user host "")))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 3 (if (zerop (length user)) (format "Opening connection for %s using %s" host method) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2c1af3e83fa..ec321d00506 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1058,7 +1058,7 @@ target of the symlink differ." "Like `file-truename' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-make-tramp-file-name method user host - (with-file-property v localname "file-truename" + (with-tramp-file-property v localname "file-truename" (let ((result nil)) ; result steps in reverse order (tramp-message v 4 "Finding true name for `%s'" filename) (cond @@ -1167,7 +1167,7 @@ target of the symlink differ." (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-exists-p" + (with-tramp-file-property v localname "file-exists-p" (or (not (null (tramp-get-file-property v localname "file-attributes-integer" nil))) (not (null (tramp-get-file-property @@ -1185,7 +1185,8 @@ target of the symlink differ." ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used)) (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname (format "file-attributes-%s" id-format) + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) (save-excursion (tramp-convert-file-attributes v @@ -1481,7 +1482,8 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-remote-selinux-p (vec) "Check, whether SELINUX is enabled on the remote host." - (with-connection-property (tramp-get-connection-process vec) "selinux-p" + (with-tramp-connection-property + (tramp-get-connection-process vec) "selinux-p" (let ((result (tramp-find-executable vec "getenforce" (tramp-get-remote-path vec) t t))) (and result @@ -1493,7 +1495,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-selinux-context (filename) "Like `file-selinux-context' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-selinux-context" + (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))) @@ -1537,7 +1539,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-executable-p" + (with-tramp-file-property v localname "file-executable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. (or (tramp-check-cached-permissions v ?x) @@ -1546,7 +1548,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-readable-p" + (with-tramp-file-property v localname "file-readable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. (or (tramp-check-cached-permissions v ?r) @@ -1600,13 +1602,13 @@ and gid of the corresponding user is taken. Both parameters must be integers." ;; desirable to return t immediately for "/method:foo:". It can ;; be expected that this is always a directory. (or (zerop (length localname)) - (with-file-property v localname "file-directory-p" + (with-tramp-file-property v localname "file-directory-p" (tramp-run-test "-d" filename))))) (defun tramp-sh-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-writable-p" + (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -1619,7 +1621,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-ownership-preserved-p (filename) "Like `file-ownership-preserved-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-ownership-preserved-p" + (with-tramp-file-property v localname "file-ownership-preserved-p" (let ((attributes (file-attributes filename))) ;; Return t if the file doesn't exist, since it's true that no ;; information would be lost by an (attempted) delete and create. @@ -1637,7 +1639,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (let* ((temp (copy-tree (with-parsed-tramp-file-name directory nil - (with-file-property + (with-tramp-file-property v localname (format "directory-files-and-attributes-%s" id-format) (save-excursion @@ -1987,7 +1989,7 @@ file names." (tramp-error v 'file-already-exists "File %s already exists" newname)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "%s %s to %s" (if (eq op 'copy) "Copying" "Renaming") filename newname) @@ -2505,7 +2507,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." nil) ((and suffix (nth 2 suffix)) ;; We found an uncompression rule. - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Uncompressing %s" file) (when (tramp-send-command-and-check v (concat (nth 2 suffix) " " @@ -2517,7 +2519,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (t ;; We don't recognize the file as compressed, so compress it. ;; Try gzip. - (tramp-with-progress-reporter v 0 (format "Compressing %s" file) + (with-tramp-progress-reporter v 0 (format "Compressing %s" file) (when (tramp-send-command-and-check v (concat "gzip -f " (tramp-shell-quote-argument localname))) @@ -2673,7 +2675,7 @@ the result will be a local, non-Tramp, filename." (string-match "\\`su\\(do\\)?\\'" method)) (setq uname (concat uname user))) (setq uname - (with-connection-property v uname + (with-tramp-connection-property v uname (tramp-send-command v (format "cd %s; pwd" (tramp-shell-quote-argument uname))) (with-current-buffer (tramp-get-buffer v) @@ -2943,7 +2945,7 @@ the result will be a local, non-Tramp, filename." ;; Use inline encoding for file transfer. (rem-enc (save-excursion - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Encoding remote file %s" filename) (tramp-barf-unless-okay v (format rem-enc (tramp-shell-quote-argument localname)) @@ -2957,7 +2959,7 @@ the result will be a local, non-Tramp, filename." (with-temp-buffer (set-buffer-multibyte nil) (insert-buffer-substring (tramp-get-buffer v)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Decoding remote file %s with function %s" filename loc-dec) (funcall loc-dec (point-min) (point-max)) @@ -2975,7 +2977,7 @@ the result will be a local, non-Tramp, filename." (let (file-name-handler-alist (coding-system-for-write 'binary)) (write-region (point-min) (point-max) tmpfile2)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Decoding remote file %s with command %s" filename loc-dec) (unwind-protect @@ -3203,7 +3205,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (set-buffer-multibyte nil) ;; Use encoding function or command. (if (functionp loc-enc) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Encoding region using function `%s'" loc-enc) (let ((coding-system-for-read 'binary)) @@ -3221,7 +3223,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (tramp-compat-temporary-file-directory))) (funcall loc-enc (point-min) (point-max)))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Encoding region using command `%s'" loc-enc) (unless (zerop (tramp-call-local-coding-command @@ -3235,7 +3237,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; Send buffer into remote decoding command which ;; writes to remote file. Because this happens on ;; the remote host, we cannot use the function. - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Decoding region into remote file %s" filename) (goto-char (point-max)) @@ -3335,7 +3337,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." "Like `vc-registered' for Tramp files." (tramp-compat-with-temp-message "" (with-parsed-tramp-file-name file nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Checking `vc-registered' for %s" file) ;; There could be new files, created by the vc backend. We @@ -3433,7 +3435,7 @@ Only send the definition if it has not already been done." (let ((scripts (tramp-get-connection-property (tramp-get-connection-process vec) "scripts" nil))) (unless (member name scripts) - (tramp-with-progress-reporter vec 5 (format "Sending script `%s'" name) + (with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name) ;; The script could contain a call of Perl. This is masked with `%s'. (tramp-barf-unless-okay vec @@ -3602,7 +3604,7 @@ file exists and nonzero exit status otherwise." (defun tramp-open-shell (vec shell) "Opens shell SHELL." - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 5 (format "Opening remote shell `%s'" shell) ;; Find arguments for this shell. (let ((tramp-end-of-output tramp-initial-end-of-output) @@ -3638,7 +3640,7 @@ file exists and nonzero exit status otherwise." (tramp-file-name-method vec) 'tramp-remote-shell))) shell) (setq shell - (with-connection-property vec "remote-shell" + (with-tramp-connection-property vec "remote-shell" ;; CCC: "root" does not exist always, see QNAP 459. ;; Which check could we apply instead? (tramp-send-command vec "echo ~root" t) @@ -3673,7 +3675,7 @@ file exists and nonzero exit status otherwise." (tramp-open-shell vec shell)) ;; Busyboxes tend to behave strange. We check for the existence. - (with-connection-property vec "busybox" + (with-tramp-connection-property vec "busybox" (tramp-send-command vec (format "%s --version" shell) t) (let ((case-fold-search t)) (and (string-match "busybox" (buffer-string)) t)))))) @@ -3798,7 +3800,7 @@ process to set up. VEC specifies the connection." ;; successfully, sending 625 bytes failed. Emacs makes a hack when ;; this host type is detected locally. It cannot handle remote ;; hosts, though. - (with-connection-property proc "chunksize" + (with-tramp-connection-property proc "chunksize" (cond ((and (integerp tramp-chunksize) (> tramp-chunksize 0)) tramp-chunksize) @@ -4327,7 +4329,7 @@ connection if a previous connection has died for some reason." (when (and (boundp 'non-essential) (symbol-value 'non-essential)) (throw 'non-essential 'non-essential)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) (format "Opening connection for %s using %s" @@ -4773,7 +4775,7 @@ This is used internally by `tramp-file-mode-from-int'." ;; Variables local to connection. (defun tramp-get-remote-path (vec) - (with-connection-property + (with-tramp-connection-property ;; When `tramp-own-remote-path' is in `tramp-remote-path', we ;; cache the result for the session only. Otherwise, the result ;; is cached persistently. @@ -4845,7 +4847,7 @@ This is used internally by `tramp-file-mode-from-int'." remote-path))))) (defun tramp-get-ls-command (vec) - (with-connection-property vec "ls" + (with-tramp-connection-property vec "ls" (tramp-message vec 5 "Finding a suitable `ls' command") (or (catch 'ls-found @@ -4871,7 +4873,7 @@ This is used internally by `tramp-file-mode-from-int'." (defun tramp-get-ls-command-with-dired (vec) (save-match-data - (with-connection-property vec "ls-dired" + (with-tramp-connection-property vec "ls-dired" (tramp-message vec 5 "Checking, whether `ls --dired' works") ;; Some "ls" versions are sensible wrt the order of arguments, ;; they fail when "-al" is after the "--dired" argument (for @@ -4880,7 +4882,7 @@ This is used internally by `tramp-file-mode-from-int'." vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec)))))) (defun tramp-get-test-command (vec) - (with-connection-property vec "test" + (with-tramp-connection-property vec "test" (tramp-message vec 5 "Finding a suitable `test' command") (if (tramp-send-command-and-check vec "test 0") "test" @@ -4890,7 +4892,7 @@ This is used internally by `tramp-file-mode-from-int'." ;; Does `test A -nt B' work? Use abominable `find' construct if it ;; doesn't. BSD/OS 4.0 wants the parentheses around the command, ;; for otherwise the shell crashes. - (with-connection-property vec "test-nt" + (with-tramp-connection-property vec "test-nt" (or (progn (tramp-send-command @@ -4908,17 +4910,17 @@ This is used internally by `tramp-file-mode-from-int'." "tramp_test_nt %s %s")))) (defun tramp-get-file-exists-command (vec) - (with-connection-property vec "file-exists" + (with-tramp-connection-property vec "file-exists" (tramp-message vec 5 "Finding command to check if file exists") (tramp-find-file-exists-command vec))) (defun tramp-get-remote-ln (vec) - (with-connection-property vec "ln" + (with-tramp-connection-property vec "ln" (tramp-message vec 5 "Finding a suitable `ln' command") (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) (defun tramp-get-remote-perl (vec) - (with-connection-property vec "perl" + (with-tramp-connection-property vec "perl" (tramp-message vec 5 "Finding a suitable `perl' command") (let ((result (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) @@ -4926,16 +4928,16 @@ This is used internally by `tramp-file-mode-from-int'." vec "perl" (tramp-get-remote-path vec))))) ;; We must check also for some Perl modules. (when result - (with-connection-property vec "perl-file-spec" + (with-tramp-connection-property vec "perl-file-spec" (tramp-send-command-and-check vec (format "%s -e 'use File::Spec;'" result))) - (with-connection-property vec "perl-cwd-realpath" + (with-tramp-connection-property vec "perl-cwd-realpath" (tramp-send-command-and-check vec (format "%s -e 'use Cwd \"realpath\";'" result)))) result))) (defun tramp-get-remote-stat (vec) - (with-connection-property vec "stat" + (with-tramp-connection-property vec "stat" (tramp-message vec 5 "Finding a suitable `stat' command") (let ((result (tramp-find-executable vec "stat" (tramp-get-remote-path vec))) @@ -4953,7 +4955,7 @@ This is used internally by `tramp-file-mode-from-int'." result))) (defun tramp-get-remote-readlink (vec) - (with-connection-property vec "readlink" + (with-tramp-connection-property vec "readlink" (tramp-message vec 5 "Finding a suitable `readlink' command") (let ((result (tramp-find-executable vec "readlink" (tramp-get-remote-path vec)))) @@ -4963,12 +4965,12 @@ This is used internally by `tramp-file-mode-from-int'." result)))) (defun tramp-get-remote-trash (vec) - (with-connection-property vec "trash" + (with-tramp-connection-property vec "trash" (tramp-message vec 5 "Finding a suitable `trash' command") (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) (defun tramp-get-remote-id (vec) - (with-connection-property vec "id" + (with-tramp-connection-property vec "id" (tramp-message vec 5 "Finding POSIX `id' command") (or (catch 'id-found @@ -4982,7 +4984,7 @@ This is used internally by `tramp-file-mode-from-int'." (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))) (defun tramp-get-remote-uid (vec id-format) - (with-connection-property vec (format "uid-%s" id-format) + (with-tramp-connection-property vec (format "uid-%s" id-format) (let ((res (tramp-send-command-and-read vec (format "%s -u%s %s" @@ -4994,7 +4996,7 @@ This is used internally by `tramp-file-mode-from-int'." (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) (defun tramp-get-remote-gid (vec id-format) - (with-connection-property vec (format "gid-%s" id-format) + (with-tramp-connection-property vec (format "gid-%s" id-format) (let ((res (tramp-send-command-and-read vec (format "%s -g%s %s" @@ -5020,7 +5022,7 @@ the length of the file to be compressed. If no corresponding command is found, nil is returned." (when (and (integerp tramp-inline-compress-start-size) (> size tramp-inline-compress-start-size)) - (with-connection-property (tramp-get-connection-process vec) prop + (with-tramp-connection-property (tramp-get-connection-process vec) prop (tramp-find-inline-compress vec) (tramp-get-connection-property (tramp-get-connection-process vec) prop nil)))) @@ -5041,7 +5043,8 @@ function cell is returned to be applied on a buffer." ;; no inline coding is found. (ignore-errors (let ((coding - (with-connection-property (tramp-get-connection-process vec) prop + (with-tramp-connection-property + (tramp-get-connection-process vec) prop (tramp-find-inline-encoding vec) (tramp-get-connection-property (tramp-get-connection-process vec) prop nil))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f1d54b6fd3c..567f8f2969a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -355,7 +355,7 @@ pass to the OPERATION." (let ((t1 (tramp-tramp-file-p dirname)) (t2 (tramp-tramp-file-p newname))) (with-parsed-tramp-file-name (if t1 dirname newname) nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) (cond ;; We must use a local temporary directory. @@ -491,7 +491,7 @@ KEEP-DATE has no effect in case NEWNAME resides on an SMB server. PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (setq filename (expand-file-name filename) newname (expand-file-name newname)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Copying %s to %s" filename newname) @@ -642,7 +642,8 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (unless id-format (setq id-format 'integer)) (ignore-errors (with-parsed-tramp-file-name filename nil - (with-file-property v localname (format "file-attributes-%s" id-format) + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v)) (tramp-smb-do-file-attributes-with-stat v id-format) ;; Reading just the filename entry via "dir localname" is not @@ -753,7 +754,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) (unless (tramp-smb-send-command v (format "get \"%s\" \"%s\"" @@ -771,7 +772,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (all-completions filename (with-parsed-tramp-file-name directory nil - (with-file-property v localname "file-name-all-completions" + (with-tramp-file-property v localname "file-name-all-completions" (save-match-data (let ((entries (tramp-smb-get-file-entries directory))) (mapcar @@ -1119,7 +1120,7 @@ target of the symlink differ." (if (file-remote-p filename) filename newname)) 'file-already-exists newname)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Renaming %s to %s" filename newname) @@ -1253,7 +1254,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (list start end tmpfile append 'no-message lockname confirm) (list start end tmpfile append 'no-message lockname))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) (unwind-protect (unless (tramp-smb-send-command @@ -1312,7 +1313,7 @@ Either the shares are listed, or the `dir' command is executed. Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) - (with-file-property v localname "file-entries" + (with-tramp-file-property v localname "file-entries" (with-current-buffer (tramp-get-connection-buffer v) (let* ((share (tramp-smb-get-share v)) (cache (tramp-get-connection-property v "share-cache" nil)) @@ -1497,7 +1498,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; When we are not logged in yet, we return nil. (if (let ((p (tramp-get-connection-process vec))) (and p (processp p) (memq (process-status p) '(run open)))) - (with-connection-property + (with-tramp-connection-property (tramp-get-connection-process vec) "cifs-capabilities" (save-match-data (when (tramp-smb-send-command vec "posix") @@ -1515,7 +1516,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; When we are not logged in yet, we return nil. (if (let ((p (tramp-get-connection-process vec))) (and p (processp p) (memq (process-status p) '(run open)))) - (with-connection-property + (with-tramp-connection-property (tramp-get-connection-process vec) "stat-capability" (tramp-smb-send-command vec "stat .")))) @@ -1625,7 +1626,7 @@ If ARGUMENT is non-nil, use it as argument for (setq args (append args (list argument)))) ;; OK, let's go. - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 3 (format "Opening connection for //%s%s/%s" (if (not (zerop (length user))) (concat user "@") "") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b1532eb2ae4..874c0aa7fef 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1353,8 +1353,7 @@ ARGS to actually emit the message (if applicable)." "tramp-debug-message" "tramp-error" "tramp-error-with-buffer" - "tramp-message" - "tramp-with-progress-reporter") + "tramp-message") t) "$") fn))) @@ -1498,7 +1497,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (when (string-match message (or (current-message) "")) (tramp-compat-funcall 'progress-reporter-update reporter value)))) -(defmacro tramp-with-progress-reporter (vec level message &rest body) +(defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. If LEVEL does not fit for visible messages, or if this is a nested call of the macro, there are only traces without a visible @@ -1527,7 +1526,42 @@ progress reporter." (tramp-message ,vec ,level "%s...done" ,message)))) (tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<tramp-with-progress-reporter\\>")) + 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) + +(defmacro with-tramp-file-property (vec file property &rest body) + "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. +FILE must be a local file name on a connection identified via VEC." + `(if (file-name-absolute-p ,file) + (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our + ;; debug messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) + ,@body)) + +(put 'with-tramp-file-property 'lisp-indent-function 3) +(put 'with-tramp-file-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) + +(defmacro with-tramp-connection-property (key property &rest body) + "Check in Tramp for property PROPERTY, otherwise executes BODY and set." + `(let ((value (tramp-get-connection-property ,key ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) + value)) + +(put 'with-tramp-connection-property 'lisp-indent-function 2) +(put 'with-tramp-connection-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) (defalias 'tramp-drop-volume-letter (if (memq system-type '(cygwin windows-nt)) @@ -2860,7 +2894,7 @@ User is always nil." (setq filename (expand-file-name filename)) (let (result local-copy remote-copy) (with-parsed-tramp-file-name filename nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Inserting `%s'" filename) (unwind-protect (if (not (file-exists-p filename)) @@ -2983,7 +3017,7 @@ User is always nil." (if (not (file-exists-p file)) nil (let ((tramp-message-show-message (not nomessage))) - (tramp-with-progress-reporter v 0 (format "Loading %s" file) + (with-tramp-progress-reporter v 0 (format "Loading %s" file) (let ((local-copy (file-local-copy file))) ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. (unwind-protect @@ -3127,7 +3161,7 @@ beginning of local filename are not substituted." "Send the login name." (when (not (stringp tramp-current-user)) (setq tramp-current-user - (with-connection-property vec "login-as" + (with-tramp-connection-property vec "login-as" (save-window-excursion (let ((enable-recursive-minibuffers t)) (pop-to-buffer (tramp-get-connection-buffer vec)) @@ -3417,13 +3451,13 @@ the remote host use line-endings as defined in the variable (defun tramp-get-inode (vec) "Returns the virtual inode number. If it doesn't exist, generate a new one." - (with-file-property vec (tramp-file-name-localname vec) "inode" + (with-tramp-file-property vec (tramp-file-name-localname vec) "inode" (setq tramp-inodes (1+ tramp-inodes)))) (defun tramp-get-device (vec) "Returns the virtual device number. If it doesn't exist, generate a new one." - (with-connection-property (tramp-get-connection-process vec) "device" + (with-tramp-connection-property (tramp-get-connection-process vec) "device" (cons -1 (setq tramp-devices (1+ tramp-devices))))) (defun tramp-equal-remote (file1 file2) @@ -3545,7 +3579,7 @@ would yield `t'. On the other hand, the following check results in nil: (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." - (with-connection-property vec "tmpdir" + (with-tramp-connection-property vec "tmpdir" (let ((dir (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -3833,7 +3867,6 @@ Only works for Bourne-like shells." ;; * In Emacs 21, `insert-directory' shows total number of bytes used ;; by the files in that directory. Add this here. ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) -;; * Make ffap.el grok Tramp filenames. (Eli Tziperman) ;; * abbreviate-file-name ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 2d0a8e3d23d..331884691f4 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.6" +(defconst tramp-version "2.2.7-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.6 is not fit for %s" + (format "Tramp 2.2.7-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) |