commit 5f720046783c5b29fad3765303c1ad57aba167ce (HEAD, refs/remotes/origin/master) Author: Noam Postavsky Date: Sat Jan 6 21:16:33 2018 -0500 Revert "Fix command repetition with lexical-binding (Bug#29334)" It does not work with more complicated interactive forms, because byte-compile-lambda actually receives an intermediate form of code rather than valid lisp source (Bug#29988). * src/callint.c (Fcall_interactively): * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Revert previous change, and update commentary. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 564aac2fc6..cc3a24e3d5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2839,7 +2839,12 @@ for symbols generated by the byte compiler itself." (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (if (eq (car-safe form) 'list) + (if (and (eq (car-safe form) 'list) + ;; For code using lexical-binding, form is not + ;; valid lisp, but rather an intermediate form + ;; which may include "calls" to + ;; internal-make-closure (Bug#29988). + (not lexical-binding)) nil (setq int `(interactive ,newform))))) ((cdr int) diff --git a/src/callint.c b/src/callint.c index dcda0bcf7a..c713e08d4d 100644 --- a/src/callint.c +++ b/src/callint.c @@ -357,9 +357,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* Compute the arg values using the user's expression. */ specs = Feval (specs, CONSP (funval) && EQ (Qclosure, XCAR (funval)) - ? CAR_SAFE (XCDR (funval)) - : COMPILEDP (funval) && INTEGERP (AREF (funval, COMPILED_ARGLIST)) - ? Qt : Qnil); + ? CAR_SAFE (XCDR (funval)) : Qnil); if (events != num_input_events || !NILP (record_flag)) { /* We should record this command on the command history. */ commit 15cd18991c1d9a9bafeef7bf9b4dad91ecc0332a Author: Alan Third Date: Sat Dec 23 11:00:35 2017 +0000 Allow setting tooltip colors in NS port * src/nsfns.m (Fx_show_tip): Get face colors and apply them to the tooltip. * src/nsmenu.m (EmacsTooltip::setBackgroundColor): (EmacsTooltip::setForegroundColor): New functions. * src/nsterm.h (EmacsTooltip::setBackgroundColor): (EmacsTooltip::setForegroundColor): New function prototypes. diff --git a/src/nsfns.m b/src/nsfns.m index d5049a7a91..3ede63f985 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2873,6 +2873,8 @@ with offset DY added (default is -10). struct frame *f; char *str; NSSize size; + NSColor *color; + Lisp_Object t; specbind (Qinhibit_redisplay, Qt); @@ -2900,6 +2902,14 @@ with offset DY added (default is -10). else Fx_hide_tip (); + t = x_get_arg (NULL, parms, Qbackground_color, NULL, NULL, RES_TYPE_STRING); + if (ns_lisp_to_color (t, &color) == 0) + [ns_tooltip setBackgroundColor: color]; + + t = x_get_arg (NULL, parms, Qforeground_color, NULL, NULL, RES_TYPE_STRING); + if (ns_lisp_to_color (t, &color) == 0) + [ns_tooltip setForegroundColor: color]; + [ns_tooltip setText: str]; size = [ns_tooltip frame].size; diff --git a/src/nsmenu.m b/src/nsmenu.m index 20b4e58b47..5748b20ce8 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -1364,6 +1364,16 @@ - (void) setText: (char *)text [textField setFrame: r]; } +- (void) setBackgroundColor: (NSColor *)col +{ + [textField setBackgroundColor: col]; +} + +- (void) setForegroundColor: (NSColor *)col +{ + [textField setTextColor: col]; +} + - (void) showAtX: (int)x Y: (int)y for: (int)seconds { NSRect wr = [win frame]; diff --git a/src/nsterm.h b/src/nsterm.h index bef2c1011b..878923cbb4 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -585,6 +585,8 @@ typedef id instancetype; } - (instancetype) init; - (void) setText: (char *)text; +- (void) setBackgroundColor: (NSColor *)col; +- (void) setForegroundColor: (NSColor *)col; - (void) showAtX: (int)x Y: (int)y for: (int)seconds; - (void) hide; - (BOOL) isActive; commit 5fd229735384a5fa479466124a181bf7d4ea8dab Author: Alan Mackenzie Date: Sat Jan 6 20:15:04 2018 +0000 Make transpose-regions invoke before-change-functions only once. In the case of two non-contiguous regions the same size, transpose-regions has been calling before-change-functions twice, once for each region. It now calls it just once, for the minimal region spanning both single regions. * src/editfns.c (Ftranspose_regions): Combine two calls of modify_text into one. diff --git a/src/editfns.c b/src/editfns.c index 4a66aeeeb6..80871a778b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -5293,8 +5293,7 @@ Transposing beyond buffer boundaries is an error. */) { USE_SAFE_ALLOCA; - modify_text (start1, end1); - modify_text (start2, end2); + modify_text (start1, end2); record_change (start1, len1); record_change (start2, len2); tmp_interval1 = copy_intervals (cur_intv, start1, len1); commit fc31788beb924c712451adef47b1005bac2ac48a Author: Michael Albinus Date: Sat Jan 6 19:36:22 2018 +0100 Minor tramp-gvfs.el cleanup * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Move up. (top): Delete goa methods only when `tramp-gvfs-enabled' is not nil. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 7d63118268..ffe3bd28bd 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -114,6 +114,16 @@ (eval-when-compile (require 'custom)) +;; We don't call `dbus-ping', because this would load dbus.el. +(defconst tramp-gvfs-enabled + (ignore-errors + (and (featurep 'dbusbind) + (tramp-compat-funcall 'dbus-get-unique-name :system) + (tramp-compat-funcall 'dbus-get-unique-name :session) + (or (tramp-compat-process-running-p "gvfs-fuse-daemon") + (tramp-compat-process-running-p "gvfsd-fuse")))) + "Non-nil when GVFS is available.") + ;;;###tramp-autoload (defcustom tramp-gvfs-methods '("afp" "dav" "davs" "gdrive" "obex" "owncloud" "sftp" "synce") @@ -137,8 +147,9 @@ (defconst tramp-goa-methods '("gdrive" "owncloud") "List of methods which require registration at GNOME Online Accounts.") -;; Remove GNOME Online Accounts if not supported. -(unless (member tramp-goa-service (dbus-list-known-names :session)) +;; Remove GNOME Online Accounts methods if not supported. +(unless (and tramp-gvfs-enabled + (member tramp-goa-service (dbus-list-known-names :session))) (dolist (method tramp-goa-methods) (setq tramp-gvfs-methods (delete method tramp-gvfs-methods)))) @@ -175,16 +186,6 @@ (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon" "The well known name of the GVFS daemon.") -;; We don't call `dbus-ping', because this would load dbus.el. -(defconst tramp-gvfs-enabled - (ignore-errors - (and (featurep 'dbusbind) - (tramp-compat-funcall 'dbus-get-unique-name :system) - (tramp-compat-funcall 'dbus-get-unique-name :session) - (or (tramp-compat-process-running-p "gvfs-fuse-daemon") - (tramp-compat-process-running-p "gvfsd-fuse")))) - "Non-nil when GVFS is available.") - (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" "The object path of the GVFS daemon.") @@ -1975,7 +1976,8 @@ connection if a previous connection has died for some reason." tramp-gvfs-interface-mountoperation "AskPassword" 'tramp-gvfs-handler-askpassword) - ;; There could be a callback of "askQuestion" when adding fingerprint. + ;; There could be a callback of "askQuestion" when adding + ;; fingerprints or checking certificates. (dbus-register-method :session dbus-service-emacs object-path tramp-gvfs-interface-mountoperation "askQuestion" commit b74fdf4408c883d02dd5c78af2ec622d632c3b1d Author: Michael Albinus Date: Fri Jan 5 21:04:39 2018 +0100 Add new Tramp connection method "owncloud" * doc/misc/tramp.texi (all): Use @acronym{GNOME} thoroughly. (Using GNOME Online Accounts based methods): Rename from "Using Google Drive". Add `owncloud'. (GVFS based methods): Add `owncloud'. * etc/NEWS: Add Tramp connection method "owncloud". * lisp/net/tramp-gvfs.el (tramp-gvfs-methods): Add "owncloud". Remove goa methods if not supported. (tramp-goa-methods, tramp-goa-service, tramp-goa-path) (tramp-goa-path-accounts, tramp-goa-interface-documents) (tramp-goa-interface-printers, tramp-goa-interface-files) (tramp-goa-interface-contacts, tramp-goa-interface-calendar) (tramp-goa-interface-oauth2based) (tramp-goa-interface-account, tramp-goa-identity-regexp) (tramp-goa-interface-mail, tramp-goa-interface-chat) (tramp-goa-interface-photos, tramp-goa-path-manager) (tramp-goa-interface-documents) (tramp-gvfs-owncloud-default-prefix) (tramp-gvfs-owncloud-default-prefix-regexp): New defconst. (tramp-goa-name): New defstruct. (tramp-gvfs-stringify-dbus-message): Handle all consp messages. (tramp-dbus-function, tramp-gvfs-get-remote-prefix) (tramp-get-goa-accounts): New defun. (with-tramp-dbus-call-method): Use it. (with-tramp-dbus-get-all-properties): New defmacro. (tramp-gvfs-url-file-name) (tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec): Map between "owncloud" and "davs". (tramp-gvfs-maybe-open-connection): Set "vector" connection property. * test/lisp/net/tramp-tests.el (tramp-gvfs-handler-askquestion): Suppress run in tests. (tramp--test-owncloud-p): New defun. (tramp-test11-copy-file, tramp-test12-rename-file): Use it. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 4bfebc00af..deaafb3d25 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -531,24 +531,33 @@ of the local file name is the share exported by the remote host, @cindex dav method @cindex davs method -On systems, which have installed the virtual file system for the Gnome -Desktop (GVFS), its offered methods could be used by @value{tramp}. -Examples are @file{@trampfn{sftp,user@@host,/path/to/file}}, +On systems, which have installed the virtual file system for the +@acronym{GNOME} Desktop (GVFS), its offered methods could be used by +@value{tramp}. Examples are +@file{@trampfn{sftp,user@@host,/path/to/file}}, @file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP file system), @file{@trampfn{dav,user@@host,/path/to/file}} and @file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares). -@anchor{Quick Start Guide: Google Drive} -@section Using Google Drive +@anchor{Quick Start Guide: GNOME Online Accounts based methods} +@section Using @acronym{GNOME} Online Accounts based methods +@cindex @acronym{GNOME} Online Accounts @cindex method gdrive @cindex gdrive method @cindex google drive +@cindex method owncloud +@cindex owncloud method +@cindex nextcloud -Another GVFS-based method allows to access a Google Drive file system. -The file name syntax is here always -@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}. -@samp{john.doe@@gmail.com} stands here for your Google Drive account. +GVFS-based methods include also @acronym{GNOME} Online Accounts, which +support the @option{Files} service. These are the Google Drive file +system, and the OwnCloud/NextCloud file system. The file name syntax +is here always +@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}} +(@samp{john.doe@@gmail.com} stands here for your Google Drive +account), or @file{@trampfn{owncloud,user@@host#8081,/path/to/file}} +(@samp{8081} stands for the port number) for OwnCloud/NextCloud files. @anchor{Quick Start Guide: Android} @@ -1061,7 +1070,7 @@ numbers are not applicable to Android devices connected through USB@. @cindex gvfs based methods @cindex dbus -GVFS is the virtual file system for the Gnome Desktop, +GVFS is the virtual file system for the @acronym{GNOME} Desktop, @uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are mounted locally through FUSE and @value{tramp} uses this locally mounted directory internally. @@ -1114,6 +1123,18 @@ directory have the same @code{display-name}, such a situation must be avoided. OBEX is an FTP-like access protocol for cell phones and similar simple devices. @value{tramp} supports OBEX over Bluetooth. +@item @option{owncloud} +@cindex @acronym{GNOME} Online Accounts +@cindex method owncloud +@cindex owncloud method +@cindex nextcloud + +As the name indicates, the method @option{owncloud} allows you to +access OwnCloud or NextCloud hosted files and directories. Like the +@option{gdrive} method, your credentials must be populated in your +@command{Online Accounts} application outside Emacs. The method +supports port numbers. + @item @option{sftp} @cindex method sftp @cindex sftp method @@ -1135,11 +1156,11 @@ requires the SYNCE-GVFS plugin. @defopt tramp-gvfs-methods This user option is a list of external methods for GVFS@. By default, this list includes @option{afp}, @option{dav}, @option{davs}, -@option{gdrive}, @option{obex}, @option{sftp} and @option{synce}. -Other methods to include are @option{ftp}, @option{http}, -@option{https} and @option{smb}. These methods are not intended to be -used directly as GVFS based method. Instead, they are added here for -the benefit of @ref{Archive file names}. +@option{gdrive}, @option{obex}, @option{owncloud}, @option{sftp} and +@option{synce}. Other methods to include are @option{ftp}, +@option{http}, @option{https} and @option{smb}. These methods are not +intended to be used directly as GVFS based method. Instead, they are +added here for the benefit of @ref{Archive file names}. @end defopt @@ -2928,8 +2949,8 @@ that remote connection. @value{tramp} offers also transparent access to files inside file archives. This is possible only on machines which have installed the -virtual file system for the Gnome Desktop (GVFS), @ref{GVFS based -methods}. Internally, file archives are mounted via the GVFS +virtual file system for the @acronym{GNOME} Desktop (GVFS), @ref{GVFS +based methods}. Internally, file archives are mounted via the GVFS @option{archive} method. A file archive is a regular file of kind @file{/path/to/dir/file.EXT}. diff --git a/etc/NEWS b/etc/NEWS index 3ba95c1ff6..c5a4bc3344 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -159,6 +159,12 @@ To restore the old behavior, use (add-hook 'eshell-expand-input-functions #'eshell-expand-history-references) +** Tramp + ++++ +*** New connection method "owncloud", which allows to access OwnCloud +or NextCloud hosted files and directories. + * New Modes and Packages in Emacs 27.1 diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 844813936f..97c687598f 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -114,8 +114,7 @@ Returns DEFAULT if not set." (tramp-file-name-hop key) nil) (let* ((hash (tramp-get-hash-table key)) (value (when (hash-table-p hash) (gethash property hash)))) - (if - ;; We take the value only if there is any, and + (if ;; We take the value only if there is any, and ;; `remote-file-name-inhibit-cache' indicates that it is still ;; valid. Otherwise, DEFAULT is set. (and (consp value) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ef354b6895..7d63118268 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,10 +49,14 @@ ;; The custom option `tramp-gvfs-methods' contains the list of ;; supported connection methods. Per default, these are "afp", "dav", -;; "davs", "gdrive", "obex", "sftp" and "synce". Note that with -;; "obex" it might be necessary to pair with the other bluetooth -;; device, if it hasn't been done already. There might be also some -;; few seconds delay in discovering available bluetooth devices. +;; "davs", "gdrive", "obex", "owncloud", "sftp" and "synce". Note +;; that with "obex" it might be necessary to pair with the other +;; bluetooth device, if it hasn't been done already. There might be +;; also some few seconds delay in discovering available bluetooth +;; devices. + +;; "gdrive" and "owncloud" connection methods require a respective +;; account in GNOME Online Accounts, with enabled "Files" service. ;; Other possible connection methods are "ftp", "http", "https" and ;; "smb". When one of these methods is added to the list, the remote @@ -112,7 +116,7 @@ ;;;###tramp-autoload (defcustom tramp-gvfs-methods - '("afp" "dav" "davs" "gdrive" "obex" "sftp" "synce") + '("afp" "dav" "davs" "gdrive" "obex" "owncloud" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp :version "26.1" @@ -124,11 +128,20 @@ (const "http") (const "https") (const "obex") + (const "owncloud") (const "sftp") (const "smb") (const "synce"))) :require 'tramp) +(defconst tramp-goa-methods '("gdrive" "owncloud") + "List of methods which require registration at GNOME Online Accounts.") + +;; Remove GNOME Online Accounts if not supported. +(unless (member tramp-goa-service (dbus-list-known-names :session)) + (dolist (method tramp-goa-methods) + (setq tramp-gvfs-methods (delete method tramp-gvfs-methods)))) + ;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. ;;;###tramp-autoload (when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)" @@ -293,6 +306,162 @@ It has been changed in GVFS 1.14.") (defconst tramp-gvfs-password-anonymous-supported 16 "Operation supports anonymous users.") +;; For the time being, we just need org.goa.Account and org.goa.Files +;; interfaces. We document the other ones, just in case. + +;;;###tramp-autoload +(defconst tramp-goa-service "org.gnome.OnlineAccounts" + "The well known name of the GNOME Online Accounts service.") + +(defconst tramp-goa-path "/org/gnome/OnlineAccounts" + "The object path of the GNOME Online Accounts.") + +(defconst tramp-goa-path-accounts (concat tramp-goa-path "/Accounts") + "The object path of the GNOME Online Accounts accounts.") + +(defconst tramp-goa-interface-documents "org.gnome.OnlineAccounts.Documents" + "The documents interface of the GNOME Online Accounts.") + +;; +;; + +(defconst tramp-goa-interface-printers "org.gnome.OnlineAccounts.Printers" + "The printers interface of the GNOME Online Accounts.") + +;; +;; + +(defconst tramp-goa-interface-files "org.gnome.OnlineAccounts.Files" + "The files interface of the GNOME Online Accounts.") + +;; +;; +;; +;; + +(defconst tramp-goa-interface-contacts "org.gnome.OnlineAccounts.Contacts" + "The contacts interface of the GNOME Online Accounts.") + +;; +;; +;; +;; + +(defconst tramp-goa-interface-calendar "org.gnome.OnlineAccounts.Calendar" + "The calendar interface of the GNOME Online Accounts.") + +;; +;; +;; +;; + +(defconst tramp-goa-interface-oauth2based "org.gnome.OnlineAccounts.OAuth2Based" + "The oauth2based interface of the GNOME Online Accounts.") + +;; +;; +;; +;; +;; +;; +;; +;; + +(defconst tramp-goa-interface-account "org.gnome.OnlineAccounts.Account" + "The account interface of the GNOME Online Accounts.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; + +(defconst tramp-goa-identity-regexp + (concat "^" "\\(" tramp-user-regexp "\\)?" + "@" "\\(" tramp-host-regexp "\\)?" + "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?") + "Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.") + +(defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail" + "The mail interface of the GNOME Online Accounts.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; + +(defconst tramp-goa-interface-chat "org.gnome.OnlineAccounts.Chat" + "The chat interface of the GNOME Online Accounts.") + +;; +;; + +(defconst tramp-goa-interface-photos "org.gnome.OnlineAccounts.Photos" + "The photos interface of the GNOME Online Accounts.") + +;; +;; + +(defconst tramp-goa-path-manager (concat tramp-goa-path "/Manager") + "The object path of the GNOME Online Accounts manager.") + +(defconst tramp-goa-interface-documents "org.gnome.OnlineAccounts.Manager" + "The manager interface of the GNOME Online Accounts.") + +;; +;; +;; +;; +;; +;; +;; +;; +;; +;; + +;; The basic structure for GNOME Online Accounts. We use a list :type, +;; in order to be compatible with Emacs 24 and 25. +(cl-defstruct (tramp-goa-name (:type list) :named) method user host port) + (defconst tramp-bluez-service "org.bluez" "The well known name of the BLUEZ service.") @@ -479,6 +648,13 @@ Every entry is a list (NAME ADDRESS).") ":[[:blank:]]+\\(.*\\)$") "Regexp to parse GVFS file system attributes with `gvfs-info'.") +(defconst tramp-gvfs-owncloud-default-prefix "/remote.php/webdav" + "Default prefix for owncloud / nextcloud methods.") + +(defconst tramp-gvfs-owncloud-default-prefix-regexp + (concat (regexp-quote tramp-gvfs-owncloud-default-prefix) "$") + "Regexp of default prefix for owncloud / nextcloud methods.") + ;; New handlers should be added here. ;;;###tramp-autoload @@ -610,12 +786,24 @@ Return nil for null BYTE-ARRAY." (cond ((and (consp message) (characterp (car message))) (format "%S" (tramp-gvfs-dbus-byte-array-to-string message))) + ((and (consp message) (not (consp (cdr message)))) + (cons (tramp-gvfs-stringify-dbus-message (car message)) + (tramp-gvfs-stringify-dbus-message (cdr message)))) ((consp message) (mapcar 'tramp-gvfs-stringify-dbus-message message)) ((stringp message) (format "%S" message)) (t message))) +(defun tramp-dbus-function (vec func args) + "Apply a D-Bus function FUNC from dbus.el. +The call will be traced by Tramp with trace level 6." + (let (result) + (tramp-message vec 6 "%s" (cons func args)) + (setq result (apply func args)) + (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result)) + result)) + (defmacro with-tramp-dbus-call-method (vec synchronous bus service path interface method &rest args) "Apply a D-Bus call on bus BUS. @@ -624,22 +812,34 @@ If SYNCHRONOUS is non-nil, the call is synchronously. Otherwise, it is an asynchronous call, with `ignore' as callback function. The other arguments have the same meaning as with `dbus-call-method' -or `dbus-call-method-asynchronously'. Additionally, the call -will be traced by Tramp with trace level 6." +or `dbus-call-method-asynchronously'." `(let ((func (if ,synchronous 'dbus-call-method 'dbus-call-method-asynchronously)) (args (append (list ,bus ,service ,path ,interface ,method) - (if ,synchronous (list ,@args) (list 'ignore ,@args)))) - result) - (tramp-message ,vec 6 "%s %s" func args) - (setq result (apply func args)) - (tramp-message ,vec 6 "%s" (tramp-gvfs-stringify-dbus-message result)) - result)) + (if ,synchronous (list ,@args) (list 'ignore ,@args))))) + (tramp-dbus-function ,vec func args))) (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 '("\\")) +(defmacro with-tramp-dbus-get-all-properties + (vec bus service path interface) + "Return all properties of INTERFACE. +The call will be traced by Tramp with trace level 6." + ;; Check, that interface exists at object path. Retrieve properties. + `(when (member + ,interface + (tramp-dbus-function + ,vec 'dbus-introspect-get-interface-names + (list ,bus ,service ,path))) + (tramp-dbus-function + ,vec 'dbus-get-all-properties (list ,bus ,service ,path ,interface)))) + +(put 'with-tramp-dbus-get-all-properties 'lisp-indent-function 1) +(put 'with-tramp-dbus-get-all-properties 'edebug-form-spec '(form symbolp body)) +(font-lock-add-keywords 'emacs-lisp-mode '("\\")) + (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. It is needed when D-Bus signals or errors arrive, because there @@ -1293,6 +1493,10 @@ file-notify events." (with-parsed-tramp-file-name filename nil (when (string-equal "gdrive" method) (setq method "google-drive")) + (when (string-equal "owncloud" method) + (setq method "davs" + localname + (concat (tramp-gvfs-get-remote-prefix v) localname))) (when (and user domain) (setq user (concat domain ";" user))) (url-parse-make-urlobj @@ -1317,24 +1521,6 @@ file-notify events." (dbus-unescape-from-identifier (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) -(defun tramp-bluez-address (device) - "Return bluetooth device address from a given bluetooth DEVICE name." - (when (stringp device) - (if (string-match tramp-ipv6-regexp device) - (match-string 0 device) - (cadr (assoc device (tramp-bluez-list-devices)))))) - -(defun tramp-bluez-device (address) - "Return bluetooth device name from a given bluetooth device ADDRESS. -ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." - (when (stringp address) - (while (string-match "[][]" address) - (setq address (replace-match "" t t address))) - (let (result) - (dolist (item (tramp-bluez-list-devices) result) - (when (string-match address (cadr item)) - (setq result (car item))))))) - ;; D-Bus GVFS functions. @@ -1405,7 +1591,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (tramp-get-connection-process v) message ;; In theory, there can be several choices. ;; Until now, there is only the question whether - ;; to accept an unknown host signature. + ;; to accept an unknown host signature or certificate. (with-temp-buffer ;; Preserve message for `progress-reporter'. (with-temp-message "" @@ -1446,6 +1632,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (while (stringp (car elt)) (setq elt (cdr elt))) (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr elt))) (mount-spec (cl-caddr elt)) + (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec))) (default-location (tramp-gvfs-dbus-byte-array-to-string (cl-cadddr elt))) (method (tramp-gvfs-dbus-byte-array-to-string @@ -1462,19 +1649,17 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (ssl (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "ssl" (cadr mount-spec))))) (uri (tramp-gvfs-dbus-byte-array-to-string - (cadr (assoc "uri" (cadr mount-spec))))) - (prefix (concat - (tramp-gvfs-dbus-byte-array-to-string - (car mount-spec)) - (tramp-gvfs-dbus-byte-array-to-string - (or (cadr (assoc "share" (cadr mount-spec))) - (cadr (assoc "volume" (cadr mount-spec)))))))) + (cadr (assoc "uri" (cadr mount-spec)))))) (when (string-match "^\\(afp\\|smb\\)" method) (setq method (match-string 1 method))) (when (string-equal "obex" method) (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (and (string-equal "davs" method) + (string-match + tramp-gvfs-owncloud-default-prefix-regexp prefix)) + (setq method "owncloud")) (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) @@ -1491,9 +1676,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (tramp-flush-file-property v "/" "list-mounts") (if (string-equal (downcase signal-name) "unmounted") (tramp-flush-file-properties v "/") - ;; Set prefix, mountpoint and location. - (unless (string-equal prefix "/") - (tramp-set-file-property v "/" "prefix" prefix)) + ;; Set mountpoint and location. (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint) (tramp-set-connection-property v "default-location" default-location))))))) @@ -1536,6 +1719,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr elt))) (mount-spec (cl-caddr elt)) + (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec))) (default-location (tramp-gvfs-dbus-byte-array-to-string (cl-cadddr elt))) (method (tramp-gvfs-dbus-byte-array-to-string @@ -1553,19 +1737,20 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (cadr (assoc "ssl" (cadr mount-spec))))) (uri (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "uri" (cadr mount-spec))))) - (prefix (concat - (tramp-gvfs-dbus-byte-array-to-string - (car mount-spec)) - (tramp-gvfs-dbus-byte-array-to-string - (or - (cadr (assoc "share" (cadr mount-spec))) - (cadr (assoc "volume" (cadr mount-spec)))))))) + (share (tramp-gvfs-dbus-byte-array-to-string + (or + (cadr (assoc "share" (cadr mount-spec))) + (cadr (assoc "volume" (cadr mount-spec))))))) (when (string-match "^\\(afp\\|smb\\)" method) (setq method (match-string 1 method))) (when (string-equal "obex" method) (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (and (string-equal "davs" method) + (string-match + tramp-gvfs-owncloud-default-prefix-regexp prefix)) + (setq method "owncloud")) (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) @@ -1582,11 +1767,9 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) - (string-match (concat "^" (regexp-quote prefix)) + (string-match (concat "^/" (regexp-quote (or share ""))) (tramp-file-name-unquote-localname vec))) - ;; Set prefix, mountpoint and location. - (unless (string-equal prefix "/") - (tramp-set-file-property vec "/" "prefix" prefix)) + ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) (tramp-set-connection-property vec "default-location" default-location) @@ -1620,7 +1803,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) - (ssl (if (string-match "^davs" method) "true" "false")) + (ssl (if (string-match "^davs\\|^owncloud" method) "true" "false")) (mount-spec `(:array ,@(cond @@ -1632,7 +1815,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry "host" (concat "[" (tramp-bluez-address host) "]")))) - ((string-match "\\`dav" method) + ((string-match "^dav\\|^owncloud" method) (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) @@ -1643,7 +1826,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ((string-equal "gdrive" method) (list (tramp-gvfs-mount-spec-entry "type" "google-drive") (tramp-gvfs-mount-spec-entry "host" host))) - ((string-match "\\`http" method) + ((string-match "^http" method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry "uri" @@ -1660,10 +1843,10 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when port (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref - (if (and (string-match "\\`dav" method) + (if (and (string-match "^dav" method) (string-match "^/?[^/]+" localname)) (match-string 0 localname) - "/"))) + (tramp-gvfs-get-remote-prefix vec)))) ;; Return. `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec))) @@ -1715,6 +1898,21 @@ ID-FORMAT valid values are `string' and `integer'." (defvar tramp-gvfs-get-remote-uid-gid-in-progress nil "Indication, that remote uid and gid determination is in progress.") +(defun tramp-gvfs-get-remote-prefix (vec) + "The prefix of the remote connection VEC. +This is relevant for GNOME Online Accounts." + (with-tramp-connection-property vec "prefix" + ;; Ensure that GNOME Online Accounts are cached. + (when (member (tramp-file-name-method vec) tramp-goa-methods) + (tramp-get-goa-accounts vec)) + (tramp-get-connection-property + (make-tramp-goa-name + :method (tramp-file-name-method vec) + :user (tramp-file-name-user vec) + :host (tramp-file-name-host vec) + :port (tramp-file-name-port vec)) + "prefix" "/"))) + (defun tramp-gvfs-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the @@ -1731,6 +1929,7 @@ connection if a previous connection has died for some reason." :name (tramp-buffer-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) + (tramp-set-connection-property p "vector" vec) (set-process-query-on-exit-flag p nil))) (unless (tramp-gvfs-connection-mounted-p vec) @@ -1869,8 +2068,81 @@ is applied, and it returns t if the return code is zero." (and (tramp-flush-file-properties vec "/") nil))))) +;; D-Bus GNOME Online Accounts functions. + +(defun tramp-get-goa-accounts (vec) + "Retrieve GNOME Online Accounts, and cache them. +The hash key is a `tramp-goa-name' structure. The value is an +alist of the properties of `tramp-goa-interface-account' and +`tramp-goa-interface-files' of the corresponding GNOME online +account. Additionally, a property \"prefix\" is added. +VEC is used only for traces." + (dolist + (object-path + (mapcar + 'car + (tramp-dbus-function + vec 'dbus-get-all-managed-objects + `(:session ,tramp-goa-service ,tramp-goa-path)))) + (let* ((account-properties + (with-tramp-dbus-get-all-properties vec + :session tramp-goa-service object-path + tramp-goa-interface-account)) + (files-properties + (with-tramp-dbus-get-all-properties vec + :session tramp-goa-service object-path + tramp-goa-interface-files)) + (identity + (or (cdr (assoc "PresentationIdentity" account-properties)) "")) + key) + ;; Only accounts which matter. + (when (and + (not (cdr (assoc "FilesDisabled" account-properties))) + (member + (cdr (assoc "ProviderType" account-properties)) + '("google" "owncloud")) + (string-match tramp-goa-identity-regexp identity)) + (setq key (make-tramp-goa-name + :method (cdr (assoc "ProviderType" account-properties)) + :user (match-string 1 identity) + :host (match-string 2 identity) + :port (match-string 3 identity))) + (when (string-equal (tramp-goa-name-method key) "google") + (setf (tramp-goa-name-method key) "gdrive")) + ;; Cache all properties. + (dolist (prop (nconc account-properties files-properties)) + (tramp-set-connection-property key (car prop) (cdr prop))) + ;; Cache "prefix". + (tramp-message + vec 10 "%s prefix %s" key + (tramp-set-connection-property + key "prefix" + (directory-file-name + (url-filename + (url-generic-parse-url + (tramp-get-connection-property key "Uri" "file:///")))))))))) + + ;; D-Bus BLUEZ functions. +(defun tramp-bluez-address (device) + "Return bluetooth device address from a given bluetooth DEVICE name." + (when (stringp device) + (if (string-match tramp-ipv6-regexp device) + (match-string 0 device) + (cadr (assoc device (tramp-bluez-list-devices)))))) + +(defun tramp-bluez-device (address) + "Return bluetooth device name from a given bluetooth device ADDRESS. +ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." + (when (stringp address) + (while (string-match "[][]" address) + (setq address (replace-match "" t t address))) + (let (result) + (dolist (item (tramp-bluez-list-devices) result) + (when (string-match address (cadr item)) + (setq result (car item))))))) + (defun tramp-bluez-list-devices () "Return all discovered bluetooth devices as list. Every entry is a list (NAME ADDRESS). diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1688a166ca..ec7e25247c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -58,8 +58,15 @@ (defvar tramp-copy-size-limit) (defvar tramp-persistency-file-name) (defvar tramp-remote-process-environment) -;; Suppress nasty messages. -(fset 'shell-command-sentinel 'ignore) + +;; Beautify batch mode. +(when noninteractive + ;; Suppress nasty messages. + (fset 'shell-command-sentinel 'ignore) + ;; We do not want to be interrupted. + (eval-after-load 'tramp-gvfs + '(fset 'tramp-gvfs-handler-askquestion + (lambda (_message _choices) '(t nil 0))))) ;; There is no default value on w32 systems, which could work out of the box. (defconst tramp-test-temporary-file-directory @@ -1941,7 +1948,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy file to directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (tramp--test-owncloud-p) (write-region "foo" nil source) (should (file-exists-p source)) (make-directory target) @@ -1962,7 +1971,11 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory to existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (and (tramp--test-owncloud-p) + (or (not (file-remote-p source)) + (not (file-remote-p target)))) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -1983,7 +1996,10 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory/file to non-existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless + (and (tramp--test-owncloud-p) (not (file-remote-p source))) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2069,7 +2085,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory to existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (tramp--test-owncloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2091,7 +2109,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory/file to non-existing directory. (unwind-protect - (progn + ;; FIXME: This fails on my QNAP server, see + ;; /share/Web/owncloud/data/owncloud.log + (unless (tramp--test-owncloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -4079,6 +4099,11 @@ This does not support external Emacs calls." (string-equal "mock" (file-remote-p tramp-test-temporary-file-directory 'method))) +(defun tramp--test-owncloud-p () + "Check, whether the owncloud method is used." + (string-equal + "owncloud" (file-remote-p tramp-test-temporary-file-directory 'method))) + (defun tramp--test-rsync-p () "Check, whether the rsync method is used. This does not support special file names." @@ -4830,6 +4855,8 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. +;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' +;; do not work properly for `owncloud'. ;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably. ;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'. commit 933d8fc0b70452f8a266e761231e58a759a7c80a Author: Jay Kamat Date: Fri Dec 22 15:34:44 2017 -0800 Make eshell history expansion more like bash (Bug#29821) - Prevent expansion of quick substitutions when the initial "^" is not at start of line (Bug#29157). - Allow spaces inside substitutions, so "^foo bar^baz" works. - Allow trailing characters after substitution, so "^foo^bar^trailing" works. - Throw an error when substitution does not match. * lisp/eshell/em-hist.el (eshell-expand-history-references): Expand history substitution before other types of expansions, and expand them with the whole line. (eshell-history-substitution): New function to expand only substitutions, taking in the entire typed line rather than individual arguments. diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 83595847bd..62e2f57d0f 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -581,21 +581,30 @@ See also `eshell-read-history'." (defun eshell-expand-history-references (beg end) "Parse and expand any history references in current input." - (let ((result (eshell-hist-parse-arguments beg end))) + (let ((result (eshell-hist-parse-arguments beg end)) + (full-line (buffer-substring-no-properties beg end))) (when result (let ((textargs (nreverse (nth 0 result))) (posb (nreverse (nth 1 result))) - (pose (nreverse (nth 2 result)))) + (pose (nreverse (nth 2 result))) + (full-line-subst (eshell-history-substitution full-line))) (save-excursion - (while textargs - (let ((str (eshell-history-reference (car textargs)))) - (unless (eq str (car textargs)) - (goto-char (car posb)) - (insert-and-inherit str) - (delete-char (- (car pose) (car posb))))) - (setq textargs (cdr textargs) - posb (cdr posb) - pose (cdr pose)))))))) + (if full-line-subst + ;; Found a ^foo^bar substitution + (progn + (goto-char beg) + (insert-and-inherit full-line-subst) + (delete-char (- end beg))) + ;; Try to expand other substitutions + (while textargs + (let ((str (eshell-history-reference (car textargs)))) + (unless (eq str (car textargs)) + (goto-char (car posb)) + (insert-and-inherit str) + (delete-char (- (car pose) (car posb))))) + (setq textargs (cdr textargs) + posb (cdr posb) + pose (cdr pose))))))))) (defvar pcomplete-stub) (defvar pcomplete-last-completion-raw) @@ -630,20 +639,31 @@ See also `eshell-read-history'." (setq history (cdr history))) (cdr fhist))))))) +(defun eshell-history-substitution (line) + "Expand quick hist substitutions formatted as ^foo^bar^. +Returns nil if string does not match quick substitution format, +and acts like !!:s/foo/bar/ otherwise." + ;; `^string1^string2^' + ;; Quick Substitution. Repeat the last command, replacing + ;; STRING1 with STRING2. Equivalent to `!!:s/string1/string2/' + (when (and (eshell-using-module 'eshell-pred) + (string-match + "^\\^\\([^^]+\\)\\^\\([^^]+\\)\\(?:\\^\\(.*\\)\\)?$" + line)) + ;; Save trailing match as `eshell-history-reference' runs string-match. + (let ((matched-end (match-string 3 line))) + (concat + (eshell-history-reference + (format "!!:s/%s/%s/" + (match-string 1 line) + (match-string 2 line))) + matched-end)))) + (defun eshell-history-reference (reference) "Expand directory stack REFERENCE. The syntax used here was taken from the Bash info manual. Returns the resultant reference, or the same string REFERENCE if none matched." - ;; `^string1^string2^' - ;; Quick Substitution. Repeat the last command, replacing - ;; STRING1 with STRING2. Equivalent to `!!:s/string1/string2/' - (if (and (eshell-using-module 'eshell-pred) - (string-match "\\^\\([^^]+\\)\\^\\([^^]+\\)\\^?\\s-*$" - reference)) - (setq reference (format "!!:s/%s/%s/" - (match-string 1 reference) - (match-string 2 reference)))) ;; `!' ;; Start a history substitution, except when followed by a ;; space, tab, the end of the line, = or (. diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 2c12cacfff..61af4048d5 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -545,7 +545,8 @@ that `ls -l' will show in the first column of its display. " (function (lambda (str) (if (string-match ,match str) - (setq str (replace-match ,replace t nil str))) + (setq str (replace-match ,replace t nil str)) + (error (concat str ": substitution failed"))) str)) lst))))) (defun eshell-include-members (&optional invert-p)