commit 2ea34662c20f71d35dd52a5ed996542c7386b9cb (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Mon Aug 31 20:41:45 2020 +0200 Use lexical-binding in pong.el * lisp/play/pong.el: Use lexical-binding. Remove redundant :group args. diff --git a/lisp/play/pong.el b/lisp/play/pong.el index d5723344a0..4e6d73b6e9 100644 --- a/lisp/play/pong.el +++ b/lisp/play/pong.el @@ -1,4 +1,4 @@ -;;; pong.el --- classical implementation of pong +;;; pong.el --- classical implementation of pong -*- lexical-binding:t -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -33,88 +33,72 @@ ;;; Customization (defgroup pong nil - "Emacs-Lisp implementation of the classical game pong." + "Emacs Lisp implementation of the classical game pong." :tag "Pong" :group 'games) (defcustom pong-buffer-name "*Pong*" "Name of the buffer used to play." - :group 'pong :type '(string)) (defcustom pong-width 50 "Width of the playfield." - :group 'pong :type '(integer)) (defcustom pong-height (min 30 (- (frame-height) 6)) "Height of the playfield." - :group 'pong :type '(integer)) (defcustom pong-bat-width 3 "Width of the bats for pong." - :group 'pong :type '(integer)) (defcustom pong-blank-color "black" "Color used for background." - :group 'pong :type 'color) (defcustom pong-bat-color "yellow" "Color used for bats." - :group 'pong :type 'color) (defcustom pong-ball-color "red" "Color used for the ball." - :group 'pong :type 'color) (defcustom pong-border-color "white" "Color used for pong borders." - :group 'pong :type 'color) (defcustom pong-left-key "4" "Alternate key to press for bat 1 to go up (primary one is [left])." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-right-key "6" "Alternate key to press for bat 1 to go down (primary one is [right])." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-up-key "8" "Alternate key to press for bat 2 to go up (primary one is [up])." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-down-key "2" "Alternate key to press for bat 2 to go down (primary one is [down])." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-quit-key "q" "Key to press to quit pong." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-pause-key "p" "Key to press to pause pong." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-resume-key "p" "Key to press to resume pong." - :group 'pong :type '(restricted-sexp :match-alternatives (stringp vectorp))) (defcustom pong-timer-delay 0.1 "Time to wait between every cycle." - :group 'pong :type 'number) commit 2f797124c303627a4543354eb18323e1e22e578e Merge: 01b5617731 f20169399d Author: Glenn Morris Date: Mon Aug 31 10:45:54 2020 -0700 Merge from origin/emacs-27 f20169399d (origin/emacs-27) Fix typo in Introduction to Emacs Lisp 7605060d51 Update Elisp Manual reference to which-function-mode 29708cbde7 Some precisions to bug handling dddc971f0e CC Mode: Fix processing for when c-multiline-string-start-... 4a73fb9668 Fix description of %-constructs in 'mode-line-format' commit 01b5617731990ead964e24ba6926d4d681192b4c Merge: f4b8919216 df5c669709 Author: Glenn Morris Date: Mon Aug 31 10:45:54 2020 -0700 ; Merge from origin/emacs-27 The following commit was skipped: df5c669709 Adapt tramp-tests.el, don't merge with master commit f4b891921608ad32a2f7826313f8dc4652cf5eb6 Merge: 332e5b54b6 da4840af12 Author: Glenn Morris Date: Mon Aug 31 10:45:54 2020 -0700 Merge from origin/emacs-27 da4840af12 Adapt reminder-for-release-blocking-bugs commit 332e5b54b6a6d2a1a9df3128bb1b90962cde7416 Merge: a0d3d2935f eb77572257 Author: Glenn Morris Date: Mon Aug 31 10:45:54 2020 -0700 ; Merge from origin/emacs-27 The following commits were skipped: eb77572257 Fix replace-region-contents performance bug a142bbd288 * admin/admin.el (reminder-for-release-blocking-bugs): New... 4657f08b7e Sync with Tramp 2.4.5-pre commit a0d3d2935f935dfac562df801d4fe841c876af7a Author: Lars Ingebrigtsen Date: Mon Aug 31 19:13:23 2020 +0200 Make quoted-printable-encode-region work in multibyte buffers * lisp/mail/qp.el (quoted-printable-encode-region): If we're in a multibyte buffer (that has been encoded with some coding system), then get-byte will get the correct byte value. diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el index 35ff47fd09..10ac696fec 100644 --- a/lisp/mail/qp.el +++ b/lisp/mail/qp.el @@ -125,7 +125,7 @@ encode lines starting with \"From\"." (not (eobp))) (insert (prog1 - (format "=%02X" (char-after)) + (format "=%02X" (get-byte)) (delete-char 1)))) ;; Encode white space at the end of lines. (goto-char (point-min)) @@ -134,7 +134,7 @@ encode lines starting with \"From\"." (while (not (eolp)) (insert (prog1 - (format "=%02X" (char-after)) + (format "=%02X" (get-byte)) (delete-char 1))))) (let ((ultra (and (boundp 'mm-use-ultra-safe-encoding) commit e63705ab9ba9081bcb4ed97e82019aab5a033d0d Author: Lars Ingebrigtsen Date: Mon Aug 31 19:12:12 2020 +0200 Add a new function dom-print * doc/lispref/text.texi (Document Object Model): Document it. * lisp/dom.el (dom-print): New function. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 0c3813ff1d..3a4cf6b572 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5154,6 +5154,11 @@ Utility functions: @item dom-pp @var{dom} &optional @var{remove-empty} Pretty-print @var{dom} at point. If @var{remove-empty}, don't print textual nodes that just contain white-space. + +@item dom-print @var{dom} &optional @var{pretty} @var{xml} +Print @var{dom} at point. If @var{xml} is non-@code{nil}, print as +@acronym{XML}; otherwise, print as @acronym{HTML}. If @var{pretty} is +non-@code{nil}, indent the @acronym{HTML}/@acronym{XML} logically. @end table diff --git a/etc/NEWS b/etc/NEWS index ad63955f7b..9a044cade1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1215,6 +1215,9 @@ equivalent period in seconds. +++ ** The new function 'dom-remove-attribute' has been added. ++++ +** The new function 'dom-print' has been added. + --- ** 'make-network-process', 'make-serial-process' ':coding' behavior change. Previously, passing ':coding nil' to either of these functions would diff --git a/lisp/dom.el b/lisp/dom.el index 7ff9e07b72..bf4a56ab9f 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -269,6 +269,50 @@ white-space." (insert ")") (insert "\n" (make-string (1+ column) ? )))))))) +(defun dom-print (dom &optional pretty xml) + "Print DOM at point as HTML/XML. +If PRETTY, indent the HTML/XML logically. +If XML, generate XML instead of HTML." + (let ((column (current-column))) + (insert (format "<%s" (dom-tag dom))) + (let ((attr (dom-attributes dom))) + (dolist (elem attr) + ;; In HTML, these are boolean attributes that should not have + ;; an = value. + (if (and (memq (car elem) + '(async autofocus autoplay checked + contenteditable controls default + defer disabled formNoValidate frameborder + hidden ismap itemscope loop + multiple muted nomodule novalidate open + readonly required reversed + scoped selected typemustmatch)) + (cdr elem) + (not xml)) + (insert (format " %s" (car elem))) + (insert (format " %s=%S" (car elem) (cdr elem)))))) + (let* ((children (dom-children dom)) + (non-text nil)) + (if (null children) + (insert " />") + (insert ">") + (dolist (child children) + (if (stringp child) + (insert child) + (setq non-text t) + (when pretty + (insert "\n" (make-string (+ column 2) ? ))) + (dom-print child pretty xml))) + ;; If we inserted non-text child nodes, or a text node that + ;; ends with a newline, then we indent the end tag. + (when (and pretty + (or (bolp) + non-text)) + (unless (bolp) + (insert "\n")) + (insert (make-string column ? ))) + (insert (format "" (dom-tag dom))))))) + (provide 'dom) ;;; dom.el ends here commit 04578c10636fbbd1c1a924404a955eb37ffefd8f Author: Stefan Kangas Date: Sat Aug 29 20:18:19 2020 +0200 * lisp/dired-x.el (dired-omit-mode): Add autoload cookie. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 873d586ca1..05c5a70422 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -137,6 +137,7 @@ folding to be used on case-insensitive filesystems only." (file-name-case-insensitive-p dir) dired-omit-case-fold)) +;;;###autoload (define-minor-mode dired-omit-mode "Toggle omission of uninteresting files in Dired (Dired-Omit mode). commit 36d485dd32fa69c683c7515cd73bd7cce2def16d Author: Michael Albinus Date: Mon Aug 31 13:31:46 2020 +0200 * .gitlab-ci.yml (test-all): Add lib/*.{h,c}. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index e60e79ee2b..f4e08d59dd 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -47,6 +47,7 @@ test-all: - aclocal.m4 - autogen.sh - configure.ac + - lib/*.{h,c} - lisp/*.el - lisp/**/*.el - src/*.{h,c} commit 58d962379546762c7eead8fc69c4c136bed8256b Author: Stefan Kangas Date: Mon Aug 31 11:43:52 2020 +0200 Fix minibuffer default of ephemeral debbugs group * lisp/gnus/gnus-group.el (gnus-group--read-bug-ids): Don't read number in "bug-123" as a negative bug ID; they are always positive. diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d613bc86ad..2cbbe62460 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2411,7 +2411,8 @@ the bug number, and browsing the URL must return mbox output." (require 'bug-reference) (let ((def (cond ((thing-at-point-looking-at bug-reference-bug-regexp 500) (match-string 2)) - ((number-at-point))))) + ((and (number-at-point) + (abs (number-at-point))))))) ;; Pass DEF as the value of COLLECTION instead of DEF because: ;; a) null input should not cause DEF to be returned and ;; b) TAB and M-n still work this way. commit f20169399df9c6c884ae597d1737ad230ecb7f5e Author: Stefan Kangas Date: Mon Aug 31 11:34:18 2020 +0200 Fix typo in Introduction to Emacs Lisp * doc/lispintro/emacs-lisp-intro.texi (type-of-animal in detail): Remove extraneous parenthesis. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 46462162ca..e6c54efba7 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -3997,7 +3997,7 @@ looks like this: @smallexample @group (if (equal characteristic "fierce") - (message "It is a tiger!"))) + (message "It is a tiger!")) @end group @end smallexample commit 7605060d51bbce88307c09bd2e9be60f2750ee3d Author: Stefan Kangas Date: Mon Aug 31 04:35:17 2020 +0200 Update Elisp Manual reference to which-function-mode * doc/lispref/modes.texi (Mode Line Top, Mode Line Variables) Don't refer to obsolete alias for 'which-function-mode'. (Bug#13716) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index e7049b4741..4edda793e0 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2047,7 +2047,7 @@ be useful for Shell mode (in reality, Shell mode does not set "%n" ")%]--" @group - '(which-func-mode ("" which-func-format "--")) + '(which-function-mode ("" which-func-format "--")) '(line-number-mode "L%l--") '(column-number-mode "C%c--") '(-3 "%p"))) @@ -2055,8 +2055,8 @@ be useful for Shell mode (in reality, Shell mode does not set @end example @noindent -(The variables @code{line-number-mode}, @code{column-number-mode} -and @code{which-func-mode} enable particular minor modes; as usual, +(The variables @code{line-number-mode}, @code{column-number-mode} and +@code{which-function-mode} enable particular minor modes; as usual, these variable names are also the minor mode command names.) @node Mode Line Variables @@ -2198,7 +2198,7 @@ enabled separately in each buffer. @defvar global-mode-string This variable holds a mode line construct that, by default, appears in -the mode line just after the @code{which-func-mode} minor mode if set, +the mode line just after the @code{which-function-mode} minor mode if set, else after @code{mode-line-modes}. The command @code{display-time} sets @code{global-mode-string} to refer to the variable @code{display-time-string}, which holds a string containing the time and @@ -2227,7 +2227,7 @@ specifies addition of text properties. " " @group mode-line-modes - (which-func-mode ("" which-func-format "--")) + (which-function-mode ("" which-func-format "--")) (global-mode-string ("--" global-mode-string)) "-%-") @end group commit 29708cbde7afef52458950512e91a7904ed491c9 Author: Michael Albinus Date: Sun Aug 30 15:43:58 2020 +0200 Some precisions to bug handling * admin/admin.el (reminder-for-release-blocking-bugs): Add date to subject. * admin/notes/bug-triage: * admin/notes/bugtracker: Minor precisions. diff --git a/admin/admin.el b/admin/admin.el index 93dc1f48f1..22d29673fb 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -951,7 +951,8 @@ changes (in a non-trivial way). This function does not check for that." (lambda () ; posthook (goto-char (point-min)) (mail-position-on-field "subject") - (insert (format "Release-blocking bugs for Emacs %s" version)) + (insert (format "Reminder: release-blocking bugs for Emacs %s (%s)" + version (format-time-string "%F" nil "UTC0"))) (mail-text) (delete-region (point) (point-max)) (insert " diff --git a/admin/notes/bug-triage b/admin/notes/bug-triage index 87fb471c70..3d9a275c9d 100644 --- a/admin/notes/bug-triage +++ b/admin/notes/bug-triage @@ -11,7 +11,11 @@ interface via org-mode. The goal of this triage is to prune down the list of old bugs, closing the ones that are not reproducible on the current release. - 1. To start, enter debbugs mode (either debbugs-gnu, debbugs-org, or via the + 0. To start, check the most relevant bugs blocking a release by + calling debbugs-gnu-emacs-release-blocking-reports. If you want + to check this for another Emacs version but the next-to-be-released-one, + use the "C-u" prefix. + 1. After that, enter debbugs mode (either debbugs-gnu, debbugs-org, or via the web browser), and accept the default list option of bugs that have severity serious, important, or normal. 2. For each bug, we want to primarily make sure it is still @@ -20,7 +24,7 @@ the ones that are not reproducible on the current release. suggested checklist to follow for handling these bugs, along with example replies. Closing, tagging, etc., are done with debbugs control messages, which in debbugs-gnu is initiated - with a "C". + with a "C" or "E". [ ] Read the mail thread for the bug. Find out if anyone has been able to reproduce this on the current release. If someone has been able to, then your work is finished for this @@ -87,7 +91,7 @@ necessary information for others to act on. For each new bug, ask the following questions: 1. Is the bug report written in a way to be easy to reproduce (starts from - emacs -Q, etc.)? If not, ask the reporter to try and reproduce it on an + "emacs -Q", etc.)? If not, ask the reporter to try and reproduce it on an emacs without customization. 2. Is the bug report written against the latest emacs? If not, try to reproduce on the latest version, and if it can't be reproduced, ask the diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index ac54f8de02..9eb65e1f86 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -33,7 +33,7 @@ By mailing commands to control@debbugs.gnu.org. Place commands at the start of the message body, one per line. severity 123 serious|important|normal|minor|wishlist -tags 123 moreinfo|unreproducible|wontfix|patch +tags 123 moreinfo|unreproducible|wontfix|patch|notabug * More detailed information @@ -185,7 +185,7 @@ Basically, reply only to the numbered bug address (and any individual people's addresses). Do not send mail direct to bug-gnu-emacs or emacs-pretest-bug unless you are reporting a new bug. -** To close bug #123 (for example), send mail +** To close bug#123 (for example), send mail To: 123-done@debbugs.gnu.org @@ -260,7 +260,7 @@ reopen 123 *** Bugs can be tagged in various ways (eg wontfix, patch, etc). The available tags are: -patch wontfix moreinfo unreproducible fixed notabug security confirmed +patch wontfix moreinfo unreproducible fixed notabug help security confirmed easy See https://debbugs.gnu.org/Developer#tags The list of tags can be prefixed with +, - or =, meaning to add (the default), remove, or reset the tags. E.g.: @@ -290,10 +290,9 @@ limited, predefined set of normal tags are available (see above). 2) A usertag is associated with a specific user. This is normally an email address (with an "@" sign and least 4 characters after the "@"), -but on debbugs.gnu.org, the definition is less strict - anything with -5 or more alphanumeric characters will work. For personal tags, +but on debbugs.gnu.org, it can also be a package name. For personal tags, using an email address is still recommended. Please only use the -"emacs" user, or other short users, for "official" tags. +"emacs" user for "official" tags. You set usertags in the same way as tags, by talking to the control server. One difference is that you can also specify the associated user. @@ -307,7 +306,7 @@ a) In a control message: user emacs # or email@example.com usertags 1234 any-tag-you-like -This will add a usertag "any-tag-you-like" to bug 1234. The tag will +This will add a usertag "any-tag-you-like" to bug#1234. The tag will be associated with the user "emacs". If you omit the first line, the tag will be associated with your email address. commit dddc971f0e58e775578623eb3f026dc43bdda48a Author: Alan Mackenzie Date: Sat Aug 29 19:29:54 2020 +0000 CC Mode: Fix processing for when c-multiline-string-start-char is a character * lisp/progmodes/cc-mode.el (c-pps-to-string-delim) (c-multiline-string-check-final-quote): Replace c-clear-char-property by c-clear-syn-tab. (c-multiline-string-check-final-quote): Replace c-put-char-property by c-put-syn-tab. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 066bec6009..74afeecf8f 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1163,7 +1163,7 @@ Note that the style variables are always made local to the buffer." (while (progn (parse-partial-sexp (point) end nil nil st-s 'syntax-table) (unless (bobp) - (c-clear-char-property (1- (point)) 'syntax-table)) + (c-clear-syn-tab (1- (point)))) (setq st-pos (point)) (and (< (point) end) (not (eq (char-before) ?\"))))) @@ -1196,7 +1196,7 @@ Note that the style variables are always made local to the buffer." t) (t ;; At a significant " - (c-clear-char-property (1- (point)) 'syntax-table) + (c-clear-syn-tab (1- (point))) (setq pos-ll (c-literal-limits) pos-lt (c-literal-type pos-ll)) nil))) @@ -1204,7 +1204,7 @@ Note that the style variables are always made local to the buffer." (cond ((bobp)) ((eq pos-lt 'string) - (c-put-char-property (1- (point)) 'syntax-table '(15))) + (c-put-syn-tab (1- (point)) '(15))) (t nil))))) (defvar c-fl-syn-tab-region nil) commit 4a73fb966876ba8c8aefa24ee51448d2b44df1bf Author: Eli Zaretskii Date: Sat Aug 29 09:45:51 2020 +0300 Fix description of %-constructs in 'mode-line-format' * doc/lispref/modes.texi (%-Constructs): Document %@ and remove %M, which is no longer supported. (Bug#43092) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index e685391c95..e7049b4741 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2335,6 +2335,10 @@ read-only buffer. @xref{Buffer Modification}. @item %& @samp{*} if the buffer is modified, and @samp{-} otherwise. +@item %@@ +@samp{@@} if the buffer's @code{default-directory} (@pxref{File Name +Expansion}) is on a remote machine, and @samp{-} otherwise. + @item %[ An indication of the depth of recursive editing levels (not counting minibuffer levels): one @samp{[} for each editing level. @@ -2352,16 +2356,13 @@ The character @samp{%}---this is how to include a literal @samp{%} in a string in which @code{%}-constructs are allowed. @end table -The following two @code{%}-constructs are still supported, but they are -obsolete, since you can get the same results with the variables -@code{mode-name} and @code{global-mode-string}. +The following @code{%}-construct is still supported, but it is +obsolete, since you can get the same result using the variable +@code{mode-name}. @table @code @item %m The value of @code{mode-name}. - -@item %M -The value of @code{global-mode-string}. @end table @node Properties in Mode commit df5c669709c318807e5b718f65796171287bf36c Author: Michael Albinus Date: Thu Aug 27 20:15:40 2020 +0200 Adapt tramp-tests.el, don't merge with master * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name) (tramp-test05-expand-file-name-relative): Adapt tests. (tramp--test-emacs28-p): New defun. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 9e46d7f538..02f436141f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2120,16 +2120,19 @@ properly. BODY shall not contain a timeout." (expand-file-name "/method:host:/path/../file") "/method:host:/file")) (should (string-equal - (expand-file-name "/method:host:/path/.") "/method:host:/path")) + (expand-file-name "/method:host:/path/.") + (if (tramp--test-emacs28-p) "/method:host:/path/" "/method:host:/path"))) (should (string-equal (expand-file-name "/method:host:/path/..") "/method:host:/")) (should (string-equal - (expand-file-name "." "/method:host:/path/") "/method:host:/path")) + (expand-file-name "." "/method:host:/path/") + (if (tramp--test-emacs28-p) "/method:host:/path/" "/method:host:/path"))) (should (string-equal - (expand-file-name "" "/method:host:/path/") "/method:host:/path")) + (expand-file-name "" "/method:host:/path/") + (if (tramp--test-emacs28-p) "/method:host:/path/" "/method:host:/path"))) ;; Quoting local part. (should (string-equal @@ -2145,11 +2148,10 @@ properly. BODY shall not contain a timeout." ;; The following test is inspired by Bug#26911 and Bug#34834. They ;; are rather bugs in `expand-file-name', and it fails for all Emacs -;; versions. Test added for later, when they are fixed. +;; versions prior 28.1. Test added for later, when they are fixed. (ert-deftest tramp-test05-expand-file-name-relative () "Check `expand-file-name'." - ;; Mark as failed until bug has been fixed. - :expected-result :failed + :expected-result (if (>= emacs-major-version 28) :passed :failed) (skip-unless (tramp--test-enabled)) ;; These are the methods the test doesn't fail. @@ -5508,6 +5510,12 @@ Some semantics has been changed for there, w/o new functions or variables, so we check the Emacs version directly." (>= emacs-major-version 27)) +(defun tramp--test-emacs28-p () + "Check for Emacs version >= 28.1. +Some semantics has been changed for there, w/o new functions or +variables, so we check the Emacs version directly." + (>= emacs-major-version 28)) + (defun tramp--test-adb-p () "Check, whether the remote host runs Android. This requires restrictions of file name syntax." commit da4840af120a2b8ac0851fe732336eb8cc33940b Author: Michael Albinus Date: Thu Aug 27 11:46:20 2020 +0200 Adapt reminder-for-release-blocking-bugs * admin/admin.el (reminder-for-release-blocking-bugs): Require `debbugs-gnu' also in `interactive' form. * admin/release-process: Rename RELEASE-CRITICAL to RELEASE-BLOCKING. Adapt Emacs version. Describe `reminder-for-release-blocking-bugs'. diff --git a/admin/admin.el b/admin/admin.el index 728aab8b1a..93dc1f48f1 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -928,13 +928,15 @@ changes (in a non-trivial way). This function does not check for that." (defun reminder-for-release-blocking-bugs (version) "Submit a reminder message for release-blocking bugs of Emacs VERSION." (interactive - (list (completing-read - "Emacs release: " - (mapcar #'identity debbugs-gnu-emacs-blocking-reports) - nil t debbugs-gnu-emacs-current-release))) + (list (progn + (require 'debbugs-gnu) + (completing-read + "Emacs release: " + (mapcar #'identity debbugs-gnu-emacs-blocking-reports) + nil t debbugs-gnu-emacs-current-release)))) - (require 'reporter) (require 'debbugs-gnu) + (require 'reporter) (when-let ((id (alist-get version debbugs-gnu-emacs-blocking-reports nil nil #'string-equal)) diff --git a/admin/release-process b/admin/release-process index b3dfad5872..c3728b582f 100644 --- a/admin/release-process +++ b/admin/release-process @@ -41,17 +41,17 @@ released in the next release cycle. From time to time, the master branches merges bugfix commits from the "emacs-NN" branch. See admin/gitmerge.el. -* RELEASE-CRITICAL BUGS +* RELEASE-BLOCKING BUGS Emacs uses the "blocking" feature of Debbugs for bugs that need to be addressed in the next release. -Currently, bug#39200 is the tracking bug for release of 27.1 and +Currently, bug#43018 is the tracking bug for release of 27.2 and bug#39202 is the tracking bug for release 28.1. Say bug#123 needs -to be fixed for Emacs 27.1. Send a message to control@debbugs.gnu.org +to be fixed for Emacs 27.2. Send a message to control@debbugs.gnu.org that says: - block 39200 by 123 + block 43018 by 123 Change "block" to "unblock" to remove a bug from the list. Closed bugs are not listed as blockers, so you do not need to explicitly @@ -59,9 +59,17 @@ unblock one that has been closed. You may need to force an update of the tracking bug with ctrl-f5/shift-reload to see the latest version. If you use the debbugs package from GNU ELPA, you can apply the -following form to see all bugs which block a given release: +following command to see all bugs which block a given release: - (debbugs-gnu-emacs-release-blocking-reports "27.1") + (debbugs-gnu-emacs-release-blocking-reports "27.2") + +The following command from admin/admin.el sends a reminder message +about release-blocking bugs to the mailing list: + + (reminder-for-release-blocking-bugs "27.2") + +It is recommended to send this reminder message once a month. Once the +pretest has started, a reminder message once a week is appropriate. * TO BE DONE SHORTLY BEFORE RELEASE commit eb77572257bfa4e649c0c8852d2d0a58ad63eaa5 Author: Paul Eggert Date: Mon Aug 24 13:12:51 2020 -0700 Fix replace-region-contents performance bug Backport from master. * src/editfns.c (rbc_quitcounter): Remove; the quitcounter is now part of the context. (EXTRA_CONTEXT_FIELDS): Remove unused member early_abort_tests. Add jmp, quitcounter. (Freplace_buffer_contents): Use setjmp/longjmp to recover from a compareseq that runs too long. Omit unnecessary rarely_quit call. (buffer_chars_equal): Occasionally check for early abort and longjmp out if so (Bug#43016). diff --git a/src/editfns.c b/src/editfns.c index fe1feaf1e7..f660513b2a 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1913,9 +1913,6 @@ determines whether case is significant or ignored. */) #undef EQUAL #define USE_HEURISTIC -/* Counter used to rarely_quit in replace-buffer-contents. */ -static unsigned short rbc_quitcounter; - #define XVECREF_YVECREF_EQUAL(ctx, xoff, yoff) \ buffer_chars_equal ((ctx), (xoff), (yoff)) @@ -1936,7 +1933,8 @@ static unsigned short rbc_quitcounter; unsigned char *deletions; \ unsigned char *insertions; \ struct timespec time_limit; \ - unsigned int early_abort_tests; + sys_jmp_buf jmp; \ + unsigned short quitcounter; #define NOTE_DELETE(ctx, xoff) set_bit ((ctx)->deletions, (xoff)) #define NOTE_INSERT(ctx, yoff) set_bit ((ctx)->insertions, (yoff)) @@ -2065,14 +2063,17 @@ nil. */) .heuristic = true, .too_expensive = XFIXNUM (max_costs), .time_limit = time_limit, - .early_abort_tests = 0 }; memclear (ctx.deletions, del_bytes); memclear (ctx.insertions, ins_bytes); /* compareseq requires indices to be zero-based. We add BEGV back later. */ - bool early_abort = compareseq (0, size_a, 0, size_b, false, &ctx); + bool early_abort; + if (! sys_setjmp (ctx.jmp)) + early_abort = compareseq (0, size_a, 0, size_b, false, &ctx); + else + early_abort = true; if (early_abort) { @@ -2082,8 +2083,6 @@ nil. */) return Qnil; } - rbc_quitcounter = 0; - Fundo_boundary (); bool modification_hooks_inhibited = false; record_unwind_protect_excursion (); @@ -2107,8 +2106,7 @@ nil. */) walk backwards, we don’t have to keep the positions in sync. */ while (i >= 0 || j >= 0) { - /* Allow the user to quit if this gets too slow. */ - rarely_quit (++rbc_quitcounter); + rarely_quit (++ctx.quitcounter); /* Check whether there is a change (insertion or deletion) before the current position. */ @@ -2123,8 +2121,6 @@ nil. */) while (j > 0 && bit_is_set (ctx.insertions, j - 1)) --j; - rarely_quit (rbc_quitcounter++); - ptrdiff_t beg_a = min_a + i; ptrdiff_t beg_b = min_b + j; eassert (beg_a <= end_a); @@ -2144,7 +2140,6 @@ nil. */) } SAFE_FREE_UNBIND_TO (count, Qnil); - rbc_quitcounter = 0; if (modification_hooks_inhibited) { @@ -2191,12 +2186,16 @@ static bool buffer_chars_equal (struct context *ctx, ptrdiff_t pos_a, ptrdiff_t pos_b) { + if (!++ctx->quitcounter) + { + maybe_quit (); + if (compareseq_early_abort (ctx)) + sys_longjmp (ctx->jmp, 1); + } + pos_a += ctx->beg_a; pos_b += ctx->beg_b; - /* Allow the user to escape out of a slow compareseq call. */ - rarely_quit (++rbc_quitcounter); - ptrdiff_t bpos_a = ctx->a_unibyte ? pos_a : buf_charpos_to_bytepos (ctx->buffer_a, pos_a); ptrdiff_t bpos_b = commit a142bbd288a814822ba63194c690552f8c0ce425 Author: Michael Albinus Date: Tue Aug 25 15:19:11 2020 +0200 * admin/admin.el (reminder-for-release-blocking-bugs): New command. diff --git a/admin/admin.el b/admin/admin.el index 310cd54e95..728aab8b1a 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -921,6 +921,51 @@ changes (in a non-trivial way). This function does not check for that." 'help-echo "Mouse-2: visit this definition" :type 'cusver-xref))))))) + +;; Reminder message for open release-blocking bugs. This requires the +;; GNU ELPA package `debbugs'. + +(defun reminder-for-release-blocking-bugs (version) + "Submit a reminder message for release-blocking bugs of Emacs VERSION." + (interactive + (list (completing-read + "Emacs release: " + (mapcar #'identity debbugs-gnu-emacs-blocking-reports) + nil t debbugs-gnu-emacs-current-release))) + + (require 'reporter) + (require 'debbugs-gnu) + + (when-let ((id (alist-get version debbugs-gnu-emacs-blocking-reports + nil nil #'string-equal)) + (status-id (debbugs-get-status id)) + (blockedby-ids (debbugs-get-attribute (car status-id) 'blockedby)) + (blockedby-status + (apply #'debbugs-get-status (sort blockedby-ids #'<)))) + + (reporter-submit-bug-report + "" ; to-address + nil nil nil + (lambda () ; posthook + (goto-char (point-min)) + (mail-position-on-field "subject") + (insert (format "Release-blocking bugs for Emacs %s" version)) + (mail-text) + (delete-region (point) (point-max)) + (insert " +The following bugs are regarded as release-blocking for Emacs " version ". +People are encouraged to work on them with priority.\n\n") + (dolist (_ blockedby-status) + (unless (equal (debbugs-get-attribute _ 'pending) "done") + (insert (format "bug#%d %s\n" + (debbugs-get-attribute _ 'id) + (debbugs-get-attribute _ 'subject))))) + (insert " +If you use the debbugs package from GNU ELPA, you can apply the +following form to see all bugs which block a given release: + + (debbugs-gnu-emacs-release-blocking-reports \"" version "\")\n"))))) + (provide 'admin) ;;; admin.el ends here commit 4657f08b7eebf01159f7d7dba8bcb0d44d68ac48 Author: Michael Albinus Date: Tue Aug 25 15:18:57 2020 +0200 Sync with Tramp 2.4.5-pre * doc/misc/tramp.texi: Adapt Tramp and Emacs version numbers. (Remote processes): Describe `process-file-return-signal-string' and $INSIDE_EMACS. (Frequently Asked Questions): Mention Emacs 28. Describe `tramp-smb-options'. * doc/misc/trampver.texi: Change version to "2.4.5-pre". * lisp/net/tramp-adb.el (process-file-return-signal-string): Declare. (tramp-adb-handle-write-region): Flush the cache after the file has been written. (tramp-adb-handle-set-file-modes, tramp-adb-handle-set-file-times): Add optional _FLAG. (tramp-adb-handle-copy-file, tramp-adb-handle-rename-file) (tramp-adb-handle-process-file): Use `tramp-file-local-name'. (tramp-adb-get-signal-strings): New defun. (tramp-adb-handle-process-file): Use it. (tramp-adb-handle-make-process): Implement `stderr'. Use `insert-file-contents-literally'. (tramp-adb-send-command-and-check): Add optional argument EXIT-STATUS. (tramp-adb-handle-process-file): Use it. * lisp/net/tramp-archive.el (tramp-archive-file-name-handler): Increase `max-specpdl-size' temporarily. * lisp/net/tramp-cache.el (top): Use `insert-file-contents-literally'. * lisp/net/tramp-cmds.el (tramp-rename-files): Use `tramp-file-local-name'. * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Prevent crash for older Emacsen. (top): Adapt `tramp-gvfs-unload-hook'. (tramp-gvfs-handle-file-system-info): Fix error. (tramp-gvfs-handle-set-file-modes, tramp-gvfs-handle-set-file-times): Add optional _FLAG. * lisp/net/tramp-rclone.el (tramp-rclone-flush-directory-cache): Fix a problem with older Emacsen. * lisp/net/tramp-sh.el (process-file-return-signal-string): Declare. (tramp-sh-extra-args): Add "-noediting" as bash arg. (tramp-hexdump-encode, tramp-hexdump-awk-encode) (tramp-od-encode, tramp-od-awk-encode): New defconst. (tramp-awk-encode, tramp-awk-decode): Adapt. (tramp-awk-coding-test): Remove. (tramp-remote-coding-commands): Add hexdump/awk encoding. (Bug#35639) (tramp-find-inline-encoding): Adapt handling of awk, hexdump and od. (tramp-get-remote-busybox, tramp-get-remote-awk) (tramp-get-remote-hexdump, tramp-get-remote-od): New defuns. (tramp-sh-handle-make-symbolic-link): (tramp-do-copy-or-rename-file-directly) (tramp-sh-handle-process-file, tramp-set-remote-path) (tramp-find-inline-encoding, tramp-get-remote-touch): Use `tramp-file-local-name'. (tramp-do-file-attributes-with-stat): Simplify shell command. Suppress errors (interpret as nil). (tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times): Add optional _FLAG. (tramp-sh-handle-make-process): Do not visit with `insert-file-contents'. Delete tmp file only if exists. Support `stderr' as file name. Delete temporary stderr file. Flush connection properties in time. (tramp-sh-get-signal-strings): New defun. (tramp-sh-handle-process-file): Use it. (tramp-sh-handle-write-region): Copy to temp file only if FILENAME exists. (Bug#40156) (tramp-set-remote-path): Send the command in several chunks if it is too large. (Bug#42538) (tramp-open-connection-setup-interactive-shell): Move up "set +o vi +o emacs" command. (Bug#39399) (tramp-send-command-and-read): Suppress `signal-hook-function' when reading expression. (tramp-send-command-and-check): Add optional argument EXIT-STATUS. (tramp-sh-handle-process-file): Use it. (Bug#41099) * lisp/net/tramp-smb.el (tramp-smb-conf): Fix docstring. (tramp-smb-options): New defcustom. (tramp-smb-handle-copy-directory, tramp-smb-handle-file-acl) (tramp-smb-handle-set-file-acl, tramp-smb-maybe-open-connection): Use it. (tramp-smb-errors): Add "NT_STATUS_INVALID_PARAMETER". (tramp-smb-handle-make-symbolic-link) (tramp-smb-handle-process-file): Use `tramp-file-local-name'. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): (tramp-sudoedit-handle-set-file-uid-gid): Use `tramp-unquote-file-local-name'. (tramp-sudoedit-handle-make-symbolic-link): Use `tramp-file-local-name'. (tramp-sudoedit-handle-file-system-info): Fix a scoping error. (tramp-sudoedit-handle-set-file-modes): (tramp-sudoedit-handle-set-file-times): Add optional _FLAG. * lisp/net/tramp.el: Bump version to 2.4.5-pre. (tramp-file-local-name, tramp-unquote-file-local-name): New defuns. (tramp-set-connection-local-variables-for-buffer) (tramp-equal-remote, tramp-handle-make-auto-save-file-name): Use `tramp-tramp-file-p'. (tramp-parse-file): Use `insert-file-contents-literally'. (tramp-handle-file-modes, tramp-handle-file-times): Add optional _FLAG. (tramp-handle-shell-command): Fix `window-start' in output buffer. (Bug#39171) Handle `shell-command-dont-erase-buffer'. (Bug#39067) Reorganize error-buffer handling. Set `default-directory'. (Bug#39253) (tramp-handle-shell-command, tramp-handle-start-file-process): Implement asynchronous `error-buffer'. (tramp-action-process-alive): Read pending output. (tramp-read-passwd): Use `tramp-compat-temporary-file-directory'. (Bug#39389, Bug#39489) (tramp-interrupt-process): Improve command. * lisp/net/trampver.el: Change version to "2.4.5-pre". (tramp-repository-branch, tramp-repository-version): Bind `debug-on-error' to nil. * test/lisp/net/tramp-tests.el (tramp-get-remote-gid) (process-file-return-signal-string) (shell-command-dont-erase-buffer): Declare. (tramp-test10-write-region, tramp-test28-process-file) (tramp-test29-start-file-process, tramp-test30-make-process) (tramp-test31-interrupt-process, tramp-test32-shell-command): Extend test. (tramp-test10-write-region, tramp-test21-file-links): Use function symbols. (tramp-test18-file-attributes): Check `file-ownership-preserved-p' only if possible. (tramp--test-async-shell-command): New defun. (tramp--test-shell-command-to-string-asynchronously): Use it. (tramp-test32-shell-command-dont-erase-buffer): New test. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index c68b9aad52..97a26421f2 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -318,14 +318,14 @@ behind the scenes when you open a file with @value{tramp}. @uref{https://ftp.gnu.org/gnu/tramp/}. The version number of @value{tramp} can be obtained by the variable @code{tramp-version}. For released @value{tramp} versions, this is a three-number string -like ``2.4.2''. +like ``2.4.3''. A @value{tramp} release, which is packaged with Emacs, could differ slightly from the corresponding standalone release. This is because it isn't always possible to synchronize release dates between Emacs and @value{tramp}. Such version numbers have the Emacs version number -as suffix, like ``2.3.5.26.3''. This means @value{tramp} 2.3.5 as -integrated in Emacs 26.3. A complete list of @value{tramp} versions +as suffix, like ``2.4.3.27.1''. This means @value{tramp} 2.4.3 as +integrated in Emacs 27.1. A complete list of @value{tramp} versions packaged with Emacs can be retrieved by @vindex customize-package-emacs-version-alist @@ -337,12 +337,12 @@ packaged with Emacs can be retrieved by ELPA} package. Besides the standalone releases, further minor version of @value{tramp} will appear on GNU ELPA, until the next @value{tramp} release appears. These minor versions have a four-number string, like -``2.4.2.1''. +``2.4.3.1''. @value{tramp} development versions are available on Git servers. Development versions contain new and incomplete features. The development version of @value{tramp} is always the version number of -the next release, plus the suffix ``-pre'', like ``2.4.3-pre''. +the next release, plus the suffix ``-pre'', like ``2.4.4-pre''. One way to obtain @value{tramp} from Git server is to visit the Savannah project page at the following URL and then clicking on the @@ -2299,7 +2299,7 @@ string of that environment variable looks always like @example @group echo $INSIDE_EMACS -@result{} 26.2,tramp:2.3.4 +@result{} 27.1,tramp:2.4.3 @end group @end example @@ -3034,6 +3034,17 @@ host when the variable @code{default-directory} is remote: @end group @end lisp +@vindex process-file-return-signal-string +@code{process-file} shall return either the exit code of the process, +or a string describing the signal, when the process has been +interrupted. Since it cannot be determined reliably whether a remote +process has been interrupted, @code{process-file} returns always the +exit code. When the user option +@code{process-file-return-signal-string} is non-nil, +@code{process-file} regards all exit codes greater than 128 as an +indication that the process has been interrupted, and returns a +respective string. + Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based methods}) because the remote file system is mounted on the local host and @value{tramp} just accesses by changing the @@ -3041,9 +3052,17 @@ and @value{tramp} just accesses by changing the @value{tramp} starts a remote process when a command is executed in a remote file or directory buffer. As of now, these packages have been -integrated to work with @value{tramp}: @file{compile.el} (commands -like @code{compile} and @code{grep}) and @file{gud.el} (@code{gdb} or -@code{perldb}). +integrated to work with @value{tramp}: @file{shell.el}, +@file{eshell.el}, @file{compile.el} (commands like @code{compile} and +@code{grep}) and @file{gud.el} (@code{gdb} or @code{perldb}). + +@vindex INSIDE_EMACS@r{, environment variable} +@value{tramp} always modifies the @env{INSIDE_EMACS} environment +variable for remote processes. Per default, this environment variable +shows the Emacs version. @value{tramp} adds its own version string, +so it looks like @samp{27.1,tramp:2.4.3.1}. However, other packages +might also add their name to this environment variable, like +@samp{27.1,comint,tramp:2.4.3.1}. For @value{tramp} to find the command on the remote, it must be accessible through the default search path as setup by @value{tramp} @@ -3238,10 +3257,10 @@ variables. @vindex async-shell-command-width @vindex COLUMNS@r{, environment variable} If Emacs supports the variable @code{async-shell-command-width} (since -Emacs 27.1), @value{tramp} cares about its value for asynchronous -shell commands. It specifies the number of display columns for -command output. For synchronous shell commands, a similar effect can -be achieved by adding the environment variable @env{COLUMNS} to +Emacs 27), @value{tramp} cares about its value for asynchronous shell +commands. It specifies the number of display columns for command +output. For synchronous shell commands, a similar effect can be +achieved by adding the environment variable @env{COLUMNS} to @code{tramp-remote-process-environment}. @@ -3725,7 +3744,7 @@ row are possible, like @file{/path/to/dir/file.tar.gz.uu/dir/file}. @vindex tramp-archive-all-gvfs-methods An archive file name could be a remote file name, as in -@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}. +@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. Since all file operations are mapped internally to @acronym{GVFS} operations, remote file names supported by @code{tramp-gvfs} perform better, because no local copy of the file archive must be downloaded @@ -3736,7 +3755,7 @@ the similar @samp{/scp:user@@host:...}. See the constant If @code{url-handler-mode} is enabled, archives could be visited via URLs, like -@file{https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}. This +@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. This allows complex file operations like @lisp @@ -3744,8 +3763,8 @@ allows complex file operations like (progn (url-handler-mode 1) (ediff-directories - "https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1" - "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2" "")) + "https://ftp.gnu.org/gnu/tramp/tramp-2.4.2.tar.gz/tramp-2.4.2" + "https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/tramp-2.4.3" "")) @end group @end lisp @@ -3860,8 +3879,8 @@ Where is the latest @value{tramp}? @item Which systems does it work on? -The package works successfully on Emacs 24, Emacs 25, Emacs 26, and -Emacs 27. +The package works successfully on Emacs 24, Emacs 25, Emacs 26, Emacs +27, and Emacs 28. While Unix and Unix-like systems are the primary remote targets, @value{tramp} has equal success connecting to other platforms, such as @@ -4127,6 +4146,23 @@ Check @command{man ssh_config} whether these options are supported on your proxy host. +@item +@value{tramp} does not connect to Samba or MS Windows hosts running +SMB1 connection protocol. + +@vindex tramp-smb-options +Recent versions of @command{smbclient} do not support old connection +protocols by default. In order to connect to such a host, add a +respective option: + +@lisp +(add-to-list 'tramp-smb-options "client min protocol=NT1") +@end lisp + +@strong{Note} that using a deprecated connection protocol raises +security problems, you should do it only if absolutely necessary. + + @item File name completion does not work with @value{tramp} diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 478ec7037a..cc3c768fe6 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version numbers are auto-frobbed from @c tramp.el, and the bug report address is auto-frobbed from @c configure.ac. -@set trampver 2.4.3.27.1 +@set trampver 2.4.5-pre @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 24.4 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 5cfcb81708..0efe055b08 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -35,6 +35,8 @@ (require 'tramp) +(defvar process-file-return-signal-string) + ;;;###tramp-autoload (defcustom tramp-adb-program "adb" "Name of the Android Debug Bridge program." @@ -631,9 +633,6 @@ But handle the case, if the \"test\" command is not available." (format "File %s exists; overwrite anyway? " filename))))) (tramp-error v 'file-already-exists filename)) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) (let* ((curbuf (current-buffer)) (tmpfile (tramp-compat-make-temp-file filename))) (when (and append (file-exists-p filename)) @@ -650,6 +649,10 @@ But handle the case, if the \"test\" command is not available." (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + (unless (equal curbuf (current-buffer)) (tramp-error v 'file-error @@ -667,13 +670,13 @@ But handle the case, if the \"test\" command is not available." (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook)))) -(defun tramp-adb-handle-set-file-modes (filename mode) +(defun tramp-adb-handle-set-file-modes (filename mode &optional _flag) "Like `set-file-modes' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) (tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname)))) -(defun tramp-adb-handle-set-file-times (filename &optional time) +(defun tramp-adb-handle-set-file-times (filename &optional time _flag) "Like `set-file-times' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) @@ -725,8 +728,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (with-tramp-progress-reporter v 0 (format "Copying %s to %s" filename newname) (if (and t1 t2 (tramp-equal-remote filename newname)) - (let ((l1 (tramp-compat-file-local-name filename)) - (l2 (tramp-compat-file-local-name newname))) + (let ((l1 (tramp-file-local-name filename)) + (l2 (tramp-file-local-name newname))) ;; We must also flush the cache of the directory, ;; because `file-attributes' reads the values from ;; there. @@ -809,8 +812,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (and t1 t2 (tramp-equal-remote filename newname) (not (file-directory-p filename))) - (let ((l1 (tramp-compat-file-local-name filename)) - (l2 (tramp-compat-file-local-name newname))) + (let ((l1 (tramp-file-local-name filename)) + (l2 (tramp-file-local-name newname))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-properties v l1) @@ -828,6 +831,33 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) (delete-file filename))))))) +(defun tramp-adb-get-signal-strings (vec) + "Strings to return by `process-file' in case of signals." + (with-tramp-connection-property vec "signal-strings" + (let ((default-directory (tramp-make-tramp-file-name vec 'localname)) + ;; `shell-file-name' and `shell-command-switch' are needed + ;; for Emacs < 27.1, which doesn't support connection-local + ;; variables in `shell-command'. + (shell-file-name "/system/bin/sh") + (shell-command-switch "-c") + process-file-return-signal-string signals result) + (dotimes (i 128) (push (format "Signal %d" i) result)) + (setq result (reverse result) + signals (split-string + (shell-command-to-string "COLUMNS=40 kill -l") "\n" 'omit)) + (setcar result 0) + (dolist (line signals) + (when (string-match + (concat + "^[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\S-+[[:space:]]+" + "\\([[:alpha:]].*\\)$") + line) + (setcar + (nthcdr (string-to-number (match-string 1 line)) result) + (match-string 2 line)))) + result))) + (defun tramp-adb-handle-process-file (program &optional infile destination display &rest args) "Like `process-file' for Tramp files." @@ -846,7 +876,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq infile (expand-file-name infile)) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (with-parsed-tramp-file-name infile nil localname)) + (setq input (tramp-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -877,8 +907,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (with-parsed-tramp-file-name - (cadr destination) nil localname)) + (setq stderr (tramp-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) @@ -895,14 +924,13 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; it. Call it in a subshell, in order to preserve working ;; directory. (condition-case nil - (progn - (setq ret - (if (tramp-adb-send-command-and-check - v - (format "(cd %s; %s)" - (tramp-shell-quote-argument localname) command)) - ;; Set return status accordingly. - 0 1)) + (unwind-protect + (setq ret (tramp-adb-send-command-and-check + v (format + "(cd %s; %s)" + (tramp-shell-quote-argument localname) command) + t)) + (unless (natnump ret) (setq ret 1)) ;; We should add the output anyway. (when outbuf (with-current-buffer outbuf @@ -918,6 +946,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (kill-buffer (tramp-get-connection-buffer v)) (setq ret 1))) + ;; Handle signals. `process-file-return-signal-string' exists + ;; since Emacs 28.1. + (when (and (bound-and-true-p process-file-return-signal-string) + (natnump ret) (> ret 128)) + (setq ret (nth (- ret 128) (tramp-adb-get-signal-strings v)))) + ;; Provide error file. (when tmpstderr (rename-file tmpstderr (cadr destination) t)) @@ -936,6 +970,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. +;; The complete STDERR buffer is available only when the process has +;; terminated. (defun tramp-adb-handle-make-process (&rest args) "Like `make-process' for Tramp files." (when args @@ -969,17 +1005,29 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) (signal 'wrong-type-argument (list #'stringp stderr))) + (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" stderr))) (let* ((buffer (if buffer (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (if (and (stringp stderr) (tramp-tramp-file-p stderr)) + (tramp-unquote-file-local-name stderr) + (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) (args (cdr command)) (command - (format "cd %s && exec %s" + (format "cd %s && exec %s %s" (tramp-shell-quote-argument localname) + (if tmpstderr (format "2>'%s'" tmpstderr) "") (mapconcat #'tramp-shell-quote-argument (cons program args) " "))) (tramp-process-connection-type @@ -1029,6 +1077,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (ignore-errors (set-process-query-on-exit-flag p (null noquery)) (set-marker (process-mark p) (point))) + ;; We must flush them here already; otherwise + ;; `rename-file', `delete-file' or + ;; `insert-file-contents' will fail. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + ;; Copy tmpstderr file. + (when (and (stringp stderr) + (not (tramp-tramp-file-p stderr))) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (rename-file remote-tmpstderr stderr)))) ;; Read initial output. Remove the first line, ;; which is the command echo. (while @@ -1037,6 +1097,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (not (re-search-forward "[\n]" nil t))) (tramp-accept-process-output p 0)) (delete-region (point-min) (point)) + ;; Provide error buffer. This shows only + ;; initial error messages; messages arriving + ;; later on will be inserted when the process + ;; is deleted. The temporary file will exist + ;; until the process is deleted. + (when (bufferp stderr) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit)) + ;; Delete tmpstderr file. + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr)))) ;; Return process. p)))) @@ -1062,7 +1139,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (read (current-buffer))) ":" 'omit))) ;; The equivalent to `exec-directory'. - `(,(tramp-compat-file-local-name default-directory)))) + `(,(tramp-file-local-name (expand-file-name default-directory))))) (defun tramp-adb-get-device (vec) "Return full host name from VEC to be used in shell execution. @@ -1146,11 +1223,14 @@ This happens for Android >= 4.0." (while (re-search-forward "\r+$" nil t) (replace-match "" nil nil)))))) -(defun tramp-adb-send-command-and-check (vec command) +(defun tramp-adb-send-command-and-check (vec command &optional exit-status) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if -the exit status is not equal 0, and t otherwise." +the exit status is not equal 0, and t otherwise. + +Optional argument EXIT-STATUS, if non-nil, triggers the return of +the exit status." (tramp-adb-send-command vec (if command (format "%s; echo tramp_exit_status $?" command) @@ -1161,7 +1241,9 @@ the exit status is not equal 0, and t otherwise." vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") (prog1 - (zerop (read (current-buffer))) + (if exit-status + (read (current-buffer)) + (zerop (read (current-buffer)))) (let ((inhibit-read-only t)) (delete-region (match-beginning 0) (point-max)))))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index b9bf6180a5..611247ef2c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -109,7 +109,7 @@ (eval-when-compile (require 'cl-lib)) ;; Sometimes, compilation fails with "Variable binding depth exceeds -;; max-specpdl-size". +;; max-specpdl-size". Shall be fixed in Emacs 27. (eval-and-compile (let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs))) @@ -318,7 +318,10 @@ arguments to pass to the OPERATION." (let* ((filename (apply #'tramp-archive-file-name-for-operation operation args)) - (archive (tramp-archive-file-name-archive filename))) + (archive (tramp-archive-file-name-archive filename)) + ;; Sometimes, it fails with "Variable binding depth exceeds + ;; max-specpdl-size". Shall be fixed in Emacs 27. + (max-specpdl-size (* 2 max-specpdl-size))) ;; `filename' could be a quoted file name. Or the file ;; archive could be a directory, see Bug#30293. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 62e25fa1f0..0f2d7a1800 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -514,7 +514,7 @@ for all methods. Resulting data are derived from connection history." tramp-cache-read-persistent-data) (condition-case err (with-temp-buffer - (insert-file-contents tramp-persistency-file-name) + (insert-file-contents-literally tramp-persistency-file-name) (let ((list (read (current-buffer))) (tramp-verbose 0) element key item) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 9d1025b907..b4dca2321c 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -358,7 +358,7 @@ The remote connection identified by SOURCE is flushed by ;; Append local file name if none is specified. (when (string-equal (file-remote-p target) target) - (setq target (concat target (file-remote-p source 'localname)))) + (setq target (concat target (tramp-file-local-name source)))) ;; Make them directory names. (setq source (directory-file-name source) target (directory-file-name target)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 723b8cfa1e..3f25afedb9 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -41,6 +41,7 @@ (require 'shell) (require 'subr-x) +;; `temporary-file-directory' as function is introduced with Emacs 26.1. (declare-function tramp-handle-temporary-file-directory "tramp") ;; For not existing functions, obsolete functions, or functions with a diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 34a234c47f..ddb535fea6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -121,7 +121,10 @@ (autoload 'zeroconf-init "zeroconf") (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") + (or ;; Until Emacs 25, `process-attributes' could crash Emacs + ;; for some processes. Better we don't check. + (<= emacs-major-version 25) + (tramp-compat-process-running-p "gvfs-fuse-daemon") (tramp-compat-process-running-p "gvfsd-fuse")))) "Non-nil when GVFS is available.") @@ -728,6 +731,10 @@ is no information where to trace the message.") (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) (add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error) +(add-hook + 'tramp-gvfs-unload-hook + (lambda () + (remove-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error))) ;; File name primitives. @@ -1301,10 +1308,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." (size (cdr (assoc "filesystem::size" attr))) (used (cdr (assoc "filesystem::used" attr))) (free (cdr (assoc "filesystem::free" attr)))) - (when (and (stringp size) (stringp used) (stringp free)) - (list (string-to-number size) - (- (string-to-number size) (string-to-number used)) - (string-to-number free)))))) + (when (or size used free) + (list (string-to-number (or size "0")) + (string-to-number (or free "0")) + (- (string-to-number (or size "0")) + (string-to-number (or used "0")))))))) (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -1341,7 +1349,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (tramp-run-real-handler #'rename-file (list filename newname ok-if-already-exists)))) -(defun tramp-gvfs-handle-set-file-modes (filename mode) +(defun tramp-gvfs-handle-set-file-modes (filename mode &optional _flag) "Like `set-file-modes' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) @@ -1350,7 +1358,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v)) "unix::mode" (number-to-string mode)))) -(defun tramp-gvfs-handle-set-file-times (filename &optional time) +(defun tramp-gvfs-handle-set-file-times (filename &optional time _flag) "Like `set-file-times' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 9f53985013..fcbd2010a2 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -478,7 +478,18 @@ file names." (with-tramp-connection-property (tramp-get-connection-process vec) "rclone-pid" (catch 'pid - (dolist (pid (list-system-processes)) ;; "pidof rclone" ? + (dolist + (pid + ;; Until Emacs 25, `process-attributes' could + ;; crash Emacs for some processes. So we use + ;; "pidof", which might not work everywhere. + (if (<= emacs-major-version 25) + (let ((default-directory temporary-file-directory)) + (mapcar + #'string-to-number + (split-string + (shell-command-to-string "pidof rclone")))) + (list-system-processes))) (and (string-match-p (regexp-quote (format "rclone mount %s:" (tramp-file-name-host vec))) @@ -564,7 +575,7 @@ connection if a previous connection has died for some reason." ,(tramp-rclone-mount-point vec) ;; This could be nil. ,(tramp-get-method-parameter vec 'tramp-mount-args)))) - (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname))) + (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc))) (tramp-cleanup-connection vec 'keep-debug 'keep-password)) ;; Mark it as connected. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index af97328b3d..9e8a3168fd 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -36,6 +36,7 @@ (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) +(defvar process-file-return-signal-string) (defvar vc-handled-backends) (defvar vc-bzr-program) (defvar vc-git-program) @@ -537,12 +538,13 @@ based on the Tramp and Emacs versions, and should not be set here." ;;;###tramp-autoload (defcustom tramp-sh-extra-args - '(("/bash\\'" . "-norc -noprofile") + '(("/bash\\'" . "-noediting -norc -noprofile") ("/zsh\\'" . "-f +Z -V")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the -arguments. +arguments. These arguments shall disable line editing, see +`tramp-open-shell'. This variable is only used when Tramp needs to start up another shell for tilde expansion. The extra arguments should typically prevent the @@ -866,8 +868,12 @@ Escape sequence %s is replaced with name of Perl binary.") "Perl program to use for decoding a file. Escape sequence %s is replaced with name of Perl binary.") +(defconst tramp-hexdump-encode "%h -v -e '16/1 \" %%02x\" \"\\n\"'" + "`hexdump' program to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + (defconst tramp-awk-encode - "od -v -t x1 -A n | busybox awk '\\ + "%a '\\ BEGIN { b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\" b16 = \"0123456789abcdef\" @@ -897,11 +903,25 @@ END { } printf tail }'" - "Awk program to use for encoding a file. + "`awk' program to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-hexdump-awk-encode + (format "%s | %s" tramp-hexdump-encode tramp-awk-encode) + "`hexdump' / `awk' pipe to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-od-encode "%o -v -t x1 -A n" + "`od' program to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-od-awk-encode + (format "%s | %s" tramp-od-encode tramp-awk-encode) + "`od' / `awk' pipe to use for encoding a file. This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-awk-decode - "busybox awk '\\ + "%a '\\ BEGIN { b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\" } @@ -926,12 +946,6 @@ BEGIN { "Awk program to use for decoding a file. This string is passed to `format', so percent characters need to be doubled.") -(defconst tramp-awk-coding-test - "test -c /dev/zero && \ -od -v -t x1 -A n = ret 128)) + (setq ret (nth (- ret 128) (tramp-sh-get-signal-strings v)))) + ;; Provide error file. (when tmpstderr (rename-file tmpstderr (cadr destination) t)) @@ -3122,7 +3217,7 @@ the result will be a local, non-Tramp, file name." (append (tramp-get-remote-path (tramp-dissect-file-name default-directory)) ;; The equivalent to `exec-directory'. - `(,(tramp-compat-file-local-name default-directory)))) + `(,(tramp-file-local-name (expand-file-name default-directory))))) (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -3258,7 +3353,8 @@ the result will be a local, non-Tramp, file name." ;; If `append' is non-nil, we copy the file locally, and let ;; the native `write-region' implementation do the job. - (when append (copy-file filename tmpfile 'ok)) + (when (and append (file-exists-p filename)) + (copy-file filename tmpfile 'ok)) ;; We say `no-message' here because we don't want the ;; visited file modtime data to be clobbered from the temp @@ -3981,23 +4077,30 @@ whether it exists and if so, it is added to the environment variable PATH." (let ((command (format - "PATH=%s; export PATH" (string-join (tramp-get-remote-path vec) ":"))) + "PATH=%s && export PATH" (string-join (tramp-get-remote-path vec) ":"))) (pipe-buf - (or (with-tramp-connection-property vec "pipe-buf" - (tramp-send-command-and-read - vec "getconf PIPE_BUF / 2>/dev/null || echo nil" 'noerror)) - 4096)) - tmpfile) + (with-tramp-connection-property vec "pipe-buf" + (tramp-send-command-and-read + vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror))) + tmpfile chunk chunksize) (tramp-message vec 5 "Setting $PATH environment variable") (if (< (length command) pipe-buf) (tramp-send-command vec command) - ;; Use a temporary file. - (setq tmpfile - (tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec))) - (write-region command nil tmpfile) - (tramp-send-command - vec (format ". %s" (tramp-compat-file-local-name tmpfile))) - (delete-file tmpfile)))) + ;; Use a temporary file. We cannot use `write-region' because + ;; setting the remote path happens in the early connection + ;; handshake, and not all external tools are determined yet. + (setq command (concat command "\n") + tmpfile (tramp-make-tramp-temp-file vec)) + (while (not (string-empty-p command)) + (setq chunksize (min (length command) (/ pipe-buf 2)) + chunk (substring command 0 chunksize) + command (substring command chunksize)) + (tramp-send-command vec (format + "echo -n %s >>%s" + (tramp-shell-quote-argument chunk) + (tramp-shell-quote-argument tmpfile)))) + (tramp-send-command vec (format ". %s" tmpfile)) + (tramp-send-command vec (format "rm -f %s" tmpfile))))) ;; ------------------------------------------------------------ ;; -- Communication with external shell -- @@ -4069,54 +4172,54 @@ file exists and nonzero exit status otherwise." (defun tramp-open-shell (vec shell) "Open shell SHELL." + ;; Find arguments for this shell. (with-tramp-progress-reporter vec 5 (format-message "Opening remote shell `%s'" shell) - ;; Find arguments for this shell. - (let ((extra-args (tramp-get-sh-extra-args shell))) - ;; doesn't know about and thus /bin/sh will display a strange - ;; prompt. For example, if $PS1 has "${CWD}" in the value, then - ;; ksh will display the current working directory but /bin/sh - ;; will display a dollar sign. The following command line sets - ;; $PS1 to a sane value, and works under Bourne-ish shells as - ;; well as csh-like shells. We also unset the variable $ENV - ;; because that is read by some sh implementations (eg, bash - ;; when called as sh) on startup; this way, we avoid the startup - ;; file clobbering $PS1. $PROMPT_COMMAND is another way to set - ;; the prompt in /bin/bash, it must be discarded as well. - ;; $HISTFILE is set according to `tramp-histfile-override'. - ;; $TERM and $INSIDE_EMACS set here to ensure they have the - ;; correct values when the shell starts, not just processes - ;; run within the shell. (Which processes include our - ;; initial probes to ensure the remote shell is usable.) - (tramp-send-command - vec (format - (eval-when-compile - (concat - "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " - "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")) - tramp-terminal-type - emacs-version tramp-version ; INSIDE_EMACS - (or (getenv-internal "ENV" tramp-remote-process-environment) "") - (if (stringp tramp-histfile-override) - (format "HISTFILE=%s" - (tramp-shell-quote-argument tramp-histfile-override)) - (if tramp-histfile-override - "HISTFILE='' HISTFILESIZE=0 HISTSIZE=0" - "")) - (tramp-shell-quote-argument tramp-end-of-output) - shell (or extra-args "")) - t) - ;; Check proper HISTFILE setting. We give up when not working. - (when (and (stringp tramp-histfile-override) - (file-name-directory tramp-histfile-override)) - (tramp-barf-unless-okay - vec - (format - "(cd %s)" - (tramp-shell-quote-argument - (file-name-directory tramp-histfile-override))) - "`tramp-histfile-override' uses invalid file `%s'" - tramp-histfile-override))) + ;; It is useful to set the prompt in the following command because + ;; some people have a setting for $PS1 which /bin/sh doesn't know + ;; about and thus /bin/sh will display a strange prompt. For + ;; example, if $PS1 has "${CWD}" in the value, then ksh will + ;; display the current working directory but /bin/sh will display + ;; a dollar sign. The following command line sets $PS1 to a sane + ;; value, and works under Bourne-ish shells as well as csh-like + ;; shells. We also unset the variable $ENV because that is read + ;; by some sh implementations (eg, bash when called as sh) on + ;; startup; this way, we avoid the startup file clobbering $PS1. + ;; $PROMPT_COMMAND is another way to set the prompt in /bin/bash, + ;; it must be discarded as well. $HISTFILE is set according to + ;; `tramp-histfile-override'. $TERM and $INSIDE_EMACS set here to + ;; ensure they have the correct values when the shell starts, not + ;; just processes run within the shell. (Which processes include + ;; our initial probes to ensure the remote shell is usable.) + (tramp-send-command + vec (format + (eval-when-compile + (concat + "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")) + tramp-terminal-type + emacs-version tramp-version ; INSIDE_EMACS + (or (getenv-internal "ENV" tramp-remote-process-environment) "") + (if (stringp tramp-histfile-override) + (format "HISTFILE=%s" + (tramp-shell-quote-argument tramp-histfile-override)) + (if tramp-histfile-override + "HISTFILE='' HISTFILESIZE=0 HISTSIZE=0" + "")) + (tramp-shell-quote-argument tramp-end-of-output) + shell (or (tramp-get-sh-extra-args shell) "")) + t) + ;; Check proper HISTFILE setting. We give up when not working. + (when (and (stringp tramp-histfile-override) + (file-name-directory tramp-histfile-override)) + (tramp-barf-unless-okay + vec + (format + "(cd %s)" + (tramp-shell-quote-argument + (file-name-directory tramp-histfile-override))) + "`tramp-histfile-override' uses invalid file `%s'" + tramp-histfile-override)) (tramp-set-connection-property (tramp-get-connection-process vec) "remote-shell" shell))) @@ -4187,9 +4290,16 @@ process to set up. VEC specifies the connection." (let ((tramp-end-of-output tramp-initial-end-of-output) (case-fold-search t)) (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell)) + (tramp-message vec 5 "Setting up remote shell environment") + + ;; Disable line editing. + (tramp-send-command vec "set +o vi +o emacs" t) + + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-send-command vec "set -o" t)) ;; Disable echo expansion. - (tramp-message vec 5 "Setting up remote shell environment") (tramp-send-command vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) ;; Check whether the echo has really been disabled. Some @@ -4259,8 +4369,6 @@ process to set up. VEC specifies the connection." (tramp-message vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))) - (tramp-send-command vec "set +o vi +o emacs" t) - ;; Check whether the remote host suffers from buggy ;; `send-process-string'. This is known for FreeBSD (see comment ;; in `send_process', file process.c). I've tested sending 624 @@ -4383,7 +4491,7 @@ and end of region, and are expected to replace the region contents with the encoded or decoded results, respectively.") (defconst tramp-remote-coding-commands - `((b64 "base64" "base64 -d -i") + '((b64 "base64" "base64 -d -i") ;; "-i" is more robust with older base64 from GNU coreutils. ;; However, I don't know whether all base64 versions do supports ;; this option. @@ -4394,8 +4502,9 @@ with the encoded or decoded results, respectively.") (b64 "recode data..base64" "recode base64..data") (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module) (b64 tramp-perl-encode tramp-perl-decode) - ;; This is painful slow, so we put it on the end. - (b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test) + ;; These are painfully slow, so we put them on the end. + (b64 tramp-hexdump-awk-encode tramp-awk-decode) + (b64 tramp-od-awk-encode tramp-awk-decode) (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout") (uu "uuencode xxx" "uudecode -o -") (uu "uuencode xxx" "uudecode -p") @@ -4421,6 +4530,8 @@ Perl or Shell implementation for this functionality. This program will be transferred to the remote host, and it is available as shell function with the same name. A \"%t\" format specifier in the variable value denotes a temporary file. +\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the +respective `awk', `hexdump' and `od' commands. The optional TEST command can be used for further tests, whether ENCODING and DECODING are applicable.") @@ -4471,11 +4582,6 @@ Goes through the list `tramp-local-coding-commands' and vec 5 "Checking remote test command `%s'" rem-test) (unless (tramp-send-command-and-check vec rem-test t) (throw 'wont-work-remote nil))) - ;; Check if remote perl exists when necessary. - (when (and (symbolp rem-enc) - (string-match-p "perl" (symbol-name rem-enc)) - (not (tramp-get-remote-perl vec))) - (throw 'wont-work-remote nil)) ;; Check if remote encoding and decoding commands can be ;; called remotely with null input and output. This makes ;; sure there are no syntax errors and the command is really @@ -4485,10 +4591,36 @@ Goes through the list `tramp-local-coding-commands' and ;; redirecting "mimencode" output to /dev/null, then as root ;; it might change the permissions of /dev/null! (unless (stringp rem-enc) - (let ((name (symbol-name rem-enc))) + (let ((name (symbol-name rem-enc)) + (value (symbol-value rem-enc))) + ;; Check if remote perl exists when necessary. + (and (string-match-p "perl" name) + (not (tramp-get-remote-perl vec)) + (throw 'wont-work-remote nil)) + ;; Check if remote awk exists when necessary. + (and (string-match-p "\\(^\\|[^%]\\)%a" value) + (not (tramp-get-remote-awk vec)) + (throw 'wont-work-remote nil)) + ;; Check if remote hexdump exists when necessary. + (and (string-match-p "\\(^\\|[^%]\\)%h" value) + (not (tramp-get-remote-hexdump vec)) + (throw 'wont-work-remote nil)) + ;; Check if remote od exists when necessary. + (and (string-match-p "\\(^\\|[^%]\\)%o" value) + (not (tramp-get-remote-od vec)) + (throw 'wont-work-remote nil)) (while (string-match "-" name) (setq name (replace-match "_" nil t name))) - (tramp-maybe-send-script vec (symbol-value rem-enc) name) + (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value) + (setq value + (format-spec + value + (format-spec-make + ?a (tramp-get-remote-awk vec) + ?h (tramp-get-remote-hexdump vec) + ?o (tramp-get-remote-od vec))) + value (replace-regexp-in-string "%" "%%" value))) + (tramp-maybe-send-script vec value name) (setq rem-enc name))) (tramp-message vec 5 @@ -4503,6 +4635,15 @@ Goes through the list `tramp-local-coding-commands' and tmpfile) (while (string-match "-" name) (setq name (replace-match "_" nil t name))) + (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value) + (setq value + (format-spec + value + (format-spec-make + ?a (tramp-get-remote-awk vec) + ?h (tramp-get-remote-hexdump vec) + ?o (tramp-get-remote-od vec))) + value (replace-regexp-in-string "%" "%%" value))) (when (string-match-p "\\(^\\|[^%]\\)%t" value) (setq tmpfile (make-temp-name @@ -4513,7 +4654,7 @@ Goes through the list `tramp-local-coding-commands' and (format-spec value (format-spec-make - ?t (tramp-compat-file-local-name tmpfile))))) + ?t (tramp-file-local-name tmpfile))))) (tramp-maybe-send-script vec value name) (setq rem-dec name))) (tramp-message @@ -4796,7 +4937,7 @@ If there is just some editing, retry it after 5 seconds." vec 5 "Cannot timeout session, trying it again in %s seconds." 5) (run-at-time 5 nil 'tramp-timeout-session vec)) (tramp-message - vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname)) + vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc)) (tramp-cleanup-connection vec 'keep-debug))) (defun tramp-maybe-open-connection (vec) @@ -5116,7 +5257,7 @@ function waits for output unless NOOUTPUT is set." found))) (defun tramp-send-command-and-check - (vec command &optional subshell dont-suppress-err) + (vec command &optional subshell dont-suppress-err exit-status) "Run COMMAND and check its exit status. Send `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just send `echo $?'. Return t if the exit @@ -5124,7 +5265,9 @@ status is 0, and nil otherwise. If the optional argument SUBSHELL is non-nil, the command is executed in a subshell, ie surrounded by parentheses. If -DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null." +DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null. +Optional argument EXIT-STATUS, if non-nil, triggers the return of +the exit status." (tramp-send-command vec (concat (if subshell "( " "") @@ -5138,7 +5281,9 @@ DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null." vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") (prog1 - (zerop (read (current-buffer))) + (if exit-status + (read (current-buffer)) + (zerop (read (current-buffer)))) (let ((inhibit-read-only t)) (delete-region (match-beginning 0) (point-max)))))) @@ -5171,7 +5316,10 @@ raises an error." command marker (buffer-string)))))) ;; Read the expression. (condition-case nil - (prog1 (read (current-buffer)) + (prog1 + (let ((signal-hook-function + (unless noerror signal-hook-function))) + (read (current-buffer))) ;; Error handling. (when (re-search-forward "\\S-" (point-at-eol) t) (error nil))) @@ -5594,7 +5742,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." "%s -t %s %s" result (format-time-string "%Y%m%d%H%M.%S") - (tramp-compat-file-local-name tmpfile)))) + (tramp-file-local-name tmpfile)))) (delete-file tmpfile)) result))) @@ -5769,6 +5917,47 @@ ID-FORMAT valid values are `string' and `integer'." tramp-unknown-id-string) (t res))))) +(defun tramp-get-remote-busybox (vec) + "Determine remote `busybox' command." + (with-tramp-connection-property vec "busybox" + (tramp-message vec 5 "Finding a suitable `busybox' command") + (tramp-find-executable vec "busybox" (tramp-get-remote-path vec)))) + +(defun tramp-get-remote-awk (vec) + "Determine remote `awk' command." + (with-tramp-connection-property vec "awk" + (tramp-message vec 5 "Finding a suitable `awk' command") + (or (tramp-find-executable vec "awk" (tramp-get-remote-path vec)) + (let* ((busybox (tramp-get-remote-busybox vec)) + (command (format "%s %s" busybox "awk"))) + (and busybox + (tramp-send-command-and-check + vec (concat command " {} ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.4.3 +;; Version: 2.4.5-pre ;; Package-Requires: ((emacs "24.4")) ;; Package-Type: multi ;; URL: https://savannah.gnu.org/projects/tramp @@ -37,7 +37,7 @@ ;; For more detailed instructions, please see the info file. ;; ;; Notes: -;; ----- +;; ------ ;; ;; Also see the todo list at the bottom of this file. ;; @@ -46,6 +46,7 @@ ;; ;; There's a mailing list for this, as well. Its name is: ;; tramp-devel@gnu.org + ;; You can use the Web to subscribe, under the following URL: ;; https://lists.gnu.org/mailman/listinfo/tramp-devel ;; @@ -1347,6 +1348,11 @@ of `process-file', `start-file-process', or `shell-command'." (match-string (nth 4 tramp-file-name-structure) name)) (tramp-compat-file-local-name name))) +;; The localname can be quoted with "/:". Extract this. +(defun tramp-unquote-file-local-name (name) + "Return unquoted localname of NAME." + (tramp-compat-file-name-unquote (tramp-file-local-name name))) + (defun tramp-find-method (method user host) "Return the right method string to use depending on USER and HOST. This is METHOD, if non-nil. Otherwise, do a lookup in @@ -1592,7 +1598,7 @@ necessary only. This function will be used in file name completion." tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host) tramp-postfix-host-format)) - (when localname localname))) + localname)) (defun tramp-get-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC. @@ -1648,7 +1654,7 @@ version, the function does nothing." "Set connection-local variables in the current buffer. If connection-local variables are not supported by this Emacs version, the function does nothing." - (when (file-remote-p default-directory) + (when (tramp-tramp-file-p default-directory) ;; `hack-connection-local-variables-apply' exists since Emacs 26.1. (tramp-compat-funcall 'hack-connection-local-variables-apply @@ -2864,7 +2870,7 @@ User is always nil." (let ((default-directory (tramp-compat-temporary-file-directory))) (when (file-readable-p filename) (with-temp-buffer - (insert-file-contents filename) + (insert-file-contents-literally filename) (goto-char (point-min)) (cl-loop while (not (eobp)) collect (funcall function)))))) @@ -3199,7 +3205,7 @@ User is always nil." (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) -(defun tramp-handle-file-modes (filename) +(defun tramp-handle-file-modes (filename &optional _flag) "Like `file-modes' for Tramp files." ;; Starting with Emacs 25.1, `when-let' can be used. (let ((attrs (file-attributes (or (file-truename filename) filename)))) @@ -3247,7 +3253,7 @@ User is always nil." ;; lower case letters. This avoids us to create a ;; temporary file. (while (and (string-match-p - "[a-z]" (tramp-compat-file-local-name candidate)) + "[a-z]" (tramp-file-local-name candidate)) (not (file-exists-p candidate))) (setq candidate (directory-file-name @@ -3257,8 +3263,7 @@ User is always nil." ;; to Emacs 26+ like `file-name-case-insensitive-p', ;; so there is no compatibility problem calling it. (unless - (string-match-p - "[a-z]" (tramp-compat-file-local-name candidate)) + (string-match-p "[a-z]" (tramp-file-local-name candidate)) (setq tmpfile (let ((default-directory (file-name-directory filename))) @@ -3271,7 +3276,7 @@ User is always nil." (file-exists-p (concat (file-remote-p candidate) - (upcase (tramp-compat-file-local-name candidate)))) + (upcase (tramp-file-local-name candidate)))) ;; Cleanup. (when tmpfile (delete-file tmpfile))))))))))) @@ -3413,7 +3418,7 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (tramp-compat-file-local-name (directory-file-name result))))))))) + (tramp-file-local-name (directory-file-name result))))))))) (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -3645,10 +3650,16 @@ support symbolic links." (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) (command (substring command 0 asynchronous)) current-buffer-p + (output-buffer-p output-buffer) (output-buffer (cond - ((bufferp output-buffer) output-buffer) - ((stringp output-buffer) (get-buffer-create output-buffer)) + ((bufferp output-buffer) + (setq current-buffer-p (eq (current-buffer) output-buffer)) + output-buffer) + ((stringp output-buffer) + (setq current-buffer-p + (eq (buffer-name (current-buffer)) output-buffer)) + (get-buffer-create output-buffer)) (output-buffer (setq current-buffer-p t) (current-buffer)) @@ -3660,13 +3671,19 @@ support symbolic links." (cond ((bufferp error-buffer) error-buffer) ((stringp error-buffer) (get-buffer-create error-buffer)))) + (error-file + (and error-buffer + (with-parsed-tramp-file-name default-directory nil + (tramp-make-tramp-file-name + v (tramp-make-tramp-temp-file v))))) (bname (buffer-name output-buffer)) (p (get-buffer-process output-buffer)) + (dir default-directory) buffer) ;; The following code is taken from `shell-command', slightly ;; adapted. Shouldn't it be factored out? - (when p + (when (and (integerp asynchronous) p) (cond ((eq async-shell-command-buffer 'confirm-kill-process) ;; If will kill a process, query first. @@ -3698,22 +3715,25 @@ support symbolic links." (rename-uniquely)) (setq output-buffer (get-buffer-create bname))))) - (setq buffer (if (and (not asynchronous) error-buffer) - (with-parsed-tramp-file-name default-directory nil - (list output-buffer - (tramp-make-tramp-file-name - v (tramp-make-tramp-temp-file v)))) - output-buffer)) - - (if current-buffer-p - (progn - (barf-if-buffer-read-only) - (push-mark nil t)) + (unless output-buffer-p (with-current-buffer output-buffer + (setq default-directory dir))) + + (setq buffer (if error-file (list output-buffer error-file) output-buffer)) + + (with-current-buffer output-buffer + (when current-buffer-p + (barf-if-buffer-read-only) + (push-mark nil t)) + ;; `shell-command-save-pos-or-erase' has been introduced with + ;; Emacs 27.1. + (if (fboundp 'shell-command-save-pos-or-erase) + (tramp-compat-funcall + 'shell-command-save-pos-or-erase current-buffer-p) (setq buffer-read-only nil) (erase-buffer))) - (if (and (not current-buffer-p) (integerp asynchronous)) + (if (integerp asynchronous) (let ((tramp-remote-process-environment ;; `async-shell-command-width' has been introduced with ;; Emacs 27.1. @@ -3726,42 +3746,68 @@ support symbolic links." ;; Run the process. (setq p (start-file-process-shell-command (buffer-name output-buffer) buffer command)) - ;; Display output. - (with-current-buffer output-buffer - (display-buffer output-buffer '(nil (allow-no-window . t))) - (setq mode-line-process '(":%s")) - (shell-mode) - (set-process-sentinel p #'shell-command-sentinel) - (set-process-filter p #'comint-output-filter)))) + ;; Insert error messages if they were separated. + (when error-file + (with-current-buffer error-buffer + (insert-file-contents-literally error-file))) + (if (process-live-p p) + ;; Display output. + (with-current-buffer output-buffer + (setq mode-line-process '(":%s")) + (unless (eq major-mode 'shell-mode) + (shell-mode)) + (set-process-filter p #'comint-output-filter) + (set-process-sentinel p #'shell-command-sentinel) + (when error-file + (add-function + :after (process-sentinel p) + (lambda (_proc _string) + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file)))) + (display-buffer output-buffer '(nil (allow-no-window . t)))) + + (when error-file + (delete-file error-file))))) (prog1 ;; Run the process. (process-file-shell-command command nil buffer nil) ;; Insert error messages if they were separated. - (when (listp buffer) + (when error-file (with-current-buffer error-buffer - (insert-file-contents (cadr buffer))) - (delete-file (cadr buffer))) + (insert-file-contents-literally error-file)) + (delete-file error-file)) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, ;; even though the command loop would deactivate the mark ;; because we inserted text. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) - (current-buffer)))) + (progn + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) + (current-buffer)))) + ;; `shell-command-set-point-after-cmd' has been + ;; introduced with Emacs 27.1. + (if (fboundp 'shell-command-set-point-after-cmd) + (tramp-compat-funcall + 'shell-command-set-point-after-cmd))) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) (display-message-or-buffer output-buffer))))))) (defun tramp-handle-start-file-process (name buffer program &rest args) - "Like `start-file-process' for Tramp files." + "Like `start-file-process' for Tramp files. +BUFFER might be a list, in this case STDERR is separated." ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only. (tramp-file-name-handler 'make-process :name name - :buffer buffer + :buffer (if (consp buffer) (car buffer) buffer) :command (and program (cons program args)) + ;; `shell-command' adds an errfile to `buffer'. + :stderr (when (consp buffer) (cadr buffer)) :noquery nil :file-handler t)) @@ -4044,6 +4090,8 @@ The terminal type can be configured with `tramp-terminal-type'." (defun tramp-action-process-alive (proc _vec) "Check, whether a process has finished." (unless (process-live-p proc) + ;; There might be pending output. + (while (tramp-accept-process-output proc 0)) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) @@ -4362,7 +4410,7 @@ would yield t. On the other hand, the following check results in nil: (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\") If both files are local, the function returns t." - (or (and (null (file-remote-p file1)) (null (file-remote-p file2))) + (or (and (null (tramp-tramp-file-p file1)) (null (tramp-tramp-file-p file2))) (and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2) (string-equal (file-remote-p file1) (file-remote-p file2))))) @@ -4632,7 +4680,7 @@ This handles also chrooted environments, which are not regarded as local." (tramp-make-tramp-file-name vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) (or (and (file-directory-p dir) (file-writable-p dir) - (tramp-compat-file-local-name dir)) + (tramp-file-local-name dir)) (tramp-error vec 'file-error "Directory %s not accessible" dir)) dir))) @@ -4655,7 +4703,7 @@ Return the local name of the temporary file." (set-file-modes result #o0700))) ;; Return the local part. - (with-parsed-tramp-file-name result nil localname))) + (tramp-file-local-name result))) (defun tramp-delete-temp-file-function () "Remove temporary files related to current buffer." @@ -4682,7 +4730,7 @@ this file, if that variable is non-nil." (let ((system-type (if (and (stringp tramp-auto-save-directory) - (file-remote-p tramp-auto-save-directory)) + (tramp-tramp-file-p tramp-auto-save-directory)) 'not-windows system-type)) (auto-save-file-name-transforms @@ -4824,7 +4872,12 @@ verbosity of 6." "Read a password from user (compat function). Consults the auth-source package. Invokes `password-read' if available, `read-passwd' else." - (let* ((case-fold-search t) + (let* (;; If `auth-sources' contains "~/.authinfo.gpg", and + ;; `exec-path' contains a relative file name like ".", it + ;; could happen that the "gpg" command is not found. So we + ;; adapt `default-directory'. (Bug#39389, Bug#39489) + (default-directory (tramp-compat-temporary-file-directory)) + (case-fold-search t) (key (tramp-make-tramp-file-name ;; In tramp-sh.el, we must use "password-vector" due to ;; multi-hop. @@ -4976,10 +5029,12 @@ name of a process or buffer, or nil to default to the current buffer." (tramp-error proc 'error "Process %s is not active" proc) (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) ;; This is for tramp-sh.el. Other backends do not support this (yet). + ;; Not all "kill" implementations support process groups by + ;; negative pid, so we try both variants. (tramp-compat-funcall 'tramp-send-command (process-get proc 'vector) - (format "kill -2 -%d" pid)) + (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid)) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. (while (tramp-accept-process-output proc 0)) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index dacdd44102..4aed8abd9b 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -39,7 +39,7 @@ (defvar inhibit-message) ;;;###tramp-autoload -(defconst tramp-version "2.4.3.27.1" +(defconst tramp-version "2.4.5-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -51,6 +51,7 @@ ;; Suppress message from `emacs-repository-get-branch'. We must ;; also handle out-of-tree builds. (let ((inhibit-message t) + (debug-on-error nil) (dir (or (locate-dominating-file (locate-library "tramp") ".git") source-directory))) ;; `emacs-repository-get-branch' has been introduced with Emacs 27.1. @@ -64,6 +65,7 @@ ;; Suppress message from `emacs-repository-get-version'. We must ;; also handle out-of-tree builds. (let ((inhibit-message t) + (debug-on-error nil) (dir (or (locate-dominating-file (locate-library "tramp") ".git") source-directory))) (and (stringp dir) (file-directory-p dir) @@ -73,7 +75,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-lessp emacs-version "24.4")) "ok" - (format "Tramp 2.4.3.27.1 is not fit for %s" + (format "Tramp 2.4.5-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 544bdb5c05..9e46d7f538 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -50,6 +50,7 @@ (require 'vc-hg) (declare-function tramp-find-executable "tramp-sh") +(declare-function tramp-get-remote-gid "tramp-sh") (declare-function tramp-get-remote-path "tramp-sh") (declare-function tramp-get-remote-perl "tramp-sh") (declare-function tramp-get-remote-stat "tramp-sh") @@ -74,6 +75,9 @@ (defvar connection-local-profile-alist) ;; Needed for Emacs 26. (defvar async-shell-command-width) +;; Needed for Emacs 27. +(defvar process-file-return-signal-string) +(defvar shell-command-dont-erase-buffer) ;; Beautify batch mode. (when noninteractive @@ -2357,7 +2361,14 @@ This checks also `file-name-as-directory', `file-name-directory', (write-region nil nil tmp-name 3)) (with-temp-buffer (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foobaz")))) + (should (string-equal (buffer-string) "foobaz"))) + (delete-file tmp-name) + (with-temp-buffer + (insert "foo") + (write-region nil nil tmp-name 'append)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo")))) ;; Write string. (write-region "foo" nil tmp-name) @@ -2393,14 +2404,14 @@ This checks also `file-name-as-directory', `file-name-directory', tramp--test-messages)))))))) ;; Do not overwrite if excluded. - (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)) + (cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t)) ;; Ange-FTP. ((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) ;; `mustbenew' is passed to Tramp since Emacs 26.1. (when (tramp--test-emacs26-p) (should-error - (cl-letf (((symbol-function 'y-or-n-p) 'ignore) + (cl-letf (((symbol-function #'y-or-n-p) #'ignore) ;; Ange-FTP. ((symbol-function 'yes-or-no-p) 'ignore)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) @@ -3115,22 +3126,38 @@ This tests also `access-file', `file-readable-p', (file-remote-p tmp-name1) (replace-regexp-in-string "/" "//" (file-remote-p tmp-name1 'localname)))) + ;; `file-ownership-preserved-p' is implemented only in tramp-sh.el. + (test-file-ownership-preserved-p (tramp--test-sh-p)) attr) (unwind-protect (progn + ;; A sticky bit could damage the `file-ownership-preserved-p' test. + (when + (and test-file-ownership-preserved-p + (zerop (logand + #o1000 + (file-modes tramp-test-temporary-file-directory)))) + (write-region "foo" nil tmp-name1) + (setq test-file-ownership-preserved-p + (= (tramp-compat-file-attribute-group-id + (file-attributes tmp-name1)) + (tramp-get-remote-gid + (tramp-dissect-file-name tmp-name1) 'integer))) + (delete-file tmp-name1)) + (should-error (access-file tmp-name1 "error") :type tramp-file-missing) ;; `file-ownership-preserved-p' should return t for - ;; non-existing files. It is implemented only in tramp-sh.el. - (when (tramp--test-sh-p) + ;; non-existing files. + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should (file-regular-p tmp-name1)) (should-not (access-file tmp-name1 "error")) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) ;; We do not test inodes and device numbers. @@ -3160,16 +3187,16 @@ This tests also `access-file', `file-readable-p', (should (stringp (tramp-compat-file-attribute-group-id attr))) (tramp--test-ignore-make-symbolic-link-error - (should-error - (access-file tmp-name2 "error") - :type tramp-file-missing) - (when (tramp--test-sh-p) + (should-error + (access-file tmp-name2 "error") + :type tramp-file-missing) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name2 'group))) (make-symbolic-link tmp-name1 tmp-name2) (should (file-exists-p tmp-name2)) (should (file-symlink-p tmp-name2)) (should-not (access-file tmp-name2 "error")) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name2 'group))) (setq attr (file-attributes tmp-name2)) (should @@ -3200,7 +3227,7 @@ This tests also `access-file', `file-readable-p', (tramp-dissect-file-name tmp-name3)))) (delete-file tmp-name2)) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (delete-file tmp-name1) (make-directory tmp-name1) @@ -3208,7 +3235,7 @@ This tests also `access-file', `file-readable-p', (should (file-readable-p tmp-name1)) (should-not (file-regular-p tmp-name1)) (should-not (access-file tmp-name1 "")) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (setq attr (file-attributes tmp-name1)) (should (eq (tramp-compat-file-attribute-type attr) t))) @@ -3420,11 +3447,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :type 'file-already-exists)) (when (tramp--test-expensive-test) ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) (should-error (make-symbolic-link tmp-name1 tmp-name2 0) :type 'file-already-exists))) - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t))) (make-symbolic-link tmp-name1 tmp-name2 0) (should (string-equal @@ -3496,11 +3523,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (add-name-to-file tmp-name1 tmp-name2) :type 'file-already-exists) ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) (should-error (add-name-to-file tmp-name1 tmp-name2 0) :type 'file-already-exists)) - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t))) (add-name-to-file tmp-name1 tmp-name2 0) (should (file-regular-p tmp-name2))) (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) @@ -4126,6 +4153,28 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (zerop (process-file "true"))) (should-not (zerop (process-file "false"))) (should-not (zerop (process-file "binary-does-not-exist"))) + ;; Return exit code. + (should (= 42 (process-file + (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") + nil nil nil "-c" "exit 42"))) + ;; Return exit code in case the process is interrupted, + ;; and there's no indication for a signal describing string. + (let (process-file-return-signal-string) + (should + (= (+ 128 2) + (process-file + (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") + nil nil nil "-c" "kill -2 $$")))) + ;; Return string in case the process is interrupted and + ;; there's an indication for a signal describing string. + (let ((process-file-return-signal-string t)) + (should + (string-match + "Interrupt\\|Signal 2" + (process-file + (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") + nil nil nil "-c" "kill -2 $$")))) + (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) @@ -4181,7 +4230,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (setq proc (start-file-process "test1" (current-buffer) "cat")) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4224,7 +4273,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (set-process-filter proc (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4248,7 +4297,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) - (tmp-name (tramp--test-make-temp-name nil quoted)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name 'local quoted)) kill-buffer-query-functions proc) (with-no-warnings (should-not (make-process))) @@ -4262,7 +4312,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4278,13 +4328,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Simple process using a file. (unwind-protect (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) (setq proc (with-no-warnings (make-process :name "test2" :buffer (current-buffer) - :command `("cat" ,(file-name-nondirectory tmp-name)) + :command `("cat" ,(file-name-nondirectory tmp-name1)) :file-handler t))) (should (processp proc)) ;; Read output. @@ -4296,7 +4346,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc) - (delete-file tmp-name))) + (delete-file tmp-name1))) ;; Process filter. (unwind-protect @@ -4311,7 +4361,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4337,7 +4387,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) (delete-process proc) ;; Read output. @@ -4345,36 +4395,67 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (accept-process-output proc 0 nil t))) ;; We cannot use `string-equal', because tramp-adb.el ;; echoes also the sent string. And a remote macOS sends - ;; a slightly modified string. - (should (string-match "killed.*\n\\'" (buffer-string)))) + ;; a slightly modified string. On MS Windows, + ;; `delete-process' sends an unknown signal. + (should + (string-match + (if (eq system-type 'windows-nt) + "unknown signal\n\\'" "killed.*\n\\'") + (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Process with stderr. tramp-adb.el doesn't support it (yet). - (unless (tramp--test-adb-p) - (let ((stderr (generate-new-buffer "*stderr*"))) - (unwind-protect + ;; Process with stderr buffer. + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test5" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr stderr + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (delete-process proc) + (with-current-buffer stderr + (should + (string-match + "cat:.* No such file or directory" (buffer-string))))) + + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (kill-buffer stderr)))) + + ;; Process with stderr file. + (dolist (tmpfile `(,tmp-name1 ,tmp-name2)) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test6" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr tmpfile + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc nil nil t))) + (delete-process proc) (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name "test5" :buffer (current-buffer) - :command '("cat" "/") - :stderr stderr - :file-handler t))) - (should (processp proc)) - ;; Read stderr. - (with-current-buffer stderr - (with-timeout (10 (tramp--test-timeout-handler)) - (while (= (point-min) (point-max)) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match "^cat:.* Is a directory" (buffer-string))))) + (insert-file-contents tmpfile) + (should + (string-match + "cat:.* No such file or directory" (buffer-string))))) - ;; Cleanup. - (ignore-errors (delete-process proc)) - (ignore-errors (kill-buffer stderr)))))))) + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (delete-file tmpfile))))))) (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." @@ -4388,10 +4469,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; order to establish the connection prior running an asynchronous ;; process. (let ((default-directory (file-truename tramp-test-temporary-file-directory)) + (delete-exited-processes t) kill-buffer-query-functions proc) (unwind-protect (with-temp-buffer - (setq proc (start-file-process "test" (current-buffer) "sleep" "10")) + (setq proc (start-file-process-shell-command + "test" (current-buffer) + "trap 'echo boom; exit 1' 2; sleep 100")) (should (processp proc)) (should (process-live-p proc)) (should (equal (process-status proc) 'run)) @@ -4399,7 +4483,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (interrupt-process proc)) ;; Let the process accept the interrupt. (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc nil nil 0))) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) (should-not (process-live-p proc)) ;; An interrupted process cannot be interrupted, again. (should-error @@ -4409,14 +4494,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))))) +(defun tramp--test-async-shell-command + (command output-buffer &optional error-buffer input) + "Like `async-shell-command', reading the output. +INPUT, if non-nil, is a string sent to the process." + (async-shell-command command output-buffer error-buffer) + (let ((proc (get-buffer-process output-buffer)) + (delete-exited-processes t)) + (when (stringp input) + (process-send-string proc input)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while (or (accept-process-output proc nil nil t) (process-live-p proc)))) + (accept-process-output proc nil nil t))) + (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer - (async-shell-command command (current-buffer)) - (with-timeout - ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) + (tramp--test-async-shell-command command (current-buffer)) (buffer-substring-no-properties (point-min) (point-max)))) (ert-deftest tramp-test32-shell-command () @@ -4435,111 +4530,294 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (inhibit-message t) kill-buffer-query-functions) - ;; Test ordinary `shell-command'. - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) - (current-buffer)) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) - (buffer-string)))) + (dolist (this-shell-command + '(;; Synchronously. + shell-command + ;; Asynchronously. + tramp--test-async-shell-command)) - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - ;; Test `shell-command' with error buffer. - (let ((stderr (generate-new-buffer "*stderr*"))) + ;; Test ordinary `{async-}shell-command'. (unwind-protect (with-temp-buffer - (shell-command "error" (current-buffer) stderr) - (should (= (point-min) (point-max))) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (funcall + this-shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) (should - (string-match - "error:.+not found" - (with-current-buffer stderr (buffer-string))))) + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) ;; Cleanup. - (ignore-errors (kill-buffer stderr)))) + (ignore-errors (delete-file tmp-name))) - ;; Test ordinary `async-shell-command'. + ;; Test `{async-}shell-command' with error buffer. + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (funcall + this-shell-command + "echo foo >&2; echo bar" (current-buffer) stderr) + (should (string-equal "bar\n" (buffer-string))) + ;; Check stderr. + (with-current-buffer stderr + (should (string-equal "foo\n" (buffer-string))))) + + ;; Cleanup. + (ignore-errors (kill-buffer stderr))))) + + ;; Test sending string to `async-shell-command'. (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) - (async-shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) - (current-buffer)) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) + (tramp--test-async-shell-command + "read line; ls $line" (current-buffer) nil + ;; String to be sent. + (format "%s\n" (file-name-nondirectory tmp-name))) (should (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) + ;; tramp-adb.el echoes, so we must add the string. + (if (tramp--test-adb-p) + (format + "%s\n%s\n" + (file-name-nondirectory tmp-name) + (file-name-nondirectory tmp-name)) + (format "%s\n" (file-name-nondirectory tmp-name))) (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (ignore-errors (delete-file tmp-name))))) - ;; Test sending string to `async-shell-command'. + ;; Test `async-shell-command-width'. It exists since Emacs 26.1, + ;; but seems to work since Emacs 27.1 only. + (when (and (tramp--test-sh-p) (tramp--test-emacs27-p)) + (let* ((async-shell-command-width 1024) + (default-directory tramp-test-temporary-file-directory) + (cols (ignore-errors + (read (tramp--test-shell-command-to-string-asynchronously + "tput cols"))))) + (when (natnump cols) + (should (= cols async-shell-command-width)))))) + +;; This test is inspired by Bug#39067. +(ert-deftest tramp-test32-shell-command-dont-erase-buffer () + "Check `shell-command-dont-erase-buffer'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. + (skip-unless (tramp--test-emacs27-p)) + + ;; We check both the local and remote case, in order to guarantee + ;; that they behave similar. + (dolist (default-directory + `(,temporary-file-directory ,tramp-test-temporary-file-directory)) + (let ((buffer (generate-new-buffer "foo")) + ;; Suppress nasty messages. + (inhibit-message t) + point kill-buffer-query-functions) (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command "read line; ls $line" (current-buffer)) - (process-send-string - (get-buffer-process (current-buffer)) - (format "%s\n" (file-name-nondirectory tmp-name))) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. - (should - (string-match - (format "\\`%s" (regexp-quote (file-name-nondirectory tmp-name))) - (buffer-string)))) + (progn + ;; Don't erase if buffer is the current one. Point is not moved. + (let (shell-command-dont-erase-buffer) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + (should (= point (point))) + (should-not (= (point) (point-max))))) + + ;; Erase if the buffer is not current one. Point is not moved. + (let (shell-command-dont-erase-buffer) + (with-current-buffer buffer + (erase-buffer) + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (with-temp-buffer + (shell-command "echo baz" buffer)) + (should (string-equal "baz\n" (buffer-string))) + (should (= point (point))) + (should-not (= (point) (point-max))))) + + ;; Erase if buffer is the current one, but + ;; `shell-command-dont-erase-buffer' is set to `erase'. + ;; There is no point to check point. + (let ((shell-command-dont-erase-buffer 'erase)) + (with-temp-buffer + (insert "bar") + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "baz\n" (buffer-string))) + ;; In the local case, point is not moved after the + ;; inserted text. + (should (= (point) + (if (file-remote-p default-directory) + (point-max) (point-min)))))) + + ;; Don't erase if the buffer is the current one and + ;; `shell-command-dont-erase-buffer' is set to + ;; `beg-last-out'. Check point. + (let ((shell-command-dont-erase-buffer 'beg-last-out)) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + ;; There is still an error in Tramp. + (unless (file-remote-p default-directory) + (should (= point (point))) + (should-not (= (point) (point-max)))))) + + ;; Don't erase if the buffer is not the current one and + ;; `shell-command-dont-erase-buffer' is set to + ;; `beg-last-out'. Check point. + (let ((shell-command-dont-erase-buffer 'beg-last-out)) + (with-current-buffer buffer + (erase-buffer) + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (with-temp-buffer + (shell-command "echo baz" buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + ;; There is still an error in Tramp. + (unless (file-remote-p default-directory) + (should (= point (point))) + (should-not (= (point) (point-max)))))) + + ;; Don't erase if the buffer is the current one and + ;; `shell-command-dont-erase-buffer' is set to + ;; `end-last-out'. Check point. + (let ((shell-command-dont-erase-buffer 'end-last-out)) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + ;; This does not work as expected in the local case. + ;; Therefore, we negate the test for the time being. + (should-not + (funcall (if (file-remote-p default-directory) #'identity #'not) + (= point (point)))) + (should + (funcall (if (file-remote-p default-directory) #'identity #'not) + (= (point) (point-max)))))) + + ;; Don't erase if the buffer is not the current one and + ;; `shell-command-dont-erase-buffer' is set to + ;; `end-last-out'. Check point. + (let ((shell-command-dont-erase-buffer 'end-last-out)) + (with-current-buffer buffer + (erase-buffer) + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (with-temp-buffer + (shell-command "echo baz" buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + ;; There is still an error in Tramp. + (unless (file-remote-p default-directory) + (should-not (= point (point))) + (should (= (point) (point-max)))))) + + ;; Don't erase if the buffer is the current one and + ;; `shell-command-dont-erase-buffer' is set to + ;; `save-point'. Check point. + (let ((shell-command-dont-erase-buffer 'save-point)) + (with-temp-buffer + (insert "bar") + (goto-char (1- (point-max))) + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (1- (point-max)))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "babaz\nr" (buffer-string))) + ;; There is still an error in Tramp. + (unless (file-remote-p default-directory) + (should (= point (point))) + (should-not (= (point) (point-max)))))) + + ;; Don't erase if the buffer is not the current one and + ;; `shell-command-dont-erase-buffer' is set to + ;; `save-point'. Check point. + (let ((shell-command-dont-erase-buffer 'save-point)) + (with-current-buffer buffer + (erase-buffer) + (insert "bar") + (goto-char (1- (point-max))) + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (1- (point-max)))) + (with-temp-buffer + (shell-command "echo baz" buffer)) + ;; This does not work as expected. Therefore, we + ;; use the "wrong" string. + (should (string-equal "barbaz\n" (buffer-string))) + ;; There is still an error in Tramp. + (unless (file-remote-p default-directory) + (should (= point (point))) + (should-not (= (point) (point-max)))))) + + ;; Don't erase if the buffer is the current one and + ;; `shell-command-dont-erase-buffer' is set to a random + ;; value. Check point. + (let ((shell-command-dont-erase-buffer 'random)) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + ;; This does not work as expected in the local case. + ;; Therefore, we negate the test for the time being. + (should-not + (funcall (if (file-remote-p default-directory) #'identity #'not) + (= point (point)))) + (should + (funcall (if (file-remote-p default-directory) #'identity #'not) + (= (point) (point-max)))))) + + ;; Don't erase if the buffer is not the current one and + ;; `shell-command-dont-erase-buffer' is set to a random + ;; value. Check point. + (let ((shell-command-dont-erase-buffer 'random)) + (with-current-buffer buffer + (erase-buffer) + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (with-temp-buffer + (shell-command "echo baz" buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + ;; There is still an error in Tramp. + (unless (file-remote-p default-directory) + (should-not (= point (point))) + (should (= (point) (point-max))))))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - ;; Test `async-shell-command-width'. Since Emacs 27.1. - (when (ignore-errors - (and (boundp 'async-shell-command-width) - (zerop (call-process "tput" nil nil nil "cols")) - (zerop (process-file "tput" nil nil nil "cols")))) - (let (async-shell-command-width) - (should - (string-equal - (format "%s\n" (car (process-lines "tput" "cols"))) - (tramp--test-shell-command-to-string-asynchronously - "tput cols"))) - (setq async-shell-command-width 1024) - (should - (string-equal - "1024\n" - (tramp--test-shell-command-to-string-asynchronously - "tput cols")))))))) + (ignore-errors (kill-buffer buffer)))))) ;; This test is inspired by Bug#23952. (ert-deftest tramp-test33-environment-variables () @@ -5753,7 +6031,7 @@ Use the `ls' command." ;; Since Emacs 27.1. (skip-unless (fboundp 'file-system-info)) - ;; `file-system-info' exists since Emacs 27. We don't want to see + ;; `file-system-info' exists since Emacs 27.1. We don't want to see ;; compiler warnings for older Emacsen. (let ((fsi (with-no-warnings (file-system-info tramp-test-temporary-file-directory)))) @@ -6191,8 +6469,6 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' ;; do not work properly for `nextcloud'. -;; * Fix `tramp-test29-start-file-process' and -;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). ;; * Implement `tramp-test31-interrupt-process' for `adb'. ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote ;; file name operation cannot run in the timer. Remove `:unstable' tag?