commit a18baf565e872759de9281c3488c3981d19a15e1 (HEAD, refs/remotes/origin/master) Author: Tino Calancha Date: Tue Jul 5 16:16:11 2016 +0900 * test/lisp/help-fns-tests.el: Add several tests for 'describe-function'. diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index babba1a..ba0d8ed 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -27,13 +27,62 @@ (autoload 'help-fns-test--macro "help-fns" nil nil t) + +;;; Several tests for describe-function + +(defun help-fns-tests--describe-function (func) + "Helper function for `describe-function' tests. +FUNC is the function to describe, a symbol. +Return first line of the output of (describe-function-1 FUNC)." + (let ((string (with-output-to-string + (describe-function-1 func)))) + (string-match "\\(.+\\)\n" string) + (match-string-no-properties 1 string))) + (ert-deftest help-fns-test-bug17410 () "Test for http://debbugs.gnu.org/17410 ." - (describe-function 'help-fns-test--macro) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "autoloaded Lisp macro" (line-end-position))))) - + (let ((regexp "autoloaded Lisp macro") + (result (help-fns-tests--describe-function 'help-fns-test--macro))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-built-in () + (let ((regexp "a built-in function in .C source code") + (result (help-fns-tests--describe-function 'mapcar))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-interactive-built-in () + (let ((regexp "an interactive built-in function in .C source code") + (result (help-fns-tests--describe-function 're-search-forward))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-lisp-macro () + (let ((regexp "a Lisp macro in .subr\.el") + (result (help-fns-tests--describe-function 'when))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-lisp-defun () + (let ((regexp "a compiled Lisp function in .subr\.el") + (result (help-fns-tests--describe-function 'last))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-lisp-defsubst () + (let ((regexp "a compiled Lisp function in .subr\.el") + (result (help-fns-tests--describe-function 'posn-window))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-alias-to-defun () + (let ((regexp "an alias for .set-file-modes. in .subr\.el") + (result (help-fns-tests--describe-function 'chmod))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-bug23887 () + "Test for http://debbugs.gnu.org/23887 ." + (let ((regexp "an alias for .re-search-forward. in .subr\.el") + (result (help-fns-tests--describe-function 'search-forward-regexp))) + (should (string-match regexp result)))) + + +;;; Test describe-function over functions with funny names (defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) "A function with a funny name. @@ -57,6 +106,8 @@ (should (search-forward "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) + +;;; Test for describe-symbol (ert-deftest help-fns-test-describe-symbol () "Test the `describe-symbol' function." ;; 'describe-symbol' would originally signal an error for commit dcefd2bbc0e404c26f1e5b68c910404355f488fb Author: Michal Nazarewicz Date: Wed Jun 22 19:06:57 2016 +0200 Don’t create unnecessary marker in ‘delete-trailing-whitespace’ * lisp/simple.el (delete-trailing-whitespace): If END argument is nil, there is no need for the end-marker to be created. diff --git a/lisp/simple.el b/lisp/simple.el index 37f6d50..ba026af 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -602,7 +602,7 @@ buffer if the variable `delete-trailing-lines' is non-nil." (list nil nil)))) (save-match-data (save-excursion - (let ((end-marker (copy-marker (or end (point-max))))) + (let ((end-marker (and end (copy-marker end)))) (goto-char (or start (point-min))) (with-syntax-table (make-syntax-table (syntax-table)) ;; Don't delete formfeeds, even if they are considered whitespace. @@ -611,15 +611,14 @@ buffer if the variable `delete-trailing-lines' is non-nil." (modify-syntax-entry ?\n "_") (while (re-search-forward "\\s-+$" end-marker t) (delete-region (match-beginning 0) (match-end 0)))) - ;; Delete trailing empty lines. - (goto-char end-marker) - (when (and (not end) - delete-trailing-lines - ;; Really the end of buffer. - (= (point-max) (1+ (buffer-size))) - (<= (skip-chars-backward "\n") -2)) - (delete-region (1+ (point)) end-marker)) - (set-marker end-marker nil)))) + (if end + (set-marker end-marker nil) + ;; Delete trailing empty lines. + (and delete-trailing-lines + ;; Really the end of buffer. + (= (goto-char (point-max)) (1+ (buffer-size))) + (<= (skip-chars-backward "\n") -2) + (delete-region (1+ (point)) (point-max))))))) ;; Return nil for the benefit of `write-file-functions'. nil) commit 7c6317a0498b6690ea668909ac012cb45e6f809b Author: Michal Nazarewicz Date: Tue Jun 21 16:46:52 2016 +0200 Simplify ‘delete-trailing-whitespace’ by not treating \n as whitespace * lisp/simple.el (delete-trailing-whitespace): Set newline’s character syntax to non-whitespace so that ‘\s-’ regular expression does not match it. This simplifies the loop slightly since a simple ‘\s-+$’ can be used and as a consequence ‘line-beginning-position’ function does not need to be called any longer. Furthermore, when newline has whitespace syntax, ‘\s-$’ regular expression ends up matching empty lins since ‘\s-’ matches newline characetr of proceeding line. This leads to needless loop iterations. Since previous change to ‘delete-trailing-whitespace’ already introduced ‘with-syntax-table’, take advantage of it and also overwrite newline’s character syntax. diff --git a/lisp/simple.el b/lisp/simple.el index 3fa23ff..37f6d50 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -607,9 +607,10 @@ buffer if the variable `delete-trailing-lines' is non-nil." (with-syntax-table (make-syntax-table (syntax-table)) ;; Don't delete formfeeds, even if they are considered whitespace. (modify-syntax-entry ?\f "_") - (while (re-search-forward "\\s-$" end-marker t) - (skip-syntax-backward "-" (line-beginning-position)) - (delete-region (point) (match-end 0)))) + ;; Treating \n as non-whitespace makes things easier. + (modify-syntax-entry ?\n "_") + (while (re-search-forward "\\s-+$" end-marker t) + (delete-region (match-beginning 0) (match-end 0)))) ;; Delete trailing empty lines. (goto-char end-marker) (when (and (not end) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 2722544..97b6c49 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -235,7 +235,8 @@ (insert " \f \n \f \f \n\nlast\n") (delete-trailing-whitespace) (should (string-equal (buffer-string) " \f\n \f \f\n\nlast\n")) - (should (equal ?\s (char-syntax ?\f)))))) + (should (equal ?\s (char-syntax ?\f))) + (should (equal ?\s (char-syntax ?\n)))))) ;;; auto-boundary tests commit dc294483af221066724f1007a595016b47fb5814 Author: Michal Nazarewicz Date: Tue Jun 21 16:52:52 2016 +0200 Make ‘delete-trailing-whitespace’ delete spaces after form feed * lisp/simple.el (delete-trailing-whitespace): Treat form fead as a non-whitespace character (regradless of whether it’s character syntax is whitespace) and delete any whitespace following it instead of leaving lines with form feeds completely unchanged. I.e. a line like "\f " will now became "\f". diff --git a/etc/NEWS b/etc/NEWS index 2f2ae65..bc8b097 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -187,6 +187,12 @@ questions, with a handy way to display help texts. 'undo', undo the last replacement; bound to 'u'. 'undo-all', undo all replacements; bound to 'U'. +** 'delete-trailing-whitespace' deletes whitespace after form feed. +In modes where form feed was treated as a whitespace character, +'delete-trailing-whitespace' would keep lines containing it unchanged. +It now deletes whitespace after the last form feed thus behaving the +same as in modes where the character is not whitespace. + * Changes in Specialized Modes and Packages in Emacs 25.2 diff --git a/lisp/simple.el b/lisp/simple.el index 0da7097..3fa23ff 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -602,15 +602,14 @@ buffer if the variable `delete-trailing-lines' is non-nil." (list nil nil)))) (save-match-data (save-excursion - (let ((end-marker (copy-marker (or end (point-max)))) - (start (or start (point-min)))) - (goto-char start) - (while (re-search-forward "\\s-$" end-marker t) - (skip-syntax-backward "-" (line-beginning-position)) + (let ((end-marker (copy-marker (or end (point-max))))) + (goto-char (or start (point-min))) + (with-syntax-table (make-syntax-table (syntax-table)) ;; Don't delete formfeeds, even if they are considered whitespace. - (if (looking-at-p ".*\f") - (goto-char (match-end 0))) - (delete-region (point) (match-end 0))) + (modify-syntax-entry ?\f "_") + (while (re-search-forward "\\s-$" end-marker t) + (skip-syntax-backward "-" (line-beginning-position)) + (delete-region (point) (match-end 0)))) ;; Delete trailing empty lines. (goto-char end-marker) (when (and (not end) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 40cd1d2..2722544 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -204,7 +204,7 @@ ;;; `delete-trailing-whitespace' -(ert-deftest simple-delete-trailing-whitespace () +(ert-deftest simple-delete-trailing-whitespace--bug-21766 () "Test bug#21766: delete-whitespace sometimes deletes non-whitespace." (defvar python-indent-guess-indent-offset) ; to avoid a warning (let ((python (featurep 'python)) @@ -219,11 +219,24 @@ "\n" "\n")) (delete-trailing-whitespace) - (should (equal (count-lines (point-min) (point-max)) 3))) + (should (string-equal (buffer-string) + (concat "query = \"\"\"WITH filtered AS\n" + "WHERE\n" + "\"\"\".format(fv_)\n")))) ;; Let's clean up if running interactive (unless (or noninteractive python) (unload-feature 'python))))) +(ert-deftest simple-delete-trailing-whitespace--formfeeds () + "Test formfeeds are not deleted but whitespace past them is." + (with-temp-buffer + (with-syntax-table (make-syntax-table) + (modify-syntax-entry ?\f " ") ; Make sure \f is whitespace + (insert " \f \n \f \f \n\nlast\n") + (delete-trailing-whitespace) + (should (string-equal (buffer-string) " \f\n \f \f\n\nlast\n")) + (should (equal ?\s (char-syntax ?\f)))))) + ;;; auto-boundary tests (ert-deftest undo-auto-boundary-timer () commit e3ae3c44882085bf52f6bb8b02e98eb7d0b1f81b Author: Dmitry Antipov Date: Mon Jul 4 20:05:06 2016 +0300 Cleanup XEditRes hack * configure.ac [USE_X_TOOLKIT]: Define X_TOOLKIT_EDITRES if _XEditResCheckMessages is declared in X11/Xmu/Editres.h and may be linked with -lXmu. This should work with any non-ancient Xmu library. * xfns.c (toplevel): Remove old cruft. (x_window) [USE_X_TOOLKIT]: Use X_TOOLKIT_EDITRES. * xterm.c (toplevel): Remove old cruft. (handle_one_xevent): Use X_TOOLKIT_EDITRES. * xterm.h (toplevel): Include X11/Xmu/Editres.h if X_TOOLKIT_EDITRES. diff --git a/configure.ac b/configure.ac index 2674806..aaddfcd 100644 --- a/configure.ac +++ b/configure.ac @@ -4287,23 +4287,32 @@ else [Returns true if character is any form of separator.]) fi -AH_TEMPLATE(NO_EDITRES, [Define if XEditRes should not be used.]) - -case $opsys in - aix4-2) - dnl Unfortunately without libXmu we cannot support EditRes. - if test "x$ac_cv_search_XmuConvertStandardSelection" = xno; then - AC_DEFINE(NO_EDITRES, 1) - fi - ;; - - hpux*) - dnl Assar Westerlund says this is necessary for - dnl HP-UX 10.20, and that it works for HP-UX 0 as well. - AC_DEFINE(NO_EDITRES, 1) +if test "$USE_X_TOOLKIT" != "none"; then + have_editres=yes + case $opsys in + hpux*) + dnl Assar Westerlund says this is necessary + dnl for HP-UX 10.20, and that it works for HP-UX 0 as well. + have_editres=no ;; -esac - + esac + if test "$have_editres" != no && test ! -z "$LIBXMU"; then + OLDLIBS="$LIBS" + dnl See libXmu.a check above. + if test x$HAVE_X11XTR6 = xyes; then + LIBS="-lXt -lSM -lICE $LIBXMU" + else + OTHERLIBS="-lXt -$LIBXMU" + fi + AC_TRY_LINK( + [#include + #include ], + [_XEditResCheckMessages (0, 0, 0, 0);], + [AC_DEFINE([X_TOOLKIT_EDITRES], 1, + [Define to 1 if we should use XEditRes.])]) + LIBS=$OLDLIBS + fi +fi case $opsys in sol2* | unixware ) diff --git a/src/xfns.c b/src/xfns.c index 265eb6c..798dc49 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -91,11 +91,6 @@ along with GNU Emacs. If not, see . */ #include "../lwlib/xlwmenu.h" #endif -#if !defined (NO_EDITRES) -#define HACK_EDITRES -extern void _XEditResCheckMessages (Widget, XtPointer, XEvent *, Boolean *); -#endif /* not defined NO_EDITRES */ - /* Unique id counter for widgets created by the Lucid Widget Library. */ extern LWLIB_ID widget_id_tick; @@ -2662,7 +2657,7 @@ x_window (struct frame *f, long window_prompting) hack_wm_protocols (f, shell_widget); -#ifdef HACK_EDITRES +#ifdef X_TOOLKIT_EDITRES XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0); #endif diff --git a/src/xterm.c b/src/xterm.c index 76b92df..cd1d712 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -95,10 +95,6 @@ along with GNU Emacs. If not, see . */ #endif #ifdef USE_X_TOOLKIT -#if !defined (NO_EDITRES) -#define HACK_EDITRES -extern void _XEditResCheckMessages (Widget, XtPointer, XEvent *, Boolean *); -#endif /* not NO_EDITRES */ /* Include toolkit specific headers for the scroll bar widget. */ @@ -7610,7 +7606,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto done; } -#ifdef HACK_EDITRES +#ifdef X_TOOLKIT_EDITRES if (event->xclient.message_type == dpyinfo->Xatom_editres) { f = any; @@ -7619,7 +7615,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, NULL, (XEvent *) event, NULL); goto done; } -#endif /* HACK_EDITRES */ +#endif /* X_TOOLKIT_EDITRES */ if (event->xclient.message_type == dpyinfo->Xatom_DONE || event->xclient.message_type == dpyinfo->Xatom_PAGE) diff --git a/src/xterm.h b/src/xterm.h index 8e1fc78..675a484 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -38,6 +38,10 @@ along with GNU Emacs. If not, see . */ #include /* foul, but we need this to use our own window inside a widget instead of one that Xt creates... */ +#ifdef X_TOOLKIT_EDITRES +#include +#endif + typedef Widget xt_or_gtk_widget; #endif commit f24fe30cb8118f8e15688eaf61a6fefde87f597e Author: Michael Albinus Date: Mon Jul 4 15:36:30 2016 +0200 Add Google Drive support to Tramp * doc/misc/tramp.texi: Add `gdrive' method. * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.1-pre". * etc/NEWS: Add Tramp connection method "gdrive". * lisp/net/tramp-gvfs.el (tramp-gvfs-methods) : Add. (tramp-default-user-alist, tramp-default-host-alist): Add rule for "gdrive". (tramp-gvfs-file-attributes): Add "name", remove "standard::icon". (tramp-gvfs-file-attributes-with-gvfs-ls-regexp): Simplify regexp. (tramp-gvfs-get-directory-attributes): Improve loop. Use "standard::display-name" as file name, if available. (tramp-gvfs-handle-file-name-all-completions): Simplify. (tramp-gvfs-url-file-name, tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec): Map between "gdrive" and "google-drive". * lisp/net/tramp.el (tramp-call-process): Do not signal error. * test/lisp/net/tramp-tests.el (tramp--instrument-test-case): Do not enable `tramp-message-show-message'. (tramp-test13-make-directory, tramp-test14-delete-directory): Do not specify error type. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 894ccbe..dc3ef23 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -957,6 +957,22 @@ syntax requires a leading volume (share) name, for example: based on standard protocols, such as HTTP@. @option{davs} does the same but with SSL encryption. Both methods support the port numbers. +@item @option{gdrive} +@cindex method gdrive +@cindex gdrive method +@cindex Google Drive + +Via the @option{gdrive} method it is possible to access your Google +Drive online storage. User and host name of the remote file name are +your email address of the Google Drive credentials, like +@file{@trampfn{gdrive,john.doe@@gmail.com,/}}. These credentials must +be populated in your @command{Online Accounts} application outside Emacs. + +Since Google Drive uses cryptic blob file names internally, +@value{tramp} works with the @code{display-name} of the files. This +could produce unexpected behaviour in case two files in the same +directory have the same @code{display-name}, such a situation must be avoided. + @item @option{obex} @cindex method obex @cindex obex method @@ -986,8 +1002,8 @@ requires the SYNCE-GVFS plugin. @vindex tramp-gvfs-methods This custom option is a list of external methods for GVFS@. By default, this list includes @option{afp}, @option{dav}, @option{davs}, -@option{obex}, @option{sftp} and @option{synce}. Other methods to -include are: @option{ftp} and @option{smb}. +@option{gdrive}, @option{obex}, @option{sftp} and @option{synce}. +Other methods to include are: @option{ftp} and @option{smb}. @end defopt diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 6f67f35..3101dc0 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.0 +@set trampver 2.3.1-pre @c Other flags from configuration @set instprefix /usr/local diff --git a/etc/NEWS b/etc/NEWS index 7e11f62..2f2ae65 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -318,6 +318,10 @@ different group ID. +++ *** New connection method "doas" for OpenBSD hosts. ++++ +*** New connection method "gdrive", which allows to access Google +Drive onsite repositories. + --- ** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0e874d6..8e7ef0f 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,10 +49,10 @@ ;; The custom option `tramp-gvfs-methods' contains the list of ;; supported connection methods. Per default, these are "afp", "dav", -;; "davs", "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", "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. ;; Other possible connection methods are "ftp" and "smb". When one of ;; these methods is added to the list, the remote access for that @@ -110,21 +110,29 @@ (require 'custom)) ;;;###tramp-autoload -(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce") +(defcustom tramp-gvfs-methods + '("afp" "dav" "davs" "gdrive" "obex" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp - :version "25.1" + :version "25.2" :type '(repeat (choice (const "afp") (const "dav") (const "davs") (const "ftp") + (const "gdrive") (const "obex") (const "sftp") (const "smb") (const "synce")))) -;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE -;; method, no user is chosen. +;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. +;;;###tramp-autoload +(when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)" + user-mail-address) + (add-to-list 'tramp-default-user-alist + `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address))) + (add-to-list 'tramp-default-host-alist + '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))) ;;;###tramp-autoload (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil)) @@ -408,11 +416,9 @@ Every entry is a list (NAME ADDRESS).") "The device interface of the HAL daemon.") (defconst tramp-gvfs-file-attributes - '("type" + '("name" + "type" "standard::display-name" - ;; We don't need this one. It is used as delimiter in case the - ;; display name contains spaces, which is hard to parse. - "standard::icon" "standard::symlink-target" "unix::nlink" "unix::uid" @@ -432,9 +438,7 @@ Every entry is a list (NAME ADDRESS).") "GVFS file attributes.") (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (concat "[[:blank:]]" - (regexp-opt tramp-gvfs-file-attributes t) - "=\\([^[:blank:]]+\\)") + (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") "Regexp to parse GVFS file attributes with `gvfs-ls'.") (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp @@ -834,25 +838,31 @@ file names." v "gvfs-ls" "-h" "-n" "-a" (mapconcat 'identity tramp-gvfs-file-attributes ",") (tramp-gvfs-url-file-name directory)) - ;; Parse output ... + ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (while (re-search-forward + (while (looking-at (concat "^\\(.+\\)[[:blank:]]" "\\([[:digit:]]+\\)[[:blank:]]" - "(\\(.+\\))[[:blank:]]" - "standard::display-name=\\(.+\\)[[:blank:]]" - "standard::icon=") - (point-at-eol) t) - (let ((item (list (cons "standard::display-name" (match-string 4)) - (cons "type" (match-string 3)) + "(\\(.+?\\))" + tramp-gvfs-file-attributes-with-gvfs-ls-regexp)) + (let ((item (list (cons "type" (match-string 3)) (cons "standard::size" (match-string 2)) - (match-string 1)))) - (while (re-search-forward - tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (point-at-eol) t) - (push (cons (match-string 1) (match-string 2)) item)) - (push (nreverse item) result)) + (cons "name" (match-string 1))))) + (goto-char (1+ (match-end 3))) + (while (looking-at + (concat + tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\|" "$" "\\)")) + (push (cons (match-string 1) (match-string 2)) item) + (goto-char (match-end 2))) + ;; Add display name as head. + (push + (cons (cdr (or (assoc "standard::display-name" item) + (assoc "name" item))) + (nreverse item)) + result)) (forward-line))) result))))) @@ -868,7 +878,7 @@ file names." ;; Send command. (tramp-gvfs-send-command v "gvfs-info" (tramp-gvfs-url-file-name filename)) - ;; Parse output ... + ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (re-search-forward @@ -1024,17 +1034,12 @@ file names." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../")) - entry) + (let ((result '("./" "../"))) ;; Get a list of directories and files. (dolist (item (tramp-gvfs-get-directory-attributes directory) result) - (setq entry - (or ;; Use display-name if available (google-drive). - ;(cdr (assoc "standard::display-name" item)) - (car item))) (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory entry) result) - (push entry result))))))))) + (push (file-name-as-directory (car item)) result) + (push (car item) result))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1220,6 +1225,8 @@ file-notify events." (url-recreate-url (if (tramp-tramp-file-p filename) (with-parsed-tramp-file-name filename nil + (when (string-equal "gdrive" method) + (setq method "google-drive")) (when (and user (string-match tramp-user-with-domain-regexp user)) (setq user (concat (match-string 2 user) ";" (match-string 1 user)))) @@ -1389,6 +1396,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (unless (zerop (length domain)) (setq user (concat user tramp-prefix-domain-format domain))) (unless (zerop (length port)) @@ -1474,6 +1483,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) (setq user (or (tramp-file-name-user vec) ""))) (unless (zerop (length domain)) @@ -1531,6 +1542,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "afp-volume") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "volume" share))) + ((string-equal "gdrive" method) + (list (tramp-gvfs-mount-spec-entry "type" "google-drive") + (tramp-gvfs-mount-spec-entry "host" host))) (t (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry "host" host)))) @@ -1896,8 +1910,9 @@ They are retrieved from the hal daemon." ;;; TODO: -;; * Host name completion via afp-server, smb-server or smb-network. -;; * Check how two shares of the same SMB server can be mounted in +;; * Host name completion for existing mount points (afp-server, +;; smb-server) or via smb-network. +;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. ;; * Apply SDP on bluetooth devices, in order to filter out obex ;; capability. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b02760b..d80006a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4012,7 +4012,7 @@ are written with verbosity of 6." (vector tramp-current-method tramp-current-user tramp-current-host nil nil))) (destination (if (eq destination t) (current-buffer) destination)) - result) + output error result) (tramp-message v 6 "`%s %s' %s %s" program (mapconcat 'identity args " ") infile destination) @@ -4023,13 +4023,17 @@ are written with verbosity of 6." 'call-process program infile (or destination t) display args)) ;; `result' could also be an error string. (when (stringp result) - (signal 'file-error (list result))) + (setq error result + result 1)) (with-current-buffer (if (bufferp destination) destination (current-buffer)) - (tramp-message v 6 "%d\n%s" result (buffer-string)))) + (setq output (buffer-string)))) (error - (setq result 1) - (tramp-message v 6 "%d\n%s" result (error-message-string err)))) + (setq error (error-message-string err) + result 1))) + (if (zerop (length error)) + (tramp-message v 6 "%d\n%s" result output) + (tramp-message v 6 "%d\n%s\n%s" result output error)) result)) (defun tramp-call-process-region diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index aea2605..fad7e7f 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -6,7 +6,7 @@ ;; Author: Kai Großjohann ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.0 +;; Version: 2.3.1-pre ;; This file is part of GNU Emacs. @@ -32,7 +32,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.0" +(defconst tramp-version "2.3.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -54,7 +54,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 23) "ok" - (format "Tramp 2.3.0 is not fit for %s" + (format "Tramp 2.3.1-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index b9562c1..fe927bb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -119,7 +119,6 @@ eval properly in `should', `should-not' or `should-error'. BODY shall not contain a timeout." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose ,verbose) - (tramp-message-show-message t) (tramp-debug-on-error t) (debug-ignored-errors (cons "^make-symbolic-link not supported$" debug-ignored-errors))) @@ -932,7 +931,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name1) (should (file-directory-p tmp-name1)) (should (file-accessible-directory-p tmp-name1)) - (should-error (make-directory tmp-name2) :type 'file-error) + (should-error (make-directory tmp-name2)) (make-directory tmp-name2 'parents) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2))) @@ -953,7 +952,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Delete non-empty directory. (make-directory tmp-name) (write-region "foo" nil (expand-file-name "bla" tmp-name)) - (should-error (delete-directory tmp-name) :type 'file-error) + (should-error (delete-directory tmp-name)) (delete-directory tmp-name 'recursive) (should-not (file-directory-p tmp-name))))