]> git.eshelyaron.com Git - emacs.git/commitdiff
Improve completion in tramp-gvfs.el
authorMichael Albinus <michael.albinus@gmx.de>
Sun, 1 Nov 2015 12:43:35 +0000 (13:43 +0100)
committerMichael Albinus <michael.albinus@gmx.de>
Sun, 1 Nov 2015 12:43:35 +0000 (13:43 +0100)
* lisp/net/tramp-gvfs.el (tramp-zeroconf-parse-device-names):
Renamed from `tramp-zeroconf-parse-service-device-names'.
(tramp-zeroconf-parse-webdav-device-names): Removed.  Code merged
with `tramp-zeroconf-parse-device-names'.
(tramp-gvfs-parse-device-names): New defun.
(top): Use it when `tramp-zeroconf-parse-device-names' is not
applicable.

* lisp/net/tramp.el (tramp-set-completion-function): The argument
could also be a zeroconf service type.

lisp/net/tramp-gvfs.el
lisp/net/tramp.el

index b93c4cf57a5869ac6fa5a168253ce1007825935f..8683241fcd187a0170ecfde578b8c896cf56e5d4 100644 (file)
@@ -1722,14 +1722,7 @@ be used."
 \f
 ;; D-Bus zeroconf functions.
 
-(defun tramp-zeroconf-parse-service-device-names (service)
-  "Return a list of (user host) tuples allowed to access."
-  (mapcar
-   (lambda (x)
-     (list nil (zeroconf-service-host x)))
-   (zeroconf-list-services service)))
-
-(defun tramp-zeroconf-parse-webdav-device-names (_ignore)
+(defun tramp-zeroconf-parse-device-names (service)
   "Return a list of (user host) tuples allowed to access."
   (mapcar
    (lambda (x)
@@ -1745,22 +1738,64 @@ be used."
           (setq user (match-string 1 (car text))))
         (setq text (cdr text)))
        (list user host)))
-   (zeroconf-list-services "_webdav._tcp")))
+   (zeroconf-list-services service)))
+
+(defun tramp-gvfs-parse-device-names (service)
+  "Return a list of (user host) tuples allowed to access.
+This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
+  (let ((result
+        (split-string
+         (shell-command-to-string (format "avahi-browse -trkp %s" service))
+         "[\n\r]+" 'omit "^\\+;.*$")))
+    (tramp-compat-delete-dups
+     (mapcar
+      (lambda (x)
+       (let* ((list (split-string x ";"))
+              (host (nth 6 list))
+              (port (nth 8 list))
+              (text (split-string (nth 9 list) "\" \"" 'omit "\""))
+              user)
+;        (when (and port (not (string-equal port "0")))
+;          (setq host (format "%s%s%s" host tramp-prefix-port-regexp port)))
+         ;; A user is marked in a TXT field like "u=guest".
+         (while text
+           (when (string-match "u=\\(.+\\)$" (car text))
+             (setq user (match-string 1 (car text))))
+           (setq text (cdr text)))
+         (list user host)))
+      result))))
 
 ;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
-(when (and tramp-gvfs-enabled
-          (member zeroconf-service-avahi (dbus-list-known-names :system)))
+(when tramp-gvfs-enabled
   (zeroconf-init tramp-gvfs-zeroconf-domain)
-  (tramp-set-completion-function
-   "afp" '((tramp-zeroconf-parse-service-device-names "_afpovertcp._tcp")))
-  (tramp-set-completion-function
-   "dav" '((tramp-zeroconf-parse-webdav-device-names "")))
-  (tramp-set-completion-function
-   "davs" '((tramp-zeroconf-parse-webdav-device-names "")))
-  (tramp-set-completion-function
-   "sftp" '((tramp-zeroconf-parse-service-device-names "_workstation._tcp")))
-  (tramp-set-completion-function
-   "smb" '((tramp-zeroconf-parse-service-device-names "_smb._tcp"))))
+  (if (zeroconf-list-service-types)
+      (progn
+       (tramp-set-completion-function
+        "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
+       (tramp-set-completion-function
+        "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
+       (tramp-set-completion-function
+        "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
+       (tramp-set-completion-function
+        "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
+                 (tramp-zeroconf-parse-device-names "_workstation._tcp")))
+       (when (member "smb" tramp-gvfs-methods)
+         (tramp-set-completion-function
+          "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
+
+    (when (executable-find "avahi-browse")
+      (tramp-set-completion-function
+       "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
+      (tramp-set-completion-function
+       "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+      (tramp-set-completion-function
+       "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+      (tramp-set-completion-function
+       "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
+               (tramp-gvfs-parse-device-names "_workstation._tcp")))
+      (when (member "smb" tramp-gvfs-methods)
+       (tramp-set-completion-function
+        "smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))
 
 \f
 ;; D-Bus SYNCE functions.
index 2f811bb73caec29c4031411908c89cecc8abdf76..89aad07ddfec85bcae99ca64720a05dd6bbe1b90 100644 (file)
@@ -1765,14 +1765,18 @@ Example:
        (setcdr v (delete (car v) (cdr v))))
       ;; Check for function and file or registry key.
       (unless (and (functionp (nth 0 (car v)))
-                  (if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
-                      ;; Windows registry.
-                      (and (memq system-type '(cygwin windows-nt))
-                           (zerop
-                            (tramp-call-process
-                             v "reg" nil nil nil "query" (nth 1 (car v)))))
-                    ;; Configuration file.
-                    (file-exists-p (nth 1 (car v)))))
+                  (cond
+                   ;; Windows registry.
+                   ((string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
+                    (and (memq system-type '(cygwin windows-nt))
+                         (zerop
+                          (tramp-call-process
+                           v "reg" nil nil nil "query" (nth 1 (car v))))))
+                   ;; Zeroconf service type.
+                   ((string-match
+                     "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
+                   ;; Configuration file.
+                   (t (file-exists-p (nth 1 (car v))))))
        (setq r (delete (car v) r)))
       (setq v (cdr v)))