diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/autorevert.el | 7 | ||||
| -rw-r--r-- | lisp/filenotify.el | 17 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 165 |
3 files changed, 99 insertions, 90 deletions
diff --git a/lisp/autorevert.el b/lisp/autorevert.el index cdd8223fffd..7cd5e7ee8bf 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -126,8 +126,6 @@ Global Auto-Revert Mode does so in all buffers." ;; Variables: -;;; What's this?: ;; Autoload for the benefit of `make-mode-line-mouse-sensitive'. -;;; What's this?: ;;;###autoload (defvar auto-revert-mode nil "Non-nil when Auto-Revert Mode is active. Never set this variable directly, use the command `auto-revert-mode' instead.") @@ -365,6 +363,9 @@ buffer.") "Non-nil when file has been modified on the file system. This has been reported by a file notification event.") +(defvar auto-revert-debug nil + "Use for debug messages.") + ;; Functions: (defun auto-revert-remove-current-buffer (&optional buffer) @@ -634,6 +635,8 @@ system.") ;; Since we watch a directory, a file name must be returned. (cl-assert (stringp file)) (when (eq action 'renamed) (cl-assert (stringp file1))) + (when auto-revert-debug + (message "auto-revert-notify-handler %S" event)) (if (eq action 'stopped) ;; File notification has stopped. Continue with polling. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 4d22061138f..a6054c175f1 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -30,6 +30,9 @@ (require 'cl-lib) (eval-when-compile (require 'subr-x)) +(defvar file-notify-debug nil + "Use for debug messages.") + (defconst file-notify--library (cond ((featurep 'inotify) 'inotify) @@ -93,7 +96,8 @@ If EVENT is a filewatch event, call its callback. It has the format Otherwise, signal a `file-notify-error'." (interactive "e") - ;;(message "file-notify-handle-event %S" event) + (when file-notify-debug + (message "file-notify-handle-event %S" event)) (if (and (consp event) (eq (car event) 'file-notify) (>= (length event) 3)) @@ -242,11 +246,12 @@ EVENT is the cadr of the event in `file-notify-handle-event' (string-equal (file-notify--watch-filename watch) (file-name-nondirectory file1))))) - ;;(message - ;;"file-notify-callback %S %S %S %S %S %S %S" - ;;desc action file file1 watch - ;;(file-notify--event-watched-file event) - ;;(file-notify--watch-directory watch)) + (when file-notify-debug + (message + "file-notify-callback %S %S %S %S %S %S %S" + desc action file file1 watch + (file-notify--event-watched-file event) + (file-notify--watch-directory watch))) (funcall (file-notify--watch-callback watch) (if file1 `(,desc ,action ,file ,file1) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index dc64726e211..37ff14a5eb2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3444,88 +3444,89 @@ the result will be a local, non-Tramp, file name." ;; any other remote command. (defun tramp-sh-handle-vc-registered (file) "Like `vc-registered' for Tramp files." - (with-temp-message "" - (with-parsed-tramp-file-name file nil - (with-tramp-progress-reporter - v 3 (format-message "Checking `vc-registered' for %s" file) - - ;; There could be new files, created by the vc backend. We - ;; cannot reuse the old cache entries, therefore. In - ;; `tramp-get-file-property', `remote-file-name-inhibit-cache' - ;; could also be a timestamp as `current-time' returns. This - ;; means invalidate all cache entries with an older timestamp. - (let (tramp-vc-registered-file-names - (remote-file-name-inhibit-cache (current-time)) - (file-name-handler-alist - `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) - - ;; Here we collect only file names, which need an operation. - (tramp-with-demoted-errors - v "Error in 1st pass of `vc-registered': %s" - (tramp-run-real-handler #'vc-registered (list file))) - (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) - - ;; Send just one command, in order to fill the cache. - (when tramp-vc-registered-file-names - (tramp-maybe-send-script - v - (format tramp-vc-registered-read-file-names - (tramp-get-file-exists-command v) - (format "%s -r" (tramp-get-test-command v))) - "tramp_vc_registered_read_file_names") - - (dolist - (elt - (ignore-errors - ;; We cannot use `tramp-send-command-and-read', - ;; because this does not cooperate well with - ;; heredoc documents. - (tramp-send-command - v - (format - "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n" - tramp-end-of-heredoc - (mapconcat #'tramp-shell-quote-argument - tramp-vc-registered-file-names - "\n") - tramp-end-of-heredoc)) - (with-current-buffer (tramp-get-connection-buffer v) - ;; Read the expression. - (goto-char (point-min)) - (read (current-buffer))))) - - (tramp-set-file-property - v (car elt) (cadr elt) (cadr (cdr elt)))))) - - ;; Second run. Now all `file-exists-p' or `file-readable-p' - ;; calls shall be answered from the file cache. We unset - ;; `process-file-side-effects' and `remote-file-name-inhibit-cache' - ;; in order to keep the cache. - (let ((vc-handled-backends vc-handled-backends) - remote-file-name-inhibit-cache process-file-side-effects) - ;; Reduce `vc-handled-backends' in order to minimize process calls. - (when (and (memq 'Bzr vc-handled-backends) - (boundp 'vc-bzr-program) - (not (with-tramp-connection-property v vc-bzr-program - (tramp-find-executable - v vc-bzr-program (tramp-get-remote-path v))))) - (setq vc-handled-backends (remq 'Bzr vc-handled-backends))) - (when (and (memq 'Git vc-handled-backends) - (boundp 'vc-git-program) - (not (with-tramp-connection-property v vc-git-program - (tramp-find-executable - v vc-git-program (tramp-get-remote-path v))))) - (setq vc-handled-backends (remq 'Git vc-handled-backends))) - (when (and (memq 'Hg vc-handled-backends) - (boundp 'vc-hg-program) - (not (with-tramp-connection-property v vc-hg-program - (tramp-find-executable - v vc-hg-program (tramp-get-remote-path v))))) - (setq vc-handled-backends (remq 'Hg vc-handled-backends))) - ;; Run. - (tramp-with-demoted-errors - v "Error in 2nd pass of `vc-registered': %s" - (tramp-run-real-handler #'vc-registered (list file)))))))) + (when vc-handled-backends + (with-temp-message "" + (with-parsed-tramp-file-name file nil + (with-tramp-progress-reporter + v 3 (format-message "Checking `vc-registered' for %s" file) + + ;; There could be new files, created by the vc backend. We + ;; cannot reuse the old cache entries, therefore. In + ;; `tramp-get-file-property', `remote-file-name-inhibit-cache' + ;; could also be a timestamp as `current-time' returns. This + ;; means invalidate all cache entries with an older timestamp. + (let (tramp-vc-registered-file-names + (remote-file-name-inhibit-cache (current-time)) + (file-name-handler-alist + `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) + + ;; Here we collect only file names, which need an operation. + (tramp-with-demoted-errors + v "Error in 1st pass of `vc-registered': %s" + (tramp-run-real-handler #'vc-registered (list file))) + (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) + + ;; Send just one command, in order to fill the cache. + (when tramp-vc-registered-file-names + (tramp-maybe-send-script + v + (format tramp-vc-registered-read-file-names + (tramp-get-file-exists-command v) + (format "%s -r" (tramp-get-test-command v))) + "tramp_vc_registered_read_file_names") + + (dolist + (elt + (ignore-errors + ;; We cannot use `tramp-send-command-and-read', + ;; because this does not cooperate well with + ;; heredoc documents. + (tramp-send-command + v + (format + "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n" + tramp-end-of-heredoc + (mapconcat #'tramp-shell-quote-argument + tramp-vc-registered-file-names + "\n") + tramp-end-of-heredoc)) + (with-current-buffer (tramp-get-connection-buffer v) + ;; Read the expression. + (goto-char (point-min)) + (read (current-buffer))))) + + (tramp-set-file-property + v (car elt) (cadr elt) (cadr (cdr elt)))))) + + ;; Second run. Now all `file-exists-p' or `file-readable-p' + ;; calls shall be answered from the file cache. We unset + ;; `process-file-side-effects' and `remote-file-name-inhibit-cache' + ;; in order to keep the cache. + (let ((vc-handled-backends vc-handled-backends) + remote-file-name-inhibit-cache process-file-side-effects) + ;; Reduce `vc-handled-backends' in order to minimize process calls. + (when (and (memq 'Bzr vc-handled-backends) + (boundp 'vc-bzr-program) + (not (with-tramp-connection-property v vc-bzr-program + (tramp-find-executable + v vc-bzr-program (tramp-get-remote-path v))))) + (setq vc-handled-backends (remq 'Bzr vc-handled-backends))) + (when (and (memq 'Git vc-handled-backends) + (boundp 'vc-git-program) + (not (with-tramp-connection-property v vc-git-program + (tramp-find-executable + v vc-git-program (tramp-get-remote-path v))))) + (setq vc-handled-backends (remq 'Git vc-handled-backends))) + (when (and (memq 'Hg vc-handled-backends) + (boundp 'vc-hg-program) + (not (with-tramp-connection-property v vc-hg-program + (tramp-find-executable + v vc-hg-program (tramp-get-remote-path v))))) + (setq vc-handled-backends (remq 'Hg vc-handled-backends))) + ;; Run. + (tramp-with-demoted-errors + v "Error in 2nd pass of `vc-registered': %s" + (tramp-run-real-handler #'vc-registered (list file))))))))) ;;;###tramp-autoload (defun tramp-sh-file-name-handler (operation &rest args) |