X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8a1f4a98c1b8e3abaf1b46394a88d09531ce4c2d..7b1bf1735e58fbadbe180d4bbbe3a00cf71baed4:/lisp/net/tramp-cache.el diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index bea8c315fb..e4fca46ce2 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -1,7 +1,6 @@ ;;; tramp-cache.el --- file information caching for Tramp -;; Copyright (C) 2000, 2005, 2006, 2007, 2008, 2009, -;; 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2005-2012 Free Software Foundation, Inc. ;; Author: Daniel Pittman ;; Michael Albinus @@ -34,7 +33,7 @@ ;; - localname is NIL. This are reusable properties. Examples: ;; "remote-shell" identifies the POSIX shell to be called on the ;; remote host, or "perl" is the command to be called on the remote -;; host, when starting a Perl script. These properties are saved in +;; host when starting a Perl script. These properties are saved in ;; the file `tramp-persistency-file-name'. ;; ;; - localname is a string. This are temporary properties, which are @@ -139,30 +138,14 @@ Returns VALUE." (set var (1+ val)))) 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 '("\\")) - ;;;###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. + (let ((truename (tramp-get-file-property vec file "file-truename" nil))) + (when (and (stringp truename) + (not (string-equal file truename))) + (tramp-flush-file-property vec truename))) ;; Unify localname. (setq vec (copy-sequence vec)) (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file))) @@ -177,10 +160,10 @@ Remove also properties of all files in subdirectories." 'directory-file-name (list directory)))) (tramp-message vec 8 "%s" directory) (maphash - '(lambda (key value) - (when (and (stringp (tramp-file-name-localname key)) - (string-match directory (tramp-file-name-localname key))) - (remhash key tramp-cache-data))) + (lambda (key value) + (when (and (stringp (tramp-file-name-localname key)) + (string-match directory (tramp-file-name-localname key))) + (remhash key tramp-cache-data))) tramp-cache-data))) ;; Reverting or killing a buffer should also flush file properties. @@ -200,13 +183,13 @@ Remove also properties of all files in subdirectories." (add-hook 'eshell-pre-command-hook 'tramp-flush-file-function) (add-hook 'kill-buffer-hook 'tramp-flush-file-function) (add-hook 'tramp-cache-unload-hook - '(lambda () - (remove-hook 'before-revert-hook - 'tramp-flush-file-function) - (remove-hook 'eshell-pre-command-hook - 'tramp-flush-file-function) - (remove-hook 'kill-buffer-hook - 'tramp-flush-file-function))) + (lambda () + (remove-hook 'before-revert-hook + 'tramp-flush-file-function) + (remove-hook 'eshell-pre-command-hook + 'tramp-flush-file-function) + (remove-hook 'kill-buffer-hook + 'tramp-flush-file-function))) ;;; -- Properties -- @@ -239,30 +222,12 @@ PROPERTY is set persistent when KEY is a vector." (aset key 3 nil)) (let ((hash (or (gethash key tramp-cache-data) (puthash key (make-hash-table :test 'equal) - tramp-cache-data)))) + tramp-cache-data)))) (puthash property value hash) (setq tramp-cache-data-changed t) (tramp-message key 7 "%s %s" property value) 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 '("\\")) - ;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. @@ -290,18 +255,18 @@ KEY identifies the connection, it is either a process or a vector." (when (hash-table-p table) (let (result) (maphash - '(lambda (key value) - (let ((tmp (format - "(%s %s)" - (if (processp key) - (prin1-to-string (prin1-to-string key)) - (prin1-to-string key)) - (if (hash-table-p value) - (tramp-cache-print value) - (if (bufferp value) - (prin1-to-string (prin1-to-string value)) - (prin1-to-string value)))))) - (setq result (if result (concat result " " tmp) tmp)))) + (lambda (key value) + (let ((tmp (format + "(%s %s)" + (if (processp key) + (prin1-to-string (prin1-to-string key)) + (prin1-to-string key)) + (if (hash-table-p value) + (tramp-cache-print value) + (if (bufferp value) + (prin1-to-string (prin1-to-string value)) + (prin1-to-string value)))))) + (setq result (if result (concat result " " tmp) tmp)))) table) result))) @@ -310,9 +275,9 @@ KEY identifies the connection, it is either a process or a vector." "Return a list of all known connection vectors according to `tramp-cache'." (let (result) (maphash - '(lambda (key value) - (when (and (vectorp key) (null (aref key 3))) - (add-to-list 'result key))) + (lambda (key value) + (when (and (vectorp key) (null (aref key 3))) + (add-to-list 'result key))) tramp-cache-data) result)) @@ -324,16 +289,22 @@ KEY identifies the connection, it is either a process or a vector." (not (zerop (hash-table-count tramp-cache-data))) tramp-cache-data-changed (stringp tramp-persistency-file-name)) - (let ((cache (copy-hash-table tramp-cache-data))) - ;; Remove temporary data. + (let ((cache (copy-hash-table tramp-cache-data)) + print-length print-level) + ;; Remove temporary data. If there is the key "login-as", we + ;; don't save either, because all other properties might + ;; depend on the login name, and we want to give the + ;; possibility to use another login name later on. (maphash - '(lambda (key value) - (if (and (vectorp key) (not (tramp-file-name-localname key))) - (progn - (remhash "process-name" value) - (remhash "process-buffer" value) - (remhash "first-password-request" value)) - (remhash key cache))) + (lambda (key value) + (if (and (vectorp key) + (not (tramp-file-name-localname key)) + (not (gethash "login-as" value))) + (progn + (remhash "process-name" value) + (remhash "process-buffer" value) + (remhash "first-password-request" value)) + (remhash key cache))) cache) ;; Dump it. (with-temp-buffer @@ -354,11 +325,12 @@ KEY identifies the connection, it is either a process or a vector." (write-region (point-min) (point-max) tramp-persistency-file-name)))))) -(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties) +(unless noninteractive + (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties)) (add-hook 'tramp-cache-unload-hook - '(lambda () - (remove-hook 'kill-emacs-hook - 'tramp-dump-connection-properties))) + (lambda () + (remove-hook 'kill-emacs-hook + 'tramp-dump-connection-properties))) ;;;###tramp-autoload (defun tramp-parse-connection-properties (method) @@ -367,19 +339,24 @@ This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from connection history." (let (res) (maphash - '(lambda (key value) - (if (and (vectorp key) - (string-equal method (tramp-file-name-method key)) - (not (tramp-file-name-localname key))) - (push (list (tramp-file-name-user key) - (tramp-file-name-host key)) - res))) + (lambda (key value) + (if (and (vectorp key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key))) + (push (list (tramp-file-name-user key) + (tramp-file-name-host key)) + res))) tramp-cache-data) res)) ;; Read persistent connection history. (when (and (stringp tramp-persistency-file-name) - (zerop (hash-table-count tramp-cache-data))) + (zerop (hash-table-count tramp-cache-data)) + ;; When "emacs -Q" has been called, both variables are nil. + ;; We do not load the persistency file then, in order to + ;; have a clean test environment. + (or (and (boundp 'init-file-user) (symbol-value 'init-file-user)) + (and (boundp 'site-run-file) (symbol-value 'site-run-file)))) (condition-case err (with-temp-buffer (insert-file-contents tramp-persistency-file-name)