diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py index 5c760fb21ce..493e7616fa9 100755 --- a/admin/nt/dist-build/build-dep-zips.py +++ b/admin/nt/dist-build/build-dep-zips.py @@ -25,12 +25,12 @@ from subprocess import check_output ## Constants -EMACS_MAJOR_VERSION= os.getenv('EMACS_MAJOR_VERSION') or "30" +EMACS_MAJOR_VERSION= os.getenv('EMACS_MAJOR_VERSION') or "31" # Base URI for the package sources mapped in PKG_REQ SRC_REPO="https://repo.msys2.org/mingw/sources" -# Map items in `dynamic-library-alist' to source packages +# Map items in `dynamic-library-alist' to source pakages PKG_REQ='''mingw-w64-x86_64-giflib mingw-w64-x86_64-gnutls mingw-w64-x86_64-harfbuzz @@ -47,29 +47,15 @@ mingw-w64-x86_64-tree-sitter mingw-w64-x86_64-sqlite3'''.split() -# Emacs style path to dependency DLLs on build system -DLL_SRC="c:/msys64/mingw64/bin" +# Emacs style path to dependancy DLLs on build system +DLL_SRC="mingw64" +OUT_TAG="" # libraries we never include DLL_SKIP=["libgccjit-0.dll"] -# Report first existing file for entries in dynamic-library-alist -# ELISP_PROG=""" -# (message "%s" (mapconcat 'identity (remove nil -# (mapcar (lambda(lib) -# (seq-find -# (lambda(file) -# (file-exists-p -# (file-name-concat "{}" -# file))) -# (cdr lib))) -# dynamic-library-alist) -# ) "\\n")) -# """.format(DLL_SRC) - ## Options DRY_RUN=False -# NEW_EMACS="bin/emacs.exe" def check_output_maybe(*args,**kwargs): if(DRY_RUN): @@ -82,7 +68,6 @@ def check_output_maybe(*args,**kwargs): # entry point def gather_deps(): - os.mkdir("x86_64") os.chdir("x86_64") @@ -95,12 +80,12 @@ def gather_deps(): if dep not in DLL_SKIP: if args.l != True: print("Adding dep", dep) - check_output_maybe(["cp /mingw64/bin/{} .".format(dep)], shell=True) + check_output_maybe(["cp /{}/bin/{} .".format(DLL_SRC,dep)], shell=True) else: if args.l != True: print("Skipping dep", dep) - zipfile="../emacs-{}-{}deps.zip".format(EMACS_MAJOR_VERSION, DATE) + zipfile="../emacs-{}{}-{}deps.zip".format(EMACS_MAJOR_VERSION, OUT_TAG, DATE) tmpfile="{}.tmp".format(zipfile) print("Zipping deps in", os.getcwd(), "as", tmpfile) check_output_maybe("zip -9vr {} *.dll".format(tmpfile), shell=True) @@ -110,7 +95,7 @@ def gather_deps(): print("Deps updated in", os.getcwd(), "as", zipfile) os.chdir("../") -# Return dependencies listed in Emacs +# Return dependancies listed in Emacs def init_deps(): return '''libXpm-nox4.dll libpng16-16.dll @@ -125,23 +110,17 @@ def init_deps(): libgio-2.0-0.dll libgobject-2.0-0.dll libgnutls-30.dll -libxml2-2.dll +libxml2-16.dll zlib1.dll liblcms2-2.dll libgccjit-0.dll -libtree-sitter.dll'''.split() - # job_args=[NEW_EMACS, "--batch", "--eval", ELISP_PROG] - # #print("args: ", job_args) - # return subprocess.check_output(job_args, stderr=subprocess.STDOUT - # ).decode('utf-8').splitlines() +libtree-sitter-0.26.dll'''.split() # Return all second order dependencies def full_dll_dependency(dlls): deps = [dll_dependency(dep) for dep in dlls] return set(sum(deps, []) + dlls) -#xs = filter(lambda x: x.attribute == value, xs) - # Dependencies for a given DLL def dll_dependency(dll): output = check_output(["/mingw64/bin/ntldd", "--recursive", @@ -171,80 +150,29 @@ def ntldd_munge(out): ## Packages to fiddle with ## Source for gcc-libs is part of gcc SKIP_SRC_PKGS=["mingw-w64-gcc-libs"] -SKIP_DEP_PKGS=["mingw-w64-glib2", "mingw-w64-ca-certificates-20211016-3"] +SKIP_DEP_PKGS=["mingw-w64-glib2", "mingw-w64-x86_64-cc-libs", "mingw-w64-ca-certificates-20211016-3"] + +## A few source packages don't follow typical naming conventions. +## Handle transformation from formulaic name to actual name MUNGE_SRC_PKGS={ - "mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git", + "mingw-w64-libwinpthread":"mingw-w64-winpthreads", "mingw-w64-gettext-runtime":"mingw-w64-gettext" } + +## As above, but for source packages of second order deps +## Empty as of 30.0.50 (May, 2026), last used for Emacs 30.2 MUNGE_DEP_PKGS={ - "mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git", - "mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git", -} -SRC_EXT={ - "mingw-w64-freetype": ".src.tar.zst", - "mingw-w64-fribidi": ".src.tar.zst", - "mingw-w64-glib2": ".src.tar.zst", - "mingw-w64-harfbuzz": ".src.tar.zst", - "mingw-w64-libunistring": ".src.tar.zst", - "mingw-w64-winpthreads-git": ".src.tar.zst", - "mingw-w64-ca-certificates": ".src.tar.zst", - "mingw-w64-libxml2": ".src.tar.zst", - "mingw-w64-ncurses": ".src.tar.zst", - "mingw-w64-openssl": ".src.tar.zst", - "mingw-w64-pango": ".src.tar.zst", - "mingw-w64-python": ".src.tar.zst", - "mingw-w64-sqlite3": ".src.tar.zst", - "mingw-w64-xpm-nox": ".src.tar.zst", - "mingw-w64-xz": ".src.tar.zst", - "mingw-w64-bzip2": ".src.tar.zst", - "mingw-w64-cairo": ".src.tar.zst", - "mingw-w64-expat": ".src.tar.zst", - "mingw-w64-fontconfig": ".src.tar.zst", - "mingw-w64-gdk-pixbuf2": ".src.tar.zst", - "mingw-w64-giflib": ".src.tar.zst", - "mingw-w64-gmp": ".src.tar.zst", - "mingw-w64-gnutls": ".src.tar.zst", - "mingw-w64-graphite2": ".src.tar.zst", - "mingw-w64-jbigkit": ".src.tar.zst", - "mingw-w64-lcms2": ".src.tar.zst", - "mingw-w64-lerc": ".src.tar.zst", - "mingw-w64-libdatrie": ".src.tar.zst", - "mingw-w64-libffi": ".src.tar.zst", - "mingw-w64-libiconv": ".src.tar.zst", - "mingw-w64-libiconv": ".src.tar.zst", - "mingw-w64-libpng": ".src.tar.zst", - "mingw-w64-librsvg": ".src.tar.zst", - "mingw-w64-libsystre": ".src.tar.zst", - "mingw-w64-libtasn": ".src.tar.zst", - "mingw-w64-libthai": ".src.tar.zst", - "mingw-w64-libtiff": ".src.tar.zst", - "mingw-w64-libtre-git": ".src.tar.zst", - "mingw-w64-libwebp": ".src.tar.zst", - "mingw-w64-mpdecimal": ".src.tar.zst", - "mingw-w64-nettle": ".src.tar.zst", - "mingw-w64-p11-kit": ".src.tar.zst", - "mingw-w64-pcre": ".src.tar.zst", - "mingw-w64-pixman": ".src.tar.zst", - "mingw-w64-python-packaging": ".src.tar.zst", - "mingw-w64-readline": ".src.tar.zst", - "mingw-w64-tcl": ".src.tar.zst", - "mingw-w64-termcap": ".src.tar.zst", - "mingw-w64-tk": ".src.tar.zst", - "mingw-w64-tree-sitter": ".src.tar.zst", - "mingw-w64-tzdata": ".src.tar.zst", - "mingw-w64-wineditline": ".src.tar.zst", - "mingw-w64-zlib": ".src.tar.zst", - "mingw-w64-zstd": ".src.tar.zst", - "mingw-w64-brotli": ".src.tar.zst", - "mingw-w64-gettext": ".src.tar.zst", - "mingw-w64-libdeflate": ".src.tar.zst", - "mingw-w64-libidn2": ".src.tar.zst", - "mingw-w64-libjpeg-turbo": ".src.tar.zst", - "mingw-w64-libtasn1": ".src.tar.zst", - "mingw-w64-pcre2": ".src.tar.zst", + #"mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git", + #"mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git", } -## Currently no packages seem to require this! +# usual source ext is now tar.zst; this overrides that.. +SRC_EXT={ +# "mingw-w64-brotli": ".src.tar.gz", +} + +## Pick up packages only when building for a given architecture +## Currently no packages seem to require this! Unused since Emacs 26 ARCH_PKGS=[] def immediate_deps(pkg): @@ -296,7 +224,7 @@ def download_source(tarball): ) print("Downloading {}... done".format(tarball)) - print("Copying {} from local".format(tarball)) + #print("Copying {} from local".format(tarball)) shutil.copyfile("../emacs-src-cache/{}".format(tarball), "{}".format(tarball)) @@ -311,6 +239,7 @@ def gather_source(deps): os.chdir("emacs-src") for pkg in deps: + #print("Parsing pkg name and version from {}".format(pkg)) pkg_name_and_version= \ check_output(["pacman","-Q", pkg]).decode("utf-8").strip() @@ -321,7 +250,7 @@ def gather_source(deps): pkg_version=pkg_name_components[1] ## source pkgs don't have an architecture in them - pkg_name = re.sub(r"x86_64-","",pkg_name) + pkg_name = re.sub(r"(ucrt-)?x86_64-","",pkg_name) if(pkg_name in SKIP_SRC_PKGS): continue @@ -329,17 +258,18 @@ def gather_source(deps): ## Switch names if necessary pkg_name = MUNGE_SRC_PKGS.get(pkg_name,pkg_name) - ## src archive is usually a .tar.gz + ## src archive is usually a .tar.zst if pkg_name in SRC_EXT.keys(): src_ext = SRC_EXT[pkg_name] else: - src_ext = ".src.tar.gz" + src_ext = ".src.tar.zst" tarball = "{}-{}{}".format(pkg_name,pkg_version,src_ext) download_source(tarball) - srczip="../emacs-{}-{}deps-mingw-w64-src.zip".format(EMACS_MAJOR_VERSION,DATE) + srczip="../emacs-{}{}-{}deps-mingw-w64-src.zip".format( + EMACS_MAJOR_VERSION,OUT_TAG, DATE) tmpzip="{}.tmp".format(srczip) print("Zipping Dsrc in", os.getcwd(), "as", tmpzip) check_output_maybe("zip -9 {} *".format(tmpzip), shell=True) @@ -367,6 +297,9 @@ def clean(): #parser.add_argument("emacs", help="emacs executable") +parser.add_argument("-u", help="UCRT64 build", + action="store_true") + parser.add_argument("-s", help="snapshot build", action="store_true") @@ -382,16 +315,21 @@ def clean(): parser.add_argument("-l", help="list dependencies", action="store_true") -parser.add_argument("-e", help="extract direct dependencies", +parser.add_argument("-e", help="extract direct dependancies", action="store_true") args = parser.parse_args() do_all=not (args.c or args.r) + #NEW_EMACS=args.emacs DRY_RUN=args.d +if( args.u ): + DLL_SRC="ucrt64" + OUT_TAG="-ucrt" + if( args.e ): print("\n".join(init_deps())) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 9abef21f459..1991ab0858a 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -761,7 +761,7 @@ that operates on the marked files finishes. @cindex operating on files in Dired This section describes the basic Dired commands to operate on one file -or several files. All of these commands are capital letters; all of +or several files. Many of these commands are capital letters; all of them use the minibuffer, either to read an argument or to ask for confirmation, before they act. All of them let you specify the files to manipulate in these ways: @@ -1022,6 +1022,21 @@ single archive anywhere on the file system. The default archive is controlled by the @code{dired-compress-directory-default-suffix} user option. Also see @code{dired-compress-files-alist}. +@cindex Dired and version control +@findex dired-vc-next-action +@kindex C-x v v @r{(Dired)} +@item C-x v v +@itemx C-x v = @r{(Dired)} +@itemx C-x v l @r{(Dired)} + If the directory you are visiting is under version control +(@pxref{Version Control}), then the normal VC commands will operate on +the selected files. For example, @kbd{C-x v v} invokes +@code{dired-vc-next-action}, which does the same as +@code{vc-next-action} in a buffer visiting a file under version control +(@pxref{Basic VC Editing}). Similarly, @kbd{C-x v =} shows the diffs +between the marked files and their committed versions, and @code{C-x v l} +shows the VC change history for the marked files. + @findex epa-dired-do-decrypt @kindex :d @r{(Dired)} @cindex decrypting files (in Dired) @@ -1947,11 +1962,6 @@ file/directory listings. To change this, customize the options @code{dired-hide-details-hide-symlink-targets} and @code{dired-hide-details-hide-information-lines}, respectively. -@cindex Dired and version control - If the directory you are visiting is under version control -(@pxref{Version Control}), then the normal VC diff and log commands -will operate on the selected files. - @findex dired-compare-directories The command @kbd{M-x dired-compare-directories} is used to compare the current Dired buffer with another directory. It marks all the files diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 2400440f951..a1825c5e515 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -862,7 +862,7 @@ v} to check-out the file and start editing it. Compare the work files in the current VC fileset with the versions you started from (@code{vc-diff}). With a prefix argument, prompt for two revisions of the current VC fileset and compare them. You can also -call this command from a Dired buffer (@pxref{Dired}). +call this command from a Dired buffer (@pxref{Operating on Files}). @ifnottex @item M-x vc-ediff @@ -1137,9 +1137,9 @@ Buffer}). If invoked from a buffer visiting a file, the current fileset consists of that single file, and point in the displayed @file{*vc-change-log*} buffer is centered at the revision of that file. If invoked from a VC Directory buffer (@pxref{VC Directory -Mode}) or from a Dired buffer (@pxref{Dired}), the fileset consists of -all the marked files, defaulting to the file shown on the current line -in the directory buffer if no file is marked. +Mode}) or from a Dired buffer (@pxref{Operating on Files}), the fileset +consists of all the marked files, defaulting to the file shown on the +current line in the directory buffer if no file is marked. If the fileset includes one or more directories, the resulting @file{*vc-change-log*} buffer shows a short log of changes (one line diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 72a1fdc7878..809fa36098a 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -411,8 +411,8 @@ that the early init file is loaded much earlier during the startup process, so you can use it to customize some things that are initialized before loading the regular init file. For example, you can customize the process of initializing the package system, by -setting variables such as @var{package-load-list} or -@var{package-enable-at-startup}. @xref{Package Installation,,, +setting variables such as @code{package-load-list} or +@code{package-enable-at-startup}. @xref{Package Installation,,, emacs,The GNU Emacs Manual}. @cindex default init file diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index 8f3f5fe79b0..3097ed02345 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -133,15 +133,6 @@ init file, and any code that should run after it in the primary init file (@pxref{Init File,,, emacs, The GNU Emacs Manual}). @end defun -@deffn Command package-initialize &optional no-activate -This function initializes Emacs's internal record of which packages are -installed, and then calls @code{package-activate-all}. - -The optional argument @var{no-activate}, if non-@code{nil}, causes -Emacs to update its record of installed packages without actually -making them available. -@end deffn - @node Simple Packages @section Simple Packages @cindex single file package diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index abb2c883f78..8779cf88917 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -282,7 +282,7 @@ previous example is equivalent to using nested @code{let} bindings: @end defspec -@defspec letrec (bindings@dots{}) forms@dots{} +@defmac letrec (bindings@dots{}) forms@dots{} This special form is like @code{let*}, but all the variables are bound before any of the local values are computed. The values are then assigned to the locally bound variables. This is useful only when @@ -299,11 +299,11 @@ being run once: (remove-hook 'post-command-hook hookfun)))) (add-hook 'post-command-hook hookfun)) @end lisp -@end defspec +@end defmac @cindex dynamic binding, temporarily @cindex dynamic let-binding -@defspec dlet (bindings@dots{}) forms@dots{} +@defmac dlet (bindings@dots{}) forms@dots{} This special form is like @code{let}, but it binds all variables dynamically. This is rarely useful---you usually want to bind normal variables lexically, and special variables (i.e., variables that are @@ -315,9 +315,9 @@ that certain variables are dynamically bound (@pxref{Dynamic Binding}), but it's impractical to @code{defvar} these variables. @code{dlet} will temporarily make the bound variables special, execute the forms, and then make the variables non-special again. -@end defspec +@end defmac -@defspec named-let name bindings &rest body +@defmac named-let name bindings &rest body This special form is a looping construct inspired from the Scheme language. It is similar to @code{let}: It binds the variables in @var{bindings}, and then evaluates @var{body}. However, @@ -353,7 +353,7 @@ itself, as is the case in the recursive call to @code{sum} above. @code{named-let} can be used only when lexical-binding is enabled. @xref{Lexical Binding}. -@end defspec +@end defmac Here is a complete list of the other facilities that create local bindings: diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 0b6be34c41f..d501fe32d5d 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -474,11 +474,11 @@ Code reformatting via the @code{eglot-format} and related commands supported and is activated automatically as you type. @item -If a completion package such as the Company package (a popular -third-party completion package providing @code{company-mode}), is -installed, Eglot enhances it by providing completion candidates based on -the language server's analysis of the source code. (Company can be -installed from GNU ELPA.) +Eglot enhances symbol completion front-ends by providing completion +candidates based on the language server's understanding of the source +code (@pxref{Symbol Completion,,, emacs, GNU Emacs Manual}). The +Company package, installable from GNU ELPA, is a popular package known +to work well with Eglot. @item If YASnippet, a popular third-party package for automatic insertion of @@ -488,12 +488,11 @@ completion package to instantiate these snippets using YASnippet. (YASnippet can be installed from GNU ELPA.) @item -If the popular third-party package @code{markdown-mode} is installed, -and the server provides at-point documentation formatted as Markdown in +When the server provides at-point documentation formatted as Markdown in addition to plain text, Eglot arranges for the ElDoc package to enrich -this text with fontifications and other nice formatting before -displaying it to the user. This makes the documentation shown by ElDoc -look nicer on display. +this text with fontifications, hyperlinks and other nice formatting +before displaying it to the user. This makes the documentation shown by +ElDoc look nicer on display. @item In addition to enabling and enhancing other features and packages, Eglot @@ -1969,7 +1968,7 @@ directory is a way to tell the maintainers about ELPA package versions. @item Include a recipe to replicate the problem with @emph{a clean Emacs run}. -The invocation @code{emacs -Q -f package-initialize} starts Emacs with +The invocation @code{emacs -Q -f package-activate-all} starts Emacs with no configuration and initializes the ELPA packages. A very minimal @file{.emacs} initialization file (10 lines or less) is also acceptable and good means to describe changes to variables. diff --git a/doc/misc/org.org b/doc/misc/org.org index ab0f8a9c1a6..8644109a6a1 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -125,7 +125,7 @@ To avoid interference with the built-in Org mode, you can use the command line (you need Emacs 30 or later): #+begin_src sh -emacs -Q -batch -eval "(progn (require 'package) (package-initialize) (package-refresh-contents) (package-upgrade 'org))" +emacs -Q -batch -eval "(progn (package-refresh-contents) (package-upgrade 'org))" #+end_src This approach has the advantage of isolating the upgrade process from diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 8428109fde7..ae65cf2a620 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4227,6 +4227,14 @@ called is local or remote, since @value{tramp} would add just the @env{HGPLAIN} setting and local processes would take whole value of @code{process-environment} along with the new value of @env{HGPLAIN}. +@vindex tramp-propagate-emacsclient-tramp +@vindex EMACSCLIENT_TRAMP@r{, environment variable} +If you set the user option @code{tramp-propagate-emacsclient-tramp} to +a non-@code{nil} value, the environment variable +@env{EMACSCLIENT_TRAMP} will be set to a value which allows to call +@command{emacsclient} from a process running on the remote +host. @xref{emacsclient Options, , , emacs}. + For integrating other Emacs packages so @value{tramp} can execute remotely, please file a bug report. @xref{Bug Reports}. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 4e01f32cecd..eb4040d107e 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -32,6 +32,12 @@ New key bindings: 'k' shuts down, 'r' reconnects, 'e' visits the events buffer, 'w' shows workspace configuration, and 'RET' invokes 'eglot-describe-connection'. +** Eglot uses new built-in 'markdown-ts-mode' of Emacs 31 (bug#80127) + +This means that on newer versions of Emacs the external +'markdown-mode.el' package does not need to be installed to render +Markdown content. + * Changes in Eglot 1.23 (2/4/2026) diff --git a/etc/NEWS.31 b/etc/NEWS.31 index c0e05deed2e..a746ca7b1a3 100644 --- a/etc/NEWS.31 +++ b/etc/NEWS.31 @@ -2451,6 +2451,13 @@ This can be used by external ELPA packages for performance optimizations in special cases. For more information, see "(tramp) New operations" in the Tramp manual. ++++ +*** New user option 'tramp-propagate-emacsclient-tramp'. +When this option is non-nil, Tramp propagates the environment variable +EMACSCLIENT_TRAMP with a proper value to remote processes. This is +helpful if you want to start emacsclient on a remote host from a process +started inside Emacs. + ** Isearch and Replace *** Typing 'd' during 'query-replace' shows the diff buffer with replacements. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 340e99c0425..2ae82292e04 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3262,6 +3262,30 @@ To turn the Windows Magnifier off, click "Start->All Programs", or "Accessibility" and click "Magnifier". In the Magnifier Settings dialog that opens, click "Exit". +** Cursor is invisible, or appears at times and then disappears + +This is known to happen if 'w32-use-visible-system-caret' is non-nil. +That variable is nil by default, but if your system has the "Speech +Recognition" feature enabled, Emacs automatically sets this variable +non-nil at startup to allow the screen reader to read the relevant part +of the Emacs display and dictate it. + +To turn this off on modern Windows systems, go to "Settings -> +Accessibility -> Speech", and turn off "Voice access". If you need to +leave this accessibility feature turned on, you can alternatively set +'w32-use-visible-system-caret' to the nil value in your init file: + + (setq w32-use-visible-system-caret nil) + +If you do need to see the system caret in Emacs windows, you can instead +work around this problem by disabling double-buffering in your init +file: + + (set-frame-parameter nil 'inhibit-double-buffering nil) + +Note that inhibiting double-buffering might cause the Emacs display to +flicker in some cases. + ** Problems with mouse-tracking and focus management There are problems with display if mouse-tracking is enabled and the diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 77ff567954f..55f9fb1988b 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -530,6 +530,7 @@ If INTERACTIVE, display it. Else, return said buffer." (things-reported-on)) (special-mode) (erase-buffer) + (visual-line-mode) (setq-local nobreak-char-display nil) (cl-loop for (docs . rest) on docs for (this-doc . plist) = docs diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index e4d838d2968..7298dd447e8 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1000,6 +1000,12 @@ to be merged by the user - `hfy-flatten-style' should do this." parent (hfy-face-to-style-i (hfy-face-attr-for-class v hfy-display-class)))))) + ;; The special value `reset' stands for the value of the + ;; corresponding attribute (KEY) of the ‘default’ face. + (when (eq val 'reset) + (setq val (plist-get + (hfy-face-attr-for-class 'default hfy-display-class) + key))) (setq this (if val (cl-case key (:family (hfy-family val)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 92002b854b3..7b90ae9c11b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3091,6 +3091,11 @@ will be used." (if (string-search "=" elt) (setq env (append env `(,elt))) (setq uenv (cons elt uenv)))))) + (env (if tramp-propagate-emacsclient-tramp + (setenv-internal + env "EMACSCLIENT_TRAMP" + (tramp-make-tramp-file-name v 'noloc) 'keep) + env)) (env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) ;; Environment is too large. Keep it here. @@ -3340,6 +3345,10 @@ will be used." (if (string-search "=" elt) (setq env (append env `(,elt))) (setq uenv (cons elt uenv))))) + (when tramp-propagate-emacsclient-tramp + (setq env (setenv-internal + env "EMACSCLIENT_TRAMP" + (tramp-make-tramp-file-name v 'noloc) 'keep))) (setq env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (when env (setq command diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6219d097f4f..fc897fb2a7c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1528,12 +1528,21 @@ The PATH environment variable should be set via `tramp-remote-path'. The TERM environment variable should be set via `tramp-terminal-type'. +The EMACSCLIENT_TRAMP environment variable will be set accordingly, if +`tramp-propagate-emacsclient-tramp' is non-nil. + The INSIDE_EMACS environment variable will automatically be set based on the Tramp and Emacs versions, and should not be set here." :version "26.1" :type '(repeat string) :link '(info-link :tag "Tramp manual" "(tramp) Remote processes")) +(defcustom tramp-propagate-emacsclient-tramp nil + "Whether to propagate the EMACSCLIENT_TRAMP environment variable." + :version "31.1" + :type 'boolean + :link '(info-link :tag "Tramp manual" "(tramp) Remote processes")) + ;;; Internal Variables: ;;;###tramp-autoload @@ -5509,6 +5518,13 @@ processes." (env (if sh-file-name-handler-p (setenv-internal env "TERM" tramp-terminal-type 'keep) env)) + ;; Add EMACSCLIENT_TRAMP. + (env (if (and tramp-propagate-emacsclient-tramp + sh-file-name-handler-p) + (setenv-internal + env "EMACSCLIENT_TRAMP" + (tramp-make-tramp-file-name v 'noloc) 'keep) + env)) ;; Add INSIDE_EMACS. (env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (env (mapcar #'tramp-shell-quote-argument (delq nil env))) @@ -7390,7 +7406,8 @@ T1 and T2 are time values (as returned by `current-time' for example)." Suppress `shell-file-name'. This is needed on w32 systems, which would use a wrong quoting for local file names. See `w32-shell-name'." (let (shell-file-name) - (shell-quote-argument (file-name-unquote s)))) + ;; Do not expand remote file names w/o a localname. + (shell-quote-argument (file-name-unquote s 'top)))) ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index e97b1749b79..3d2c267650e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -720,9 +720,14 @@ This can be useful when using docker to run a language server.") (if (>= emacs-major-version 27) (executable-find command remote) (executable-find command))) +(declare-function treesit-grammar-location "treesit.c") (defun eglot--accepted-formats () - (if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode)) - ["markdown" "plaintext"] ["plaintext"])) + (if (and (not eglot-prefer-plaintext) + (or (fboundp 'gfm-view-mode) + (and (fboundp 'markdown-ts-view-mode) + (treesit-grammar-location 'markdown)))) + ["markdown" "plaintext"] + ["plaintext"])) (defconst eglot--uri-path-allowed-chars (let ((vec (copy-sequence url-path-allowed-chars))) @@ -2225,48 +2230,51 @@ Doubles as an indicator of snippet support." (unless (bound-and-true-p yas-minor-mode) (yas-minor-mode 1)) (apply #'yas-expand-snippet args))))) -(defun eglot--format-markup (markup &optional mode) +(cl-defun eglot--format-markup + (markup &optional mode + &aux string lang render extract + (built-in (and (fboundp 'markdown-ts-view-mode) + (treesit-grammar-location 'markdown)))) "Format MARKUP according to LSP's spec. -MARKUP is either an LSP MarkedString or MarkupContent object." - (let (string render-mode language) - (cond ((stringp markup) - (setq string markup - render-mode (or mode 'gfm-view-mode))) - ((setq language (plist-get markup :language)) - ;; Deprecated MarkedString - (setq string (concat "```" language "\n" - (plist-get markup :value) "\n```") - render-mode (or mode 'gfm-view-mode))) - (t - ;; MarkupContent - (setq string (plist-get markup :value) - render-mode - (or mode - (pcase (plist-get markup :kind) - ("markdown" 'gfm-view-mode) - ("plaintext" 'text-mode) - (_ major-mode)))))) +MARKUP is either an LSP MarkedString or MarkupContent object. +If MODE, force MODE to be used for fontifying MARKUP." + (cl-labels + ((gfm-extract () + ;; For `gfm-view-mode', the `invisible' regions are set to + ;; `markdown-markup'. Set them to 't' on extraction, since + ;; this has actual meaning in the "*eldoc*" buffer where we're + ;; taking this string (#bug79552). + (cl-loop with inhibit-read-only = t + for from = (point-min) then to + while (< from (point-max)) + for inv = (get-text-property from 'invisible) + for to = (or (next-single-property-change from 'invisible) + (point-max)) + when inv + do (put-text-property from to 'invisible t))) + (calc2 (forced-mode) + (cond + (forced-mode `(,forced-mode)) + (built-in `(,#'markdown-ts-view-mode)) + ((fboundp 'gfm-view-mode) `(,#'gfm-view-mode #'gfm-extract)) + (t `(#'text-mode)))) + (calc (s &optional (forced-mode mode) &aux (x (calc2 forced-mode))) + (setq string s render (car x) extract (or (cadr x) #'buffer-string)))) + (cond ((stringp markup) (calc string)) ; plain string + ((setq lang (plist-get markup :language)) ; deprecated MarkedString + (calc (format "```%s\n%s\n```" lang (plist-get markup :value)))) + (t (calc (plist-get markup :value) ; Assume MarkupContent + (or mode (pcase (plist-get markup :kind) + ("markdown" nil) + ("plaintext" 'text-mode) + (_ major-mode)))))) (with-temp-buffer (setq-local markdown-fontify-code-blocks-natively t) (insert string) - (let ((inhibit-message t) - (message-log-max nil)) - (ignore-errors (delay-mode-hooks (funcall render-mode))) + (let ((inhibit-message t) (message-log-max nil)) + (ignore-errors (delay-mode-hooks (funcall render))) (font-lock-ensure) - (goto-char (point-min)) - (let ((inhibit-read-only t)) - ;; If `render-mode' is `gfm-view-mode', the `invisible' - ;; regions are set to `markdown-markup'. Set them to 't' - ;; instead, since this has actual meaning in the "*eldoc*" - ;; buffer where we're taking this string (#bug79552). - (cl-loop for from = (point) then to - while (< from (point-max)) - for inv = (get-text-property from 'invisible) - for to = (or (next-single-property-change from 'invisible) - (point-max)) - when inv - do (put-text-property from to 'invisible t))) - (string-trim (buffer-string)))))) + (string-trim (funcall extract)))))) (defun eglot--read-server (prompt &optional dont-if-just-the-one) "Read a running Eglot server from minibuffer using PROMPT. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f62f9f5ce3c..823aa4fe673 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -2428,7 +2428,10 @@ symbol `fringes' or the symbol `margins'." `((margin ,flymake-margin-indicator-position) ,(propertize indicator-car - 'face `(:inherit (,(cdr valuelist) default)) + 'face `(:inherit (,(cdr valuelist) + ,(if (facep 'margin) + 'margin + 'default))) 'mouse-face 'highlight 'help-echo "Open Flymake diagnostics" 'keymap (let ((map (make-sparse-keymap))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index f781a82b105..44b50584bf4 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -299,7 +299,7 @@ use that face for the ellipsis instead." :version "31.1") (defface hs-indicator-hide - '((t :inherit (shadow default))) + '((t :inherit shadow)) "Face used in hideshow indicator to indicate a hidden block." :version "31.1") @@ -1094,14 +1094,16 @@ the overlay: `invisible' `hs'. Also, depending on variable `(left-fringe ,fringe-type ,face-or-icon))) ;; Margins ('margin - (propertize - "+" 'display - `((margin left-margin) - ,(or (plist-get (icon-elements face-or-icon) 'image) - (propertize (icon-string face-or-icon) - 'keymap hs-indicators-map))) - 'face face-or-icon - 'keymap hs-indicators-map)) + (let* ((icon-elements (icon-elements face-or-icon))) + (propertize + "+" 'display + `((margin left-margin) + ,(or (plist-get icon-elements 'image) + (propertize (plist-get icon-elements 'string) + 'face `(,face-or-icon margin) + 'keymap hs-indicators-map))) + 'face `(,face-or-icon margin) + 'keymap hs-indicators-map))) ;; EOL string ('nil (concat diff --git a/lisp/textmodes/markdown-ts-mode-x.el b/lisp/textmodes/markdown-ts-mode-x.el index 1327191828e..1296e3567a3 100644 --- a/lisp/textmodes/markdown-ts-mode-x.el +++ b/lisp/textmodes/markdown-ts-mode-x.el @@ -736,7 +736,11 @@ is nil and the command is run interactively, prompt for a template. The basic template uses all defaults and is likely the best choice for most uses. The complete template illustrates all parameters set to their defaults and is useful as a starting point to customize a table." - (interactive "cTemplate [b]asic [c]omplete:") + (interactive + (list (car (read-multiple-choice + "Table of contents template" + '((?b "basic") + (?c "complete")))))) (pcase char (?b (insert "\n" diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index 05f016ab377..d2f4fcd8fa7 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -154,6 +154,17 @@ ;; content. Lowercase `' works as a workaround. ;; See . ;; +;; - The grammar parses solo tildes, incorrectly applying strikethrough. +;; For example, writing: +;; +;; I see ~approximately four lights. +;; I do not see ~approximately five lights. +;; +;; Results in strikethrough incorrectly starting at the first +;; ~approximately and extending till the tilde at the second +;; ~approximately. +;; See . +;; ;; - Superscript (`^text^') and subscript (`~text~') syntax is not ;; supported by the grammar. No EXTENSION_ build flag exists for ;; this. This is Pandoc / PHP Markdown Extra syntax, not CommonMark @@ -279,6 +290,8 @@ use that string instead." (defcustom markdown-ts-inline-images nil "Non-nil means display inline images below image links." :type 'boolean + :local t + :safe #'booleanp :version "31.1" :package-version "1.0") @@ -302,6 +315,28 @@ Remote images are skipped by default for security." :version "31.1" :package-version "1.0") +(defcustom markdown-ts-unordered-list-marker '(("● " . "- ") + ("○ " . "- ") + ("◼ " . "- ") + ("• " . "- ")) + "If markup is hidden, display these for an unordered list marker. +Each list item marker's depth in its list controls its selected string +starting at the first element and cycling through the others for deeper +items. The list will be cycle around back to the beginning if there are +insufficient strings to represent deep levels. + +Note that the default strings have trailing spaces. + +Value forms: + - (list (cons (PREFERRED . FALLBACK)) ...): where PREFERRED is used if + its first character passes `char-displayable-p', otherwise FALLBACK. + - nil: display the raw markup." + :type '(choice (repeat (cons (string :tag "Preferred (GUI)") + (string :tag "Fallback (TTY)"))) + (const :tag "Display original markup" nil)) + :version "31.1" + :package-version "1.0") + (defcustom markdown-ts-checked-checkbox '("☑" . "+") "If markup is hidden, display this for a checked task list marker. Value forms: @@ -354,10 +389,14 @@ Consulted only when `markdown-ts-unchecked-checkbox' is the symbol (defcustom markdown-ts-thematic-break-character '(?─ . ?-) "If markup is hidden, display this character for thematic breaks. -It is repeated to fill the window width. +It is repeated to fill the window width. This assumes a static window +width. +You may prefer an `:extend' attribute on the +`markdown-ts-thematic-break' which will span window width dynamically +using an underline, in which case this character is ignored. The value is a cons (PREFERRED . FALLBACK): PREFERRED is used if it passes `char-displayable-p', otherwise FALLBACK is used. -nil displays the raw markup." +Use nil to display the raw markup." :type '(choice (cons (character :tag "Preferred (GUI)") (character :tag "Fallback (TTY)")) (const :tag "Display original markup" nil)) @@ -371,7 +410,8 @@ The value is a cons (PREFERRED . FALLBACK): PREFERRED is used if it passes nil keeps the raw markup." :type '(choice (cons (character :tag "Preferred (GUI)") (character :tag "Fallback (TTY)")) - (const :tag "Display original markup" nil)) + (const :tag "Display original markup" nil) + (const :tag "Hide markup" hide)) :version "31.1" :package-version "1.0") @@ -391,7 +431,8 @@ The value can be: :type '(choice (character :tag "Display specified character (no repetition)") (string :tag "Display specified string (no repetition)") (function :tag "Function from count to display string") - (const :tag "Display original markup" nil)) + (const :tag "Display original markup" nil) + (const :tag "Hide markup" hide)) :version "31.1" :package-version "1.0") @@ -523,6 +564,18 @@ Set to nil to disable the lighter." :version "31.1" :package-version "1.0") +(defcustom markdown-ts-view-mode-pre-init-hook (list #'markdown-ts-add-final-newline) + "Hooks run before `markdown-ts-view-mode` initialization. +Functions on this list are intended to amend buffer content for +`markdown-ts-view-mode' and tree-sitter Markdown grammar compatibility. + +For example, `markdown-ts-add-final-newline' ensures the grammar +correctly parses markup at the end of the buffer that depends on a final +newline." + :type '(hook) + :version "31.1" + :package-version "1.0") + ;;; Faces: (defgroup markdown-ts-faces nil @@ -586,7 +639,7 @@ Set to nil to disable the lighter." "Face for Markdown link destinations (URLs)." :version "31.1") -(defface markdown-ts-code-span '((t (:inherit font-lock-string-face))) +(defface markdown-ts-code-span '((t (:inherit font-lock-keyword-face))) "Face for Markdown inline code spans." :version "31.1") @@ -750,7 +803,6 @@ shadow-colored block." (ts typescript-ts-mode) (yml yaml-ts-mode)) "Extra mappings from code block language tags to major modes. - Entries here are only needed when the language tag in a fenced code block does NOT match the conventional mode name derivation, e.g. the user writes \\=`\\=`\\=`ts instead of \\=`\\=`\\=`typescript, or @@ -783,7 +835,6 @@ conventional font-lock. `markdown-ts-mode' itself is one of them.") (defun markdown-ts--fontify-delimiter (node override start end &rest _) "Fontify delimiter NODE and optionally hide its markup. - NODE is the tree-sitter node representing the delimiter. OVERRIDE, START, and END are passed through to `treesit-fontify-with-override'." @@ -794,6 +845,26 @@ OVERRIDE, START, and END are passed through to (put-text-property (treesit-node-start node) (treesit-node-end node) 'invisible 'markdown-ts--markup))) +(defun markdown-ts--fontify-atx-delimiter (node override start end &rest _) + "Fontify atx_heading delimiter NODE and optionally hide its markup. +NODE is the tree-sitter node representing the delimiter. +Leading whitespace between the delimiter and the heading text is hidden +along with the delimiter when hiding markup. +OVERRIDE, START, and END are passed through to +`treesit-fontify-with-override'." + (treesit-fontify-with-override + (treesit-node-start node) (treesit-node-end node) + 'markdown-ts-delimiter override start end) + (when markdown-ts-hide-markup + (put-text-property (treesit-node-start node) + (save-excursion + (goto-char (treesit-node-end node)) + (re-search-forward "[^[:blank:]]" (pos-eol) 'no-error) + (if (eq (point) (pos-eol)) + (point) + (1- (point)))) + 'invisible 'markdown-ts--markup))) + (defvar url-mail-command) ; url/url-vars.el (defun markdown-ts--make-link-button (beg end url) @@ -1008,57 +1079,89 @@ Pushes the mark before moving so `C-u C-SPC' returns. Signals (recenter)) (user-error "No heading for fragment: #%s" id))) -(defun markdown-ts--fontify-heading (node _override _start _end &rest _) - "Apply the heading face across NODE. +(defun markdown-ts--fontify-atx-heading (node _override _start _end &rest _) + "Apply the heading face across an atx_heading NODE. Layer the face on top of child sub-nodes (e.g. an inline link) so their own faces are preserved. Strip any prior copy of the face first so it does not accumulate when the heading is refontified or its level/type changes during editing. - -For ATX headings, also fontify any optional trailing closing-`#' -sequence as a delimiter. The tree-sitter grammar does not produce a -separate node for these; per CommonMark they are decorative and -must be preceded by a space or tab." - (let* ((type (treesit-node-type node)) - (n-start (treesit-node-start node)) +Do not fontify the header's trailing newline. +Elide trailing whitespace when hiding markup. +Fontify any optional trailing closing-`#' sequence as a delimiter. The +tree-sitter grammar does not produce a separate node for these; per +CommonMark they are decorative and must be preceded by a space or tab." + (let* ((n-start (treesit-node-start node)) (n-end (treesit-node-end node)) - (face (cond - ((equal type "setext_heading") - 'markdown-ts-setext-heading) - (t - (let ((marker (treesit-node-child node 0))) - (intern (format "markdown-ts-heading-%d" - (length (treesit-node-text marker t))))))))) + (face (let ((marker (treesit-node-child node 0))) + (intern (format "markdown-ts-heading-%d" + (length (treesit-node-text marker t))))))) (font-lock--remove-face-from-text-property n-start n-end 'face face) - (font-lock-append-text-property n-start n-end 'face face) - (when (string-prefix-p "atx_" type) - (save-excursion - (goto-char n-end) - (skip-chars-backward " \t\n" n-start) - (let ((line-end (point))) - (skip-chars-backward " \t" n-start) - (let ((trailing-end (point))) - (skip-chars-backward "#" n-start) - (let ((trailing-start (point))) - (when (and (< trailing-start trailing-end) - (> trailing-start n-start) - (memq (char-before trailing-start) '(?\s ?\t))) - (font-lock--remove-face-from-text-property - trailing-start trailing-end - 'face 'markdown-ts-delimiter) - (font-lock-prepend-text-property - trailing-start trailing-end - 'face 'markdown-ts-delimiter) - (when markdown-ts-hide-markup - ;; Also hide the space(s) preceding the closer and any - ;; trailing whitespace, so the heading looks clean. - (let ((hide-start (save-excursion - (goto-char trailing-start) - (skip-chars-backward " \t" n-start) - (point)))) - (put-text-property hide-start line-end - 'invisible - 'markdown-ts--markup))))))))))) + (font-lock-append-text-property n-start (1- n-end) 'face face) + (save-excursion + (goto-char n-end) + (skip-chars-backward "[:space:]" n-start) + (let ((trailing-end (point))) + (skip-chars-backward "#" n-start) + (let ((trailing-start (point))) + (cond ((and (< trailing-start trailing-end) + (> trailing-start n-start) + (memq (char-before trailing-start) '(?\s ?\t))) + ;; Identify the optional trailing closing-# sequence, + ;; fontify it as a delimiter, and remove whitespace + ;; between the heading text and the delimiter. The + ;; grammar omits a node for this run despite CommonMark. + (font-lock--remove-face-from-text-property + trailing-start trailing-end + 'face 'markdown-ts-delimiter) + (font-lock-prepend-text-property + trailing-start trailing-end + 'face 'markdown-ts-delimiter) + (when markdown-ts-hide-markup + (let ((hide-start (save-excursion + (goto-char trailing-start) + (skip-chars-backward "[:space:]" n-start) + (point)))) + (put-text-property hide-start (pos-eol) + 'invisible 'markdown-ts--markup)))) + (markdown-ts-hide-markup + ;; Hide trailing whitespace in the nominal case. + (put-text-property trailing-end (pos-eol) + 'invisible 'markdown-ts--markup)))))))) + +(defun markdown-ts--fontify-setext-heading (node _override _start _end &rest _) + "Apply the heading face across a setext NODE. +Layer the face on top of child sub-nodes (e.g. an inline link) so +their own faces are preserved. Strip any prior copy of the face +first so it does not accumulate when the heading is refontified or +its level/type changes during editing. +Apply the face to the setext heading_content separately from the +underline rather than treat them as a single range. This avoids putting +the face on the heading_content newline. If `markdown-ts-hide-markup' +is non-nil, hide the underline line entirely by setting its line-height +text property to 0. +Elide trailing whitespace when hiding markup." + (let* ((n-start (treesit-node-start node)) + (n-end (treesit-node-end node)) + (content (treesit-node-child node 0 'named)) + (content-start (treesit-node-start content)) + (content-end (treesit-node-end content)) + (underline (treesit-node-child node 1 'named)) + (underline-start (treesit-node-start underline)) + (underline-end (treesit-node-end underline)) + (face 'markdown-ts-setext-heading)) + (font-lock--remove-face-from-text-property n-start n-end 'face face) + ;; 1- content-end avoids the newline so it hides correctly. + (font-lock-append-text-property content-start (1- content-end) 'face face) + (font-lock-append-text-property underline-start underline-end 'face face) + (when markdown-ts-hide-markup + ;; Hide heading_content trailing spaces. + (put-text-property (save-excursion + (goto-char content-end) + (skip-chars-backward "[:space:]" content-start) + (point)) + content-end + 'invisible 'markdown-ts--markup) + (put-text-property underline-start underline-end 'line-height 0)))) (defun markdown-ts--fontify-link-node (node override start end &rest _) "Fontify link or image text NODE as a clickable button. @@ -1248,12 +1351,51 @@ OVERRIDE, START, and END are passed through to (defun markdown-ts--resolve-display-value (val) "Resolve VAL, a cons (PREFERRED . FALLBACK), to a displayable value. -Return PREFERRED if its first character passes `char-displayable-p', -otherwise return FALLBACK. Return nil if VAL is nil." - (when val - (let* ((preferred (car val)) - (ch (if (characterp preferred) preferred (aref preferred 0)))) - (if (char-displayable-p ch) (car val) (cdr val))))) +PREFERRED and FALLBACK can be a character or a string. Return PREFERRED +if it, or its first character, is `char-displayable-p', otherwise return +FALLBACK. +If VAL is not a cons or is nil, return VAL." + (if (consp val) + (let* ((preferred (car val)) + (ch (if (characterp preferred) + preferred + (aref preferred 0)))) + (if (char-displayable-p ch) + (car val) + (cdr val))) + val)) + +(defun markdown-ts--list-item-depth (node) + "Compute the depth of list NODE relative to its parents. +NODE can be a list, list_item, or one of the list_marker_'s. +If NODE is not in a list, return -1." + (let ((depth -1)) + (while (and node + (not (equal (treesit-node-type node) "section"))) + (when (equal (treesit-node-type node) "list") + (setq depth (1+ depth))) + (setq node (treesit-node-parent node))) + depth)) + +(defun markdown-ts--fontify-unordered-list-marker (node override start end &rest _) + "Fontify unordered list marker NODE, show a symbol when markup is hidden. +OVERRIDE, START, and END are passed through to +`treesit-fontify-with-override'." + (let* ((node-start (treesit-node-start node)) + (node-end (treesit-node-end node)) + (face 'markdown-ts-list-marker)) + (treesit-fontify-with-override node-start node-end face + override start end) + (cond (markdown-ts-hide-markup + (let* ((depth (markdown-ts--list-item-depth node)) + (value (if markdown-ts-unordered-list-marker + (nth (mod depth (length markdown-ts-unordered-list-marker)) + markdown-ts-unordered-list-marker) + nil)) + (display-spec (markdown-ts--resolve-display-value value))) + (put-text-property node-start node-end 'display display-spec))) + (t + (remove-text-properties node-start node-end '(display nil)))))) (defun markdown-ts--fontify-checkbox (node override start end &rest _) "Fontify task list checkbox NODE, show a Unicode symbol when markup is hidden. @@ -1297,6 +1439,9 @@ A backslash break gets `markdown-ts-hard-line-break-backslash' (or its backslash break is replaced by a single `markdown-ts-hard-line-break' glyph; a trailing-spaces break replaces each space with the glyph, so the run of pilcrows fills the line up to the newline. +If `markdown-ts-hard-line-break-backslash' or +`markdown-ts-hard-line-break-space' are the symbol `hide', hide the +markup entirely. OVERRIDE, START, and END are passed through to `treesit-fontify-with-override'." (let* ((node-start (treesit-node-start node)) @@ -1350,21 +1495,24 @@ OVERRIDE, START, and END are passed through to ((stringp spec) spec) ((functionp spec) (funcall spec (- region-end region-start)))))) - (when (and (stringp str) - (> (length str) 0) - (char-displayable-p (aref str 0))) - (put-text-property region-start (1+ region-start) - 'display str) - ;; For the trailing-spaces variant, hide the remaining - ;; spaces in the run so the line doesn't end with leftover - ;; whitespace after the substituted glyph. Each position - ;; gets its own empty-string `display' so cursor placement - ;; stays unambiguous. - (unless backslash - (let ((i (1+ region-start))) - (while (< i region-end) - (put-text-property i (1+ i) 'display "") - (setq i (1+ i)))))))))) + (if (eq spec 'hide) + (put-text-property region-start region-end + 'invisible 'markdown-ts--markup) + (when (and (stringp str) + (> (length str) 0) + (char-displayable-p (aref str 0))) + (put-text-property region-start (1+ region-start) + 'display str) + ;; For the trailing-spaces variant, hide the remaining + ;; spaces in the run so the line doesn't end with leftover + ;; whitespace after the substituted glyph. Each position + ;; gets its own empty-string `display' so cursor placement + ;; stays unambiguous. + (unless backslash + (let ((i (1+ region-start))) + (while (< i region-end) + (put-text-property i (1+ i) 'display "") + (setq i (1+ i))))))))))) (defun markdown-ts--fontify-thematic-break (node override start end &rest _) "Fontify thematic break NODE and show a line when markup is hidden. @@ -1375,22 +1523,27 @@ OVERRIDE, START, and END are passed through to (treesit-fontify-with-override node-start node-end 'markdown-ts-thematic-break override start end) - (let ((char (markdown-ts--resolve-display-value - markdown-ts-thematic-break-character))) - (if (and markdown-ts-hide-markup char (char-displayable-p char)) - (let* ((col (save-excursion (goto-char node-start) - (current-column))) - ;; Span if the face has non-nil :extend. - (span-length (if (face-attribute 'markdown-ts-thematic-break - :extend nil 'default) - (- (window-body-width) col) - 12))) - (put-text-property node-start node-end - 'display - (concat - (make-string span-length char) - "\n"))) - (remove-text-properties node-start node-end '(display nil)))))) + (if markdown-ts-hide-markup + (cond + ((and (display-supports-face-attributes-p '(:extend t)) + (face-attribute 'markdown-ts-thematic-break + :extend nil 'default)) + (put-text-property node-start node-end + 'display + (propertize "\n" 'face '(:extend t :underline t)))) + (t + (when-let* ((char (markdown-ts--resolve-display-value + markdown-ts-thematic-break-character)) + (_ (char-displayable-p char))) + (let* ((col (save-excursion (goto-char node-start) + (current-column))) + (span-length (max 12 (- (window-body-width) col)))) + (put-text-property node-start node-end + 'display + (concat + (make-string span-length char) + "\n")))))) + (remove-text-properties node-start node-end '(display nil))))) (defun markdown-ts--fontify-code-block (node _override _start _end &rest _) "Fontify code block content NODE with a background overlay. @@ -1524,6 +1677,7 @@ Remote images are controlled by (<= (overlay-end ov) search-end)) (delete-overlay ov))) (when (and markdown-ts-inline-images + (display-images-p) ;; Don't create image overlays for nodes inside ;; folded (outline-invisible) headings, since the ;; images wouldn't be visible and could interfere @@ -1623,18 +1777,18 @@ Skip matches already inside tree-sitter link or autolink nodes." :language 'markdown :feature 'heading - '(((atx_heading) @markdown-ts--fontify-heading) - ((setext_heading) @markdown-ts--fontify-heading)) + '(((atx_heading) @markdown-ts--fontify-atx-heading) + ((setext_heading) @markdown-ts--fontify-setext-heading)) :language 'markdown :feature 'heading :override 'prepend - '((atx_h1_marker) @markdown-ts--fontify-delimiter - (atx_h2_marker) @markdown-ts--fontify-delimiter - (atx_h3_marker) @markdown-ts--fontify-delimiter - (atx_h4_marker) @markdown-ts--fontify-delimiter - (atx_h5_marker) @markdown-ts--fontify-delimiter - (atx_h6_marker) @markdown-ts--fontify-delimiter + '((atx_h1_marker) @markdown-ts--fontify-atx-delimiter + (atx_h2_marker) @markdown-ts--fontify-atx-delimiter + (atx_h3_marker) @markdown-ts--fontify-atx-delimiter + (atx_h4_marker) @markdown-ts--fontify-atx-delimiter + (atx_h5_marker) @markdown-ts--fontify-atx-delimiter + (atx_h6_marker) @markdown-ts--fontify-atx-delimiter (setext_h1_underline) @markdown-ts--fontify-delimiter (setext_h2_underline) @markdown-ts--fontify-delimiter) @@ -1643,9 +1797,9 @@ Skip matches already inside tree-sitter link or autolink nodes." '(((thematic_break) @markdown-ts--fontify-thematic-break) ((html_block) @markdown-ts-html-block) ((indented_code_block) @markdown-ts-indented-code-block) - (list_item (list_marker_star) @markdown-ts-list-marker) - (list_item (list_marker_plus) @markdown-ts-list-marker) - (list_item (list_marker_minus) @markdown-ts-list-marker) + (list_item (list_marker_star) @markdown-ts--fontify-unordered-list-marker) + (list_item (list_marker_plus) @markdown-ts--fontify-unordered-list-marker) + (list_item (list_marker_minus) @markdown-ts--fontify-unordered-list-marker) (list_item (list_marker_dot) @markdown-ts-list-marker) (list_item (list_marker_parenthesis) @markdown-ts-list-marker) (list_item (task_list_marker_unchecked) @markdown-ts--fontify-checkbox) @@ -1694,12 +1848,16 @@ Skip matches already inside tree-sitter link or autolink nodes." :override 'append '((fenced_code_block (code_fence_content) @markdown-ts--fontify-code-block)) + :language 'markdown-inline + :override 'prepend + :feature 'paragraph-inline + '(((code_span) @markdown-ts-code-span) + ((code_span_delimiter) @markdown-ts--fontify-delimiter)) + :language 'markdown-inline :override 'append :feature 'paragraph-inline '(((link_destination) @markdown-ts--fontify-link-destination) - ((code_span) @markdown-ts-code-span) - ((code_span_delimiter) @markdown-ts--fontify-delimiter) ((emphasis) @markdown-ts-emphasis) ((strong_emphasis) @markdown-ts-bold) ((strikethrough) @markdown-ts-strikethrough) @@ -2035,7 +2193,8 @@ indentation, which tree-sitter may include in the node." (defun markdown-ts--list-ordered-item-p (item) "Return non-nil if ITEM is an ordered (numbered) list item." (let ((marker (treesit-node-child item 0))) - (equal (treesit-node-type marker) "list_marker_dot"))) + (member (treesit-node-type marker) + '("list_marker_dot" "list_marker_parenthesis")))) (defun markdown-ts--list-promote-or-demote (demote) "Change nesting of the list item at point. @@ -4233,13 +4392,18 @@ Note: To compute the column, point must be within the column and cannot be on the leading or trailing whitespace or on a column delimiter. ALIGN can be one of the symbols `left', `center', `right' or nil for -unspecified or the characters l, c, or r. +unspecified, or the characters l, c, or r. If ALIGN is nil, assume unspecified. Make the alignment string a minimum of 5 characters to accommodate Markdown conventions. If point is not at a table, do nothing." - (interactive "cAlign column [l]eft [c]enter [r]ight [u]nspecified:") + (interactive + (list (car (read-multiple-choice + "Align column" '((?l "left") + (?c "center") + (?r "right") + (?u "unspecified")))))) (markdown-ts--barf-if-not-mode 'markdown-ts-table-align-column) (setq align (if (characterp align) (pcase align (?l 'left) (?c 'center) (?r 'right)) @@ -4593,15 +4757,16 @@ If point is not at a table, do nothing." "Return range settings for `markdown-ts-mode'." (apply #'treesit-range-rules - `(:embed markdown-inline - :host markdown + `( :embed markdown-inline + :host markdown + :local t ((inline) @markdown-inline) ,@(when markdown-ts-fontify-code-blocks-natively - '(:embed markdown-ts--code-block-ts-language - :host markdown - :local t - ((fenced_code_block (info_string (language) @language) - (code_fence_content) @content))))))) + '( :embed markdown-ts--code-block-ts-language + :host markdown + :local t + ((fenced_code_block (info_string (language) @language) + (code_fence_content) @content))))))) (defun markdown-ts--remove-image-overlays () "Remove all inline image overlays from the current buffer." @@ -4886,6 +5051,27 @@ On a heading, call `outline-cycle'. Otherwise do nothing." "M-RET" #'markdown-ts-insert-list-item "TAB" #'markdown-ts-outline-cycle) +(defvar-keymap markdown-ts-view-mode-map + :doc "Keymap for `markdown-ts-view-mode'." + :parent special-mode-map + :menu nil + "g" #'ignore ; Override special-mode-map #'revert-buffer + "C-c C-n" #'outline-next-heading + "n" #'outline-next-heading + "C-c C-p" #'outline-previous-heading + "p" #'outline-previous-heading + "C-c C-u" #'outline-up-heading + "u" #'outline-up-heading + "C-c C-f" #'outline-forward-same-level + "f" #'outline-forward-same-level + "C-c C-b" #'outline-backward-same-level + "b" #'outline-backward-same-level + "C-c C-x C-m" #'markdown-ts-toggle-hide-markup + "C-c C-x C-v" #'markdown-ts-toggle-inline-images + "C-c C-v n" #'markdown-ts-move-to-next-code-block + "C-c C-v p" #'markdown-ts-move-to-previous-code-block + "TAB" #'markdown-ts-outline-cycle) + (defvar-keymap markdown-ts-code-block-in-context-mode-map :doc "Keymap for `markdown-ts-code-block-in-context-mode'. These override keys in `markdown-ts-mode-map' to support executing their @@ -5009,7 +5195,6 @@ NOTE: Call this function only when the treesit `markdown' and (setq-local adaptive-fill-function #'markdown-ts--adaptive-fill) ;; Create and configure the parsers. - (treesit-parser-create 'markdown-inline) (setq treesit-primary-parser (treesit-parser-create 'markdown)) @@ -5021,11 +5206,12 @@ NOTE: Call this function only when the treesit `markdown' and (image-preview error))) (cond (markdown-ts--set-up-inline - (setq-local treesit-range-settings - (treesit-range-rules - :embed 'markdown-inline - :host 'markdown - '((inline) @markdown-inline)))) + (treesit-parser-create 'markdown-inline) + (setq-local treesit-range-settings + (treesit-range-rules + :embed 'markdown-inline + :host 'markdown + '((inline) @markdown-inline)))) (t ;; Range settings differ in the master buffer vs. inline above. (setq-local treesit-range-settings (markdown-ts--range-settings)) @@ -5054,7 +5240,6 @@ NOTE: Call this function only when the treesit `markdown' and #'markdown-ts--outline-view-change nil t)) (progn - (make-local-variable 'markdown-ts-hide-markup) (make-local-variable 'font-lock-extra-managed-props) (dolist (prop '(invisible display button category action help-echo)) (add-to-list 'font-lock-extra-managed-props prop))) @@ -5171,10 +5356,8 @@ With a prefix argument, ARG, if needed, install parsers for `html', (require 'toml-ts-mode) (treesit-install-language-grammar 'toml)))) -;;;###autoload -(define-derived-mode markdown-ts-mode text-mode "Markdown" - "Major mode for editing Markdown using tree-sitter grammar. -NOTE: See `markdown-ts--set-up-inline'." +(defun markdown-ts-mode--initialize () + "Invoke this from major mode definitions after local variable set up." (treesit-ensure-installed 'markdown) (treesit-ensure-installed 'markdown-inline) ;; Bypass `treesit-max-buffer-size' so the mode activates in large @@ -5183,16 +5366,57 @@ NOTE: See `markdown-ts--set-up-inline'." ;; they are installed. Revisit if `treesit-parser-create' gains its ;; own buffer-size guard (see bug#80909). (let ((treesit-max-buffer-size most-positive-fixnum)) - (if (treesit-ready-p '(markdown markdown-inline) t) - (markdown-ts--set-up) - (warn "markdown-ts-mode cannot be set up; using fundamental-mode. + (cond ((treesit-ready-p '(markdown markdown-inline) t) + (markdown-ts--set-up)) + (t + (warn "markdown-ts-mode cannot be set up; using fundamental-mode. The tree-sitter parsers `markdown' and `markdown-inline' were not found. Use the command `markdown-ts-mode-install-parsers' to install them. With a prefix argument, it can also install optional parsers.") - (fundamental-mode)))) + (fundamental-mode))))) + +;;;###autoload +(define-derived-mode markdown-ts-mode text-mode "Markdown" + "Major mode for editing Markdown using tree-sitter grammar. +NOTE: See `markdown-ts--set-up-inline'." + (markdown-ts-mode--initialize)) (derived-mode-add-parents 'markdown-ts-mode '(markdown-mode)) +;;; View mode: + +;;;###autoload +(define-derived-mode markdown-ts-view-mode + nil ; Intentionally left blank. + "Markdown View" + "Major mode for read-only viewing Markdown using tree-sitter grammar." + ;; NOTE: `markdown-ts-mode' is manually added as a parent to avoid + ;; invoking its initialization before we set override variables. + (setq-local markdown-ts-menu-bar-show nil) + (setq-local markdown-ts-hide-markup t) + (setq-local markdown-ts-inline-images t) + (setq-local markdown-ts-hard-line-break-backslash 'hide) + (setq-local markdown-ts-hard-line-break-space 'hide) + (setq-local markdown-ts-fontify-code-blocks-natively t) + (setq-local markdown-ts-enable-code-block-context-mode nil) + (setq-local markdown-ts-enable-table-mode nil) + (run-hooks 'markdown-ts-view-mode-pre-init-hook) + (markdown-ts-mode--initialize) + (setq buffer-read-only t)) + +(derived-mode-add-parents 'markdown-ts-view-mode '(markdown-ts-mode special-mode)) + +;;; Mode utilities: + +;;;###autoload +(defun markdown-ts-buffer-string () + "Like `buffer-string', and convert overlay properties to text properties." + (let ((str (buffer-string))) + (dolist (ov (overlays-in (point-min) (point-max)) str) + (when-let* ((face (overlay-get ov 'face))) + (font-lock-append-text-property + (overlay-start ov) (overlay-end ov) 'face face str))))) + (defun markdown-ts--barf-if-not-mode (&optional context) "Signal an error if the current buffer is not a `markdown-ts-mode' buffer. Prefix the error message with CONTEXT." @@ -5200,6 +5424,18 @@ Prefix the error message with CONTEXT." (user-error "%sis valid only in `markdown-ts-mode' buffers" (if context (format "%s: " context) "")))) +(defun markdown-ts-add-final-newline () + "Add a final newline to the current buffer, if necessary." + ;; Inspired by files.el. + (let ((inhibit-read-only t)) + (when (or (eq (buffer-size) 0) + (and (/= (char-after (1- (point-max))) ?\n) + (not (and (eq selective-display t) + (= (char-after (1- (point-max))) ?\r))))) + (save-excursion + (goto-char (point-max)) + (insert ?\n))))) + (define-minor-mode markdown-ts-code-block-in-context-mode "Minor mode enabled if point is within a fenced code block. This enables the keymap `markdown-ts-code-block-in-context-mode-map'." diff --git a/lisp/treesit.el b/lisp/treesit.el index 5253439a9dd..e2e62bb71a2 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -133,6 +133,8 @@ in a Emacs not built with tree-sitter library." (declare-function treesit-parser-remove-notifier "treesit.c") + (declare-function treesit-grammar-location "treesit.c") + (defvar treesit-thing-settings) (defvar treesit-major-mode-remap-alist) (defvar treesit-extra-load-path))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 3c9222d725f..2d6f8ee97d0 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1261,12 +1261,9 @@ that file." (vc-dir-fileinfo->state crt-data)) result)) (nreverse result))) -(defun vc-dir-recompute-file-state (fname def-dir &optional truename) - "Compute state of FNAME known to live inside DEF-DIR. -If TRUENAME is non-nil, FNAME is a truename, DEF-DIR not necessarily." - (let* ((file-short (file-relative-name - fname (if truename (file-truename def-dir) def-dir))) - (fname (if truename (expand-file-name file-short def-dir) fname)) +(defun vc-dir-recompute-file-state (fname def-dir) + "Compute state of FNAME known to live inside DEF-DIR." + (let* ((file-short (file-relative-name fname def-dir)) (_remove-me-when-CVS-works (when (eq vc-dir-backend 'CVS) ;; FIXME: Warning: UGLY HACK. The CVS backend caches the state @@ -1309,8 +1306,9 @@ If TRUENAME is non-nil, FNAME is a truename, DEF-DIR not necessarily." (defun vc-dir-resynch-file (&optional fname) "Update the entries for FNAME in any directory buffers that list it." - (let ((file (file-truename (or fname buffer-file-name))) - (drop '())) + (let* ((file (or fname buffer-file-name)) + (file-tn (file-truename file)) + (drop '())) (save-current-buffer ;; look for a vc-dir buffer that might show this file. (dolist (status-buf vc-dir-buffers) @@ -1328,17 +1326,15 @@ If TRUENAME is non-nil, FNAME is a truename, DEF-DIR not necessarily." ;; `default-directory' in order to do its work, ;; but that's irrelevant to us here. (buffer-local-toplevel-value 'default-directory)))) - (when (file-in-directory-p file ddir) - (if (file-directory-p file) + (when (file-in-directory-p file-tn ddir) + (if (file-directory-p file-tn) (progn - (vc-dir-resync-directory-files file) + (vc-dir-resync-directory-files file-tn) (ewoc-set-hf vc-ewoc (vc-dir-headers vc-dir-backend ddir) "")) (let* ((complete-state - ;; Make sure 'vc-dir-recompute-file-state' - ;; knows about the truename nature of 'file' - ;; (bug#80967). - (vc-dir-recompute-file-state file ddir t)) + ;; Pass FILE not FILE-TN here. See bug#80967. + (vc-dir-recompute-file-state file ddir)) (state (cadr complete-state))) (vc-dir-update (list complete-state) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4a6ae7e4290..8f0e9e5bdc4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1719,7 +1719,7 @@ from which to check out the file(s)." (t (vc-register vc-fileset)))) ((eq state 'missing) - (vc-delete-file files)) + (vc-delete-file fileset-only-files)) ;; Files are up-to-date, or need a merge and user specified a revision ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) (cond diff --git a/src/sfnt.c b/src/sfnt.c index f778179a5ff..ab6a2d5e7bc 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -736,6 +736,7 @@ sfnt_read_cmap_format_12 (int fd, return NULL; /* Allocate a buffer of sufficient size. */ + eassert (length < UINT32_MAX - sizeof *format12); format12 = xmalloc (length + sizeof *format12); format12->format = header->format; format12->reserved = header->length; diff --git a/src/xdisp.c b/src/xdisp.c index b485d9ccf40..c1d6fedb553 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -26643,13 +26643,11 @@ display_line (struct it *it, int cursor_vpos) /* If the default face is remapped or the 'margin' face has a non-default background, and the window has display margins, - and no glyphs were written yet to the margins on this screen - line, fill the margin area so that the margins use the - correct background. Placed here, after the if/else-if chain - above, so it fires for all three truncation paths: TTY/no-fringe - truncation glyph, GUI newline-overflow-into-fringe, and GUI - regular truncation where the indicator is drawn as a fringe - bitmap. */ + extend the face in the margin area so that the margins use + the correct background. This handles all three truncation + paths: TTY/no-fringe truncation glyph, GUI + newline-overflow-into-fringe, and GUI regular truncation + where the indicator is drawn as a fringe bitmap. */ { int margin_face_id = lookup_basic_face (it->w, it->f, MARGIN_FACE_ID); @@ -26657,10 +26655,8 @@ display_line (struct it *it, int cursor_vpos) != DEFAULT_FACE_ID || FACE_FROM_ID (it->f, margin_face_id)->background != FRAME_BACKGROUND_PIXEL (it->f)) - && ((WINDOW_LEFT_MARGIN_WIDTH (it->w) > 0 - && it->glyph_row->used[LEFT_MARGIN_AREA] == 0) - || (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 - && it->glyph_row->used[RIGHT_MARGIN_AREA] == 0))) + && (WINDOW_LEFT_MARGIN_WIDTH (it->w) > 0 + || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)) extend_face_to_end_of_line (it); } diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c76d6d54c3d..c0ad7205c5d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6524,8 +6524,7 @@ INPUT, if non-nil, is a string sent to the process." "Check that remote processes set / unset environment variables properly." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-environment-variables-p)) (dolist (this-shell-command-to-string (append @@ -6555,6 +6554,21 @@ INPUT, if non-nil, is a string sent to the process." (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))) + ;; Check EMACSCLIENT_TRAMP. + (setenv "EMACSCLIENT_TRAMP") + (let ((tramp-propagate-emacsclient-tramp t)) + (should + (string-equal + (format "%s\n" (tramp-make-tramp-file-name tramp-test-vec 'noloc)) + (funcall + this-shell-command-to-string "echo \"${EMACSCLIENT_TRAMP:-bla}\"")))) + (let (tramp-propagate-emacsclient-tramp) + (should + (string-equal + "bla\n" + (funcall + this-shell-command-to-string "echo \"${EMACSCLIENT_TRAMP:-bla}\"")))) + ;; Set a value. (let ((process-environment (cons (concat envvar "=foo") process-environment))) @@ -7782,6 +7796,11 @@ This requires restrictions of file name syntax." (tramp--test-sh-p) (tramp--test-smb-p) (tramp--test-sudoedit-p))) +(defun tramp--test-supports-environment-variables-p () + "Return whether setting environment variables is supported." + (and (tramp--test-sh-p) + (not (tramp--test-crypt-p)))) + (defun tramp--test-check-files (&rest files) "Run a simple but comprehensive test over every file in FILES." (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index e4a1bf36a63..b64b20fb6cb 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -92,11 +92,11 @@ `(,(expand-file-name invocation-name invocation-directory) "-Q" "--batch" "--eval" ,(prin1-to-string - `(progn (setq kill-emacs-on-sigint nil) - (message "Ready!") - (condition-case nil - (dotimes (_ 3) (sit-for 1)) - (quit (message "%s" ,exit-msg))))))))) + `(condition-case nil + (progn (setq kill-emacs-on-sigint nil) + (message "Ready!") + (sleep-for 3)) + (quit (message "%s" ,exit-msg)))))))) (while (progn (accept-process-output proc 1.0) (goto-char (point-min)) (not (re-search-forward "Ready!" nil t)))