diff options
| author | Michael Albinus | 2019-10-31 11:13:13 +0100 |
|---|---|---|
| committer | Michael Albinus | 2019-10-31 11:13:13 +0100 |
| commit | bdb33af39d32cfb0bb23f18eb34775a30e2ff62d (patch) | |
| tree | eed9633f5519abb8c10d85d4583fb25260df64af | |
| parent | e168bb73865f64cc67f80f8b2599c826cbf9e957 (diff) | |
| download | emacs-bdb33af39d32cfb0bb23f18eb34775a30e2ff62d.tar.gz emacs-bdb33af39d32cfb0bb23f18eb34775a30e2ff62d.zip | |
Fix some minor Tramp problems
* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
Check, that `tramp-password-save-function' is a function.
* lisp/net/tramp-smb.el (tramp-smb-handle-file-system-info):
Check, that there is a share.
* lisp/net/tramp.el (outline-regexp): Declare.
(tramp-get-debug-buffer): Let-bind `signal-hook-function'.
* test/lisp/net/tramp-tests.el (tramp-test04-substitute-in-file-name):
Skip some tests for Emacs 24 and 25; they let Emacs crash.
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 4 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 48 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 4 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 64 |
4 files changed, 65 insertions, 55 deletions
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 4843c63cb87..c08c7194cc7 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -1911,7 +1911,9 @@ connection if a previous connection has died for some reason." | |||
| 1911 | (tramp-error vec 'file-error "FUSE mount denied")) | 1911 | (tramp-error vec 'file-error "FUSE mount denied")) |
| 1912 | 1912 | ||
| 1913 | ;; Save the password. | 1913 | ;; Save the password. |
| 1914 | (ignore-errors (funcall tramp-password-save-function)) | 1914 | (ignore-errors |
| 1915 | (and (functionp tramp-password-save-function) | ||
| 1916 | (funcall tramp-password-save-function))) | ||
| 1915 | 1917 | ||
| 1916 | ;; Set connection-local variables. | 1918 | ;; Set connection-local variables. |
| 1917 | (tramp-set-connection-local-variables vec) | 1919 | (tramp-set-connection-local-variables vec) |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 27c321bb9cb..5e52b26e7c6 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -946,29 +946,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 946 | (unless (file-directory-p filename) | 946 | (unless (file-directory-p filename) |
| 947 | (setq filename (file-name-directory filename))) | 947 | (setq filename (file-name-directory filename))) |
| 948 | (with-parsed-tramp-file-name (expand-file-name filename) nil | 948 | (with-parsed-tramp-file-name (expand-file-name filename) nil |
| 949 | (tramp-message v 5 "file system info: %s" localname) | 949 | (when (tramp-smb-get-share v) |
| 950 | (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v))) | 950 | (tramp-message v 5 "file system info: %s" localname) |
| 951 | (with-current-buffer (tramp-get-connection-buffer v) | 951 | (tramp-smb-send-command |
| 952 | (let (total avail blocksize) | 952 | v (format "du %s/*" (tramp-smb-get-localname v))) |
| 953 | (goto-char (point-min)) | 953 | (with-current-buffer (tramp-get-connection-buffer v) |
| 954 | (forward-line) | 954 | (let (total avail blocksize) |
| 955 | (when (looking-at | 955 | (goto-char (point-min)) |
| 956 | (eval-when-compile | 956 | (forward-line) |
| 957 | (concat "[[:space:]]*\\([[:digit:]]+\\)" | 957 | (when (looking-at |
| 958 | " blocks of size \\([[:digit:]]+\\)" | 958 | (eval-when-compile |
| 959 | "\\. \\([[:digit:]]+\\) blocks available"))) | 959 | (concat "[[:space:]]*\\([[:digit:]]+\\)" |
| 960 | (setq blocksize (string-to-number (match-string 2)) | 960 | " blocks of size \\([[:digit:]]+\\)" |
| 961 | total (* blocksize (string-to-number (match-string 1))) | 961 | "\\. \\([[:digit:]]+\\) blocks available"))) |
| 962 | avail (* blocksize (string-to-number (match-string 3))))) | 962 | (setq blocksize (string-to-number (match-string 2)) |
| 963 | (forward-line) | 963 | total (* blocksize (string-to-number (match-string 1))) |
| 964 | (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") | 964 | avail (* blocksize (string-to-number (match-string 3))))) |
| 965 | ;; The used number of bytes is not part of the result. As | 965 | (forward-line) |
| 966 | ;; side effect, we store it as file property. | 966 | (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") |
| 967 | (tramp-set-file-property | 967 | ;; The used number of bytes is not part of the result. |
| 968 | v localname "used-bytes" (string-to-number (match-string 1)))) | 968 | ;; As side effect, we store it as file property. |
| 969 | ;; Result. | 969 | (tramp-set-file-property |
| 970 | (when (and total avail) | 970 | v localname "used-bytes" (string-to-number (match-string 1)))) |
| 971 | (list total (- total avail) avail))))))) | 971 | ;; Result. |
| 972 | (when (and total avail) | ||
| 973 | (list total (- total avail) avail)))))))) | ||
| 972 | 974 | ||
| 973 | (defun tramp-smb-handle-file-writable-p (filename) | 975 | (defun tramp-smb-handle-file-writable-p (filename) |
| 974 | "Like `file-writable-p' for Tramp files." | 976 | "Like `file-writable-p' for Tramp files." |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index adcc2a336f9..21b6f0070f7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -64,6 +64,7 @@ | |||
| 64 | (require 'cl-lib) | 64 | (require 'cl-lib) |
| 65 | (declare-function netrc-parse "netrc") | 65 | (declare-function netrc-parse "netrc") |
| 66 | (defvar auto-save-file-name-transforms) | 66 | (defvar auto-save-file-name-transforms) |
| 67 | (defvar outline-regexp) | ||
| 67 | 68 | ||
| 68 | ;;; User Customizable Internal Variables: | 69 | ;;; User Customizable Internal Variables: |
| 69 | 70 | ||
| @@ -1650,7 +1651,8 @@ The outline level is equal to the verbosity of the Tramp message." | |||
| 1650 | ;; Furthermore, `outline-regexp' must have the correct value | 1651 | ;; Furthermore, `outline-regexp' must have the correct value |
| 1651 | ;; already, because it is used by `font-lock-compile-keywords'. | 1652 | ;; already, because it is used by `font-lock-compile-keywords'. |
| 1652 | (let ((default-directory (tramp-compat-temporary-file-directory)) | 1653 | (let ((default-directory (tramp-compat-temporary-file-directory)) |
| 1653 | (outline-regexp tramp-debug-outline-regexp)) | 1654 | (outline-regexp tramp-debug-outline-regexp) |
| 1655 | signal-hook-function) | ||
| 1654 | (outline-mode)) | 1656 | (outline-mode)) |
| 1655 | (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) | 1657 | (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) |
| 1656 | (set (make-local-variable 'outline-level) 'tramp-debug-outline-level) | 1658 | (set (make-local-variable 'outline-level) 'tramp-debug-outline-level) |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c56c7dbbca2..baebae17e1f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -1956,36 +1956,40 @@ properly. BODY shall not contain a timeout." | |||
| 1956 | (substitute-in-file-name "/method:host:/:/path//foo") | 1956 | (substitute-in-file-name "/method:host:/:/path//foo") |
| 1957 | "/method:host:/:/path//foo")) | 1957 | "/method:host:/:/path//foo")) |
| 1958 | 1958 | ||
| 1959 | (should | 1959 | ;; Forwhatever reasons, the following tests let Emacs crash for |
| 1960 | (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo")) | 1960 | ;; Emacs 24 and Emacs 25, occasionally. No idea what's up. |
| 1961 | (should | 1961 | (when (or (tramp--test-emacs26-p) (tramp--test-emacs27-p)) |
| 1962 | (string-equal | 1962 | (should |
| 1963 | (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo")) | 1963 | (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo")) |
| 1964 | (should | 1964 | (should |
| 1965 | (string-equal | 1965 | (string-equal |
| 1966 | (substitute-in-file-name "/method:host:/path//~foo") "/~foo")) | 1966 | (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo")) |
| 1967 | ;; (substitute-in-file-name "/path/~foo") expands only for a local | 1967 | (should |
| 1968 | ;; user "foo" to "/~foo"". Otherwise, it doesn't expand. | 1968 | (string-equal |
| 1969 | (should | 1969 | (substitute-in-file-name "/method:host:/path//~foo") "/~foo")) |
| 1970 | (string-equal | 1970 | ;; (substitute-in-file-name "/path/~foo") expands only for a local |
| 1971 | (substitute-in-file-name | 1971 | ;; user "foo" to "/~foo"". Otherwise, it doesn't expand. |
| 1972 | "/method:host:/path/~foo") "/method:host:/path/~foo")) | 1972 | (should |
| 1973 | ;; Quoting local part. | 1973 | (string-equal |
| 1974 | (should | 1974 | (substitute-in-file-name |
| 1975 | (string-equal | 1975 | "/method:host:/path/~foo") "/method:host:/path/~foo")) |
| 1976 | (substitute-in-file-name "/method:host:/://~foo") | 1976 | ;; Quoting local part. |
| 1977 | "/method:host:/://~foo")) | 1977 | (should |
| 1978 | (should | 1978 | (string-equal |
| 1979 | (string-equal | 1979 | (substitute-in-file-name "/method:host:/://~foo") |
| 1980 | (substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo")) | 1980 | "/method:host:/://~foo")) |
| 1981 | (should | 1981 | (should |
| 1982 | (string-equal | 1982 | (string-equal |
| 1983 | (substitute-in-file-name | 1983 | (substitute-in-file-name |
| 1984 | "/method:host:/:/path//~foo") "/method:host:/:/path//~foo")) | 1984 | "/method:host:/:/~foo") "/method:host:/:/~foo")) |
| 1985 | (should | 1985 | (should |
| 1986 | (string-equal | 1986 | (string-equal |
| 1987 | (substitute-in-file-name | 1987 | (substitute-in-file-name |
| 1988 | "/method:host:/:/path/~foo") "/method:host:/:/path/~foo")) | 1988 | "/method:host:/:/path//~foo") "/method:host:/:/path//~foo")) |
| 1989 | (should | ||
| 1990 | (string-equal | ||
| 1991 | (substitute-in-file-name | ||
| 1992 | "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))) | ||
| 1989 | 1993 | ||
| 1990 | (let (process-environment) | 1994 | (let (process-environment) |
| 1991 | (should | 1995 | (should |