[Emacs-diffs] emacs/lisp/net tramp-gvfs.el

[Michael Albinus]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Michael Albinus <albinus>       09/06/30 14:47:34

Modified files:
        lisp/net       : tramp-gvfs.el 

Log message:
        * net/tramp-gvfs.el (tramp-gvfs-methods): Add "synce" method.
        (tramp-gvfs-connection-mounted-p): Handle empty user name for
        synce.
        (tramp-synce-list-devices, tramp-synce-parse-device-names): New
        defuns.
        (top): Add completion function for "synce" method.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/tramp-gvfs.el?cvsroot=emacs&r1=1.4&r2=1.5

Patches:
Index: tramp-gvfs.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/tramp-gvfs.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- tramp-gvfs.el       24 Jun 2009 05:10:57 -0000      1.4
+++ tramp-gvfs.el       30 Jun 2009 14:47:34 -0000      1.5
@@ -98,7 +98,7 @@
 (require 'url-parse)
 (require 'zeroconf)
 
-(defcustom tramp-gvfs-methods '("dav" "davs" "obex")
+(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
   "*List of methods for remote files, accessed with GVFS."
   :group 'tramp
   :type '(repeat (choice (const "dav")
@@ -106,7 +106,8 @@
                         (const "ftp")
                         (const "obex")
                         (const "sftp")
-                        (const "smb"))))
+                        (const "smb")
+                        (const "synce"))))
 
 (defcustom tramp-gvfs-zeroconf-domain "local"
   "*Zeroconf domain to be used for discovering services, like host names."
@@ -898,6 +899,8 @@
          (setq host (tramp-bluez-device host)))
        (when (and (string-equal "dav" method) (string-equal "true" ssl))
          (setq method "davs"))
+       (when (and (string-equal "synce" method) (zerop (length user)))
+         (setq user (or (tramp-file-name-user vec) "")))
        (unless (zerop (length domain))
          (setq user (concat user tramp-prefix-domain-format domain)))
        (unless (zerop (length port))
@@ -1171,6 +1174,39 @@
   (tramp-set-completion-function
    "davs" '((tramp-zeroconf-parse-webdav-device-names ""))))
 
+
+;; D-Bus SYNCE functions.
+
+(defun tramp-synce-list-devices ()
+  "Returns all discovered synce devices as list."
+  (let (tramp-synce-devices)
+    (dolist (device
+            (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
+             :system "org.freedesktop.Hal"
+             "/org/freedesktop/Hal/Manager"
+             "org.freedesktop.Hal.Manager" "GetAllDevices"))
+      (when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
+             :system "org.freedesktop.Hal" device
+             "org.freedesktop.Hal.Device" "PropertyExists" "sync.plugin")
+       (add-to-list
+        'tramp-synce-devices
+        (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
+          :system "org.freedesktop.Hal" device
+            "org.freedesktop.Hal.Device"
+            "GetPropertyString" "pda.pocketpc.name"))))
+    (tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices)
+    tramp-synce-devices))
+
+(defun tramp-synce-parse-device-names (ignore)
+  "Return a list of (nil host) tuples allowed to access."
+  (mapcar
+   (lambda (x) (list nil x))
+   (tramp-synce-list-devices)))
+
+;; Add completion function for SYNCE method.
+(tramp-set-completion-function
+ "synce" '((tramp-synce-parse-device-names "")))
+
 (provide 'tramp-gvfs)
 
 ;;; TODO: