diff options
| author | Michael Albinus | 2018-02-11 10:26:57 +0100 |
|---|---|---|
| committer | Michael Albinus | 2018-02-11 10:26:57 +0100 |
| commit | 13f4b518d0bb7cb4536d341a2a2c8d0b76f75f6b (patch) | |
| tree | 69aa4224c109494c599a62f3c6238b318d5a1a89 | |
| parent | 09465bfa063a62f03ea746685111632a832068b9 (diff) | |
| download | emacs-13f4b518d0bb7cb4536d341a2a2c8d0b76f75f6b.tar.gz emacs-13f4b518d0bb7cb4536d341a2a2c8d0b76f75f6b.zip | |
Fix handling of file notifications in tramp-gvfs.el
* lisp/net/tramp-archive.el (tramp-archive-dissect-file-name):
Fix docstring.
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
Use consequently "gio monitor".
(tramp-gvfs-monitor-process-filter): Rename from
`tramp-gvfs-monitor-file-process-filter'. Adapt implementation.
* lisp/net/tramp-sh.el (tramp-gio-events): Move this ...
* lisp/net/tramp.el (tramp-gio-events): ... here.
| -rw-r--r-- | lisp/net/tramp-archive.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 66 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 29 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 10 |
4 files changed, 59 insertions, 48 deletions
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 5f28756d753..c859ca147e7 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el | |||
| @@ -387,7 +387,7 @@ name of a local copy, if any.") | |||
| 387 | (defun tramp-archive-dissect-file-name (name) | 387 | (defun tramp-archive-dissect-file-name (name) |
| 388 | "Return a `tramp-file-name' structure. | 388 | "Return a `tramp-file-name' structure. |
| 389 | The structure consists of the `tramp-archive-method' method, the | 389 | The structure consists of the `tramp-archive-method' method, the |
| 390 | hexlified archive name as host, and the localname. The archive | 390 | hexified archive name as host, and the localname. The archive |
| 391 | name is kept in slot `hop'" | 391 | name is kept in slot `hop'" |
| 392 | (save-match-data | 392 | (save-match-data |
| 393 | (unless (tramp-archive-file-name-p name) | 393 | (unless (tramp-archive-file-name-p name) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 70ac077a7c5..eb3dddcd6c5 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -1286,9 +1286,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1286 | "Like `file-notify-add-watch' for Tramp files." | 1286 | "Like `file-notify-add-watch' for Tramp files." |
| 1287 | (setq file-name (expand-file-name file-name)) | 1287 | (setq file-name (expand-file-name file-name)) |
| 1288 | (with-parsed-tramp-file-name file-name nil | 1288 | (with-parsed-tramp-file-name file-name nil |
| 1289 | ;; We cannot watch directories, because `gvfs-monitor-dir' is not | 1289 | ;; TODO: We cannot watch directories, because `gio monitor' is not |
| 1290 | ;; supported for gvfs-mounted directories. | 1290 | ;; supported for gvfs-mounted directories. However, |
| 1291 | (when (file-directory-p file-name) | 1291 | ;; `file-notify-add-watch' uses directories. |
| 1292 | (when (or (not (tramp-gvfs-gio-tool-p v)) (file-directory-p file-name)) | ||
| 1292 | (tramp-error | 1293 | (tramp-error |
| 1293 | v 'file-notify-error "Monitoring not supported for `%s'" file-name)) | 1294 | v 'file-notify-error "Monitoring not supported for `%s'" file-name)) |
| 1294 | (let* ((default-directory (file-name-directory file-name)) | 1295 | (let* ((default-directory (file-name-directory file-name)) |
| @@ -1303,9 +1304,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1303 | (p (apply | 1304 | (p (apply |
| 1304 | 'start-process | 1305 | 'start-process |
| 1305 | "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*") | 1306 | "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*") |
| 1306 | (if (tramp-gvfs-gio-tool-p v) | 1307 | `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name))))) |
| 1307 | `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name)) | ||
| 1308 | `("gvfs-monitor-file" (tramp-gvfs-url-file-name file-name)))))) | ||
| 1309 | (if (not (processp p)) | 1308 | (if (not (processp p)) |
| 1310 | (tramp-error | 1309 | (tramp-error |
| 1311 | v 'file-notify-error "Monitoring not supported for `%s'" file-name) | 1310 | v 'file-notify-error "Monitoring not supported for `%s'" file-name) |
| @@ -1316,7 +1315,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1316 | (process-put p 'watch-name localname) | 1315 | (process-put p 'watch-name localname) |
| 1317 | (process-put p 'adjust-window-size-function 'ignore) | 1316 | (process-put p 'adjust-window-size-function 'ignore) |
| 1318 | (set-process-query-on-exit-flag p nil) | 1317 | (set-process-query-on-exit-flag p nil) |
| 1319 | (set-process-filter p 'tramp-gvfs-monitor-file-process-filter) | 1318 | (set-process-filter p 'tramp-gvfs-monitor-process-filter) |
| 1320 | ;; There might be an error if the monitor is not supported. | 1319 | ;; There might be an error if the monitor is not supported. |
| 1321 | ;; Give the filter a chance to read the output. | 1320 | ;; Give the filter a chance to read the output. |
| 1322 | (tramp-accept-process-output p 1) | 1321 | (tramp-accept-process-output p 1) |
| @@ -1325,45 +1324,58 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1325 | p 'file-notify-error "Monitoring not supported for `%s'" file-name)) | 1324 | p 'file-notify-error "Monitoring not supported for `%s'" file-name)) |
| 1326 | p)))) | 1325 | p)))) |
| 1327 | 1326 | ||
| 1328 | (defun tramp-gvfs-monitor-file-process-filter (proc string) | 1327 | (defun tramp-gvfs-monitor-process-filter (proc string) |
| 1329 | "Read output from \"gvfs-monitor-file\" and add corresponding \ | 1328 | "Read output from \"gvfs-monitor-file\" and add corresponding \ |
| 1330 | file-notify events." | 1329 | file-notify events." |
| 1331 | (let* ((rest-string (process-get proc 'rest-string)) | 1330 | (let* ((events (process-get proc 'events)) |
| 1331 | (rest-string (process-get proc 'rest-string)) | ||
| 1332 | (dd (with-current-buffer (process-buffer proc) default-directory)) | 1332 | (dd (with-current-buffer (process-buffer proc) default-directory)) |
| 1333 | (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) | 1333 | (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) |
| 1334 | (when rest-string | 1334 | (when rest-string |
| 1335 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) | 1335 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) |
| 1336 | (tramp-message proc 6 "%S\n%s" proc string) | 1336 | (tramp-message proc 6 "%S\n%s" proc string) |
| 1337 | (setq string (concat rest-string string) | 1337 | (setq string (concat rest-string string) |
| 1338 | ;; Attribute change is returned in unused wording. | 1338 | ;; Fix action names. |
| 1339 | string (replace-regexp-in-string | 1339 | string (replace-regexp-in-string |
| 1340 | "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) | 1340 | "attributes changed" "attribute-changed" string) |
| 1341 | (when (string-match "Monitoring not supported" string) | 1341 | string (replace-regexp-in-string |
| 1342 | "changes done" "changes-done-hint" string) | ||
| 1343 | string (replace-regexp-in-string | ||
| 1344 | "renamed to" "moved" string)) | ||
| 1345 | ;; https://bugs.launchpad.net/bugs/1742946 | ||
| 1346 | (when (string-match "Monitoring not supported\\|No locations given" string) | ||
| 1342 | (delete-process proc)) | 1347 | (delete-process proc)) |
| 1343 | 1348 | ||
| 1344 | (while (string-match | 1349 | (while (string-match |
| 1345 | (concat "^[\n\r]*" | 1350 | (concat "^.+:" |
| 1346 | "File Monitor Event:[\n\r]+" | 1351 | "[[:space:]]\\(.+\\):" |
| 1347 | "File = \\([^\n\r]+\\)[\n\r]+" | 1352 | "[[:space:]]" (regexp-opt tramp-gio-events t) |
| 1348 | "Event = \\([^[:blank:]]+\\)[\n\r]+") | 1353 | "\\([[:space:]]\\(.+\\)\\)?$") |
| 1349 | string) | 1354 | string) |
| 1355 | |||
| 1350 | (let ((file (match-string 1 string)) | 1356 | (let ((file (match-string 1 string)) |
| 1351 | (action (intern-soft | 1357 | (file1 (match-string 4 string)) |
| 1352 | (replace-regexp-in-string | 1358 | (action (intern-soft (match-string 2 string)))) |
| 1353 | "_" "-" (downcase (match-string 2 string)))))) | ||
| 1354 | (setq string (replace-match "" nil nil string)) | 1359 | (setq string (replace-match "" nil nil string)) |
| 1355 | ;; File names are returned as URL paths. We must convert them. | 1360 | ;; File names are returned as URL paths. We must convert them. |
| 1356 | (when (string-match ddu file) | 1361 | (when (string-match ddu file) |
| 1357 | (setq file (replace-match dd nil nil file))) | 1362 | (setq file (replace-match dd nil nil file))) |
| 1358 | (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file) | 1363 | (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file) |
| 1359 | (setq file | 1364 | (setq file (url-unhex-string file))) |
| 1360 | (replace-match | 1365 | (when (string-match ddu (or file1 "")) |
| 1361 | (char-to-string (string-to-number (match-string 1 file) 16)) | 1366 | (setq file1 (replace-match dd nil nil file1))) |
| 1362 | nil nil file))) | 1367 | (while (string-match "%\\([0-9A-F]\\{2\\}\\)" (or file1 "")) |
| 1368 | (setq file1 (url-unhex-string file1))) | ||
| 1369 | ;; Remove watch when file or directory to be watched is deleted. | ||
| 1370 | (when (and (member action '(moved deleted)) | ||
| 1371 | (string-equal file (process-get proc 'watch-name))) | ||
| 1372 | (delete-process proc)) | ||
| 1363 | ;; Usually, we would add an Emacs event now. Unfortunately, | 1373 | ;; Usually, we would add an Emacs event now. Unfortunately, |
| 1364 | ;; `unread-command-events' does not accept several events at | 1374 | ;; `unread-command-events' does not accept several events at |
| 1365 | ;; once. Therefore, we apply the callback directly. | 1375 | ;; once. Therefore, we apply the callback directly. |
| 1366 | (tramp-compat-funcall 'file-notify-callback (list proc action file)))) | 1376 | (when (member action events) |
| 1377 | (tramp-compat-funcall | ||
| 1378 | 'file-notify-callback (list proc action file file1))))) | ||
| 1367 | 1379 | ||
| 1368 | ;; Save rest of the string. | 1380 | ;; Save rest of the string. |
| 1369 | (when (zerop (length string)) (setq string nil)) | 1381 | (when (zerop (length string)) (setq string nil)) |
| @@ -1483,7 +1495,7 @@ file-notify events." | |||
| 1483 | 1495 | ||
| 1484 | (defun tramp-gvfs-url-file-name (filename) | 1496 | (defun tramp-gvfs-url-file-name (filename) |
| 1485 | "Return FILENAME in URL syntax." | 1497 | "Return FILENAME in URL syntax." |
| 1486 | ;; "/" must NOT be hexlified. | 1498 | ;; "/" must NOT be hexified. |
| 1487 | (setq filename (tramp-compat-file-name-unquote filename)) | 1499 | (setq filename (tramp-compat-file-name-unquote filename)) |
| 1488 | (let ((url-unreserved-chars (cons ?/ url-unreserved-chars)) | 1500 | (let ((url-unreserved-chars (cons ?/ url-unreserved-chars)) |
| 1489 | result) | 1501 | result) |
| @@ -2352,7 +2364,7 @@ They are retrieved from the hal daemon." | |||
| 2352 | ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. | 2364 | ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. |
| 2353 | 2365 | ||
| 2354 | ;; * Host name completion for existing mount points (afp-server, | 2366 | ;; * Host name completion for existing mount points (afp-server, |
| 2355 | ;; smb-server) or via smb-network. | 2367 | ;; smb-server, google-drive, owncloud) or via smb-network. |
| 2356 | ;; | 2368 | ;; |
| 2357 | ;; * Check, how two shares of the same SMB server can be mounted in | 2369 | ;; * Check, how two shares of the same SMB server can be mounted in |
| 2358 | ;; parallel. | 2370 | ;; parallel. |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 25c00d180bb..ff5d404aaac 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -3556,11 +3556,6 @@ 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 | |||
| 3564 | (defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback) | 3559 | (defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback) |
| 3565 | "Like `file-notify-add-watch' for Tramp files." | 3560 | "Like `file-notify-add-watch' for Tramp files." |
| 3566 | (setq file-name (expand-file-name file-name)) | 3561 | (setq file-name (expand-file-name file-name)) |
| @@ -3665,13 +3660,12 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3665 | (when (string-match "Monitoring not supported\\|No locations given" string) | 3660 | (when (string-match "Monitoring not supported\\|No locations given" string) |
| 3666 | (delete-process proc)) | 3661 | (delete-process proc)) |
| 3667 | 3662 | ||
| 3668 | (while | 3663 | (while (string-match |
| 3669 | (string-match | 3664 | (concat "^[^:]+:" |
| 3670 | (concat "^[^:]+:" | 3665 | "[[:space:]]\\([^:]+\\):" |
| 3671 | "[[:space:]]\\([^:]+\\):" | 3666 | "[[:space:]]" (regexp-opt tramp-gio-events t) |
| 3672 | "[[:space:]]" (regexp-opt tramp-gio-events t) | 3667 | "\\([[:space:]]\\([^:]+\\)\\)?$") |
| 3673 | "\\([[:space:]]\\([^:]+\\)\\)?$") | 3668 | string) |
| 3674 | string) | ||
| 3675 | 3669 | ||
| 3676 | (let* ((file (match-string 1 string)) | 3670 | (let* ((file (match-string 1 string)) |
| 3677 | (file1 (match-string 4 string)) | 3671 | (file1 (match-string 4 string)) |
| @@ -3762,12 +3756,11 @@ file-notify events." | |||
| 3762 | (tramp-message proc 6 "%S\n%s" proc string) | 3756 | (tramp-message proc 6 "%S\n%s" proc string) |
| 3763 | (dolist (line (split-string string "[\n\r]+" 'omit)) | 3757 | (dolist (line (split-string string "[\n\r]+" 'omit)) |
| 3764 | ;; Check, whether there is a problem. | 3758 | ;; Check, whether there is a problem. |
| 3765 | (unless | 3759 | (unless (string-match |
| 3766 | (string-match | 3760 | (concat "^[^[:blank:]]+" |
| 3767 | (concat "^[^[:blank:]]+" | 3761 | "[[:blank:]]+\\([^[:blank:]]+\\)+" |
| 3768 | "[[:blank:]]+\\([^[:blank:]]+\\)+" | 3762 | "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") |
| 3769 | "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") | 3763 | line) |
| 3770 | line) | ||
| 3771 | (tramp-error proc 'file-notify-error "%s" line)) | 3764 | (tramp-error proc 'file-notify-error "%s" line)) |
| 3772 | 3765 | ||
| 3773 | (let ((object | 3766 | (let ((object |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b2e20000d3f..618d026abde 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -3623,10 +3623,16 @@ of." | |||
| 3623 | ;; only if that agrees with the buffer's record. | 3623 | ;; only if that agrees with the buffer's record. |
| 3624 | (t (equal mt '(-1 65535))))))))) | 3624 | (t (equal mt '(-1 65535))))))))) |
| 3625 | 3625 | ||
| 3626 | ;; This is used in tramp-gvfs.el and tramp-sh.el. | ||
| 3627 | (defconst tramp-gio-events | ||
| 3628 | '("attribute-changed" "changed" "changes-done-hint" | ||
| 3629 | "created" "deleted" "moved" "pre-unmount" "unmounted") | ||
| 3630 | "List of events \"gio monitor\" could send.") | ||
| 3631 | |||
| 3632 | ;; This is the default handler. tramp-gvfs.el and tramp-sh.el have | ||
| 3633 | ;; their own one. | ||
| 3626 | (defun tramp-handle-file-notify-add-watch (filename _flags _callback) | 3634 | (defun tramp-handle-file-notify-add-watch (filename _flags _callback) |
| 3627 | "Like `file-notify-add-watch' for Tramp files." | 3635 | "Like `file-notify-add-watch' for Tramp files." |
| 3628 | ;; This is the default handler. tramp-gvfs.el and tramp-sh.el have | ||
| 3629 | ;; their own one. | ||
| 3630 | (setq filename (expand-file-name filename)) | 3636 | (setq filename (expand-file-name filename)) |
| 3631 | (with-parsed-tramp-file-name filename nil | 3637 | (with-parsed-tramp-file-name filename nil |
| 3632 | (tramp-error | 3638 | (tramp-error |