diff options
| author | Michael Albinus | 2018-02-10 09:41:04 +0100 |
|---|---|---|
| committer | Michael Albinus | 2018-02-10 09:41:04 +0100 |
| commit | 2c980ea613115f5c2858e172f3bf9be103439a46 (patch) | |
| tree | e3e1bf0a1bfb37862bb597d267b0f101c65f7a6e | |
| parent | 875cb835f00260d58c536b3a3f7c0343fd5f28dc (diff) | |
| download | emacs-2c980ea613115f5c2858e172f3bf9be103439a46.tar.gz emacs-2c980ea613115f5c2858e172f3bf9be103439a46.zip | |
Handle "gio monitor" in tramp-sh.el
* lisp/net/tramp-sh.el (tramp-gio-events): New defconst.
(tramp-sh-handle-file-notify-add-watch): Handle "gio monitor" extra.
(tramp-sh-gio-monitor-process-filter)
(tramp-get-remote-gio-monitor): New defuns.
(tramp-sh-gvfs-monitor-dir-process-filter)
(tramp-get-remote-gvfs-monitor-dir): Do not check for gio anymore.
| -rw-r--r-- | lisp/net/tramp-sh.el | 94 |
1 files changed, 85 insertions, 9 deletions
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5204ec725a3..25c00d180bb 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -3556,6 +3556,11 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3556 | ;; Default file name handlers, we don't care. | 3556 | ;; Default file name handlers, we don't care. |
| 3557 | (t (tramp-run-real-handler operation args))))))) | 3557 | (t (tramp-run-real-handler operation args))))))) |
| 3558 | 3558 | ||
| 3559 | (defconst tramp-gio-events | ||
| 3560 | '("attribute-changed" "changed" "changes-done-hint" | ||
| 3561 | "created" "deleted" "moved" "pre-unmount" "unmounted") | ||
| 3562 | "List of events \"gio monitor\" could send.") | ||
| 3563 | |||
| 3559 | (defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback) | 3564 | (defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback) |
| 3560 | "Like `file-notify-add-watch' for Tramp files." | 3565 | "Like `file-notify-add-watch' for Tramp files." |
| 3561 | (setq file-name (expand-file-name file-name)) | 3566 | (setq file-name (expand-file-name file-name)) |
| @@ -3581,7 +3586,19 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3581 | (mapcar | 3586 | (mapcar |
| 3582 | (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x))) | 3587 | (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x))) |
| 3583 | (split-string events "," 'omit)))) | 3588 | (split-string events "," 'omit)))) |
| 3584 | ;; "gvfs-monitor-dir" or "gio monitor". | 3589 | ;; "gio monitor". |
| 3590 | ((setq command (tramp-get-remote-gio-monitor v)) | ||
| 3591 | (setq filter 'tramp-sh-gio-monitor-process-filter | ||
| 3592 | events | ||
| 3593 | (cond | ||
| 3594 | ((and (memq 'change flags) (memq 'attribute-change flags)) | ||
| 3595 | '(created changed changes-done-hint moved deleted | ||
| 3596 | attribute-changed)) | ||
| 3597 | ((memq 'change flags) | ||
| 3598 | '(created changed changes-done-hint moved deleted)) | ||
| 3599 | ((memq 'attribute-change flags) '(attribute-changed))) | ||
| 3600 | sequence `(,command "monitor" ,localname))) | ||
| 3601 | ;; "gvfs-monitor-dir". | ||
| 3585 | ((setq command (tramp-get-remote-gvfs-monitor-dir v)) | 3602 | ((setq command (tramp-get-remote-gvfs-monitor-dir v)) |
| 3586 | (setq filter 'tramp-sh-gvfs-monitor-dir-process-filter | 3603 | (setq filter 'tramp-sh-gvfs-monitor-dir-process-filter |
| 3587 | events | 3604 | events |
| @@ -3592,9 +3609,7 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3592 | ((memq 'change flags) | 3609 | ((memq 'change flags) |
| 3593 | '(created changed changes-done-hint moved deleted)) | 3610 | '(created changed changes-done-hint moved deleted)) |
| 3594 | ((memq 'attribute-change flags) '(attribute-changed))) | 3611 | ((memq 'attribute-change flags) '(attribute-changed))) |
| 3595 | sequence (if (string-match "/gio$" command) | 3612 | sequence `(,command ,localname))) |
| 3596 | `(,command "monitor" ,localname) | ||
| 3597 | `(,command ,localname)))) | ||
| 3598 | ;; None. | 3613 | ;; None. |
| 3599 | (t (tramp-error | 3614 | (t (tramp-error |
| 3600 | v 'file-notify-error | 3615 | v 'file-notify-error |
| @@ -3628,6 +3643,65 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3628 | p 'file-notify-error "Monitoring not supported for `%s'" file-name)) | 3643 | p 'file-notify-error "Monitoring not supported for `%s'" file-name)) |
| 3629 | p)))) | 3644 | p)))) |
| 3630 | 3645 | ||
| 3646 | (defun tramp-sh-gio-monitor-process-filter (proc string) | ||
| 3647 | "Read output from \"gio monitor\" and add corresponding file-notify events." | ||
| 3648 | (let ((events (process-get proc 'events)) | ||
| 3649 | (remote-prefix | ||
| 3650 | (with-current-buffer (process-buffer proc) | ||
| 3651 | (file-remote-p default-directory))) | ||
| 3652 | (rest-string (process-get proc 'rest-string))) | ||
| 3653 | (when rest-string | ||
| 3654 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) | ||
| 3655 | (tramp-message proc 6 "%S\n%s" proc string) | ||
| 3656 | (setq string (concat rest-string string) | ||
| 3657 | ;; Fix action names. | ||
| 3658 | string (replace-regexp-in-string | ||
| 3659 | "attributes changed" "attribute-changed" string) | ||
| 3660 | string (replace-regexp-in-string | ||
| 3661 | "changes done" "changes-done-hint" string) | ||
| 3662 | string (replace-regexp-in-string | ||
| 3663 | "renamed to" "moved" string)) | ||
| 3664 | ;; https://bugs.launchpad.net/bugs/1742946 | ||
| 3665 | (when (string-match "Monitoring not supported\\|No locations given" string) | ||
| 3666 | (delete-process proc)) | ||
| 3667 | |||
| 3668 | (while | ||
| 3669 | (string-match | ||
| 3670 | (concat "^[^:]+:" | ||
| 3671 | "[[:space:]]\\([^:]+\\):" | ||
| 3672 | "[[:space:]]" (regexp-opt tramp-gio-events t) | ||
| 3673 | "\\([[:space:]]\\([^:]+\\)\\)?$") | ||
| 3674 | string) | ||
| 3675 | |||
| 3676 | (let* ((file (match-string 1 string)) | ||
| 3677 | (file1 (match-string 4 string)) | ||
| 3678 | (object | ||
| 3679 | (list | ||
| 3680 | proc | ||
| 3681 | (list | ||
| 3682 | (intern-soft (match-string 2 string))) | ||
| 3683 | ;; File names are returned as absolute paths. We must | ||
| 3684 | ;; add the remote prefix. | ||
| 3685 | (concat remote-prefix file) | ||
| 3686 | (when file1 (concat remote-prefix file1))))) | ||
| 3687 | (setq string (replace-match "" nil nil string)) | ||
| 3688 | ;; Remove watch when file or directory to be watched is deleted. | ||
| 3689 | (when (and (member (cl-caadr object) '(moved deleted)) | ||
| 3690 | (string-equal file (process-get proc 'watch-name))) | ||
| 3691 | (delete-process proc)) | ||
| 3692 | ;; Usually, we would add an Emacs event now. Unfortunately, | ||
| 3693 | ;; `unread-command-events' does not accept several events at | ||
| 3694 | ;; once. Therefore, we apply the handler directly. | ||
| 3695 | (when (member (cl-caadr object) events) | ||
| 3696 | (tramp-compat-funcall | ||
| 3697 | 'file-notify-handle-event | ||
| 3698 | `(file-notify ,object file-notify-callback))))) | ||
| 3699 | |||
| 3700 | ;; Save rest of the string. | ||
| 3701 | (when (zerop (length string)) (setq string nil)) | ||
| 3702 | (when string (tramp-message proc 10 "Rest string:\n%s" string)) | ||
| 3703 | (process-put proc 'rest-string string))) | ||
| 3704 | |||
| 3631 | (defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) | 3705 | (defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) |
| 3632 | "Read output from \"gvfs-monitor-dir\" and add corresponding \ | 3706 | "Read output from \"gvfs-monitor-dir\" and add corresponding \ |
| 3633 | file-notify events." | 3707 | file-notify events." |
| @@ -3643,9 +3717,6 @@ file-notify events." | |||
| 3643 | ;; Attribute change is returned in unused wording. | 3717 | ;; Attribute change is returned in unused wording. |
| 3644 | string (replace-regexp-in-string | 3718 | string (replace-regexp-in-string |
| 3645 | "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) | 3719 | "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) |
| 3646 | ;; https://bugs.launchpad.net/bugs/1742946 | ||
| 3647 | (when (string-match "Monitoring not supported\\|No locations given" string) | ||
| 3648 | (delete-process proc)) | ||
| 3649 | 3720 | ||
| 3650 | (while (string-match | 3721 | (while (string-match |
| 3651 | (concat "^[\n\r]*" | 3722 | (concat "^[\n\r]*" |
| @@ -5459,6 +5530,12 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5459 | vec (format "%s --block-size=1 --output=size,used,avail /" result)) | 5530 | vec (format "%s --block-size=1 --output=size,used,avail /" result)) |
| 5460 | result)))) | 5531 | result)))) |
| 5461 | 5532 | ||
| 5533 | (defun tramp-get-remote-gio-monitor (vec) | ||
| 5534 | "Determine remote `gio-monitor' command." | ||
| 5535 | (with-tramp-connection-property vec "gio-monitor" | ||
| 5536 | (tramp-message vec 5 "Finding a suitable `gio-monitor' command") | ||
| 5537 | (tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t))) | ||
| 5538 | |||
| 5462 | (defun tramp-get-remote-gvfs-monitor-dir (vec) | 5539 | (defun tramp-get-remote-gvfs-monitor-dir (vec) |
| 5463 | "Determine remote `gvfs-monitor-dir' command." | 5540 | "Determine remote `gvfs-monitor-dir' command." |
| 5464 | (with-tramp-connection-property vec "gvfs-monitor-dir" | 5541 | (with-tramp-connection-property vec "gvfs-monitor-dir" |
| @@ -5466,8 +5543,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5466 | ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to | 5543 | ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to |
| 5467 | ;; establish better timeouts in filenotify-tests.el. Any better | 5544 | ;; establish better timeouts in filenotify-tests.el. Any better |
| 5468 | ;; distinction approach would be welcome! | 5545 | ;; distinction approach would be welcome! |
| 5469 | (or (tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t) | 5546 | (or (tramp-find-executable |
| 5470 | (tramp-find-executable | ||
| 5471 | vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t) | 5547 | vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t) |
| 5472 | (tramp-find-executable | 5548 | (tramp-find-executable |
| 5473 | vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t)))) | 5549 | vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t)))) |