From: Michael Albinus Date: Sat, 4 Mar 2023 09:17:25 +0000 (+0100) Subject: Merge branch 'master' into feature/tramp-thread-safe X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b14cd8380ed412a8bc728d334d9f7b1b4da23753;p=emacs.git Merge branch 'master' into feature/tramp-thread-safe --- b14cd8380ed412a8bc728d334d9f7b1b4da23753 diff --cc doc/emacs/files.texi index 75082e02533,a9ae4696a06..c8c07e2d13f --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@@ -226,36 -238,15 +238,45 @@@ File Names}, for information on how to actually contains wildcard characters. You can disable the wildcard feature by customizing @code{find-file-wildcards}. + @vindex query-about-changed-file + If you're asking to visit a file that's already visited in a buffer, + but the file has changed externally, Emacs normally asks you whether + you want to re-read the file from disk. But if you set + @code{query-about-changed-file} to @code{nil}, Emacs won't query you, + but will instead just display the buffer's contents before the + changes, and show an echo-area message telling you how to revert the + buffer from the file. + +@cindex visiting files asynchronously +@vindex execute-file-commands-asynchronously + Sometimes, it is handy to visit a file asynchronously. This means, +while loading the file into its buffer Emacs keeps responsive, and you +can continue to edit other files, or call commands. This is +controlled by the user option @code{execute-file-commands-asynchronously}. +If this option is @code{nil} (the default), visiting a file is a +synchronous operation. If the value is a regexp, this allows +asynchronously visiting files whose name matches the regexp, otherwise +synchronously. If the value is @code{t}, visiting files is +unconditionally asynchronous. + +If you want to visit all remote files asynchronously, you should set + +@example +@group +(customize-set-variable + 'execute-file-commands-asynchronously tramp-file-name-regexp + "Visit remote files asynchronously") +@end group +@end example + +@kindex C-x & + If you type @kbd{C-x &} (@code{universal-async-argument}) prior the +file visiting command, the meaning of +@code{execute-file-commands-asynchronously} will be reverted. If this +user option is @code{nil}, visiting a file is performed +asynchronously. Contrary, if this user option is non-@code{nil}, +visiting a file is performed synchronously. + @kindex C-x C-v @findex find-alternate-file If you visit the wrong file unintentionally by typing its name diff --cc etc/NEWS index fd1ed3ec9db,116b60d8b11..bdd617476ec --- a/etc/NEWS +++ b/etc/NEWS @@@ -22,298 -22,359 +22,379 @@@ When you add a new item, use the approp applies, and please also update docstrings as needed. - * Installation Changes in Emacs 28.1 - - ** Cairo graphics library is now used by default if found. - '--with-cairo' is now the default, if the appropriate development files - are found by 'configure'. Note that building with Cairo means using - Pango instead of libXFT for font support. Since Pango 1.44 has - removed support for bitmapped fonts, this may require you to adjust - your font settings. - - Note also that 'FontBackend' settings in ".Xdefaults" or - ".Xresources", or 'font-backend' frame parameter settings in your init - files, may need to be adjusted, as 'xft' is no longer a valid backend - when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz - text shaping support, and 'ftcr' otherwise. You can determine this by - checking 'system-configuration-features'. The 'ftcr' backend will - still be available when HarfBuzz is supported, but will not be used by - default. We strongly recommend building with HarBuzz support. 'x' is - still a valid backend. - - --- - ** 'configure' now warns about building with libXft support. - libXft is unmaintained, and causes a number of problems with modern - fonts including but not limited to crashes; support for it may be - removed in a future version of Emacs. Please consider using - Cairo + HarfBuzz instead. - - --- - ** 'configure' now warns about not using HarfBuzz if using Cairo. - We want to encourage people to use the most modern font features - available, and this is the Cairo graphics library + HarfBuzz for font - shaping, so 'configure' now recommends that combination. - - --- - ** The ftx font backend driver has been removed. - It was declared obsolete in Emacs 27.1. + * Installation Changes in Emacs 30.1 - * Startup Changes in Emacs 28.1 + * Startup Changes in Emacs 30.1 - * Changes in Emacs 28.1 + * Changes in Emacs 30.1 - ** Support for '(box . SIZE)' 'cursor-type'. - By default, 'box' cursor always has a filled box shape. But if you - specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow - box if the point is on an image larger than 'SIZE' pixels in any - dimension. + ** X selection requests are now handled much faster and asynchronously. + This means it should be less necessary to disable the likes of + 'select-active-regions' when Emacs is running over a slow network + connection. - - * Editing Changes in Emacs 28.1 + ** Emacs now updates invisible frames that are made visible by a compositor. + If an invisible or an iconified frame is shown to the user by the + compositing manager, Emacs will now redisplay such a frame even though + 'frame-visible-p' returns nil or 'icon' for it. This can happen, for + example, as part of preview for iconified frames. +++ - ** New command 'undo-redo'. - It undoes previous undo commands, but doesn't record itself as an - undoable command. + ** 'write-region-inhibit-fsync' now defaults to t in interactive mode, + as it has in batch mode since Emacs 24. +++ - ** 'read-number' now has its own history variable. - Additionally, the function now accepts a HIST argument which can be - used to specify a custom history variable. + ** New user option 'remote-file-name-inhibit-delete-by-moving-to-trash'. + When non-nil, this option suppresses moving remote files to the local + trash when deleting. Default is nil. +++ - ** Input history for 'goto-line' is now local to every buffer. - Each buffer will keep a separate history of line numbers used with - 'goto-line'. This should help making faster the process of finding - line numbers that were previously jumped to. + ** New user option 'yes-or-no-prompt'. + This allows the user to customize the prompt that is appended by + 'yes-or-no-p' when asking questions. The default value is + "(yes or no) ". - +++ - ** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' - shows equivalent key bindings for all commands that have them. + --- + ** New face 'display-time-date-and-time'. + This is used for displaying the time and date components of + 'display-time-mode'. + + + * Editing Changes in Emacs 30.1 + + --- + ** On X, Emacs now supports input methods which perform "string conversion". + This means an input method can now ask Emacs to delete text + surrounding point and replace it with something else, as well as query + Emacs for surrounding text. If your input method allows you to "undo" + mistaken compositions, this will now work as well. + + --- + ** New command 'kill-matching-buffers-no-ask'. + This works like 'kill-matching-buffers', but without asking for + confirmation. ++++ +** Files can be visited asynchronously. +If the new user option 'execute-file-commands-asynchronously' has a +non-nil value, interactive file visiting commands load the file +asynchronously into the respective buffer. I.e., Emacs is still +responsive while loading the files, which is useful especially for +remote files. If the value is a regular expression, files matching +this expression are loaded asynchronously. See the node "(emacs) +Visiting" in the user manual for the supported commands. + - * Changes in Specialized Modes and Packages in Emacs 28.1 + * Changes in Specialized Modes and Packages in Emacs 30.1 - ** Emacs-Lisp mode + --- + ** Variable order and truncation can now be configured in 'gdb-many-windows'. + The new user option 'gdb-locals-table-row-config' allows users to + configure the order and max length of various properties in the local + variables buffer when using 'gdb-many-windows'. + + By default, this user option is set to write the properties in the order: + name, type and value, where the name and type are truncated to 20 + characters, and the value is truncated according to the value of + 'gdb-locals-value-limit'. - *** The mode-line now indicates whether we're using lexical or dynamic scoping. + If you want to get back the old behavior, set the user option to the value - ** Dired + (setopt gdb-locals-table-row-config + `((type . 0) (name . 0) (value . ,gdb-locals-value-limit))) - *** New user option 'dired-mark-region' affects all Dired commands - that mark files. When non-nil and the region is active in Transient - Mark mode, then Dired commands operate only on files in the active - region. The values 'file' and 'line' of this user option define the - details of marking the file at the end of the region. + ** Compile - *** State changing VC operations are supported in 'dired-mode' on files - (but still not on directories). + *** New user option 'grep-use-headings'. + When non-nil, the output of Grep is split into sections, one for each + file, instead of having file names prefixed to each line. It is + equivalent to the --heading option of some tools such as 'git grep' + and 'rg'. The headings are displayed using the new 'grep-heading' + face. - ** Gnus + ** VC --- - *** Change to default value of 'message-draft-headers' user option. - The 'Date' symbol has been removed from the default value, meaning that - draft or delayed messages will get a date reflecting when the message - was sent. To restore the original behavior of dating a message - from when it is first saved or delayed, add the symbol 'Date' back to - this user option. + *** New user option 'vc-git-shortlog-switches'. + This is a string or a list of strings that specifies the Git log + switches for shortlogs, such as the one produced by 'C-x v L'. + 'vc-git-log-switches' is no longer used for shortlogs. - ** Help + ** Diff Mode +++ - *** New command 'describe-keymap' describes keybindings in a keymap. + *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. + When called with a non-nil prefix argument + 'diff-ignore-whitespace-hunk' now iterates over all the hunks in the + current diff, regenerating them without whitespace changes. - --- - ** The old non-SMIE indentation of 'sh-mode' has been removed. + +++ + *** New user option 'diff-ignore-whitespace-switches'. + This allows changing which type of whitespace changes are ignored when + regenerating hunks with 'diff-ignore-whitespace-hunk'. Defaults to + the previously hard-coded "-b". - --- - ** The sb-image.el library is now marked obsolete. - This file was a compatibility kludge which is no longer needed. + ** Buffer Selection --- - ** 'lisp-mode' now uses 'common-lisp-indent-function'. - To revert to the previous behaviour, - '(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. + *** New user option 'bs-default-action-list'. + You can now configure how to display the "*buffer-selection*" buffer + using this new option. (Or set 'display-buffer-alist' directly.) - ** Edebug + ** Eshell +++ - *** Edebug specification lists can use the new keyword '&error', which - unconditionally aborts the current edebug instrumentation with the - supplied error message. + *** New splice operator for Eshell dollar expansions. + Dollar expansions in Eshell now let you splice the elements of the + expansion in-place using '$@expr'. This makes it easier to fill lists + of arguments into a command, such as when defining aliases. For more + information, see the "(eshell) Dollars Expansion" node in the Eshell + manual. +++ - ** ElDoc + *** Eshell now supports negative numbers and ranges for indices. + Now, you can retrieve the last element of a list with '$my-list[-1]' + or get a sublist of elements 2 through 4 with '$my-list[2..5]'. For + more information, see the "(eshell) Dollars Expansion" node in the + Eshell manual. + + --- + *** Eshell now uses 'field' properties in its output. + In particular, this means that pressing the '' key moves the + point to the beginning of your input, not the beginning of the whole + line. If you want to go back to the old behavior, add something like + this to your configuration: - *** New hook 'eldoc-documentation-functions' to be used for registering - doc string functions. This makes the results of all doc string - functions accessible to the user through the existing single function hook - 'eldoc-documentation-function'. + (keymap-set eshell-mode-map "" #'eshell-bol-ignoring-prompt) + + --- + *** You can now properly unload Eshell. + Calling "(unload-feature 'eshell)" no longer signals an error, and now + correctly unloads Eshell and all of its modules. - *** 'eldoc-documentation-function' is now a user option. - Modes should use the new hook instead of this user option to register - their backends. + +++ + *** 'eshell-read-aliases-list' is now an interactive command. + After manually editing 'eshell-aliases-file', you can use this command + to load the edited aliases. + + ** Prog Mode + + +++ + *** New command 'prog-fill-reindent-defun'. + This command either fills a single paragraph in a defun, such as a + docstring, or a comment, or (re)indents the surrounding defun if + point is not in a comment or a string. It is by default bound to + 'M-q' in 'prog-mode' and all its descendants. ** Tramp +--- +*** Tramp is now thread-safe. + +++ - *** New connection method "media", which allows accessing media devices - like cell phones, tablets or cameras. + *** New connection method "toolbox". + This allows accessing system containers provided by Toolbox. - ** Tempo + ** EWW - --- - *** 'tempo-define-template' can now re-assign templates to tags. - Previously, assigning a new template to an already defined tag had no - effect. + +++ + *** 'eww-open-file' can now display the file in a new buffer. + By default, the command reuses the "*eww*" buffer, but if called with + the new argument NEW-BUFFER non-nil, it will use a new buffer instead. + Interactively, invoke 'eww-open-file' with a prefix argument to + activate this behavior. + ** go-ts-mode - ** map.el + +++ + *** New command 'go-ts-mode-docstring'. + This command adds a docstring comment to the current defun. If a + comment already exists, point is only moved to the comment. It is + bound to 'C-c C-d' in 'go-ts-mode'. - *** Pcase 'map' pattern added keyword symbols abbreviation. - A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', - equivalent to '(map (:sym sym))'. + ** Man-mode - ** Package + +++ + *** New user option 'Man-prefer-synchronous-call'. + When this is non-nil, call the 'man' program synchronously rather than + asynchronously (which is the default behavior). + + + * New Modes and Packages in Emacs 30.1 + + ** New major modes based on the tree-sitter library. +++ - *** New functions to filter the package list. - The filter command key bindings are as follows: + *** New major mode 'html-ts-mode'. + An optional major mode based on the tree-sitter library for editing + HTML files. - key binding - --- ------- - / a package-menu-filter-by-archive - / k package-menu-filter-by-keyword - / n package-menu-filter-by-name - / s package-menu-filter-by-status - / v package-menu-filter-by-version - / / package-menu-filter-clear + --- + ** The highly accessible Modus themes collection has six items. + The 'modus-operandi' and 'modus-vivendi' are the main themes that have + been part of Emacs since version 28. The former is light, the latter + dark. In addition to these, we now have 'modus-operandi-tinted' and + 'modus-vivendi-tinted' for easier legibility, as well as + 'modus-operandi-deuteranopia' and 'modus-vivendi-deuteranopia' to + cover the needs of users with red-green color deficiency. The Info + manual "(modus-themes) Top" describes the details and showcases all + their customization options. - ** gdb-mi + + * Incompatible Lisp Changes in Emacs 30.1 + + ** User option 'tramp-completion-reread-directory-timeout' has been removed. + This user option has been obsoleted in Emacs 27, use + 'remote-file-name-inhibit-cache' instead. + + --- + ** User options 'eshell-NAME-unload-hook' are now obsolete. + These hooks were named incorrectly, and so they never actually ran + when unloading the correspending feature. Instead, you should use + hooks named after the feature name, like 'esh-mode-unload-hook'. + + + * Lisp Changes in Emacs 30.1 + ++--- (Needs better documentation) ++** There is a new command 'universal-async-argument', bound to 'C-x &'. ++If this command precedes another command, the value of variable ++'universal-async-argument' will be toggled. This indicates, that the ++following command shall be executed asynchronously. For example, ++file visiting commands would load files into buffers asynchronously. ++ + ** Functions and variables to transpose sexps +++ - *** gdb-mi can now store and restore window configurations. - Use 'gdb-save-window-configuration' to save window configuration to a - file and 'gdb-load-window-configuration' to load from a file. These - commands can also be accessed through the menu bar under 'Gud -- - GDB-Windows'. 'gdb-default-window-configuration-file', when non-nil, - is loaded when GDB starts up. + *** New helper variable 'transpose-sexps-function'. + Emacs now can set this variable to customize the behavior of the + 'transpose-sexps' function. +++ - *** gdb-mi can now restore window configuration after quit. - Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs - will remember the window configuration before GDB started and restore - it after GDB quits. A toggle button is also provided under 'Gud -- - GDB-Windows'. + *** New function 'transpose-sexps-default-function'. + The previous implementation is moved into its own function, to be + bound by 'transpose-sexps-function'. - ** Gravatar + *** New function 'treesit-transpose-sexps'. + Tree-sitter now unconditionally sets 'transpose-sexps-function' for all + tree-sitter enabled modes. This functionality utilizes the new + 'transpose-sexps-function'. - --- - *** New user option 'gravatar-service' for host to query for gravatars. - Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. + ** Functions and variables to move by program statements - ** Compilation mode + *** New variable 'forward-sentence-function'. + Major modes can now set this variable to customize the behavior of the + 'forward-sentence' command. - *** Regexp matching of messages is now case-sensitive by default. - The user option 'compilation-error-case-fold-search' can be set - for case-insensitive matching of messages. + *** New function 'forward-sentence-default-function'. + The previous implementation of 'forward-sentence' is moved into its + own function, to be bound by 'forward-sentence-function'. - - * New Modes and Packages in Emacs 28.1 + *** New buffer-local variable 'treesit-sentence-type-regexp'. + Similarly to 'treesit-defun-type-regexp', this variable is used to + define "sentences" in tree-sitter enabled modes. - - * Incompatible Editing Changes in Emacs 28.1 + *** New function 'treesit-forward-sentence'. + All tree-sitter enabled modes that define 'treesit-sentence-type-regexp' + now set 'forward-sentence-function' to call 'treesit-forward-sentence'. - ** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'. - The original key binding was 'M-s', which interfered with I-search, - since the latter uses 'M-s' as a prefix key of the search prefix map. + ** Functions and variables to move by program sexps - ** 'vc-print-branch-log' shows the change log for BRANCH from its root - directory instead of the default directory. + *** New buffer-local variable 'treesit-sexp-type-regexp'. + Similarly to 'treesit-defun-type-regexp', this variable is used to + define "sexps" in tree-sitter enabled modes. - - * Incompatible Lisp Changes in Emacs 28.1 + *** New function 'treesit-forward-sexp'. + Tree-sitter conditionally sets 'forward-sexp-function' for major modes + that have defined 'treesit-sexp-type-regexp' to enable sexp-related + motion commands. - ** 'equal' no longer examines some contents of window configurations. - Instead, it considers window configurations to be equal only if they - are 'eq'. To compare contents, use 'compare-window-configurations' - instead. This change helps fix a bug in 'sxhash-equal', which returned - incorrect hashes for window configurations and some other objects. + ** New or changed byte-compilation warnings --- - ** The obsolete function 'thread-alive-p' has been removed. + *** Warn about empty bodies for more special forms and macros. + The compiler now warns about an empty body argument to 'when', + 'unless', 'ignore-error' and 'with-suppressed-warnings' in addition to + the existing warnings for 'let' and 'let*'. Example: + + (when (> x 2)) - ** 'dns-query' now consistently uses Lisp integers to represent integers. - Formerly it made an exception for integer components of SOA records, - because SOA serial numbers can exceed fixnum ranges on 32-bit platforms. - Emacs now supports bignums so this old glitch is no longer needed. + This warning can be suppressed using 'with-suppressed-warnings' with + the warning name 'empty-body'. - ** The Lisp variables 'previous-system-messages-locale' and - 'previous-system-time-locale' have been removed, as they were created - by mistake and were not useful to Lisp code. + --- + *** Warn about quoted error names in 'condition-case' and 'ignore-error'. + The compiler now warns about quoted condition (error) names + in 'condition-case' and 'ignore-error'. Example: - ** The 'load-dangerous-libraries' variable is now obsolete. - It was used to allow loading Lisp libraries compiled by XEmacs, a - modified version of Emacs which is no longer actively maintained. - This is no longer supported, and setting this variable has no effect. + (condition-case nil + (/ x y) + ('arith-error "division by zero")) - - * Lisp Changes in Emacs 28.1 + Quoting them adds the error name 'quote' to those handled or ignored + respectively, which was probably not intended. - ** New macro 'dlet' to dynamically bind variables. + --- + *** Warn about comparison with literal constants without defined identity. + The compiler now warns about comparisons by identity with a literal + string, cons, vector, record, function, large integer or float as this + may not match any value at all. Example: - ** The variable 'force-new-style-backquotes' has been removed. - This removes the final remaining trace of old-style backquotes. + (eq x "hello") - ** The module header 'emacs-module.h' now contains type aliases - 'emacs_function' and 'emacs_finalizer' for module functions and - finalizers, respectively. + Only literals for symbols and small integers (fixnums), including + characters, are guaranteed to have a consistent (unique) identity. + This warning applies to 'eq', 'eql', 'memq', 'memql', 'assq', 'rassq', + 'remq' and 'delq'. - ** Module functions can now install an optional finalizer that is - called when the function object is garbage-collected. Use - 'set_function_finalizer' to set the finalizer and - 'get_function_finalizer' to retrieve it. + To compare by (structural) value, use 'equal', 'member', 'assoc', + 'rassoc', 'remove' or 'delete' instead. Floats and bignums can also + be compared using 'eql', '=' and 'memql'. Function literals cannot be + compared reliably at all. - ** Modules can now open a channel to an existing pipe process using - the new module function 'open_channel'. Modules can use this - functionality to asynchronously send data back to Emacs. + This warning can be suppressed using 'with-suppressed-warnings' with + the warning name 'suspicious'. - ** 'file-modes', 'set-file-modes', and 'set-file-times' now have an - optional argument specifying whether to follow symbolic links. + --- + *** Warn about 'condition-case' without handlers. + The compiler now warns when the 'condition-case' form is used without + any actual handlers, as in - ** 'parse-time-string' can now parse ISO 8601 format strings, - such as "2020-01-15T16:12:21-08:00". + (condition-case nil (read buffer)) - --- (Needs better documentation) - ** There is a new command 'universal-async-argument', bound to 'C-x &'. - If this command precedes another command, the value of variable - 'universal-async-argument' will be toggled. This indicates, that the - following command shall be executed asynchronously. For example, - file visiting commands would load files into buffers asynchronously. + because it has no effect other than the execution of the body form. + In particular, no errors are caught or suppressed. If the intention + was to catch all errors, add an explicit handler for 'error', or use + 'ignore-error' or 'ignore-errors'. - - * Changes in Emacs 28.1 on Non-Free Operating Systems + This warning can be suppressed using 'with-suppressed-warnings' with + the warning name 'suspicious'. +++ - ** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. - 'module-file-suffix' now has the value ".dylib" on macOS, but the - ".so" suffix is supported as well. + ** New function 'file-user-uid'. + This function is like 'user-uid', but is aware of file name handlers, + so it will return the remote UID for remote files (or -1 if the + connection has no associated user). + + +++ + ** 'fset' and 'defalias' now signal an error for circular alias chains. + Previously, 'fset' and 'defalias' could be made to build circular + function indirection chains as in + + (defalias 'able 'baker) + (defalias 'baker 'able) + + but trying to call them would often make Emacs hang. Now, an attempt + to create such a loop results in an error. + + Since circular alias chains now cannot occur, 'function-alias-p' and + 'indirect-function' will never signal an error. Their second + 'noerror' arguments have no effect and are therefore obsolete. + + + * Changes in Emacs 30.1 on Non-Free Operating Systems ---------------------------------------------------------------------- diff --cc lisp/files.el index 14760c32ccd,387a3b5dc66..e74ad236d12 --- a/lisp/files.el +++ b/lisp/files.el @@@ -1649,29 -1777,18 +1777,33 @@@ rather than FUN itself, to `minibuffer- ,@body) (remove-hook 'minibuffer-setup-hook ,hook))))) -(defun find-file-read-args (prompt mustmatch) - (list (read-file-name prompt nil default-directory mustmatch) - t)) +(defun find-file-read-args (prompt mustmatch &optional wildcards) + "Return the interactive spec ( ). +If WILDCARDS is non-nil, return the spec ( t )." + (let ((filename (read-file-name prompt nil default-directory mustmatch)) + (async (and (featurep 'threads) + (xor universal-async-argument + execute-file-commands-asynchronously)))) + (when (stringp async) (setq async (string-match-p async filename))) + (if wildcards `(,filename t ,async) `(,filename ,async)))) + (defun file-name-history--add (file) + "Add FILE to `file-name-history'." + (add-to-history 'file-name-history (abbreviate-file-name file))) + -(defun find-file (filename &optional wildcards) +(defmacro find-file-with-threads (filename async &rest body) + "Run BODY in an own thread, if ASYNC is non-nil." + (declare (indent 2) (debug t)) + `(if ,async + (progn + (make-thread (lambda () ,@body) (concat "find-file " ,filename)) + (thread-yield)) + ,@body)) + +(defun find-file (filename &optional wildcards async) "Edit file FILENAME. - Switch to a buffer visiting file FILENAME, - creating one if none already exists. + \\Switch to a buffer visiting file FILENAME, creating one if none + already exists. Interactively, the default if you just type RET is the current directory, but the visited file name is available through the minibuffer history: type \\[next-history-element] to pull it into the minibuffer. @@@ -1695,13 -1811,7 +1826,13 @@@ Interactively, or if WILDCARDS is non-n expand wildcards (if any) and visit multiple files. You can suppress wildcard expansion by setting `find-file-wildcards' to nil. +If ASYNC is non-nil, the file will be loaded into the buffer +asynchronously. Interactively, this is indicated by setting +`execute-file-commands-asynchronously' to a proper non-nil value. +This behavior can be toggled by \\[universal-async-argument] +prior the command invocation. + - To visit a file without any kind of conversion and without + \\To visit a file without any kind of conversion and without automatically choosing a major mode, use \\[find-file-literally]." (interactive (find-file-read-args "Find file: " diff --cc lisp/net/tramp-compat.el index ee85c99174c,420d6cadb9c..224a1ae5a66 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@@ -64,243 -78,11 +78,37 @@@ (defsubst tramp-compat-make-temp-file (f &optional dir-flag) "Create a local temporary file (compat function). Add the extension of F, if existing." - (let* (file-name-handler-alist - (prefix (expand-file-name - (symbol-value 'tramp-temp-name-prefix) - (tramp-compat-temporary-file-directory))) - (extension (file-name-extension f t))) - (make-temp-file prefix dir-flag extension))) - - ;; `temporary-file-directory' as function is introduced with Emacs 26.1. - (defalias 'tramp-compat-temporary-file-directory-function - (if (fboundp 'temporary-file-directory) - #'temporary-file-directory - #'tramp-handle-temporary-file-directory)) - - ;; `file-attribute-*' are introduced in Emacs 26.1. - - (defalias 'tramp-compat-file-attribute-type - (if (fboundp 'file-attribute-type) - #'file-attribute-type - (lambda (attributes) - "The type field in ATTRIBUTES returned by `file-attributes'. - The value is either t for directory, string (name linked to) for - symbolic link, or nil." - (nth 0 attributes)))) - - (defalias 'tramp-compat-file-attribute-link-number - (if (fboundp 'file-attribute-link-number) - #'file-attribute-link-number - (lambda (attributes) - "Return the number of links in ATTRIBUTES returned by `file-attributes'." - (nth 1 attributes)))) - - (defalias 'tramp-compat-file-attribute-user-id - (if (fboundp 'file-attribute-user-id) - #'file-attribute-user-id - (lambda (attributes) - "The UID field in ATTRIBUTES returned by `file-attributes'. - This is either a string or a number. If a string value cannot be - looked up, a numeric value, either an integer or a float, is - returned." - (nth 2 attributes)))) - - (defalias 'tramp-compat-file-attribute-group-id - (if (fboundp 'file-attribute-group-id) - #'file-attribute-group-id - (lambda (attributes) - "The GID field in ATTRIBUTES returned by `file-attributes'. - This is either a string or a number. If a string value cannot be - looked up, a numeric value, either an integer or a float, is - returned." - (nth 3 attributes)))) - - (defalias 'tramp-compat-file-attribute-access-time - (if (fboundp 'file-attribute-access-time) - #'file-attribute-access-time - (lambda (attributes) - "The last access time in ATTRIBUTES returned by `file-attributes'. - This a Lisp timestamp in the style of `current-time'." - (nth 4 attributes)))) - - (defalias 'tramp-compat-file-attribute-modification-time - (if (fboundp 'file-attribute-modification-time) - #'file-attribute-modification-time - (lambda (attributes) - "The modification time in ATTRIBUTES returned by `file-attributes'. - This is the time of the last change to the file's contents, and - is a Lisp timestamp in the style of `current-time'." - (nth 5 attributes)))) - - (defalias 'tramp-compat-file-attribute-status-change-time - (if (fboundp 'file-attribute-status-change-time) - #'file-attribute-status-change-time - (lambda (attributes) - "The status modification time in ATTRIBUTES returned by `file-attributes'. - This is the time of last change to the file's attributes: owner - and group, access mode bits, etc., and is a Lisp timestamp in the - style of `current-time'." - (nth 6 attributes)))) - - (defalias 'tramp-compat-file-attribute-size - (if (fboundp 'file-attribute-size) - #'file-attribute-size - (lambda (attributes) - "The size (in bytes) in ATTRIBUTES returned by `file-attributes'. - If the size is too large for a fixnum, this is a bignum in Emacs 27 - and later, and is a float in Emacs 26 and earlier." - (nth 7 attributes)))) - - (defalias 'tramp-compat-file-attribute-modes - (if (fboundp 'file-attribute-modes) - #'file-attribute-modes - (lambda (attributes) - "The file modes in ATTRIBUTES returned by `file-attributes'. - This is a string of ten letters or dashes as in ls -l." - (nth 8 attributes)))) - - ;; `file-missing' is introduced in Emacs 26.1. - (defconst tramp-file-missing - (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) - "The error symbol for the `file-missing' error.") - - ;; `file-local-name', `file-name-quoted-p', `file-name-quote' and - ;; `file-name-unquote' are introduced in Emacs 26.1. - (defalias 'tramp-compat-file-local-name - (if (fboundp 'file-local-name) - #'file-local-name - (lambda (name) - "Return the local name component of NAME. - It returns a file name which can be used directly as argument of - `process-file', `start-file-process', or `shell-command'." - (or (file-remote-p name 'localname) name)))) - - ;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got - ;; a second argument in Emacs 27.1. - (defalias 'tramp-compat-file-name-quoted-p - (if (and - (fboundp 'file-name-quoted-p) - (equal (tramp-compat-funcall 'func-arity #'file-name-quoted-p) '(1 . 2))) - #'file-name-quoted-p - (lambda (name &optional top) - "Whether NAME is quoted with prefix \"/:\". - If NAME is a remote file name and TOP is nil, check the local part of NAME." - (let ((file-name-handler-alist (unless top file-name-handler-alist))) - (string-prefix-p "/:" (tramp-compat-file-local-name name)))))) - - (defalias 'tramp-compat-file-name-quote - (if (and - (fboundp 'file-name-quote) - (equal (tramp-compat-funcall 'func-arity #'file-name-quote) '(1 . 2))) - #'file-name-quote - (lambda (name &optional top) - "Add the quotation prefix \"/:\" to file NAME. - If NAME is a remote file name and TOP is nil, the local part of NAME is quoted." - (let ((file-name-handler-alist (unless top file-name-handler-alist))) - (if (tramp-compat-file-name-quoted-p name top) - name - (concat - (file-remote-p name) "/:" (tramp-compat-file-local-name name))))))) - - (defalias 'tramp-compat-file-name-unquote - (if (and - (fboundp 'file-name-unquote) - (equal (tramp-compat-funcall 'func-arity #'file-name-unquote) '(1 . 2))) - #'file-name-unquote - (lambda (name &optional top) - "Remove quotation prefix \"/:\" from file NAME. - If NAME is a remote file name and TOP is nil, the local part of - NAME is unquoted." - (let* ((file-name-handler-alist (unless top file-name-handler-alist)) - (localname (tramp-compat-file-local-name name))) - (when (tramp-compat-file-name-quoted-p localname top) - (setq - localname (if (= (length localname) 2) "/" (substring localname 2)))) - (concat (file-remote-p name) localname))))) - - ;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still - ;; support old settings. - (defsubst tramp-compat-tramp-syntax () - "Return proper value of `tramp-syntax'." - (defvar tramp-syntax) - (cond ((eq tramp-syntax 'ftp) 'default) - ((eq tramp-syntax 'sep) 'separate) - (t tramp-syntax))) - - ;; The signature of `tramp-make-tramp-file-name' has been changed. - ;; Therefore, we cannot use `url-tramp-convert-url-to-tramp' prior - ;; Emacs 26.1. We use `temporary-file-directory' as indicator. - (defconst tramp-compat-use-url-tramp-p (fboundp 'temporary-file-directory) - "Whether to use url-tramp.el.") + (make-temp-file + (expand-file-name + tramp-temp-name-prefix tramp-compat-temporary-file-directory) + dir-flag (file-name-extension f t))) +;; Threads have entered Emacs 26.1, `main-thread' in Emacs 27.1. But +;; then, they might not exist when Emacs is configured +;; --without-threads. +(defconst tramp-compat-main-thread (bound-and-true-p main-thread) + "The main thread of Emacs, if compiled --with-threads.") + +(defsubst tramp-compat-current-thread () + "The current thread, or nil if compiled --without-threads." + (tramp-compat-funcall 'current-thread)) + +(defsubst tramp-compat-thread-yield () + "Yield the CPU to another thread." + (tramp-compat-funcall 'thread-yield)) + - ;; Mutexes have entered Emacs 26.1. Once we use only Emacs 26+, we - ;; must check (mutexp mutex), because the other functions might still - ;; not exist when Emacs is configured --without-threads. ++(defsubst tramp-compat-make-mutex (name) ++ "Create a mutex." ++ (tramp-compat-funcall 'make-mutex name)) ++ +(defmacro tramp-compat-with-mutex (mutex &rest body) + "Invoke BODY with MUTEX held, releasing MUTEX when done. +This is the simplest safe way to acquire and release a mutex." + (declare (indent 1) (debug t)) - `(if (fboundp 'with-mutex) ++ `(if (mutexp ,mutex) + (with-mutex ,mutex ,@body) + ,@body)) + - ;; `exec-path' is new in Emacs 27.1. - (defalias 'tramp-compat-exec-path - (if (fboundp 'exec-path) - #'exec-path - (lambda () - "List of directories to search programs to run in remote subprocesses." - (if-let ((handler (find-file-name-handler default-directory 'exec-path))) - (funcall handler 'exec-path) - exec-path)))) - - ;; `time-equal-p' has appeared in Emacs 27.1. - (defalias 'tramp-compat-time-equal-p - (if (fboundp 'time-equal-p) - #'time-equal-p - (lambda (t1 t2) - "Return non-nil if time value T1 is equal to time value T2. - A nil value for either argument stands for the current time." - (equal (or t1 (current-time)) (or t2 (current-time)))))) - - ;; `flatten-tree' has appeared in Emacs 27.1. - (defalias 'tramp-compat-flatten-tree - (if (fboundp 'flatten-tree) - #'flatten-tree - (lambda (tree) - "Take TREE and \"flatten\" it." - (let (elems) - (setq tree (list tree)) - (while (let ((elem (pop tree))) - (cond ((consp elem) - (setq tree (cons (car elem) (cons (cdr elem) tree)))) - (elem - (push elem elems))) - tree)) - (nreverse elems))))) - - ;; `progress-reporter-update' got argument SUFFIX in Emacs 27.1. - (defalias 'tramp-compat-progress-reporter-update - (if (equal (tramp-compat-funcall 'func-arity #'progress-reporter-update) - '(1 . 3)) - #'progress-reporter-update - (lambda (reporter &optional value _suffix) - (progress-reporter-update reporter value)))) - ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. (defalias 'tramp-compat-file-modes diff --cc lisp/net/tramp-ftp.el index 2868b491cba,1712c00b0a0..6e6d876b126 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@@ -31,9 -31,6 +31,7 @@@ (require 'tramp) ;; Pacify byte-compiler. - (eval-when-compile - (require 'custom)) +(declare-function ange-ftp-ftp-process-buffer "ange-ftp") (defvar ange-ftp-ftp-name-arg) (defvar ange-ftp-ftp-name-res) (defvar ange-ftp-name-format) @@@ -123,34 -120,36 +121,43 @@@ pass to the OPERATION. (nth 2 tramp-file-name-structure) (nth 4 tramp-file-name-structure))) ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res' - ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, + ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, ;; there could be incorrect values from previous calls in case the - ;; "ftp" method is used in the Tramp file name. So we unset + ;; "ftp" method is used in the Tramp file name. So we unset ;; those values. (ange-ftp-ftp-name-arg "") - (ange-ftp-ftp-name-res nil) - ange-ftp-ftp-name-res) ++ ange-ftp-ftp-name-res + (v (tramp-dissect-file-name + (apply #'tramp-file-name-for-operation operation args) t))) + (setf (tramp-file-name-method v) tramp-ftp-method) + ;; Set "process-name" for thread support. + (tramp-set-connection-property + v "process-name" + (ange-ftp-ftp-process-buffer + (tramp-file-name-host v) (tramp-file-name-user v))) + (cond ;; If argument is a symlink, `file-directory-p' and - ;; `file-exists-p' call the traversed file recursively. So we + ;; `file-exists-p' call the traversed file recursively. So we ;; cannot disable the file-name-handler this case. We set the ;; connection property "started" in order to put the remote ;; location into the cache, which is helpful for further ;; completion. We don't use `with-parsed-tramp-file-name', ;; because this returns another user but the one declared in ;; "~/.netrc". + ;; For file names which look like Tramp archive files like + ;; "/ftp:anonymous@ftp.gnu.org:/gnu/tramp/tramp-2.0.39.tar.gz", + ;; we must disable tramp-archive.el, because in + ;; `ange-ftp-get-files' this is "normalized" by + ;; `file-name-as-directory' with unwelcome side side-effects. + ;; This disables the file archive functionality, perhaps we + ;; could fix this otherwise. (Bug#56078) ((memq operation '(file-directory-p file-exists-p)) - (if (apply #'ange-ftp-hook-function operation args) - (tramp-set-connection-property v "started" t) - nil)) + (cl-letf (((symbol-function #'tramp-archive-file-name-handler) + (lambda (operation &rest args) + (tramp-archive-run-real-handler operation args)))) + (prog1 (apply #'ange-ftp-hook-function operation args) - (let ((v (tramp-dissect-file-name (car args) t))) - (setf (tramp-file-name-method v) tramp-ftp-method) - (tramp-set-connection-property v "started" t))))) ++ (tramp-set-connection-property v "started" t)))) ;; If the second argument of `copy-file' or `rename-file' is a ;; remote file name but via FTP, ange-ftp doesn't check this. diff --cc lisp/net/tramp.el index 5278c26f181,47173b95bea..17499e4dc32 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@@ -1721,56 -2070,72 +2070,76 @@@ They are completed by \"M-x TAB\" only "Append message to debug buffer of VEC. Message is formatted with FMT-STRING as control string and the remaining ARGUMENTS to actually emit the message (if applicable)." - (with-current-buffer (tramp-get-debug-buffer vec) - (goto-char (point-max)) - ;; Headline. - (when (bobp) - (insert - (format - ";; Emacs: %s Tramp: %s -*- mode: outline; -*-" - emacs-version tramp-version)) - (when (>= tramp-verbose 10) - (let ((tramp-verbose 0)) + (let ((inhibit-message t) + create-lockfiles file-name-handler-alist message-log-max + signal-hook-function) + (with-current-buffer (tramp-get-debug-buffer vec) + (goto-char (point-max)) + (let ((point (point))) + (when (bobp) + ;; Headline. (insert (format - "\n;; Location: %s Git: %s/%s" - (locate-library "tramp") - (or tramp-repository-branch "") - (or tramp-repository-version "")))))) - (unless (bolp) - (insert "\n")) - ;; Timestamp. - (let ((now (current-time))) - (insert (format-time-string "%T." now)) - (insert (format "%06d " (nth 2 now)))) - ;; Threads. - (unless (or (null tramp-compat-main-thread) - (eq (tramp-compat-current-thread) tramp-compat-main-thread)) - (insert (format "%s " (tramp-compat-current-thread)))) - ;; Calling Tramp function. We suppress compat and trace functions - ;; from being displayed. - (let ((btn 1) btf fn) - (while (not fn) - (setq btf (nth 1 (backtrace-frame btn))) - (if (not btf) - (setq fn "") - (and (symbolp btf) (setq fn (symbol-name btf)) - (or (not (string-match-p "^tramp" fn)) - (get btf 'tramp-suppress-trace)) - (setq fn nil)) - (setq btn (1+ btn)))) - ;; The following code inserts filename and line number. Should - ;; be inactive by default, because it is time consuming. - ; (let ((ffn (find-function-noselect (intern fn)))) - ; (insert - ; (format - ; "%s:%d: " - ; (file-name-nondirectory (buffer-file-name (car ffn))) - ; (with-current-buffer (car ffn) - ; (1+ (count-lines (point-min) (cdr ffn))))))) - (insert (format "%s " fn))) - ;; The message. - (insert (apply #'format-message fmt-string arguments)))) + ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-" + emacs-version tramp-version)) + (when (>= tramp-verbose 10) + (let ((tramp-verbose 0)) + (insert + (format + "\n;; Location: %s Git: %s/%s" + (locate-library "tramp") + (or tramp-repository-branch "") + (or tramp-repository-version ""))))) + ;; Traces. + (when (>= tramp-verbose 11) + (dolist + (elt + (append + (mapcar + #'intern (all-completions "tramp-" obarray #'functionp)) + tramp-trace-functions)) + (unless (get elt 'tramp-suppress-trace) + (trace-function-background elt)))) + ;; Delete debug file. + (when (and tramp-debug-to-file (tramp-get-debug-file-name vec)) + (ignore-errors (delete-file (tramp-get-debug-file-name vec))))) + (unless (bolp) + (insert "\n")) + ;; Timestamp. + (insert (format-time-string "%T.%6N ")) ++ ;; Threads. ++ (unless (or (null tramp-compat-main-thread) ++ (eq (tramp-compat-current-thread) tramp-compat-main-thread)) ++ (insert (format "%s " (tramp-compat-current-thread)))) + ;; Calling Tramp function. We suppress compat and trace + ;; functions from being displayed. + (let ((btn 1) btf fn) + (while (not fn) + (setq btf (nth 1 (backtrace-frame btn))) + (if (not btf) + (setq fn "") + (and (symbolp btf) (setq fn (symbol-name btf)) + (or (not (string-prefix-p "tramp" fn)) + (get btf 'tramp-suppress-trace)) + (setq fn nil)) + (setq btn (1+ btn)))) + ;; The following code inserts filename and line number. + ;; Should be inactive by default, because it is time consuming. + ;; (let ((ffn (find-function-noselect (intern fn)))) + ;; (insert + ;; (format + ;; "%s:%d: " + ;; (file-name-nondirectory (buffer-file-name (car ffn))) + ;; (with-current-buffer (car ffn) + ;; (1+ (count-lines (point-min) (cdr ffn))))))) + (insert (format "%s " fn))) + ;; The message. + (insert (apply #'format-message fmt-string arguments)) + ;; Write message to debug file. + (when tramp-debug-to-file + (ignore-errors + (write-region + point (point-max) (tramp-get-debug-file-name vec) 'append))))))) (put #'tramp-debug-message 'tramp-suppress-trace t) @@@ -2289,50 -2684,11 +2688,23 @@@ Must be handled by the callers. res (cdr elt)))) res))) - ;; In Emacs, there is some concurrency due to timers. If a timer - ;; interrupts Tramp and wishes to use the same connection buffer as - ;; the "main" Emacs, then garbage might occur in the connection - ;; buffer. Therefore, we need to make sure that a timer does not use - ;; the same connection buffer as the "main" Emacs. We implement a - ;; cheap global lock, instead of locking each connection buffer - ;; separately. The global lock is based on two variables, - ;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true - ;; (with setq) to indicate a lock. But Tramp also calls itself during - ;; processing of a single file operation, so we need to allow - ;; recursive calls. That's where the `tramp-locker' variable comes in - ;; -- it is let-bound to t during the execution of the current - ;; handler. So if `tramp-locked' is t and `tramp-locker' is also t, - ;; then we should just proceed because we have been called - ;; recursively. But if `tramp-locker' is nil, then we are a timer - ;; interrupting the "main" Emacs, and then we signal an error. - - (defvar tramp-locked nil - "If non-nil, then Tramp is currently busy. - Together with `tramp-locker', this implements a locking mechanism - preventing reentrant calls of Tramp.") - - (defvar tramp-locker nil - "If non-nil, then a caller has locked Tramp. - Together with `tramp-locked', this implements a locking mechanism - preventing reentrant calls of Tramp.") - - ;; Mutexes have entered Emacs 26.1. - (defvar tramp-mutex (tramp-compat-funcall 'make-mutex "tramp") ++(defvar tramp-mutex (tramp-compat-make-mutex "tramp") + "Global mutex for Tramp threads.") + +(defun tramp-get-mutex (vec) + "Return the mutex locking Tramp threads for VEC." + (if-let ((p (and (tramp-connectable-p vec) + (tramp-get-connection-process vec)))) + (with-tramp-connection-property p "mutex" - (tramp-compat-funcall 'make-mutex (process-name p))) ++ (tramp-compat-make-mutex (process-name p))) + tramp-mutex)) + ;; Main function. + ;;;###autoload (defun tramp-file-name-handler (operation &rest args) "Invoke Tramp file name handler for OPERATION and ARGS. -Fall back to normal file name handler if no Tramp file name handler exists." +Fall back to normal file name handler if no Tramp file name handler exists. +If Emacs is compiled --with-threads, the body is protected by a mutex." (let ((filename (apply #'tramp-file-name-for-operation operation args)) ;; `file-remote-p' is called for everything, even for symbolic ;; links which look remote. We don't want to get an error. @@@ -2341,103 -2697,79 +2713,95 @@@ (save-match-data (setq filename (tramp-replace-environment-variables filename)) (with-parsed-tramp-file-name filename nil - (let ((current-connection tramp-current-connection) - (foreign - (tramp-find-foreign-file-name-handler v operation)) - (signal-hook-function #'tramp-signal-hook-function) - result) - ;; Set `tramp-current-connection'. - (unless - (tramp-file-name-equal-p v (car tramp-current-connection)) - (setq tramp-current-connection (list v))) - - ;; Call the backend function. - (unwind-protect - (if foreign - (let ((sf (symbol-function foreign))) - ;; Some packages set the default directory to - ;; a remote path, before respective Tramp - ;; packages are already loaded. This results - ;; in recursive loading. Therefore, we load - ;; the Tramp packages locally. - (when (autoloadp sf) - ;; FIXME: Not clear why we need these bindings here. - ;; The explanation above is not convincing and - ;; the bug#9114 for which it was added doesn't - ;; clarify the core of the problem. - (let ((default-directory - tramp-compat-temporary-file-directory) - file-name-handler-alist) - (autoload-do-load sf foreign))) - ;; (tramp-message - ;; v 4 "Running `%s'..." (cons operation args)) - ;; If `non-essential' is non-nil, Tramp shall - ;; not open a new connection. - ;; If Tramp detects that it shouldn't continue - ;; to work, it throws the `suppress' event. - ;; This could happen for example, when Tramp - ;; tries to open the same connection twice in - ;; a short time frame. - ;; In both cases, we try the default handler then. - (setq result - (catch 'non-essential - (catch 'suppress - (apply foreign operation args)))) - ;; (tramp-message - ;; v 4 "Running `%s'...`%s'" (cons operation args) result) - (cond - ((eq result 'non-essential) - (tramp-message - v 5 "Non-essential received in operation %s" - (cons operation args)) - (let ((tramp-verbose 10)) (tramp-backtrace v)) - (tramp-run-real-handler operation args)) - ((eq result 'suppress) - (let ((inhibit-message t)) + ;; Give other threads a chance. + (tramp-compat-thread-yield) + ;; The mutex allows concurrent run of operations. It + ;; guarantees, that the threads are not mixed. + (tramp-compat-with-mutex (tramp-get-mutex v) ++ ;; Run only when Emacs is idle. ++ (tramp-compat-funcall 'check-idle-thread) + (let ((current-connection tramp-current-connection) - (foreign - (tramp-find-foreign-file-name-handler filename operation)) ++ (foreign (tramp-find-foreign-file-name-handler v operation)) + (signal-hook-function #'tramp-signal-hook-function) + result) + ;; Set `tramp-current-connection'. + (unless + (tramp-file-name-equal-p v (car tramp-current-connection)) + (setq tramp-current-connection (list v))) + + ;; Call the backend function. + (unwind-protect + (if foreign + (let ((sf (symbol-function foreign)) + p) + ;; Some packages set the default directory + ;; to a remote path, before respective Tramp + ;; packages are already loaded. This + ;; results in recursive loading. Therefore, + ;; we load the Tramp packages locally. + (when (autoloadp sf) + ;; FIXME: Not clear why we need these bindings here. + ;; The explanation above is not convincing and + ;; the bug#9114 for which it was added doesn't + ;; clarify the core of the problem. + (let ((default-directory - (tramp-compat-temporary-file-directory)) ++ tramp-compat-temporary-file-directory) + file-name-handler-alist) + (autoload-do-load sf foreign))) + ;; (tramp-message + ;; v 4 "Running `%s'..." (cons operation args)) + ;; Switch process thread. + (when (and tramp-mutex + (tramp-connectable-p v) + (setq p (tramp-get-connection-process v))) + (tramp-compat-funcall + 'set-process-thread + p (tramp-compat-current-thread))) + ;; If `non-essential' is non-nil, Tramp + ;; shall not open a new connection. + ;; If Tramp detects that it shouldn't + ;; continue to work, it throws the + ;; `suppress' event. This could happen for + ;; example, when Tramp tries to open the + ;; same connection twice in a short time + ;; frame. + ;; In both cases, we try the default handler + ;; then. + (setq result + (catch 'non-essential + (catch 'suppress - (when (and tramp-locked (not tramp-locker)) - (setq tramp-locked nil) - (tramp-error - v 'file-error - "Forbidden reentrant call of Tramp")) - (let ((tl tramp-locked)) - (setq tramp-locked t) - (unwind-protect - (let ((tramp-locker t)) - (apply foreign operation args)) - (setq tramp-locked tl)))))) ++ (apply foreign operation args)))) + ;; (tramp-message - ;; v 4 "Running `%s'...`%s'" (cons operation args) result) ++ ;; v 4 "Running `%s'...`%s'" ++ ;; (cons operation args) result) + (cond + ((eq result 'non-essential) (tramp-message - v 1 "Suppress received in operation %s" + v 5 "Non-essential received in operation %s" (cons operation args)) - (tramp-cleanup-connection v t) - (tramp-run-real-handler operation args))) - (t result))) - - ;; Nothing to do for us. However, since we are in - ;; `tramp-mode', we must suppress the volume - ;; letter on MS Windows. - (setq result (tramp-run-real-handler operation args)) - (if (stringp result) - (tramp-drop-volume-letter result) - result)) - - ;; Reset `tramp-current-connection'. - (unless - (tramp-file-name-equal-p - (car current-connection) (car tramp-current-connection)) - (setq tramp-current-connection current-connection)))))) + (tramp-run-real-handler operation args)) + ((eq result 'suppress) + (let ((inhibit-message t)) + (tramp-message + v 1 "Suppress received in operation %s" + (cons operation args)) + (tramp-cleanup-connection v t) + (tramp-run-real-handler operation args))) + (t result))) + + ;; Nothing to do for us. However, since we are + ;; in `tramp-mode', we must suppress the volume + ;; letter on MS Windows. + (setq result (tramp-run-real-handler operation args)) + (if (stringp result) + (tramp-drop-volume-letter result) + result)) + + ;; Reset `tramp-current-connection'. + (unless + (tramp-file-name-equal-p + (car current-connection) (car tramp-current-connection)) + (setq tramp-current-connection current-connection))))))) ;; When `tramp-mode' is not enabled, or the file name is quoted, ;; we don't do anything. diff --cc lisp/vc/vc-hooks.el index 44d7a1ff1b0,e242d1e48e2..eb95aec84dc --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@@ -808,80 -781,63 +785,81 @@@ This command is more thorough than `vc- also supports switching a back-end or removing the file from VC. In the latter case, VC mode is deactivated for this buffer." (interactive) -- ;; Recompute whether file is version controlled, -- ;; if user has killed the buffer and revisited. ++ ;; Recompute whether file is version controlled, if user has killed ++ ;; the buffer and revisited. (when vc-mode (setq vc-mode nil)) (when buffer-file-name - (vc-file-clearprops buffer-file-name) - ;; FIXME: Why use a hook? Why pass it buffer-file-name? - (add-hook 'vc-mode-line-hook #'vc-mode-line nil t) - (let (backend) - (cond - ((setq backend (with-demoted-errors "VC refresh error: %S" - (vc-backend buffer-file-name))) - ;; Let the backend setup any buffer-local things he needs. - (vc-call-backend backend 'find-file-hook) - ;; Compute the state and put it in the mode line. - (vc-mode-line buffer-file-name backend) - (unless vc-make-backup-files - ;; Use this variable, not make-backup-files, - ;; because this is for things that depend on the file name. - (setq-local backup-inhibited t))) - ((let* ((truename (and buffer-file-truename - (expand-file-name buffer-file-truename))) - (link-type (and truename - (not (equal buffer-file-name truename)) - (vc-backend truename)))) - (cond ((not link-type) nil) ;Nothing to do. - ((eq vc-follow-symlinks nil) - (message - "Warning: symbolic link to %s-controlled source file" link-type)) - ((or (not (eq vc-follow-symlinks 'ask)) - ;; Assume we cannot ask, default to yes. - noninteractive - ;; Copied from server-start. Seems like there should - ;; be a better way to ask "can we get user input?"... - (and (daemonp) - (null (cdr (frame-list))) - (eq (selected-frame) terminal-frame)) - ;; If we already visited this file by following - ;; the link, don't ask again if we try to visit - ;; it again. GUD does that, and repeated questions - ;; are painful. - (get-file-buffer - (abbreviate-file-name - (file-chase-links buffer-file-name)))) - - (vc-follow-link) - (message "Followed link to %s" buffer-file-name) - (vc-refresh-state)) - (t - (if (yes-or-no-p (format - "Symbolic link to %s-controlled source file; follow link? " link-type)) - (progn (vc-follow-link) - (message "Followed link to %s" buffer-file-name) - (vc-refresh-state)) - (message - "Warning: editing through the link bypasses version control") - ))))))))) + ;; Run it asynchronously. + (make-thread + (lambda () + ;; Wait, until the file visiting function tells us so. + (with-mutex vc-mutex) + (vc-file-clearprops buffer-file-name) ++ (vc-file-clearprops buffer-file-name) + ;; FIXME: Why use a hook? Why pass it buffer-file-name? - (add-hook 'vc-mode-line-hook 'vc-mode-line nil t) ++ (add-hook 'vc-mode-line-hook #'vc-mode-line nil t) + (let (backend) + (cond - ((setq backend (with-demoted-errors (vc-backend buffer-file-name))) ++ ((setq backend (with-demoted-errors "VC refresh error: %S" ++ (vc-backend buffer-file-name))) + ;; Let the backend setup any buffer-local things he needs. + (vc-call-backend backend 'find-file-hook) + ;; Compute the state and put it in the mode line. + (vc-mode-line buffer-file-name backend) + (unless vc-make-backup-files + ;; Use this variable, not make-backup-files, because this + ;; is for things that depend on the file name. - (set (make-local-variable 'backup-inhibited) t))) ++ (setq-local backup-inhibited t))) + ((let* ((truename (and buffer-file-truename + (expand-file-name buffer-file-truename))) + (link-type (and truename + (not (equal buffer-file-name truename)) + (vc-backend truename)))) + (cond ((not link-type) nil) ;Nothing to do. + ((eq vc-follow-symlinks nil) + (message - "Warning: symbolic link to %s-controlled source file" - link-type)) ++ "Warning: symbolic link to %s-controlled source file" link-type)) + ((or (not (eq vc-follow-symlinks 'ask)) + ;; Assume we cannot ask, default to yes. + noninteractive + ;; Copied from server-start. Seems like there + ;; should be a better way to ask "can we get + ;; user input?"... + (and (daemonp) + (null (cdr (frame-list))) + (eq (selected-frame) terminal-frame)) + ;; If we already visited this file by + ;; following the link, don't ask again if we + ;; try to visit it again. GUD does that, and + ;; repeated questions are painful. + (get-file-buffer + (abbreviate-file-name + (file-chase-links buffer-file-name)))) + + (vc-follow-link) + (message "Followed link to %s" buffer-file-name) + (vc-refresh-state)) + (t + (if (yes-or-no-p + (format + (concat + "Symbolic link to %s-controlled source file; " + "follow link? ") + link-type)) + (progn (vc-follow-link) + (message + "Followed link to %s" buffer-file-name) + (vc-refresh-state)) + (message + (concat + "Warning: editing through the link " + "bypasses version control")))))))))) + ;; The thread name. + (concat "vc-refresh-state " (buffer-name))) + + ;; Give other threads a chance to run. + (thread-yield))) (add-hook 'find-file-hook #'vc-refresh-state) (define-obsolete-function-alias 'vc-find-file-hook #'vc-refresh-state "25.1") diff --cc test/lisp/net/tramp-tests.el index e5649767de2,b6ad2e2f219..9d089c927a2 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@@ -6193,116 -7576,113 +7576,219 @@@ process sentinels. They shall not dist (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive)))))) - (ert-deftest tramp-test44-threads () + ;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests + ;; 'unstable) + + (ert-deftest tramp-test46-dired-compress-file () + "Check that Tramp (un)compresses normal files." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-crypt-p))) + ;; Starting with Emacs 29.1, `dired-compress-file' is performed by + ;; default handler. + (skip-unless (not (tramp--test-emacs29-p))) + + (let ((default-directory ert-remote-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name))) + (write-region "foo" nil tmp-name) + (dired default-directory) + (dired-revert) + (dired-goto-file tmp-name) + (should-not (dired-compress)) + (should (string= (concat tmp-name ".gz") (dired-get-filename))) + (should-not (dired-compress)) + (should (string= tmp-name (dired-get-filename))) + (delete-file tmp-name))) + + (ert-deftest tramp-test46-dired-compress-dir () + "Check that Tramp (un)compresses directories." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-crypt-p))) + ;; Starting with Emacs 29.1, `dired-compress-file' is performed by + ;; default handler. + (skip-unless (not (tramp--test-emacs29-p))) + + (let ((default-directory ert-remote-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name))) + (make-directory tmp-name) + (dired default-directory) + (dired-revert) + (dired-goto-file tmp-name) + (should-not (dired-compress)) + (should (string= (concat tmp-name ".tar.gz") (dired-get-filename))) + (should-not (dired-compress)) + (should (string= tmp-name (dired-get-filename))) + (delete-directory tmp-name) + (delete-file (concat tmp-name ".tar.gz")))) + + (ert-deftest tramp-test47-read-password () + "Check Tramp password handling." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-mock-p)) + ;; Not all read commands understand argument "-s" or "-p". + (skip-unless + (string-empty-p + (let ((shell-file-name "sh")) + (shell-command-to-string "read -s -p Password: pass")))) + + (let ((pass "secret") + (mock-entry (copy-sequence (assoc "mock" tramp-methods))) + mocked-input tramp-methods) + ;; We must mock `read-string', in order to avoid interactive + ;; arguments. + (cl-letf* (((symbol-function #'read-string) + (lambda (&rest _args) (pop mocked-input)))) + (setcdr + (assq 'tramp-login-args mock-entry) + `((("-c") + (,(tramp-shell-quote-argument + (concat + "read -s -p 'Password: ' pass; echo; " + "(test \"pass$pass\" != \"pass" pass "\" && " + "echo \"Login incorrect\" || sh -i)")))))) + (setq tramp-methods `(,mock-entry)) + + ;; Reading password from stdin works. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + ;; We don't want to invalidate the password. + (setq mocked-input `(,(copy-sequence pass))) + (should (file-exists-p ert-remote-temporary-file-directory)) + + ;; Don't entering a password returns in error. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (should-error (file-exists-p ert-remote-temporary-file-directory)) + + ;; A wrong password doesn't work either. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input `(,(concat pass pass))) + (should-error (file-exists-p ert-remote-temporary-file-directory)) + + ;; Reading password from auth-source works. We use the netrc + ;; backend; the other backends shall behave similar. + ;; Macro `ert-with-temp-file' was introduced in Emacs 29.1. + (with-no-warnings (when (symbol-plist 'ert-with-temp-file) + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (auth-source-forget-all-cached) + (ert-with-temp-file netrc-file + :prefix "tramp-test" :suffix "" + :text (format + "machine %s port mock password %s" + (file-remote-p ert-remote-temporary-file-directory 'host) pass) + (let ((auth-sources `(,netrc-file))) + (should (file-exists-p ert-remote-temporary-file-directory))))))))) + ++(ert-deftest tramp-test48-threads () + "Check that Tramp cooperates with threads." + (skip-unless (tramp--test-enabled)) + (skip-unless (featurep 'threads)) + (skip-unless (= (length (with-no-warnings (all-threads))) 1)) + (skip-unless (not (with-no-warnings (thread-last-error)))) - ;; We need the thread features introduced in Emacs 27. - (skip-unless (bound-and-true-p main-thread)) ++ (skip-unless (boundp main-thread)) + ;; For the time being it works only in the feature branch. + (skip-unless - (string-equal - (bound-and-true-p emacs-repository-branch) "feature/tramp-thread-safe")) ++ (string-equal (or emacs-repository-branch "") "feature/tramp-thread-safe")) + + (tramp--test-instrument-test-case 0 + (with-no-warnings + (with-timeout (60 (tramp--test-timeout-handler)) + ;; We cannot bind the variables dynamically; they are used in the threads. + (defvar tmp-name1 (tramp--test-make-temp-name)) + (defvar tmp-name2 (tramp--test-make-temp-name)) + (defvar tmp-mutex (make-mutex "mutex")) + (defvar tmp-condvar1 (make-condition-variable tmp-mutex "condvar1")) + (defvar tmp-condvar2 (make-condition-variable tmp-mutex "condvar2")) + + ;; Rename simple file. + (unwind-protect + (let (tmp-thread1 tmp-thread2) + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (should-not (file-exists-p tmp-name2)) + + (should (mutexp tmp-mutex)) + (should (condition-variable-p tmp-condvar1)) + (should (condition-variable-p tmp-condvar2)) + + ;; This thread renames `tmp-name1' to `tmp-name2' twice. + (setq + tmp-thread1 + (make-thread + (lambda () + ;; Rename first time. + (rename-file tmp-name1 tmp-name2) + ;; Notify thread2. + (with-mutex (condition-mutex tmp-condvar2) + (condition-notify tmp-condvar2 t)) + ;; Rename second time, once we've got notification from thread2. + (with-mutex (condition-mutex tmp-condvar1) + (condition-wait tmp-condvar1)) + (rename-file tmp-name1 tmp-name2)) + "thread1")) + + (should (threadp tmp-thread1)) + (should (thread-live-p tmp-thread1)) + + ;; This thread renames `tmp-name2' to `tmp-name1' twice. + (setq + tmp-thread2 + (make-thread + (lambda () + ;; Rename first time, once we've got notification from thread1. + (with-mutex (condition-mutex tmp-condvar2) + (condition-wait tmp-condvar2)) + (rename-file tmp-name2 tmp-name1) + ;; Notify thread1. + (with-mutex (condition-mutex tmp-condvar1) + (condition-notify tmp-condvar1 t)) + ;; Rename second time, once we've got notification from + ;; the main thread. + (with-mutex (condition-mutex tmp-condvar2) + (condition-wait tmp-condvar2)) + (rename-file tmp-name2 tmp-name1)) + "thread2")) + + (should (threadp tmp-thread2)) + (should (thread-live-p tmp-thread2)) + (should (= (length (all-threads)) 3)) + + ;; Wait for thread1. + (thread-join tmp-thread1) + ;; Checks. + (should-not (thread-live-p tmp-thread1)) + (should (= (length (all-threads)) 2)) + (should-not (thread-last-error)) + (should (file-exists-p tmp-name2)) + (should-not (file-exists-p tmp-name1)) + + ;; Notify thread2. + (with-mutex (condition-mutex tmp-condvar2) + (condition-notify tmp-condvar2 t)) + + ;; Wait for thread2. + (thread-join tmp-thread2) + ;; Checks. + (should-not (thread-live-p tmp-thread2)) + (should (= (length (all-threads)) 1)) + (should-not (thread-last-error)) + (should (file-exists-p tmp-name1)) + (should-not (file-exists-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + ;; We could have spurious threads still running; wait for them to die. + (while (cdr (all-threads)) + (thread-signal (cadr (all-threads)) 'error nil) + (thread-yield)) + ;; Cleanup errors. + (ignore-errors (thread-last-error 'cleanup))))))) + ;; This test is inspired by Bug#29163. - (ert-deftest tramp-test45-auto-load () -(ert-deftest tramp-test48-auto-load () ++(ert-deftest tramp-test49-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@@ -6327,12 -7707,8 +7813,8 @@@ (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) - (ert-deftest tramp-test45-delay-load () -(ert-deftest tramp-test48-delay-load () ++(ert-deftest tramp-test49-delay-load () "Check that Tramp is loaded lazily, only when needed." - ;; The autoloaded Tramp objects are different since Emacs 26.1. We - ;; cannot test older Emacsen, therefore. - (skip-unless (tramp--test-emacs26-p)) - ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t. @@@ -6360,7 -7737,7 +7843,7 @@@ (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) - (ert-deftest tramp-test45-recursive-load () -(ert-deftest tramp-test48-recursive-load () ++(ert-deftest tramp-test49-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@@ -6384,12 -7761,8 +7867,8 @@@ (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) - (ert-deftest tramp-test45-remote-load-path () -(ert-deftest tramp-test48-remote-load-path () ++(ert-deftest tramp-test49-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." - ;; The autoloaded Tramp objects are different since Emacs 26.1. We - ;; cannot test older Emacsen, therefore. - (skip-unless (tramp--test-emacs26-p)) - ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the ;; `load-path'. @@@ -6413,7 -7786,7 +7892,7 @@@ (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) - (ert-deftest tramp-test46-unload () -(ert-deftest tramp-test49-unload () ++(ert-deftest tramp-test50-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@@ -6490,14 -7891,15 +7997,16 @@@ If INTERACTIVE is non-nil, the tests ar ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. - ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. - ;; * Fix `tramp-test06-directory-file-name' for `ftp'. - ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' - ;; do not work properly for `nextcloud'. - ;; * 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? - ;; * Fix `tramp-test44-threads'. + ;; * Fix `tramp-test06-directory-file-name' for "ftp". + ;; * Check, why a process filter t doesn't work in + ;; `tramp-test29-start-file-process' and + ;; `tramp-test30-make-process'. + ;; * Implement `tramp-test31-interrupt-process' and + ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct + ;; async processes. Check, why they don't run stable. + ;; * Check, why direct async processes do not work for + ;; `tramp-test45-asynchronous-requests'. ++;; * Fix `tramp-test48-threads'. (provide 'tramp-tests)