Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca

[gnu-emacs] / lisp / net / tramp-gvfs.el

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 396443e60e6de2d8b90e21b4c842a6882de7e391..7473871e56456eea47804176a12605b43c9b39d0 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1,6 +1,6 @@
 ;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon
 
 ;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon
 

-;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc.

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


@@ -91,11 +91,7 @@
 
 ;; D-Bus support in the Emacs core can be disabled with configuration
 ;; option "--without-dbus".  Declare used subroutines and variables.
 
 ;; D-Bus support in the Emacs core can be disabled with configuration
 ;; option "--without-dbus".  Declare used subroutines and variables.

-(declare-function dbus-call-method "dbusbind.c")
-(declare-function dbus-call-method-asynchronously "dbusbind.c")

 (declare-function dbus-get-unique-name "dbusbind.c")
 (declare-function dbus-get-unique-name "dbusbind.c")

-(declare-function dbus-register-method "dbusbind.c")
-(declare-function dbus-register-signal "dbusbind.c")

 
 ;; Pacify byte-compiler
 (eval-when-compile
 
 ;; Pacify byte-compiler
 (eval-when-compile


@@ -111,7 +107,7 @@
 
 ;;;###tramp-autoload
 (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
 
 ;;;###tramp-autoload
 (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")

-  "*List of methods for remote files, accessed with GVFS."
+  "List of methods for remote files, accessed with GVFS."

   :group 'tramp
   :version "23.2"
   :type '(repeat (choice (const "dav")
   :group 'tramp
   :version "23.2"
   :type '(repeat (choice (const "dav")


@@ -128,7 +124,7 @@
 (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
 
 (defcustom tramp-gvfs-zeroconf-domain "local"
 (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
 
 (defcustom tramp-gvfs-zeroconf-domain "local"

-  "*Zeroconf domain to be used for discovering services, like host names."
+  "Zeroconf domain to be used for discovering services, like host names."

   :group 'tramp
   :version "23.2"
   :type 'string)
   :group 'tramp
   :version "23.2"
   :type 'string)


@@ -388,7 +384,8 @@ Every entry is a list (NAME ADDRESS).")
     (dired-uncache . tramp-handle-dired-uncache)
     ;; `executable-find' is not official yet. performed by default handler.
     (expand-file-name . tramp-gvfs-handle-expand-file-name)
     (dired-uncache . tramp-handle-dired-uncache)
     ;; `executable-find' is not official yet. performed by default handler.
     (expand-file-name . tramp-gvfs-handle-expand-file-name)

-    ;; `file-accessible-directory-p' performed by default handler.
+    (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+    (file-acl . tramp-gvfs-handle-file-acl)

     (file-attributes . tramp-gvfs-handle-file-attributes)
     (file-directory-p . tramp-gvfs-handle-file-directory-p)
     (file-executable-p . tramp-gvfs-handle-file-executable-p)
     (file-attributes . tramp-gvfs-handle-file-attributes)
     (file-directory-p . tramp-gvfs-handle-file-directory-p)
     (file-executable-p . tramp-gvfs-handle-file-executable-p)


@@ -421,6 +418,7 @@ Every entry is a list (NAME ADDRESS).")
     (make-symbolic-link . ignore)
     (process-file . tramp-gvfs-handle-process-file)
     (rename-file . tramp-gvfs-handle-rename-file)
     (make-symbolic-link . ignore)
     (process-file . tramp-gvfs-handle-process-file)
     (rename-file . tramp-gvfs-handle-rename-file)

+    (set-file-acl . tramp-gvfs-handle-set-file-acl)

     (set-file-modes . tramp-gvfs-handle-set-file-modes)
     (set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context)
     (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
     (set-file-modes . tramp-gvfs-handle-set-file-modes)
     (set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context)
     (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)


@@ -436,6 +434,8 @@ Every entry is a list (NAME ADDRESS).")
   "Alist of handler functions for Tramp GVFS method.
 Operations not mentioned here will be handled by the default Emacs primitives.")
 
   "Alist of handler functions for Tramp GVFS method.
 Operations not mentioned here will be handled by the default Emacs primitives.")
 

+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el.  Otherwise, there would be recursive autoloading.

 ;;;###tramp-autoload
 (defsubst tramp-gvfs-file-name-p (filename)
   "Check if it's a filename handled by the GVFS daemon."
 ;;;###tramp-autoload
 (defsubst tramp-gvfs-file-name-p (filename)
   "Check if it's a filename handled by the GVFS daemon."


@@ -525,23 +525,27 @@ It is needed when D-Bus signals or errors arrive, because there
 is no information where to trace the message.")
 
 (defun tramp-gvfs-dbus-event-error (event err)
 is no information where to trace the message.")
 
 (defun tramp-gvfs-dbus-event-error (event err)

-  "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'."
+  "Called when a D-Bus error message arrives, see `dbus-event-error-functions'."

   (when tramp-gvfs-dbus-event-vector
     (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
     (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
 
   (when tramp-gvfs-dbus-event-vector
     (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
     (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
 

-(add-hook 'dbus-event-error-hooks 'tramp-gvfs-dbus-event-error)
+;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'.
+(add-hook
+ (if (boundp 'dbus-event-error-functions)
+     'dbus-event-error-functions 'dbus-event-error-hooks)
+ 'tramp-gvfs-dbus-event-error)

 
 \f
 ;; File name primitives.
 
 (defun tramp-gvfs-handle-copy-file
   (filename newname &optional ok-if-already-exists keep-date
 
 \f
 ;; File name primitives.
 
 (defun tramp-gvfs-handle-copy-file
   (filename newname &optional ok-if-already-exists keep-date

-           preserve-uid-gid preserve-selinux-context)
+           preserve-uid-gid preserve-extended-attributes)

   "Like `copy-file' for Tramp files."
   (with-parsed-tramp-file-name
       (if (tramp-tramp-file-p filename) filename newname) nil
   "Like `copy-file' for Tramp files."
   (with-parsed-tramp-file-name
       (if (tramp-tramp-file-p filename) filename newname) nil

-    (tramp-with-progress-reporter
+    (with-tramp-progress-reporter

        v 0 (format "Copying %s to %s" filename newname)
       (condition-case err
          (let ((args
        v 0 (format "Copying %s to %s" filename newname)
       (condition-case err
          (let ((args


@@ -553,8 +557,8 @@ is no information where to trace the message.")
                      (tramp-gvfs-fuse-file-name newname)
                    newname)
                  ok-if-already-exists keep-date preserve-uid-gid)))
                      (tramp-gvfs-fuse-file-name newname)
                    newname)
                  ok-if-already-exists keep-date preserve-uid-gid)))

-           (when preserve-selinux-context
-             (setq args (append args (list preserve-selinux-context))))
+           (when preserve-extended-attributes
+             (setq args (append args (list preserve-extended-attributes))))

            (apply 'copy-file args))
 
        ;; Error case.  Let's try it with the GVFS utilities.
            (apply 'copy-file args))
 
        ;; Error case.  Let's try it with the GVFS utilities.


@@ -625,7 +629,7 @@ is no information where to trace the message.")
       ;; If there is a default location, expand tilde.
       (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
        (save-match-data
       ;; If there is a default location, expand tilde.
       (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
        (save-match-data

-         (tramp-gvfs-maybe-open-connection (vector method user host "/")))
+         (tramp-gvfs-maybe-open-connection (vector method user host "/" hop)))

        (setq localname
              (replace-match
               (tramp-get-file-property  v "/" "default-location" "~")
        (setq localname
              (replace-match
               (tramp-get-file-property  v "/" "default-location" "~")


@@ -653,6 +657,10 @@ is no information where to trace the message.")
        (tramp-run-real-handler
        'expand-file-name (list localname))))))
 
        (tramp-run-real-handler
        'expand-file-name (list localname))))))
 

+(defun tramp-gvfs-handle-file-acl (filename)
+  "Like `file-acl' for Tramp files."
+  (tramp-compat-funcall 'file-acl (tramp-gvfs-fuse-file-name filename)))
+

 (defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
   "Like `file-attributes' for Tramp files."
   (file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
 (defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
   "Like `file-attributes' for Tramp files."
   (file-attributes (tramp-gvfs-fuse-file-name filename) id-format))


@@ -745,7 +753,7 @@ is no information where to trace the message.")
   "Like `rename-file' for Tramp files."
   (with-parsed-tramp-file-name
       (if (tramp-tramp-file-p filename) filename newname) nil
   "Like `rename-file' for Tramp files."
   (with-parsed-tramp-file-name
       (if (tramp-tramp-file-p filename) filename newname) nil

-    (tramp-with-progress-reporter
+    (with-tramp-progress-reporter

        v 0 (format "Renaming %s to %s" filename newname)
       (condition-case err
          (rename-file
        v 0 (format "Renaming %s to %s" filename newname)
       (condition-case err
          (rename-file


@@ -779,6 +787,11 @@ is no information where to trace the message.")
       (tramp-flush-file-property v (file-name-directory localname))
       (tramp-flush-file-property v localname))))
 
       (tramp-flush-file-property v (file-name-directory localname))
       (tramp-flush-file-property v localname))))
 

+(defun tramp-gvfs-handle-set-file-acl (filename acl-string)
+  "Like `set-file-acl' for Tramp files."
+  (with-tramp-gvfs-error-message filename 'set-file-acl
+    (tramp-gvfs-fuse-file-name filename) acl-string))
+

 (defun tramp-gvfs-handle-set-file-modes (filename mode)
   "Like `set-file-modes' for Tramp files."
   (with-tramp-gvfs-error-message filename 'set-file-modes
 (defun tramp-gvfs-handle-set-file-modes (filename mode)
   "Like `set-file-modes' for Tramp files."
   (with-tramp-gvfs-error-message filename 'set-file-modes


@@ -1060,7 +1073,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
    (catch 'mounted
      (dolist
         (elt
    (catch 'mounted
      (dolist
         (elt

-         (with-file-property vec "/" "list-mounts"
+         (with-tramp-file-property vec "/" "list-mounts"

            (with-tramp-dbus-call-method vec t
              :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
              tramp-gvfs-interface-mounttracker "listMounts"))
            (with-tramp-dbus-call-method vec t
              :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
              tramp-gvfs-interface-mounttracker "listMounts"))


@@ -1203,7 +1216,7 @@ connection if a previous connection has died for some reason."
            (tramp-gvfs-object-path
             (tramp-make-tramp-file-name method user host ""))))
 
            (tramp-gvfs-object-path
             (tramp-make-tramp-file-name method user host ""))))
 

-      (tramp-with-progress-reporter
+      (with-tramp-progress-reporter

          vec 3
          (if (zerop (length user))
              (format "Opening connection for %s using %s" host method)
          vec 3
          (if (zerop (length user))
              (format "Opening connection for %s using %s" host method)


@@ -1267,7 +1280,7 @@ COMMAND is usually a command from the gvfs-* utilities.
     (with-current-buffer (tramp-get-buffer vec)
       (erase-buffer)
       (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
     (with-current-buffer (tramp-get-buffer vec)
       (erase-buffer)
       (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))

-      (setq result (apply 'tramp-local-call-process command nil t nil args))
+      (setq result (apply 'tramp-compat-call-process command nil t nil args))

       (tramp-message vec 6 "%s" (buffer-string))
       result)))
 
       (tramp-message vec 6 "%s" (buffer-string))
       result)))