;;; tramp-cache.el --- file information caching for Tramp
-;; Copyright (C) 2000, 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2013 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
(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 '("\\<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.
+ (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)))
'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.
(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 --
(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 '("\\<with-connection-property\\>"))
-
;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
(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)))
"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))
(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
(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)
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)
HCoop / bpt / emacs.git / blobdiff