Merge from emacs-23

[bpt/emacs.git] / lisp / net / tramp-gvfs.el

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 479eaae..054875f 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -4,6 +4,7 @@
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, processes
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, processes

+;; Package: tramp

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -102,11 +103,13 @@
   (require 'custom))
 
 (require 'tramp)
   (require 'custom))
 
 (require 'tramp)

+

 (require 'dbus)
 (require 'url-parse)
 (require 'url-util)
 (require 'zeroconf)
 
 (require 'dbus)
 (require 'url-parse)
 (require 'url-util)
 (require 'zeroconf)
 

+;;;###tramp-autoload

 (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
   "*List of methods for remote files, accessed with GVFS."
   :group 'tramp
 (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
   "*List of methods for remote files, accessed with GVFS."
   :group 'tramp


@@ -121,8 +124,8 @@
 
 ;; Add a default for `tramp-default-user-alist'.  Rule: For the SYNCE
 ;; method, no user is chosen.
 
 ;; Add a default for `tramp-default-user-alist'.  Rule: For the SYNCE
 ;; method, no user is chosen.

-(add-to-list 'tramp-default-user-alist
-            '("synce" nil nil))
+;;;###tramp-autoload
+(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."
 
 (defcustom tramp-gvfs-zeroconf-domain "local"
   "*Zeroconf domain to be used for discovering services, like host names."


@@ -132,11 +135,11 @@
 
 ;; Add the methods to `tramp-methods', in order to allow minibuffer
 ;; completion.
 
 ;; Add the methods to `tramp-methods', in order to allow minibuffer
 ;; completion.

-(eval-after-load "tramp-gvfs"
-  '(when (featurep 'tramp-gvfs)
-     (dolist (elt tramp-gvfs-methods)
-       (unless (assoc elt tramp-methods)
-        (add-to-list 'tramp-methods (cons elt nil))))))
+;;;###tramp-autoload
+(when (featurep 'dbusbind)
+  (dolist (elt tramp-gvfs-methods)
+    (unless (assoc elt tramp-methods)
+      (add-to-list 'tramp-methods (cons elt nil)))))

 
 (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
   "The preceeding object path for own objects.")
 
 (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
   "The preceeding object path for own objects.")


@@ -144,9 +147,12 @@
 (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
   "The well known name of the GVFS daemon.")
 
 (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
   "The well known name of the GVFS daemon.")
 

-;; Check that GVFS is available.
-(unless (dbus-ping :session tramp-gvfs-service-daemon 100)
-  (throw 'tramp-loading nil))
+;; Check that GVFS is available.  D-Bus integration is available since
+;; Emacs 23 on some system types.  We don't call `dbus-ping', because
+;; this would load dbus.el.
+(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session)
+            (tramp-compat-process-running-p "gvfs-fuse-daemon"))
+  (error "Package `tramp-gvfs' not supported"))

 
 (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
   "The object path of the GVFS daemon.")
 
 (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
   "The object path of the GVFS daemon.")


@@ -384,7 +390,7 @@ Every entry is a list (NAME ADDRESS).")
     (expand-file-name . tramp-gvfs-handle-expand-file-name)
     ;; `file-accessible-directory-p' performed by default handler.
     (file-attributes . tramp-gvfs-handle-file-attributes)
     (expand-file-name . tramp-gvfs-handle-expand-file-name)
     ;; `file-accessible-directory-p' performed by default handler.
     (file-attributes . tramp-gvfs-handle-file-attributes)

-    (file-directory-p . tramp-smb-handle-file-directory-p)
+    (file-directory-p . tramp-gvfs-handle-file-directory-p)

     (file-executable-p . tramp-gvfs-handle-file-executable-p)
     (file-exists-p . tramp-gvfs-handle-file-exists-p)
     (file-local-copy . tramp-gvfs-handle-file-local-copy)
     (file-executable-p . tramp-gvfs-handle-file-executable-p)
     (file-exists-p . tramp-gvfs-handle-file-exists-p)
     (file-local-copy . tramp-gvfs-handle-file-local-copy)


@@ -430,13 +436,15 @@ 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.")
 

-(defun tramp-gvfs-file-name-p (filename)
+;;;###tramp-autoload
+(defsubst tramp-gvfs-file-name-p (filename)

   "Check if it's a filename handled by the GVFS daemon."
   (and (tramp-tramp-file-p filename)
        (let ((method
              (tramp-file-name-method (tramp-dissect-file-name filename))))
         (and (stringp method) (member method tramp-gvfs-methods)))))
 
   "Check if it's a filename handled by the GVFS daemon."
   (and (tramp-tramp-file-p filename)
        (let ((method
              (tramp-file-name-method (tramp-dissect-file-name filename))))
         (and (stringp method) (member method tramp-gvfs-methods)))))
 

+;;;###tramp-autoload

 (defun tramp-gvfs-file-name-handler (operation &rest args)
   "Invoke the GVFS related OPERATION.
 First arg specifies the OPERATION, second arg is a list of arguments to
 (defun tramp-gvfs-file-name-handler (operation &rest args)
   "Invoke the GVFS related OPERATION.
 First arg specifies the OPERATION, second arg is a list of arguments to


@@ -448,8 +456,10 @@ pass to the OPERATION."
 
 ;; This might be moved to tramp.el.  It shall be the first file name
 ;; handler.
 
 ;; This might be moved to tramp.el.  It shall be the first file name
 ;; handler.

-(add-to-list 'tramp-foreign-file-name-handler-alist
-            (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler))
+;;;###tramp-autoload
+(when (featurep 'dbusbind)
+  (add-to-list 'tramp-foreign-file-name-handler-alist
+              (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)))

 
 (defun tramp-gvfs-stringify-dbus-message (message)
   "Convert a D-Bus message into readable UTF8 strings, used for traces."
 
 (defun tramp-gvfs-stringify-dbus-message (message)
   "Convert a D-Bus message into readable UTF8 strings, used for traces."


@@ -484,7 +494,8 @@ will be traced by Tramp with trace level 6."
 
 (put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
 (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
 
 (put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
 (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))

-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))

 
 (defmacro with-tramp-gvfs-error-message (filename handler &rest args)
   "Apply a Tramp GVFS `handler'.
 
 (defmacro with-tramp-gvfs-error-message (filename handler &rest args)
   "Apply a Tramp GVFS `handler'.


@@ -493,7 +504,7 @@ In case of an error, modify the error message by replacing
   `(let ((fuse-file-name  (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
         elt)
      (condition-case err
   `(let ((fuse-file-name  (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
         elt)
      (condition-case err

-        (funcall ,handler ,@args)
+        (tramp-compat-funcall ,handler ,@args)

        (error
        (setq elt (cdr err))
        (while elt
        (error
        (setq elt (cdr err))
        (while elt


@@ -505,7 +516,8 @@ In case of an error, modify the error message by replacing
 
 (put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
 (put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))
 
 (put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
 (put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))

-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
+(tramp-compat-font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))

 
 (defvar tramp-gvfs-dbus-event-vector nil
   "Current Tramp file name to be used, as vector.
 
 (defvar tramp-gvfs-dbus-event-vector nil
   "Current Tramp file name to be used, as vector.


@@ -515,7 +527,6 @@ 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'."
   (when tramp-gvfs-dbus-event-vector
 (defun tramp-gvfs-dbus-event-error (event err)
   "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'."
   (when tramp-gvfs-dbus-event-vector

-    ;(tramp-cleanup-connection 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))))
 
     (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
     (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
 


@@ -646,6 +657,10 @@ is no information where to trace the message.")
   "Like `file-attributes' for Tramp files."
   (file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
 
   "Like `file-attributes' for Tramp files."
   (file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
 

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

 (defun tramp-gvfs-handle-file-executable-p (filename)
   "Like `file-executable-p' for Tramp files."
   (file-executable-p (tramp-gvfs-fuse-file-name filename)))
 (defun tramp-gvfs-handle-file-executable-p (filename)
   "Like `file-executable-p' for Tramp files."
   (file-executable-p (tramp-gvfs-fuse-file-name filename)))


@@ -955,7 +970,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
            ;; host signature.
            (with-temp-buffer
              ;; Preserve message for `progress-reporter'.
            ;; host signature.
            (with-temp-buffer
              ;; Preserve message for `progress-reporter'.

-             (with-temp-message ""
+             (tramp-compat-with-temp-message ""

                (insert message)
                (pop-to-buffer (current-buffer))
                (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))
                (insert message)
                (pop-to-buffer (current-buffer))
                (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))


@@ -1178,7 +1193,7 @@ connection if a previous connection has died for some reason."
              :name (tramp-buffer-name vec)
              :buffer (tramp-get-buffer vec)
              :server t :host 'local :service t)))
              :name (tramp-buffer-name vec)
              :buffer (tramp-get-buffer vec)
              :server t :host 'local :service t)))

-      (tramp-set-process-query-on-exit-flag p nil)))
+      (tramp-compat-set-process-query-on-exit-flag p nil)))

 
   (unless (tramp-gvfs-connection-mounted-p vec)
     (let* ((method (tramp-file-name-method vec))
 
   (unless (tramp-gvfs-connection-mounted-p vec)
     (let* ((method (tramp-file-name-method vec))


@@ -1402,6 +1417,10 @@ They are retrieved from the hal daemon."
 (tramp-set-completion-function
  "synce" '((tramp-synce-parse-device-names "")))
 
 (tramp-set-completion-function
  "synce" '((tramp-synce-parse-device-names "")))
 

+(add-hook 'tramp-unload-hook
+         (lambda ()
+           (unload-feature 'tramp-gvfs 'force)))
+

 (provide 'tramp-gvfs)
 
 ;;; TODO:
 (provide 'tramp-gvfs)
 
 ;;; TODO:


@@ -1413,5 +1432,4 @@ They are retrieved from the hal daemon."
 ;;   capability.
 ;; * Implement obex for other serial communication but bluetooth.
 
 ;;   capability.
 ;; * Implement obex for other serial communication but bluetooth.
 

-;; arch-tag: f7f660ce-77f4-4132-9663-f5c25a47f7ed

 ;;; tramp-gvfs.el ends here
 ;;; tramp-gvfs.el ends here