Make heredocs more robust in Tramp.

[bpt/emacs.git] / lisp / net / tramp-cache.el

diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index d222dd1..825731c 100644 (file)
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -1,6 +1,6 @@
 ;;; tramp-cache.el --- file information caching for Tramp
 
 ;;; tramp-cache.el --- file information caching for Tramp
 

-;; Copyright (C) 2000, 2005-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2014 Free Software Foundation, Inc.

 
 ;; Author: Daniel Pittman <daniel@inanna.danann.net>
 ;;         Michael Albinus <michael.albinus@gmx.de>
 
 ;; Author: Daniel Pittman <daniel@inanna.danann.net>
 ;;         Michael Albinus <michael.albinus@gmx.de>


@@ -38,9 +38,11 @@
 ;;
 ;; - localname is a string.  This are temporary properties, which are
 ;;   related to the file localname is referring to.  Examples:
 ;;
 ;; - localname is a string.  This are temporary properties, which are
 ;;   related to the file localname is referring to.  Examples:

-;;   "file-exists-p" is t or nile, depending on the file existence, or
+;;   "file-exists-p" is t or nil, depending on the file existence, or

 ;;   "file-attributes" caches the result of the function
 ;;   "file-attributes" caches the result of the function

-;;  `file-attributes'.
+;;   `file-attributes'.  These entries have a timestamp, and they
+;;   expire after `remote-file-name-inhibit-cache' seconds if this
+;;   variable is set.

 ;;
 ;; - The key is a process.  This are temporary properties related to
 ;;   an open connection.  Examples: "scripts" keeps shell script
 ;;
 ;; - The key is a process.  This are temporary properties related to
 ;;   an open connection.  Examples: "scripts" keeps shell script


@@ -58,6 +60,19 @@
 (defvar tramp-cache-data (make-hash-table :test 'equal)
   "Hash table for remote files properties.")
 
 (defvar tramp-cache-data (make-hash-table :test 'equal)
   "Hash table for remote files properties.")
 

+;;;###tramp-autoload
+(defcustom tramp-connection-properties nil
+  "List of static connection properties.
+Every entry has the form (REGEXP PROPERTY VALUE).  The regexp
+matches remote file names.  It can be nil.  PROPERTY is a string,
+and VALUE the corresponding value.  They are used, if there is no
+matching entry for PROPERTY in `tramp-cache-data'."
+  :group 'tramp
+  :version "24.4"
+  :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
+                      (choice :tag "        Property" string)
+                      (choice :tag "           Value" sexp))))
+

 (defcustom tramp-persistency-file-name
   (cond
    ;; GNU Emacs.
 (defcustom tramp-persistency-file-name
   (cond
    ;; GNU Emacs.


@@ -85,16 +100,30 @@
 (defvar tramp-cache-data-changed nil
   "Whether persistent cache data have been changed.")
 
 (defvar tramp-cache-data-changed nil
   "Whether persistent cache data have been changed.")
 

+(defun tramp-get-hash-table (key)
+  "Returns the hash table for KEY.
+If it doesn't exist yet, it is created and initialized with
+matching entries of `tramp-connection-properties'."
+  (or (gethash key tramp-cache-data)
+      (let ((hash
+            (puthash key (make-hash-table :test 'equal) tramp-cache-data)))
+       (when (vectorp key)
+         (dolist (elt tramp-connection-properties)
+           (when (string-match
+                  (or (nth 0 elt) "")
+                  (tramp-make-tramp-file-name
+                   (aref key 0) (aref key 1) (aref key 2) nil))
+             (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
+       hash)))
+

 ;;;###tramp-autoload
 ;;;###tramp-autoload

-(defun tramp-get-file-property (vec file property default)
-  "Get the PROPERTY of FILE from the cache context of VEC.
+(defun tramp-get-file-property (key file property default)
+  "Get the PROPERTY of FILE from the cache context of KEY.

 Returns DEFAULT if not set."
   ;; Unify localname.
 Returns DEFAULT if not set."
   ;; Unify localname.

-  (setq vec (copy-sequence vec))
-  (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
-  (let* ((hash (or (gethash vec tramp-cache-data)
-                  (puthash vec (make-hash-table :test 'equal)
-                           tramp-cache-data)))
+  (setq key (copy-sequence key))
+  (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+  (let* ((hash (tramp-get-hash-table key))

         (value (when (hash-table-p hash) (gethash property hash))))
     (if
        ;; We take the value only if there is any, and
         (value (when (hash-table-p hash) (gethash property hash))))
     (if
        ;; We take the value only if there is any, and


@@ -112,7 +141,7 @@ Returns DEFAULT if not set."
        (setq value (cdr value))
       (setq value default))
 
        (setq value (cdr value))
       (setq value default))
 

-    (tramp-message vec 8 "%s %s %s" file property value)
+    (tramp-message key 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)))
     (when (>= tramp-verbose 10)
       (let* ((var (intern (concat "tramp-cache-get-count-" property)))
             (val (or (ignore-errors (symbol-value var)) 0)))


@@ -120,18 +149,16 @@ Returns DEFAULT if not set."
     value))
 
 ;;;###tramp-autoload
     value))
 
 ;;;###tramp-autoload

-(defun tramp-set-file-property (vec file property value)
-  "Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
+(defun tramp-set-file-property (key file property value)
+  "Set the PROPERTY of FILE to VALUE, in the cache context of KEY.

 Returns VALUE."
   ;; Unify localname.
 Returns VALUE."
   ;; Unify localname.

-  (setq vec (copy-sequence vec))
-  (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
-  (let ((hash (or (gethash vec tramp-cache-data)
-                 (puthash vec (make-hash-table :test 'equal)
-                          tramp-cache-data))))
+  (setq key (copy-sequence key))
+  (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+  (let ((hash (tramp-get-hash-table key)))

     ;; We put the timestamp there.
     (puthash property (cons (current-time) value) hash)
     ;; We put the timestamp there.
     (puthash property (cons (current-time) value) hash)

-    (tramp-message vec 8 "%s %s %s" file property value)
+    (tramp-message key 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)))
     (when (>= tramp-verbose 10)
       (let* ((var (intern (concat "tramp-cache-set-count-" property)))
             (val (or (ignore-errors (symbol-value var)) 0)))


@@ -139,49 +166,28 @@ Returns VALUE."
     value))
 
 ;;;###tramp-autoload
     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."
+(defun tramp-flush-file-property (key file)
+  "Remove all properties of FILE in the cache context of KEY."

   ;; Remove file property of symlinks.
   ;; Remove file property of symlinks.

-  (let ((truename (tramp-get-file-property vec file "file-truename" nil)))
+  (let ((truename (tramp-get-file-property key file "file-truename" nil)))

     (when (and (stringp truename)
               (not (string-equal file truename)))
     (when (and (stringp truename)
               (not (string-equal file truename)))

-      (tramp-flush-file-property vec truename)))
+      (tramp-flush-file-property key truename)))

   ;; Unify localname.
   ;; Unify localname.

-  (setq vec (copy-sequence vec))
-  (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
-  (tramp-message vec 8 "%s" file)
-  (remhash vec tramp-cache-data))
+  (setq key (copy-sequence key))
+  (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+  (tramp-message key 8 "%s" file)
+  (remhash key tramp-cache-data))

 
 ;;;###tramp-autoload
 
 ;;;###tramp-autoload

-(defun tramp-flush-directory-property (vec directory)
-  "Remove all properties of DIRECTORY in the cache context of VEC.
+(defun tramp-flush-directory-property (key directory)
+  "Remove all properties of DIRECTORY in the cache context of KEY.

 Remove also properties of all files in subdirectories."
   (let ((directory (tramp-run-real-handler
                    'directory-file-name (list directory))))
 Remove also properties of all files in subdirectories."
   (let ((directory (tramp-run-real-handler
                    'directory-file-name (list directory))))

-  (tramp-message vec 8 "%s" directory)
+    (tramp-message key 8 "%s" directory)

     (maphash
     (maphash

-     (lambda (key value)
+     (lambda (key _value)

        (when (and (stringp (tramp-file-name-localname key))
                  (string-match directory (tramp-file-name-localname key)))
         (remhash key tramp-cache-data)))
        (when (and (stringp (tramp-file-name-localname key))
                  (string-match directory (tramp-file-name-localname key)))
         (remhash key tramp-cache-data)))


@@ -224,7 +230,7 @@ If the value is not set for the connection, returns DEFAULT."
   (when (vectorp key)
     (setq key (copy-sequence key))
     (aset key 3 nil))
   (when (vectorp key)
     (setq key (copy-sequence key))
     (aset key 3 nil))

-  (let* ((hash (gethash key tramp-cache-data))
+  (let* ((hash (tramp-get-hash-table key))

         (value (if (hash-table-p hash)
                    (gethash property hash default)
                  default)))
         (value (if (hash-table-p hash)
                    (gethash property hash default)
                  default)))


@@ -241,31 +247,17 @@ PROPERTY is set persistent when KEY is a vector."
   (when (vectorp key)
     (setq key (copy-sequence key))
     (aset key 3 nil))
   (when (vectorp key)
     (setq key (copy-sequence key))
     (aset key 3 nil))

-  (let ((hash (or (gethash key tramp-cache-data)
-                 (puthash key (make-hash-table :test 'equal)
-                          tramp-cache-data))))
+  (let ((hash (tramp-get-hash-table key)))

     (puthash property value hash)
     (setq tramp-cache-data-changed t)
     (tramp-message key 7 "%s %s" property value)
     value))
 
 ;;;###tramp-autoload
     (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\\>"))
+(defun tramp-connection-property-p (key property)
+  "Check whether named PROPERTY of a connection is defined.
+KEY identifies the connection, it is either a process or a vector."
+  (not (eq (tramp-get-connection-property key property 'undef) 'undef)))

 
 ;;;###tramp-autoload
 (defun tramp-flush-connection-property (key)
 
 ;;;###tramp-autoload
 (defun tramp-flush-connection-property (key)


@@ -280,10 +272,8 @@ KEY identifies the connection, it is either a process or a vector."
    key 7 "%s %s" key
    (let ((hash (gethash key tramp-cache-data))
         properties)
    key 7 "%s %s" key
    (let ((hash (gethash key tramp-cache-data))
         properties)

-     (if (hash-table-p hash)
-        (maphash
-         (lambda (x y) (add-to-list 'properties x 'append))
-         (gethash key tramp-cache-data)))
+     (when (hash-table-p hash)
+       (maphash (lambda (x _y) (add-to-list 'properties x 'append)) hash))

      properties))
   (setq tramp-cache-data-changed t)
   (remhash key tramp-cache-data))
      properties))
   (setq tramp-cache-data-changed t)
   (remhash key tramp-cache-data))


@@ -295,6 +285,21 @@ KEY identifies the connection, it is either a process or a vector."
     (let (result)
       (maphash
        (lambda (key value)
     (let (result)
       (maphash
        (lambda (key value)

+        ;; Remove text properties from KEY and VALUE.
+        ;; `substring-no-properties' does not exist in XEmacs.
+        (when (functionp 'substring-no-properties)
+          (when (vectorp key)
+            (dotimes (i (length key))
+              (when (stringp (aref key i))
+                (aset key i
+                      (tramp-compat-funcall
+                       'substring-no-properties (aref key i))))))
+          (when (stringp key)
+            (setq key (tramp-compat-funcall 'substring-no-properties key)))
+          (when (stringp value)
+            (setq value
+                  (tramp-compat-funcall 'substring-no-properties value))))
+        ;; Dump.

         (let ((tmp (format
                     "(%s %s)"
                     (if (processp key)
         (let ((tmp (format
                     "(%s %s)"
                     (if (processp key)


@@ -314,7 +319,7 @@ 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
   "Return a list of all known connection vectors according to `tramp-cache'."
     (let (result)
       (maphash

-       (lambda (key value)
+       (lambda (key _value)

         (when (and (vectorp key) (null (aref key 3)))
           (add-to-list 'result key)))
        tramp-cache-data)
         (when (and (vectorp key) (null (aref key 3)))
           (add-to-list 'result key)))
        tramp-cache-data)


@@ -328,7 +333,8 @@ 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))
               (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)))
+      (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
        ;; 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


@@ -377,7 +383,7 @@ This function is added always in `tramp-get-completion-function'
 for all methods.  Resulting data are derived from connection history."
   (let (res)
     (maphash
 for all methods.  Resulting data are derived from connection history."
   (let (res)
     (maphash

-     (lambda (key value)
+     (lambda (key _value)

        (if (and (vectorp key)
                (string-equal method (tramp-file-name-method key))
                (not (tramp-file-name-localname key)))
        (if (and (vectorp key)
                (string-equal method (tramp-file-name-method key))
                (not (tramp-file-name-localname key)))


@@ -399,11 +405,16 @@ for all methods.  Resulting data are derived from connection history."
       (with-temp-buffer
        (insert-file-contents tramp-persistency-file-name)
        (let ((list (read (current-buffer)))
       (with-temp-buffer
        (insert-file-contents tramp-persistency-file-name)
        (let ((list (read (current-buffer)))

+             (tramp-verbose 0)

              element key item)
          (while (setq element (pop list))
            (setq key (pop element))
            (while (setq item (pop element))
              element key item)
          (while (setq element (pop list))
            (setq key (pop element))
            (while (setq item (pop element))

-             (tramp-set-connection-property key (pop item) (car item)))))
+             ;; We set only values which are not contained in
+             ;; `tramp-connection-properties'.  The cache is
+             ;; initialized properly by side effect.
+             (unless (tramp-connection-property-p key (car item))
+               (tramp-set-connection-property key (pop item) (car item))))))

        (setq tramp-cache-data-changed nil))
     (file-error
      ;; Most likely because the file doesn't exist yet.  No message.
        (setq tramp-cache-data-changed nil))
     (file-error
      ;; Most likely because the file doesn't exist yet.  No message.