aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/tramp-archive.el2
-rw-r--r--lisp/net/tramp-gvfs.el66
-rw-r--r--lisp/net/tramp-sh.el29
-rw-r--r--lisp/net/tramp.el10
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.
389The structure consists of the `tramp-archive-method' method, the 389The structure consists of the `tramp-archive-method' method, the
390hexlified archive name as host, and the localname. The archive 390hexified archive name as host, and the localname. The archive
391name is kept in slot `hop'" 391name 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 \
1330file-notify events." 1329file-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