Mercurial > emacs
changeset 108887:2c20a51413cb
* 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.
| author | Michael Albinus <michael.albinus@gmx.de> |
|---|---|
| date | Fri, 04 Jun 2010 13:26:54 +0200 |
| parents | 0ed39249e8e4 |
| children | c2ac5cece5ea |
| files | lisp/ChangeLog lisp/net/tramp-gvfs.el lisp/net/tramp-smb.el |
| diffstat | 3 files changed, 91 insertions(+), 63 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Jun 04 03:38:12 2010 +0200 +++ b/lisp/ChangeLog Fri Jun 04 13:26:54 2010 +0200 @@ -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)
--- a/lisp/net/tramp-gvfs.el Fri Jun 04 03:38:12 2010 +0200 +++ b/lisp/net/tramp-gvfs.el Fri Jun 04 13:26:54 2010 +0200 @@ -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 @@ (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 @@ "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 @@ :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 @@ (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)
--- a/lisp/net/tramp-smb.el Fri Jun 04 03:38:12 2010 +0200 +++ b/lisp/net/tramp-smb.el Fri Jun 04 13:26:54 2010 +0200 @@ -382,7 +382,7 @@ (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 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))