]> git.eshelyaron.com Git - emacs.git/commitdiff
Some minor Tramp updates
authorMichael Albinus <michael.albinus@gmx.de>
Tue, 16 Nov 2021 14:04:27 +0000 (15:04 +0100)
committerMichael Albinus <michael.albinus@gmx.de>
Tue, 16 Nov 2021 14:04:27 +0000 (15:04 +0100)
* 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
lisp/net/tramp.el
test/lisp/net/tramp-tests.el

index f60841cf8c19910647904bd5ef0cfd20347a202d..4ff8e6bbf1267d7781231365cec521ed7a842722 100644 (file)
@@ -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."))
index 26425199bfa4e193e6c6cfc6637337eaada3a772..7927ddd1072e44fc4d0a95e120f8ffd997806be9 100644 (file)
@@ -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)
index 150ea29838ca8173d8affd659c2b4461f5403963..482d3ff554fa4699f8ec7ea2d4bae97de5b79401 100644 (file)
@@ -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'."