[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 6e93cb0: Some minor Tramp updates
From: |
Michael Albinus |
Subject: |
master 6e93cb0: Some minor Tramp updates |
Date: |
Tue, 16 Nov 2021 09:04:34 -0500 (EST) |
branch: master
commit 6e93cb0954285b16054d07e420cf3bdc5d93c1c2
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Some minor Tramp updates
* lisp/net/tramp-crypt.el (tramp-crypt-add-directory): Add comment.
* lisp/net/tramp.el (tramp-debug-buffer-command-completion-p)
(tramp-setup-debug-buffer): New defuns.
(tramp-get-debug-buffer): Call `tramp-setup-debug-buffer.
* test/lisp/net/tramp-tests.el (tramp-test07-abbreviate-file-name):
Extend test.
---
lisp/net/tramp-crypt.el | 1 +
lisp/net/tramp.el | 66 ++++++++++++++++++++++++++++++--------------
test/lisp/net/tramp-tests.el | 11 +++++++-
3 files changed, 56 insertions(+), 22 deletions(-)
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index f60841c..4ff8e6b 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -486,6 +486,7 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'."
Files in that directory and all subdirectories will be encrypted
before copying to, and decrypted after copying from that
directory. File names will be also encrypted."
+ ;; (declare (completion tramp-crypt-command-completion-p))
(interactive "DRemote directory name: ")
(unless tramp-crypt-enabled
(tramp-user-error nil "Feature is not enabled."))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 2642519..7927ddd 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1904,31 +1904,55 @@ The outline level is equal to the verbosity of the
Tramp message."
(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+(defun tramp-debug-buffer-command-completion-p (_symbol buffer)
+ "A predicate for Tramp interactive commands.
+They are completed by \"M-x TAB\" only in Tramp debug buffers."
+ (with-current-buffer buffer
+ (string-equal (buffer-substring 1 10) ";; Emacs:")))
+
+(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
+
+(defun tramp-setup-debug-buffer ()
+ "Function to setup debug buffers."
+ ;; (declare (completion tramp-debug-buffer-command-completion-p))
+ (interactive)
+ (set-buffer-file-coding-system 'utf-8)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes die.
+ ;; Yes: I've seen `flyspell-mode', which starts "ispell".
+ ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises
+ ;; on error in `(outline-mode)', we don't want to see it in the
+ ;; traces.
+ (let ((default-directory tramp-compat-temporary-file-directory))
+ (outline-mode))
+ (setq-local outline-level 'tramp-debug-outline-level)
+ (setq-local font-lock-keywords
+ ;; FIXME: This `(t FOO . BAR)' representation in
+ ;; `font-lock-keywords' is supposed to be an internal
+ ;; implementation "detail". Don't abuse it here!
+ `(t (eval ,tramp-debug-font-lock-keywords t)
+ ,(eval tramp-debug-font-lock-keywords t)))
+ ;; Do not edit the debug buffer.
+ (use-local-map special-mode-map)
+ ;; For debugging purposes.
+ (local-set-key "\M-n" 'clone-buffer)
+ (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
+
+(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
+
+(function-put
+ #'tramp-setup-debug-buffer 'completion-predicate
+ #'tramp-debug-buffer-command-completion-p)
+
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer for VEC."
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
- (set-buffer-file-coding-system 'utf-8)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes
- ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; `(custom-declare-variable outline-minor-mode-prefix ...)'
- ;; raises on error in `(outline-mode)', we don't want to see it
- ;; in the traces.
- (let ((default-directory tramp-compat-temporary-file-directory))
- (outline-mode))
- (setq-local outline-level 'tramp-debug-outline-level)
- (setq-local font-lock-keywords
- ;; FIXME: This `(t FOO . BAR)' representation in
- ;; `font-lock-keywords' is supposed to be an
- ;; internal implementation "detail". Don't abuse it here!
- `(t (eval ,tramp-debug-font-lock-keywords t)
- ,(eval tramp-debug-font-lock-keywords t)))
- ;; Do not edit the debug buffer.
- (use-local-map special-mode-map)
- ;; For debugging purposes.
- (define-key (current-local-map) "\M-n" 'clone-buffer))
+ (tramp-setup-debug-buffer))
(current-buffer)))
(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 150ea29..482d3ff 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2314,7 +2314,16 @@ This checks also `file-name-as-directory',
`file-name-directory',
(concat remote-host "~/f/bar")))
(should (equal (abbreviate-file-name
(concat remote-host "/nowhere/special"))
- (concat remote-host "/nw/special"))))))
+ (concat remote-host "/nw/special"))))
+
+ ;; Check that home-dir abbreviation doesn't occur when home-dir is just
"/".
+ (setq home-dir (concat remote-host "/"))
+ ;; The remote home directory is kept in the connection property
+ ;; "home-directory". We fake this setting.
+ (tramp-set-connection-property tramp-test-vec "home-directory" home-dir)
+ (should (equal (concat home-dir "foo/bar")
+ (abbreviate-file-name (concat home-dir "foo/bar"))))
+ (tramp-flush-connection-property tramp-test-vec "home-directory")))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 6e93cb0: Some minor Tramp updates,
Michael Albinus <=