tramp-integration.el 7.49 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
;;; tramp-integration.el --- Tramp integration into other packages  -*- lexical-binding:t -*-

;; Copyright (C) 2019 Free Software Foundation, Inc.

;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This assembles all integration of Tramp with other packages.

;;; Code:

30 31
(require 'tramp-compat)

32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
;; Pacify byte-compiler.
(require 'cl-lib)
(declare-function tramp-dissect-file-name "tramp")
(declare-function tramp-file-name-equal-p "tramp")
(declare-function tramp-tramp-file-p "tramp")
(declare-function recentf-cleanup "recentf")
(defvar eshell-path-env)
(defvar recentf-exclude)
(defvar tramp-current-connection)
(defvar tramp-postfix-host-format)

;;; Fontification of `read-file-name':

(defvar tramp-rfn-eshadow-overlay)
(make-variable-buffer-local 'tramp-rfn-eshadow-overlay)

(defun tramp-rfn-eshadow-setup-minibuffer ()
  "Set up a minibuffer for `file-name-shadow-mode'.
Adds another overlay hiding filename parts according to Tramp's
special handling of `substitute-in-file-name'."
  (when minibuffer-completing-file-name
    (setq tramp-rfn-eshadow-overlay
	  (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
    ;; Copy rfn-eshadow-overlay properties.
    (let ((props (overlay-properties rfn-eshadow-overlay)))
      (while props
        ;; The `field' property prevents correct minibuffer
        ;; completion; we exclude it.
        (if (not (eq (car props) 'field))
            (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))
          (pop props) (pop props))))))

(add-hook 'rfn-eshadow-setup-minibuffer-hook
65
	  #'tramp-rfn-eshadow-setup-minibuffer)
66 67 68
(add-hook 'tramp-unload-hook
	  (lambda ()
	    (remove-hook 'rfn-eshadow-setup-minibuffer-hook
69
			 #'tramp-rfn-eshadow-setup-minibuffer)))
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107

(defun tramp-rfn-eshadow-update-overlay-regexp ()
  (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))

;; Package rfn-eshadow is preloaded in Emacs, but for some reason,
;; it only did (defvar rfn-eshadow-overlay) without giving it a global
;; value, so it was only declared as dynamically-scoped within the
;; rfn-eshadow.el file.  This is now fixed in Emacs>26.1 but we still need
;; this defvar here for older releases.
(defvar rfn-eshadow-overlay)

(defun tramp-rfn-eshadow-update-overlay ()
  "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
This is intended to be used as a minibuffer `post-command-hook' for
`file-name-shadow-mode'; the minibuffer should have already
been set up by `rfn-eshadow-setup-minibuffer'."
  ;; In remote files name, there is a shadowing just for the local part.
  (ignore-errors
    (let ((end (or (overlay-end rfn-eshadow-overlay)
		   (minibuffer-prompt-end)))
	  ;; We do not want to send any remote command.
	  (non-essential t))
      (when (tramp-tramp-file-p (buffer-substring end (point-max)))
	(save-excursion
	  (save-restriction
	    (narrow-to-region
	     (1+ (or (string-match-p
		      (tramp-rfn-eshadow-update-overlay-regexp)
		      (buffer-string) end)
		     end))
	     (point-max))
	    (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
		  (rfn-eshadow-update-overlay-hook nil)
		  file-name-handler-alist)
	      (move-overlay rfn-eshadow-overlay (point-max) (point-max))
	      (rfn-eshadow-update-overlay))))))))

(add-hook 'rfn-eshadow-update-overlay-hook
108
	  #'tramp-rfn-eshadow-update-overlay)
109 110 111
(add-hook 'tramp-unload-hook
	  (lambda ()
	    (remove-hook 'rfn-eshadow-update-overlay-hook
112
			 #'tramp-rfn-eshadow-update-overlay)))
113 114 115 116 117 118 119 120 121 122 123

;;; Integration of eshell.el:

;; eshell.el keeps the path in `eshell-path-env'.  We must change it
;; when `default-directory' points to another host.
(defun tramp-eshell-directory-change ()
  "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
  ;; Remove last element of `(exec-path)', which is `exec-directory'.
  ;; Use `path-separator' as it does eshell.
  (setq eshell-path-env
	(mapconcat
124
	 #'identity (butlast (tramp-compat-exec-path)) path-separator)))
125 126 127 128

(eval-after-load "esh-util"
  '(progn
     (add-hook 'eshell-mode-hook
129
	       #'tramp-eshell-directory-change)
130
     (add-hook 'eshell-directory-change-hook
131
	       #'tramp-eshell-directory-change)
Michael Albinus's avatar
Michael Albinus committed
132
     (add-hook 'tramp-integration-unload-hook
133 134
	       (lambda ()
		 (remove-hook 'eshell-mode-hook
135
			      #'tramp-eshell-directory-change)
136
		 (remove-hook 'eshell-directory-change-hook
137
			      #'tramp-eshell-directory-change)))))
138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154

;;; Integration of recentf.el:

(defun tramp-recentf-exclude-predicate (name)
  "Predicate to exclude a remote file name from recentf.
NAME must be equal to `tramp-current-connection'."
  (when (file-remote-p name)
    (tramp-file-name-equal-p
     (tramp-dissect-file-name name) (car tramp-current-connection))))

(defun tramp-recentf-cleanup (vec)
  "Remove all file names related to VEC from recentf."
  (when (bound-and-true-p recentf-list)
    (let ((tramp-current-connection `(,vec))
	  (recentf-exclude '(tramp-recentf-exclude-predicate)))
      (recentf-cleanup))))

Michael Albinus's avatar
Michael Albinus committed
155 156 157 158 159 160 161 162 163
(defun tramp-recentf-cleanup-all ()
  "Remove all remote file names from recentf."
  (when (bound-and-true-p recentf-list)
    (let ((recentf-exclude '(file-remote-p)))
      (recentf-cleanup))))

(eval-after-load "recentf"
  '(progn
     (add-hook 'tramp-cleanup-connection-hook
164
	       #'tramp-recentf-cleanup)
Michael Albinus's avatar
Michael Albinus committed
165
     (add-hook 'tramp-cleanup-all-connections-hook
166
	       #'tramp-recentf-cleanup-all)
Michael Albinus's avatar
Michael Albinus committed
167 168 169
     (add-hook 'tramp-integration-unload-hook
	       (lambda ()
		 (remove-hook 'tramp-cleanup-connection-hook
170
			      #'tramp-recentf-cleanup)
Michael Albinus's avatar
Michael Albinus committed
171
		 (remove-hook 'tramp-cleanup-all-connections-hook
172
			      #'tramp-recentf-cleanup-all)))))
Michael Albinus's avatar
Michael Albinus committed
173

174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
;;; Default connection-local variables for Tramp:

;;;###tramp-autoload
(defvar tramp-connection-local-safe-shell-file-names nil
  "List of safe `shell-file-name' values for remote hosts.")
(add-to-list 'tramp-connection-local-safe-shell-file-names "/bin/sh")

(defconst tramp-connection-local-default-profile
  '((shell-file-name . "/bin/sh")
    (shell-command-switch . "-c"))
  "Default connection-local variables for remote connections.")
(put 'shell-file-name 'safe-local-variable
     (lambda (item)
       (and (stringp item)
	    (member item tramp-connection-local-safe-shell-file-names))))
(put 'shell-command-switch 'safe-local-variable
     (lambda (item) (and (stringp item) (string-equal item "-c"))))

;; `connection-local-set-profile-variables' and
;; `connection-local-set-profiles' exists since Emacs 26.1.
(eval-after-load "shell"
  '(progn
     (tramp-compat-funcall
      'connection-local-set-profile-variables
      'tramp-connection-local-default-profile
      tramp-connection-local-default-profile)
     (tramp-compat-funcall
      'connection-local-set-profiles
      `(:application tramp)
      'tramp-connection-local-default-profile)))

205 206 207 208 209 210
(add-hook 'tramp-unload-hook
	  (lambda () (unload-feature 'tramp-integration 'force)))

(provide 'tramp-integration)

;;; tramp-integration.el ends here