changeset 110702:4e901a2d3669

* files.el (remote-file-name-inhibit-cache): New defcustom. * time.el (display-time-file-nonempty-p): Use `remote-file-name-inhibit-cache'. * net/tramp.el (tramp-completion-reread-directory-timeout): Fix docstring. * net/tramp-cache.el (tramp-cache-inhibit-cache): Remove. (tramp-get-file-property): Replace `tramp-cache-inhibit-cache' by `remote-file-name-inhibit-cache'. Check also for an integer value. Add/increase counter when `tramp-verbose' >= 10. (tramp-set-file-property): Add/increase counter when `tramp-verbose' >= 10. * net/tramp-cmds.el (tramp-cleanup-all-connections) (tramp-cleanup-all-buffers): Set tramp-autoload cookie. (tramp-bug): Set tramp-autoload cookie. Report all interned tramp-* variables. Report also `remote-file-name-inhibit-cache'. (tramp-reporter-dump-variable): Fix docstring. Mask non-7bit characters only in strings. * net/tramp-compat.el (remote-file-name-inhibit-cache): Define due to backward compatibility. * net/tramp-sh.el (tramp-handle-verify-visited-file-modtime) (tramp-handle-file-name-all-completions) (tramp-handle-vc-registered): Use `remote-file-name-inhibit-cache'. (tramp-open-connection-setup-interactive-shell): Call `tramp-cleanup-connection' directly.
author Michael Albinus <michael.albinus@gmx.de>
date Sat, 02 Oct 2010 15:21:43 +0200
parents af844b79b99f
children 73242c00fd4a
files lisp/ChangeLog lisp/files.el lisp/net/tramp-cache.el lisp/net/tramp-cmds.el lisp/net/tramp-compat.el lisp/net/tramp-gvfs.el lisp/net/tramp-sh.el lisp/net/tramp.el lisp/time.el
diffstat 9 files changed, 146 insertions(+), 123 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/ChangeLog	Sat Oct 02 15:21:43 2010 +0200
@@ -1,3 +1,37 @@
+2010-10-02  Michael Albinus  <michael.albinus@gmx.de>
+
+	* files.el (remote-file-name-inhibit-cache): New defcustom.
+
+	* time.el (display-time-file-nonempty-p): Use
+	`remote-file-name-inhibit-cache'.
+
+	* net/tramp.el (tramp-completion-reread-directory-timeout): Fix
+	docstring.
+
+	* net/tramp-cache.el (tramp-cache-inhibit-cache): Remove.
+	(tramp-get-file-property): Replace `tramp-cache-inhibit-cache' by
+	`remote-file-name-inhibit-cache'.  Check also for an integer
+	value.  Add/increase counter when `tramp-verbose' >= 10.
+	(tramp-set-file-property): Add/increase counter when
+	`tramp-verbose' >= 10.
+
+	* net/tramp-cmds.el (tramp-cleanup-all-connections)
+	(tramp-cleanup-all-buffers): Set tramp-autoload cookie.
+	(tramp-bug): Set tramp-autoload cookie.  Report all interned
+	tramp-* variables.  Report also `remote-file-name-inhibit-cache'.
+	(tramp-reporter-dump-variable): Fix docstring.  Mask non-7bit
+	characters only in strings.
+
+	* net/tramp-compat.el (remote-file-name-inhibit-cache): Define due
+	to backward compatibility.
+
+	* net/tramp-sh.el (tramp-handle-verify-visited-file-modtime)
+	(tramp-handle-file-name-all-completions)
+	(tramp-handle-vc-registered): Use
+	`remote-file-name-inhibit-cache'.
+	(tramp-open-connection-setup-interactive-shell): Call
+	`tramp-cleanup-connection' directly.
+
 2010-10-02  Glenn Morris  <rgm@gnu.org>
 
 	* emacs-lisp/checkdoc.el (checkdoc-minor-keymap): Remove obsolete alias.
--- a/lisp/files.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/files.el	Sat Oct 02 15:21:43 2010 +0200
@@ -949,6 +949,36 @@
 	(funcall handler 'file-remote-p file identification connected)
       nil)))
 
+(defcustom remote-file-name-inhibit-cache 10
+  "Whether to use the remote file-name cache for read access.
+
+When `nil', always use the cached values.
+When `t', never use them.
+A number means use them for that amount of seconds since they were
+cached.
+
+File attributes of remote files are cached for better performance.
+If they are changed out of Emacs' control, the cached values
+become invalid, and must be invalidated.
+
+In case a remote file is checked regularly, it might be
+reasonable to let-bind this variable to a value less then the
+time period between two checks.
+Example:
+
+  \(defun display-time-file-nonempty-p \(file)
+    \(let \(\(remote-file-name-inhibit-cache \(- display-time-interval 5)))
+      \(and \(file-exists-p file)
+           \(< 0 \(nth 7 \(file-attributes \(file-chase-links file)))))))"
+  :group 'files
+  :version "24.1"
+  :type `(choice
+	  (const   :tag "Do not inhibit file name cache" nil)
+	  (const   :tag "Do not use file name cache" t)
+	  (integer :tag "Do not use file name cache"
+		   :format "Do not use file name cache older then %v seconds"
+		   :value 10)))
+
 (defun file-local-copy (file)
   "Copy the file FILE into a temporary file on this machine.
 Returns the name of the local copy, or nil, if FILE is directly
--- a/lisp/net/tramp-cache.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/net/tramp-cache.el	Sat Oct 02 15:21:43 2010 +0200
@@ -59,13 +59,6 @@
 (defvar tramp-cache-data (make-hash-table :test 'equal)
   "Hash table for remote files properties.")
 
-(defvar tramp-cache-inhibit-cache nil
-  "Inhibit cache read access, when `t'.
-`nil' means to accept cache entries unconditionally.  If the
-value is a timestamp (as returned by `current-time'), cache
-entries are not used when they have been written before this
-time.")
-
 (defcustom tramp-persistency-file-name
   (cond
    ;; GNU Emacs.
@@ -104,19 +97,25 @@
 	 (value (when (hash-table-p hash) (gethash property hash))))
     (if
 	;; We take the value only if there is any, and
-	;; `tramp-cache-inhibit-cache' indicates that it is still
+	;; `remote-file-name-inhibit-cache' indicates that it is still
 	;; valid.  Otherwise, DEFAULT is set.
 	(and (consp value)
-	     (or (null tramp-cache-inhibit-cache)
-		 (and (consp tramp-cache-inhibit-cache)
+	     (or (null remote-file-name-inhibit-cache)
+		 (and (integerp remote-file-name-inhibit-cache)
+		      (<=
+		       (tramp-time-diff (current-time) (car value))
+		       remote-file-name-inhibit-cache))
+		 (and (consp remote-file-name-inhibit-cache)
 		      (tramp-time-less-p
-		       tramp-cache-inhibit-cache (car value)))))
+		       remote-file-name-inhibit-cache (car value)))))
 	(setq value (cdr value))
       (setq value default))
 
-    (if (consp tramp-cache-inhibit-cache)
-	(tramp-message vec 1 "%s %s %s" file property value))
     (tramp-message vec 8 "%s %s %s" file property value)
+    (when (>= tramp-verbose 10)
+      (let* ((var (intern (concat "tramp-cache-get-count-" property)))
+	     (val (or (ignore-errors (symbol-value var)) 0)))
+	(set var (1+ val))))
     value))
 
 ;;;###tramp-autoload
@@ -132,6 +131,10 @@
     ;; We put the timestamp there.
     (puthash property (cons (current-time) value) hash)
     (tramp-message vec 8 "%s %s %s" file property value)
+    (when (>= tramp-verbose 10)
+      (let* ((var (intern (concat "tramp-cache-set-count-" property)))
+	     (val (or (ignore-errors (symbol-value var)) 0)))
+	(set var (1+ val))))
     value))
 
 ;;;###tramp-autoload
--- a/lisp/net/tramp-cmds.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/net/tramp-cmds.el	Sat Oct 02 15:21:43 2010 +0200
@@ -99,6 +99,7 @@
 		   (tramp-get-connection-property vec "process-buffer" nil)))
       (when (bufferp buf) (kill-buffer buf)))))
 
+;;;###tramp-autoload
 (defun tramp-cleanup-all-connections ()
   "Flush all Tramp internal objects.
 This includes password cache, file cache, connection cache, buffers."
@@ -117,6 +118,7 @@
   (dolist (name (tramp-list-tramp-buffers))
     (when (bufferp (get-buffer name)) (kill-buffer name))))
 
+;;;###tramp-autoload
 (defun tramp-cleanup-all-buffers ()
   "Kill all remote buffers."
   (interactive)
@@ -141,6 +143,7 @@
 
 (autoload 'reporter-submit-bug-report "reporter")
 
+;;;###tramp-autoload
 (defun tramp-bug ()
   "Submit a bug report to the Tramp developers."
   (interactive)
@@ -150,65 +153,25 @@
       (reporter-submit-bug-report
        tramp-bug-report-address		; to-address
        (format "tramp (%s)" tramp-version) ; package name and version
-       (delq nil
-	     `(;; Current state
-	       tramp-current-method
-	       tramp-current-user
-	       tramp-current-host
-
-	       ;; System defaults
-	       tramp-auto-save-directory        ; vars to dump
-	       tramp-default-method
-	       tramp-default-method-alist
-	       tramp-default-host
-	       tramp-default-proxies-alist
-	       tramp-default-user
-	       tramp-default-user-alist
-	       tramp-rsh-end-of-line
-	       tramp-default-password-end-of-line
-	       tramp-login-prompt-regexp
-	       ;; Mask non-7bit characters
-	       (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
-	       tramp-wrong-passwd-regexp
-	       tramp-yesno-prompt-regexp
-	       tramp-yn-prompt-regexp
-	       tramp-terminal-prompt-regexp
-	       tramp-temp-name-prefix
-	       tramp-file-name-structure
-	       tramp-file-name-regexp
-	       tramp-methods
-	       tramp-end-of-output
-	       tramp-local-coding-commands
-	       tramp-remote-coding-commands
-	       tramp-actions-before-shell
-	       tramp-actions-copy-out-of-band
-	       tramp-terminal-type
-	       ;; Mask non-7bit characters
-	       (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
-	       ,(when (boundp 'tramp-backup-directory-alist)
-		  'tramp-backup-directory-alist)
-	       ,(when (boundp 'tramp-bkup-backup-directory-info)
-		  'tramp-bkup-backup-directory-info)
-	       ;; Dump cache.
-	       (tramp-cache-data . tramp-reporter-dump-variable)
-
-	       ;; Non-tramp variables of interest
-	       ;; Mask non-7bit characters
-	       (shell-prompt-pattern . tramp-reporter-dump-variable)
-	       backup-by-copying
-	       backup-by-copying-when-linked
-	       backup-by-copying-when-mismatch
-	       ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
-		  'backup-by-copying-when-privileged-mismatch)
-	       ,(when (boundp 'password-cache)
-		  'password-cache)
-	       ,(when (boundp 'password-cache-expiry)
-		  'password-cache-expiry)
-	       ,(when (boundp 'backup-directory-alist)
-		  'backup-directory-alist)
-	       ,(when (boundp 'bkup-backup-directory-info)
-		  'bkup-backup-directory-info)
-	       file-name-handler-alist))
+       (sort
+	(delq nil (mapcar
+	  (lambda (x)
+	    (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
+	  (append
+	   (mapcar 'intern (all-completions "tramp-" obarray 'boundp))
+	   ;; Non-tramp variables of interest.
+	   '(shell-prompt-pattern
+	     backup-by-copying
+	     backup-by-copying-when-linked
+	     backup-by-copying-when-mismatch
+	     backup-by-copying-when-privileged-mismatch
+	     backup-directory-alist
+	     bkup-backup-directory-info
+	     password-cache
+	     password-cache-expiry
+	     remote-file-name-inhibit-cache
+	     file-name-handler-alist))))
+	(lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
 
        'tramp-load-report-modules	; pre-hook
        'tramp-append-tramp-buffers	; post-hook
@@ -238,8 +201,7 @@
 "))))
 
 (defun tramp-reporter-dump-variable (varsym mailbuf)
-  "Pretty-print the value of the variable in symbol VARSYM.
-Used for non-7bit chars in strings."
+  "Pretty-print the value of the variable in symbol VARSYM."
   (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
 	 (val (with-current-buffer reporter-eval-buffer
 		(symbol-value varsym))))
@@ -247,12 +209,13 @@
     (if (hash-table-p val)
 	;; Pretty print the cache.
 	(set varsym (read (format "(%s)" (tramp-cache-print val))))
-      ;; There are characters to be masked.
+      ;; There are non-7bit characters to be masked.
       (when (and (boundp 'mm-7bit-chars)
+		 (stringp val)
 		 (string-match
 		  (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
 	(with-current-buffer reporter-eval-buffer
-	  (set varsym (format "(base64-decode-string \"%s\""
+	  (set varsym (format "(base64-decode-string \"%s\")"
 			      (base64-encode-string val))))))
 
     ;; Dump variable.
@@ -268,7 +231,7 @@
 		     "\\(\")\\)" "\"$"))                    ;; \4 "
 	(replace-match "\\1\\2\\3\\4")
 	(beginning-of-line)
-	(insert " ;; variable encoded due to non-printable characters\n"))
+	(insert " ;; Variable encoded due to non-printable characters.\n"))
       (forward-line 1))
 
     ;; Reset VARSYM to old value.
@@ -277,7 +240,6 @@
 
 (defun tramp-load-report-modules ()
   "Load needed modules for reporting."
-
   ;; We load message.el and mml.el from Gnus.
   (if (featurep 'xemacs)
       (progn
@@ -290,7 +252,6 @@
 
 (defun tramp-append-tramp-buffers ()
   "Append Tramp buffers and buffer local variables into the bug report."
-
   (goto-char (point-max))
 
   ;; Dump buffer local variables.
--- a/lisp/net/tramp-compat.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/net/tramp-compat.el	Sat Oct 02 15:21:43 2010 +0200
@@ -96,6 +96,11 @@
     (defvar byte-compile-not-obsolete-vars nil))
   (setq byte-compile-not-obsolete-vars '(directory-sep-char))
 
+  ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1.
+  ;; Besides `t', `nil', and integer, we use also timestamps (as
+  ;; returned by `current-time') internally.
+  (defvar remote-file-name-inhibit-cache nil)
+
   ;; For not existing functions, or functions with a changed argument
   ;; list, there are compiler warnings.  We want to avoid them in
   ;; cases we know what we do.
--- a/lisp/net/tramp-gvfs.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/net/tramp-gvfs.el	Sat Oct 02 15:21:43 2010 +0200
@@ -531,7 +531,6 @@
 (defun tramp-gvfs-dbus-event-error (event err)
   "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'."
   (when tramp-gvfs-dbus-event-vector
-    ;(tramp-cleanup-connection tramp-gvfs-dbus-event-vector)
     (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
     (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
 
--- a/lisp/net/tramp-sh.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/net/tramp-sh.el	Sat Oct 02 15:21:43 2010 +0200
@@ -1366,8 +1366,8 @@
 	      (not (tramp-file-name-handler 'file-remote-p f nil 'connected)))
 	  t
 	(with-parsed-tramp-file-name f nil
-	  (tramp-flush-file-property v localname)
-	  (let* ((attr (file-attributes f))
+	  (let* ((remote-file-name-inhibit-cache t)
+		 (attr (file-attributes f))
 		 (modtime (nth 5 attr))
 		 (mt (visited-file-modtime)))
 
@@ -1770,46 +1770,39 @@
        (mapcar
 	'list
         (or
-         ;; Try cache first
-         (and
-          ;; Ignore if expired
-          (or (not (integerp tramp-completion-reread-directory-timeout))
-              (<= (tramp-time-diff
-                   (current-time)
-                   (tramp-get-file-property
-                    v localname "last-completion" '(0 0 0)))
-                  tramp-completion-reread-directory-timeout))
-
-          ;; Try cache entries for filename, filename with last
-          ;; character removed, filename with last two characters
-          ;; removed, ..., and finally the empty string - all
-          ;; concatenated to the local directory name
-
-          ;; This is inefficient for very long filenames, pity
-          ;; `reduce' is not available...
-          (car
-           (apply
-            'append
-            (mapcar
-             (lambda (x)
-               (let ((cache-hit
-                      (tramp-get-file-property
-                       v
-                       (concat localname (substring filename 0 x))
-                       "file-name-all-completions"
-                       nil)))
-                 (when cache-hit (list cache-hit))))
-             (tramp-compat-number-sequence (length filename) 0 -1)))))
+	 ;; Try cache entries for filename, filename with last
+	 ;; character removed, filename with last two characters
+	 ;; removed, ..., and finally the empty string - all
+	 ;; concatenated to the local directory name.
+         (let ((remote-file-name-inhibit-cache
+		(or remote-file-name-inhibit-cache
+		    tramp-completion-reread-directory-timeout)))
+
+	   ;; This is inefficient for very long filenames, pity
+	   ;; `reduce' is not available...
+	   (car
+	    (apply
+	     'append
+	     (mapcar
+	      (lambda (x)
+		(let ((cache-hit
+		       (tramp-get-file-property
+			v
+			(concat localname (substring filename 0 x))
+			"file-name-all-completions"
+			nil)))
+		  (when cache-hit (list cache-hit))))
+	      (tramp-compat-number-sequence (length filename) 0 -1)))))
 
          ;; Cache expired or no matching cache entry found so we need
-         ;; to perform a remote operation
+         ;; to perform a remote operation.
          (let (result)
            ;; Get a list of directories and files, including reliably
            ;; tagging the directories with a trailing '/'.  Because I
            ;; rock.  --daniel@danann.net
 
            ;; Changed to perform `cd' in the same remote op and only
-           ;; get entries starting with `filename'. Capture any `cd'
+           ;; get entries starting with `filename'.  Capture any `cd'
            ;; error messages.  Ensure any `cd' and `echo' aliases are
            ;; ignored.
            (tramp-send-command
@@ -1904,9 +1897,6 @@
 		    v (concat localname entry) "file-exists-p" t))
 		 result)
 
-           (tramp-set-file-property
-            v localname "last-completion" (current-time))
-
            ;; Store result in the cache
            (tramp-set-file-property
             v (concat localname filename)
@@ -3669,7 +3659,7 @@
 	;; There could be new files, created by the vc backend.  We
 	;; cannot reuse the old cache entries, therefore.
 	(let (tramp-vc-registered-file-names
-	      (tramp-cache-inhibit-cache (current-time))
+	      (remote-file-name-inhibit-cache (current-time))
 	      (file-name-handler-alist
 	       `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
 
@@ -4085,7 +4075,7 @@
 	;; Keep the debug buffer.
 	(rename-buffer
 	 (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
-	(tramp-compat-funcall 'tramp-cleanup-connection vec)
+	(tramp-cleanup-connection vec)
 	(if (= (point-min) (point-max))
 	    (kill-buffer nil)
 	  (rename-buffer (tramp-debug-buffer-name vec) 'unique))
--- a/lisp/net/tramp.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/net/tramp.el	Sat Oct 02 15:21:43 2010 +0200
@@ -974,8 +974,8 @@
 make it visible during file name completion in the minibuffer,
 Tramp flushes its cache and rereads the directory contents when
 more than `tramp-completion-reread-directory-timeout' seconds
-have been gone since last remote command execution.  A value of 0
-would require an immediate reread during filename completion, nil
+have been gone since last remote command execution.  A value of `t'
+would require an immediate reread during filename completion, `nil'
 means to use always cached values for the directory contents."
   :group 'tramp
   :type '(choice (const nil) integer))
--- a/lisp/time.el	Sat Oct 02 14:34:02 2010 +0200
+++ b/lisp/time.el	Sat Oct 02 15:21:43 2010 +0200
@@ -454,8 +454,9 @@
   (force-mode-line-update))
 
 (defun display-time-file-nonempty-p (file)
-  (and (file-exists-p file)
-       (< 0 (nth 7 (file-attributes (file-chase-links file))))))
+  (let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
+    (and (file-exists-p file)
+	 (< 0 (nth 7 (file-attributes (file-chase-links file)))))))
 
 ;;;###autoload
 (define-minor-mode display-time-mode