* net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): Expand "~/".

(tramp-gvfs-handler-mounted-unmounted)
(tramp-gvfs-connection-mounted-p): Handle default-location.

* net/tramp-smb.el (tramp-smb-handle-delete-directory): Don't try to
move files to trash.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e4ed37cf9cdf886f01c1a013e6569d03a799a704..4ce37b1996a111c388c83d397850f63cf6c6b7be 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2010-06-04  Michael Albinus  <michael.albinus@gmx.de>
+
+       * net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name): Expand "~/".
+       (tramp-gvfs-handler-mounted-unmounted)
+       (tramp-gvfs-connection-mounted-p): Handle default-location.
+
+       * net/tramp-smb.el (tramp-smb-handle-delete-directory): Don't try to
+       move files to trash.
+
 2010-06-04  Juanma Barranquero  <lekktu@gmail.com>
 
        * international/mule-cmds.el (nonascii-insert-offset)

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 3c1bcbb61cc7b2f7ad56580fcc22d93d8436b9d8..a984dd37fd8da072ab7cd8b38886a9acf754d683 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -157,7 +157,7 @@
 ;; <interface name='org.gtk.vfs.MountTracker'>
 ;;   <method name='listMounts'>
 ;;     <arg name='mount_info_list'
-;;          type='a{sosssssbay{aya{say}}}'
+;;          type='a{sosssssbay{aya{say}}ay}'
 ;;          direction='out'/>
 ;;   </method>
 ;;   <method name='mountLocation'>
@@ -167,11 +167,11 @@
 ;;   </method>
 ;;   <signal name='mounted'>
 ;;     <arg name='mount_info'
-;;          type='{sosssssbay{aya{say}}}'/>
+;;          type='{sosssssbay{aya{say}}ay}'/>
 ;;   </signal>
 ;;   <signal name='unmounted'>
 ;;     <arg name='mount_info'
-;;          type='{sosssssbay{aya{say}}}'/>
+;;          type='{sosssssbay{aya{say}}ay}'/>
 ;;   </signal>
 ;; </interface>
 ;;
@@ -191,7 +191,7 @@
 ;;       STRUCT                    mount_spec_item
 ;;         STRING            key (server, share, type, user, host, port)
 ;;         ARRAY BYTE        value
-;;   STRING               default_location     Since GVFS 1.5 only !!!
+;;   ARRAY BYTE           default_location     Since GVFS 1.5 only !!!
 
 (defconst tramp-gvfs-interface-mountoperation "org.gtk.vfs.MountOperation"
   "Used by the dbus-proxying implementation of GMountOperation.")
@@ -608,6 +608,14 @@ is no information where to trace the message.")
       (tramp-run-real-handler 'expand-file-name (list name nil))
     ;; Dissect NAME.
     (with-parsed-tramp-file-name name nil
+      ;; If there is a default location, expand tilde.
+      (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
+       (save-match-data
+         (tramp-gvfs-maybe-open-connection (vector method user host "/")))
+       (setq localname
+             (replace-match
+              (tramp-get-file-property  v "/" "default-location" "~")
+              nil t localname 1)))
       ;; Tilde expansion is not possible.
       (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
        (tramp-error
@@ -967,47 +975,55 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
   "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and
 \"org.gtk.vfs.MountTracker.unmounted\" signals."
   (ignore-errors
-    ;; The last element could be the default location in newer gvfs
-    ;; versions.  We must check this.
-    (unless (consp (car (last mount-info)))
-      (setq mount-info (butlast mount-info)))
-    (let* ((signal-name (dbus-event-member-name last-input-event))
-          (mount-spec (cadar (last mount-info)))
-          (method (dbus-byte-array-to-string (cadr (assoc "type" mount-spec))))
-          (user (dbus-byte-array-to-string (cadr (assoc "user" mount-spec))))
-          (domain (dbus-byte-array-to-string
-                   (cadr (assoc "domain" mount-spec))))
-          (host (dbus-byte-array-to-string
-                 (cadr (or (assoc "host" mount-spec)
-                           (assoc "server" mount-spec)))))
-          (port (dbus-byte-array-to-string (cadr (assoc "port" mount-spec))))
-          (ssl (dbus-byte-array-to-string (cadr (assoc "ssl" mount-spec))))
-          (prefix (concat (dbus-byte-array-to-string (caar (last mount-info)))
-                          (dbus-byte-array-to-string
-                           (cadr (assoc "share" mount-spec))))))
-      (when (string-match "^smb" method)
-       (setq method "smb"))
-      (when (string-equal "obex" method)
-       (setq host (tramp-bluez-device host)))
-      (when (and (string-equal "dav" method) (string-equal "true" ssl))
-       (setq method "davs"))
-      (unless (zerop (length domain))
-       (setq user (concat user tramp-prefix-domain-format domain)))
-      (unless (zerop (length port))
-       (setq host (concat host tramp-prefix-port-format port)))
-      (with-parsed-tramp-file-name
-         (tramp-make-tramp-file-name method user host "") nil
-       (tramp-message
-        v 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message mount-info))
-       (tramp-set-file-property v "/" "list-mounts" 'undef)
-       (if (string-equal signal-name "unmounted")
-           (tramp-set-file-property v "/" "fuse-mountpoint" nil)
-         ;; Set prefix and mountpoint.
-         (unless (string-equal prefix "/")
-           (tramp-set-file-property v "/" "prefix" prefix))
-         (tramp-set-file-property
-          v "/" "fuse-mountpoint"
-          (dbus-byte-array-to-string (car (last mount-info 2)))))))))
+    (let ((signal-name (dbus-event-member-name last-input-event))
+         (elt mount-info))
+      ;; Jump over the first elements of the mount info. Since there
+      ;; were changes in the antries, we cannot access dedicated
+      ;; elements.
+      (while (stringp (car elt)) (setq elt (cdr elt)))
+      (let* ((fuse-mountpoint (dbus-byte-array-to-string (cadr elt)))
+            (mount-spec (caddr elt))
+            (default-location (dbus-byte-array-to-string (cadddr elt)))
+            (method (dbus-byte-array-to-string
+                     (cadr (assoc "type" (cadr mount-spec)))))
+            (user (dbus-byte-array-to-string
+                   (cadr (assoc "user" (cadr mount-spec)))))
+            (domain (dbus-byte-array-to-string
+                     (cadr (assoc "domain" (cadr mount-spec)))))
+            (host (dbus-byte-array-to-string
+                   (cadr (or (assoc "host" (cadr mount-spec))
+                             (assoc "server" (cadr mount-spec))))))
+            (port (dbus-byte-array-to-string
+                   (cadr (assoc "port" (cadr mount-spec)))))
+            (ssl (dbus-byte-array-to-string
+                  (cadr (assoc "ssl" (cadr mount-spec)))))
+            (prefix (concat (dbus-byte-array-to-string (car mount-spec))
+                            (dbus-byte-array-to-string
+                             (cadr (assoc "share" (cadr mount-spec)))))))
+       (when (string-match "^smb" method)
+         (setq method "smb"))
+       (when (string-equal "obex" method)
+         (setq host (tramp-bluez-device host)))
+       (when (and (string-equal "dav" method) (string-equal "true" ssl))
+         (setq method "davs"))
+       (unless (zerop (length domain))
+         (setq user (concat user tramp-prefix-domain-format domain)))
+       (unless (zerop (length port))
+         (setq host (concat host tramp-prefix-port-format port)))
+       (with-parsed-tramp-file-name
+           (tramp-make-tramp-file-name method user host "") nil
+         (tramp-message
+          v 6 "%s %s"
+          signal-name (tramp-gvfs-stringify-dbus-message mount-info))
+         (tramp-set-file-property v "/" "list-mounts" 'undef)
+         (if (string-equal signal-name "unmounted")
+             (tramp-set-file-property v "/" "fuse-mountpoint" nil)
+           ;; Set prefix, mountpoint and location.
+           (unless (string-equal prefix "/")
+             (tramp-set-file-property v "/" "prefix" prefix))
+           (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint)
+           (tramp-set-file-property
+            v "/" "default-location" default-location)))))))
 
 (dbus-register-signal
  :session nil tramp-gvfs-path-mounttracker
@@ -1031,25 +1047,29 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
              :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
              tramp-gvfs-interface-mounttracker "listMounts"))
          nil)
-       ;; The last element could be the default location in newer gvfs
-       ;; versions.  We must check this.
-       (unless (consp (car (last elt))) (setq elt (butlast elt)))
-       (let* ((mount-spec (cadar (last elt)))
+       ;; Jump over the first elements of the mount info. Since there
+       ;; were changes in the antries, we cannot access dedicated
+       ;; elements.
+       (while (stringp (car elt)) (setq elt (cdr elt)))
+       (let* ((fuse-mountpoint (dbus-byte-array-to-string (cadr elt)))
+             (mount-spec (caddr elt))
+             (default-location (dbus-byte-array-to-string (cadddr elt)))
              (method (dbus-byte-array-to-string
-                      (cadr (assoc "type" mount-spec))))
+                      (cadr (assoc "type" (cadr mount-spec)))))
              (user (dbus-byte-array-to-string
-                    (cadr (assoc "user" mount-spec))))
+                    (cadr (assoc "user" (cadr mount-spec)))))
              (domain (dbus-byte-array-to-string
-                      (cadr (assoc "domain" mount-spec))))
+                      (cadr (assoc "domain" (cadr mount-spec)))))
              (host (dbus-byte-array-to-string
-                    (cadr (or (assoc "host" mount-spec)
-                              (assoc "server" mount-spec)))))
+                    (cadr (or (assoc "host" (cadr mount-spec))
+                              (assoc "server" (cadr mount-spec))))))
              (port (dbus-byte-array-to-string
-                    (cadr (assoc "port" mount-spec))))
-             (ssl (dbus-byte-array-to-string (cadr (assoc "ssl" mount-spec))))
-             (prefix (concat (dbus-byte-array-to-string (caar (last elt)))
+                    (cadr (assoc "port" (cadr mount-spec)))))
+             (ssl (dbus-byte-array-to-string
+                   (cadr (assoc "ssl" (cadr mount-spec)))))
+             (prefix (concat (dbus-byte-array-to-string (car mount-spec))
                              (dbus-byte-array-to-string
-                              (cadr (assoc "share" mount-spec))))))
+                              (cadr (assoc "share" (cadr mount-spec)))))))
         (when (string-match "^smb" method)
           (setq method "smb"))
         (when (string-equal "obex" method)
@@ -1068,12 +1088,11 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
                (string-equal host (tramp-file-name-host vec))
                (string-match (concat "^" (regexp-quote prefix))
                              (tramp-file-name-localname vec)))
-          ;; Set prefix and mountpoint.
+          ;; Set prefix, mountpoint and location.
           (unless (string-equal prefix "/")
             (tramp-set-file-property vec "/" "prefix" prefix))
-          (tramp-set-file-property
-           vec "/" "fuse-mountpoint"
-           (dbus-byte-array-to-string (car (last elt 2))))
+          (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
+          (tramp-set-file-property vec "/" "default-location" default-location)
           (throw 'mounted t)))))))
 
 (defun tramp-gvfs-mount-spec (vec)

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 9c4d991d0e17a5775f5f07fd9b7c0d00741425e1..f1ec7a9b81c4be7b8b66c18aa6923db65bff502a 100644 (file)
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -382,7 +382,7 @@ PRESERVE-UID-GID is completely ignored."
         (lambda (file)
           (if (file-directory-p file)
               (tramp-compat-delete-directory file recursive)
-            (tramp-compat-delete-file file 'trash)))
+            (delete-file file)))
         ;; We do not want to delete "." and "..".
         (directory-files
          directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))