diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index bf137ef946b..77fff25b7b2 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -868,13 +868,20 @@ otherwise stated, affects only the current Emacs session. The only way to alter the variable in future sessions is to put something in your initialization file (@pxref{Init File}). - If you're setting a customizable variable in your initialization -file, and you don't want to use the Customize interface, you can use -the @code{setopt} macro. For instance: - @findex setopt + If you're setting a customizable variable, and you don't want to use +the Customize interface, you can use the @code{setopt} macro. For +instance: + @example -(setopt fill-column 75) + M-: (setopt fill-column 75) @key{RET} +@end example + +@noindent +Or, if you want to do this in your initialization file: + +@example + (setopt fill-column 75) @end example This works the same as @code{setq}, but if the variable has any @@ -883,6 +890,34 @@ special setter functions, they will be run automatically when using non-customizable variables, but this is less efficient than using @code{setq}. +@findex setopt-local + There is also a buffer-local version of @code{setopt}, called +@code{setopt-local}, that you can use to set buffer specific values for +customizable options, for example, in mode hooks (@pxref{Hooks}). + +This works the same as @code{setq-local}, but if the variable has any +special setter functions, they will be run automatically when using +@code{setopt-local}. You can also use @code{setopt-local} on other, +non-customizable variables, but this is less efficient than using +@code{setq-local}. + + If you want to change the value of a customizable variable only in +your current buffer, you can use the @code{setopt-local} macro. For +instance: + +@example + M-: (setopt-local fill-column 75) @key{RET} +@end example + +@noindent +Or, if you want to do this in your initialization file, use the +following inside a mode hook so this variable will be automatically +customized in buffers of that mode (@pxref{Hooks}): + +@example + (setopt-local fill-column 75) +@end example + @node Hooks @subsection Hooks @cindex hook @@ -3262,7 +3297,7 @@ acquainted with conventions from other programs. The functionality enabled by the @code{newcomers-presets} theme will change between releases of Emacs. We may add new functionality, and also remove old functionality that we think has been superseded. -Therefore, if you get used to the newcomers' presets, consider copying -them into your own configuration and then disabling the theme again. -You can use the command @code{copy-theme-options} (@pxref{Custom -Themes}) to do this. +Therefore, if you get used to the newcomers' presets, you should copy +them into your own configuration and then disable the theme again. You +can use the command @code{copy-theme-options} (@pxref{Custom Themes}) to +do this. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 4aee5e1045d..697a13dbe7b 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2764,10 +2764,10 @@ Table}.) @node Xref Commands @subsubsection Commands Available in the @file{*xref*} Buffer @cindex commands in @file{*xref*} buffers -@cindex XREF mode +@cindex Xref mode The following commands are provided in the @file{*xref*} buffer by -the special XREF mode: +the special Xref mode: @table @kbd @item @key{RET} @@ -2880,7 +2880,7 @@ prompt always, customize the value of the variable to prompt only if there's no usable identifier at point.) The command then presents the @file{*xref*} buffer with all the references to the identifier, showing the file name and the line where the identifier is -referenced. The XREF mode commands are available in this buffer, see +referenced. The Xref mode commands are available in this buffer, see @ref{Xref Commands}. When invoked in a buffer whose major mode uses the @code{etags} backend, @@ -2926,6 +2926,16 @@ matches of that regexp in the names of the identifiers with @code{xref-query-replace-in-results}, but is more convenient when you want to rename a single identifier specified by its name @var{from}. +@findex xref-change-to-xref-edit-mode +@cindex Xref Edit mode +@cindex mode, Xref Edit + Typing @kbd{e} in the @file{*xref*} buffer makes the buffer writable +and enters the Xref Edit mode. Similar to Occur Edit mode (@pxref{Other +Repeating Search}), you can edit the matching lines reported by +Xref backend and have those changes reflected in the buffer visiting the +originating file. Type @kbd{C-c C-c} to leave the Xref Edit mode and +return to the Xref mode. + @findex tags-search @kbd{M-x tags-search} reads a regexp using the minibuffer, then searches for matches in all the files in the selected tags table, one diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 1497a9906bd..a712b3a1b46 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -14660,9 +14660,9 @@ beginning of the file. The function definition looks like this: @smallexample @group (defun lengths-list-file (filename) - "Return list of definitions' lengths within FILE. + "Return list of definitions' lengths within the file named FILENAME. The returned list is a list of numbers. -Each number is the number of words or +Each number in the list is the number of words or symbols in one function definition." @end group @group @@ -14683,10 +14683,10 @@ symbols in one function definition." @end smallexample @noindent -The function is passed one argument, the name of the file on which it -will work. It has four lines of documentation, but no interactive -specification. Since people worry that a computer is broken if they -don't see anything going on, the first line of the body is a +The function is passed one argument @var{filename}, the name of the file +on which it will work. It has four lines of documentation, but no +interactive specification. Since people worry that a computer is broken +if they don't see anything going on, the first line of the body is a message. The next line contains a @code{save-excursion} that returns Emacs's @@ -14730,8 +14730,8 @@ definition and constructs a lengths' list containing the information. Emacs kills the buffer after working through it. This is to save space inside of Emacs. My version of GNU Emacs 19 contained over 300 source files of interest; GNU Emacs 22 contains over a thousand source -files. Another function will apply @code{lengths-list-file} to each -of the files. +files, and Emacs 30.2 more than 1600. Another function will apply +@code{lengths-list-file} to each of the files. Finally, the last expression within the @code{let} expression is the @code{lengths-list} variable; its value is returned as the value of @@ -14744,13 +14744,13 @@ C-e} (@code{eval-last-sexp}). @c !!! 22.1.1 lisp sources location here @smallexample (lengths-list-file - "/usr/local/share/emacs/22.1/lisp/emacs-lisp/debug.el") + "/usr/local/share/emacs/30.2/lisp/emacs-lisp/debug.el") @end smallexample @noindent -You may need to change the pathname of the file; the one here is for -GNU Emacs version 22.1. To change the expression, copy it to -the @file{*scratch*} buffer and edit it. +You may need to change the name of the file; the one here is for default +installation tree of GNU Emacs version 30.2. To change the expression, +copy it to the @file{*scratch*} buffer and edit it. @need 1200 @noindent @@ -14768,10 +14768,11 @@ Then evaluate the @code{lengths-list-file} expression.) @need 1200 The lengths' list for @file{debug.el} takes less than a second to -produce and looks like this in GNU Emacs 22: +produce and looks like this in GNU Emacs 30.2: @smallexample -(83 113 105 144 289 22 30 97 48 89 25 52 52 88 28 29 77 49 43 290 232 587) +(79 26 140 34 17 112 81 24 155 54 43 102 21 36 36 117 28 29 102 49 43 + 208 101 28 22 728 15 27) @end smallexample @need 1500 diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 364edf63031..705af15e4e2 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -372,12 +372,15 @@ added by calls to @code{custom-add-frequent-value} (see below). @item :set @var{setfunction} Specify @var{setfunction} as the way to change the value of this option when using the Customize interface. The function -@var{setfunction} should take two arguments, a symbol (the option -name) and the new value, and should do whatever is necessary to update +@var{setfunction} should take two or three arguments, a symbol (the option +name), the new value, and an optional @var{buffer-local} indicator. +@var{setfunction} should do whatever is necessary to update the value properly for this option (which may not mean simply setting the option as a Lisp variable); preferably, though, it should not -modify its value argument destructively. The default for -@var{setfunction} is @code{set-default-toplevel-value}. +modify its value argument destructively. If optional @var{buffer-local} +is non-nil, the new value should be set buffer locally and not affect its +global or default values. The default for @var{setfunction} is +@code{set-default-toplevel-value}. If defined, @var{setfunction} will also be called when evaluating a @code{defcustom} form with @kbd{C-M-x} in Emacs Lisp mode and when the @@ -387,7 +390,7 @@ If defined, @var{setfunction} will also be called when evaluating a If you specify this keyword, the variable's documentation string should describe how to do the same job in hand-written Lisp code, either by invoking @var{setfunction} directly or by using -@code{setopt}. +@code{setopt} or @code{setopt-local}. @kindex get@r{, @code{defcustom} keyword} @item :get @var{getfunction} diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 656a422cf6e..9115b3a4691 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1661,6 +1661,7 @@ Tips and Conventions * Compilation Tips:: Making compiled code run fast. * Warning Tips:: Turning off compiler warnings. * Documentation Tips:: Writing readable documentation strings. +* Documentation Group Tips:: Writing useful documentation groups. * Comment Tips:: Conventions for writing comments. * Library Headers:: Standard headers for library packages. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 049e8ac3e84..f86a18fd896 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2777,6 +2777,9 @@ the end of the file name. If @var{text} is a string, @code{make-temp-file} inserts it in the file. +On Posix systems, Emacs creates the file with permissions that limit its +access to the current user. + To prevent conflicts among different libraries running in the same Emacs, each Lisp program that uses @code{make-temp-file} should have its own @var{prefix}. The number added to the end of @var{prefix} diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index d57d643e922..c50619a2de0 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -89,6 +89,20 @@ displayed on that terminal; the list of possible values is the same as for @code{framep} above. @end defun +@defun frame-initial-p &optional frame +This predicate returns non-@code{nil} if @var{frame} is or holds the +initial text frame that is used internally during daemon mode +(@pxref{Initial Options, daemon,, emacs, The GNU Emacs Manual}), batch +mode (@pxref{Batch Mode}), and the early stages of startup +(@pxref{Startup Summary}). Interactive and graphical programs, for +instance, can use this predicate to avoid operating on the initial +frame, which is never displayed. + +If @var{frame} is a terminal, this function returns non-@code{nil} if +@var{frame} holds the initial frame. If @var{frame} is omitted or +@code{nil}, it defaults to the selected one. +@end defun + @cindex top-level frame On a graphical terminal we distinguish two types of frames: A normal @dfn{top-level frame} is a frame whose window-system window is a child @@ -3029,7 +3043,7 @@ direction. See also @code{next-window} and @code{previous-window}, in @ref{Cyclic Window Ordering}. - Some Lisp programs need to find one or more frames that satisfy a + Some Lisp programs need to find one or more frames that satisfy given criteria. The function @code{filtered-frame-list} is provided for this purpose. diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 3261cf838f7..a9bc9221912 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -828,14 +828,16 @@ if the user types the help character again. @cindex documentation groups @cindex groups of functions @cindex function groups +@cindex shortdoc groups Emacs can list functions based on various groupings. For instance, @code{string-trim} and @code{mapconcat} are ``string'' functions, so -@kbd{M-x shortdoc RET string RET} will give an overview -of functions that operate on strings. +@kbd{M-x shortdoc RET string RET} will give an overview of these and +other functions that operate on strings. The documentation groups are created with the -@code{define-short-documentation-group} macro. +@code{define-short-documentation-group} macro. @xref{Documentation +Group Tips}, for how to write good documentation groups. @defmac define-short-documentation-group group &rest functions Define @var{group} as a group of functions, and provide short @@ -846,6 +848,7 @@ summaries of using those functions. The optional argument (@var{func} [@var{keyword} @var{val}]@dots{}) @end lisp +@cindex documentation group keywords The following keywords are recognized: @table @code diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 7f22dc06ef2..2fbac9508d6 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -35,6 +35,7 @@ in batch mode, e.g., with a command run by @kbd{@w{M-x compile * Compilation Tips:: Making compiled code run fast. * Warning Tips:: Turning off compiler warnings. * Documentation Tips:: Writing readable documentation strings. +* Documentation Group Tips:: Writing useful documentation groups. * Comment Tips:: Conventions for writing comments. * Library Headers:: Standard headers for library packages. @end menu @@ -934,6 +935,89 @@ If you do not anticipate anyone editing your code with older Emacs versions, there is no need for this work-around. @end itemize +@node Documentation Group Tips +@section Tips for Documentation Groups +@cindex documentation groups, tips +@cindex tips for documentation groups + +@cindex documentation groups, compatibility + Documentation groups, available since Emacs 28, are useful to document +functions of Lisp packages based on various groupings +(@pxref{Documentation Groups}). This section gives some tips on how you +can define documentation groups in your Lisp package in a way such that +users of different Emacs versions can equally well use these groups. + +@itemize @bullet +@item +To define documentation groups for your own Lisp package across +different Emacs versions, you can use a boilerplate template along the +lines of the following to make your package compile and load without +errors: + +@smallexample +@group +;;; well-doc.el --- a well-documented package -*- lexical-binding: t; -*- + +@dots{} package header and contents @dots{} +@end group + +@group +;; Explicitly require shortdoc for Emacs 28, which does not have an +;; autoload for macro `define-short-documentation-group'. And for +;; Emacs 30, so that we can redefine `shortdoc--check' later. +(require 'shortdoc nil t) + +(eval-when-compile + + ;; Default macro `define-short-documentation-group' for Emacs 27 + ;; and older, which do not have the shortdoc feature at all. + (unless (fboundp 'define-short-documentation-group) + (defmacro define-short-documentation-group (&rest _))) + + ;; Disable too rigid shortdoc checks for Emacs 30, which let it + ;; error out on newer shortdoc keywords. + (when (eq emacs-major-version 30) + (fset 'shortdoc--check #'ignore))) +@end group + +@group +(define-short-documentation-group well-doc + @dots{}) + +;;; well-doc.el ends here +@end group +@end smallexample + +@findex define-short-documentation-group +If you do not intend to support some of the Emacs versions mentioned +above, you can safely omit the corresponding forms from the template. +If you intend to support only Emacs 31 and newer, you do not need any +of the above and can just use @code{define-short-documentation-group}. + +@item +@cindex documentation group keywords, compatibility +Newer Emacs versions might introduce newer documentation group features +and keywords. However, these features or keywords will never break the +display of a documentation group in older Emacs versions. Suppose you +use a hypothetical group keyword @code{:super-pretty-print}, available +in some future Emacs version, like this in your Lisp package +@file{well-doc.el}: + +@smallexample +@group +(define-short-documentation-group well-doc + (well-doc-foo + :eval (well-doc-foo) + :super-pretty-print t)) +@end group +@end smallexample + +That future Emacs version will then supposedly super-pretty-print the +example for function @code{well-doc-foo}. Older Emacs versions will +silently ignore keyword @code{:super-pretty-print} and show the example +according to their regular display rules. +@end itemize + @node Comment Tips @section Tips on Writing Comments @cindex comments, Lisp convention for diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index b75a037f78b..23b6dce2ec6 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -6728,6 +6728,45 @@ See the docstring of variable @code{tramp-methods} for possible @code{foo-tramp-executable} in this example would be a Lisp constant, which is the program name of @command{foo}. +If a parameter doesn't have a static value but must be computed at +runtime, a format specifier can be used, like @t{"%h"} in the example +above. See the docstring of @code{tramp-methods}, which patterns are +expanded in which parameter. Furthermore, other format specifiers can +be added via the variable @code{tramp-extra-expand-args}. + +The following parameters expand format specifiers for the +@code{tramp-sh} backend: @code{tramp-copy-args}, +@code{tramp-copy-env}, @code{tramp-copy-file-name}, +@code{tramp-login-args}, @code{tramp-login-program}, +@code{tramp-remote-copy-args}. + +The example above could use + +@lisp +(tramp-login-program "%1") +@end lisp + +And you could set @code{tramp-extra-expand-args} as connection-local value: + +@lisp +@group +(defun foo-tramp-get-login-program (vec) + "Return connection-local value of `tramp-login-program'." + @dots{}) +@end group + +@group +(connection-local-set-profile-variables + 'foo-tramp-connection-local-default-profile + '((tramp-extra-expand-args + ?1 (foo-tramp-get-login-program (car tramp-current-connection))))) + +(connection-local-set-profiles + '(:application tramp :protocol "foo") + foo-tramp-connection-local-default-profile) +@end group +@end lisp + Another initialization could tell @value{tramp} which are the default user and host name for method @option{foo}. This is done by calling @code{tramp-set-completion-function}: diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 20c2208c54c..81becb41eba 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -18,7 +18,16 @@ to look up issue github#1234, go to https://github.com/joaotavora/eglot/issues/1234. -* Changes to upcoming Eglot +* Changes in Eglot 1.23 (2/4/2026) + +** Unbreak ELPA Eglot (github#1584) + +Broken due to bad 'jsonrpc.el' dependency. + +** 'eglot-report-progress' can be safely set to 'messages' (bug#80653) + + +* Changes in Eglot 1.22 (1/4/2026) ** File watch limits to prevent resource exhaustion (github#1568) @@ -50,6 +59,19 @@ beneficial and helps servers avoid costly useless work. Eglot now sets 'imenu-create-index-function' using ':override' advice, making the integration cleaner and more predictable. +** Diagnostics from unopened files recalled on session start (github#1531) + +Some servers (notably rust-analyzer) publish diagnostics for all +project files at startup and never republish them on 'didOpen'. Eglot +now saves such early diagnostics and reports them when those files are +subsequently opened. + +** Changes to 'eglot-server-programs' + +- new 'static-ls' for 'haskell-mode' +- new 'wat_server' for 'wat-mode' (WebAssembly Text) (bug#80188) +- new 'elp' replaces 'erlang_ls' for 'erlang-mode' (bug#79943) + ** Fixed textDocument/prepareRename support (github#1554) Eglot now properly checks server capabilities before sending diff --git a/etc/NEWS b/etc/NEWS index 053d2f0a2a2..528eb09eff8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1760,6 +1760,15 @@ If 'page-delimiters' is set in 'whitespace-style', or the new minor mode width of the window. The new 'whitespace-page-delimiter' face can be used to customize the appearance. +--- +*** New user option 'whitespace-global-mode-buffers'. +Normally, 'global-whitespace-mode' skips special buffers whose name +starts with an asterisk '*'. This user option provides an override: it +contains a list of regular expressions used to match the names of +special buffers in which 'global-whitespace-mode' should turn on. The +default value preserves the existing exception for the "*scratch*" +buffer. + ** Bookmark --- @@ -2531,6 +2540,12 @@ of a literal newline. This prevents executing many Dired operations on such a file from failing and signaling an error. The default value of this user option is nil. +--- +*** New Dired handling of errors from 'ls'. +When invoking a Dired command causes 'ls' to emit an error message, +Emacs now displays the message in a popped up buffer instead of +outputting it in the Dired buffer and signaling an error. + ** Grep +++ @@ -3187,6 +3202,11 @@ This minor mode binds 'xref-find-definitions-at-mouse' to definition, following the convention from other editors. The global minor mode 'global-xref-mouse-mode' will enable this in all buffers. ++++ +*** New command 'xref-change-to-xref-edit-mode'. +It's bound to "e" and it switches an Xref buffer into an "editable" mode +like similar features in Occur and Grep buffers. + ** Revert +++ @@ -4092,6 +4112,14 @@ to display its char argument on a given frame. This new function, unlike 'char-displayable-p', does not check whether the character can be encoded by the underlying terminal. ++++ +** New function 'frame-initial-p'. +This predicate returns non-nil if a given frame or terminal is or holds, +respectively, the initial text frame that is used internally during +daemon mode, batch mode, and the early stages of startup. Interactive +and graphical programs, for instance, can use this predicate to avoid +operating on the initial frame, which is never displayed. + +++ ** New macros 'static-when' and 'static-unless'. Like 'static-if', these macros evaluate their condition at @@ -4124,6 +4152,17 @@ change it globally with: --- *** Loading a file displays a warning if there is no 'lexical-binding' cookie. +--- +** New function 'set-local'. +This is the buffer local equivalent of the function 'set'. + ++++ +** New macro 'setopt-local'. +This is the buffer local version of 'setopt' for user options rather +than plain variables and uses 'custom-set'/'set-local' to set variable +values. A new argument, BUFFER-LOCAL, is passed to 'custom-set' +functions to indicate the buffer local context. + +++ ** New macros 'incf' and 'decf'. They increment or decrement the value stored in a variable (a symbol), @@ -4458,6 +4497,13 @@ singleton list. * Changes in Emacs 31.1 on Non-Free Operating Systems +--- +** Support macOS Accessibility Zoom focus tracking. +This is an important change for visually-impaired users. If macOS +Accessibility Zoom is enabled (System Settings, Accessibility, Zoom) +with keyboard focus tracking (Advanced...), Zoom is informed of updated +cursor positions during each redisplay cycle. + --- ** Process execution has been optimized on Android. The run-time performance of subprocesses on recent Android releases, diff --git a/etc/themes/newcomers-presets-theme.el b/etc/themes/newcomers-presets-theme.el index b14465d8e3f..12205a4ee8e 100644 --- a/etc/themes/newcomers-presets-theme.el +++ b/etc/themes/newcomers-presets-theme.el @@ -21,11 +21,20 @@ ;;; Commentary -;; A theme that enables user options new users might be interested in. -;; The guideline to enabling a feature is "would this interest someone -;; who wouldn't even know that this option exists?". Please avoid -;; opinionated cosmetic changes, that is the job of regular/color-scheme -;; themes. +;; This theme configures user options that we can reasonably expect the +;; average, new user to want to enable, but would otherwise be unlikely +;; to discover on their own. This includes support for convenience +;; features, adjustment of default settings that are in place for +;; historical reasons, aiding discoverability (at the potential cost of +;; more visual noise) and trying and follow common conventions that +;; other editors have established over the past decades. + +;; The goal is to help providing a better starting point for users who +;; would otherwise feel overwhelmed when first starting to use Emacs, +;; without having to burden existing users with invasive changes to +;; Emacs' default behavior. Options in the theme should NOT hinder +;; developing a better understanding of Emacs (e.g. enabling emulation +;; modes) or make opinionated cosmetic changes. ;;; Code: @@ -120,6 +129,7 @@ This minor mode will enable and disable the theme on startup." '(indent-tabs-mode nil) '(imenu-auto-rescan t) '(view-read-only t) + '(column-number-mode t) ;;;; Directory managment-related options '(dired-auto-revert-buffer t) @@ -153,7 +163,10 @@ This minor mode will enable and disable the theme on startup." ;;;; Frame- and window-related options '(frame-inhibit-implied-resize t) '(tab-bar-history-mode t) - '(tab-bar-show 0)) + '(tab-bar-show 0) + +;;;; Programming-related options + '(compilation-scroll-output 'first-error)) (provide-theme 'newcomers-presets) ;;; newcomers-presets-theme.el ends here diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index b9558ba3da7..a8cdc6e06f9 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -316,6 +316,11 @@ main (int argc, char **argv) SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); + /* Allow reading the scheduler policy and affinity, so num_processors + can determine the number of usable CPUs. */ + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sched_getaffinity)); + RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sched_getscheduler)); + /* Block changing resource limits, but don't crash. */ RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64), SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index adaa901612a..15dfa2f358f 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -85,6 +85,9 @@ HOST, USER, PORT, REQUIRE, and MAX." ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + ((not (file-directory-p auth-source-pass-filename)) + ;; Do nothing if the password-store folder doesn't exist. + nil) (auth-source-pass-extra-query-keywords (auth-source-pass--build-result-many host port user require max)) (t diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 52677f435ee..87d8ecade54 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1084,7 +1084,7 @@ even if it doesn't match the type.) \(fn [VARIABLE VALUE]...)" (declare (debug setq)) (unless (evenp (length pairs)) - (error "PAIRS must have an even number of variable/value members")) + (signal 'wrong-number-of-arguments (list 'setopt (length pairs)))) (let ((expr nil)) (while pairs (unless (symbolp (car pairs)) @@ -1100,11 +1100,53 @@ even if it doesn't match the type.) ;; Check that the type is correct. (when-let* ((type (get variable 'custom-type))) (unless (widget-apply (widget-convert type) :match value) - (warn "Value `%S' for variable `%s' does not match its type \"%s\"" - value variable type))) + (warn "Value does not match %S's type `%S': %S" variable type value))) (put variable 'custom-check-value (list value)) (funcall (or (get variable 'custom-set) #'set-default) variable value)) +;;;###autoload +(defmacro setopt-local (&rest pairs) + "Set buffer local VARIABLE/VALUE pairs, and return the final VALUE. +This is like `setq-local', but is meant for user options instead of +plain variables. This means that `setopt-local' will execute any +`custom-set' form associated with VARIABLE. Unlike `setopt', +`setopt-local' does not affect a user option's global value. + +Note that `setopt-local' will emit a warning if the type of a VALUE does +not match the type of the corresponding VARIABLE as declared by +`defcustom'. (VARIABLE will be assigned the value even if it doesn't +match the type.) + +Signal an error if a `custom-set' form does not support the +`buffer-local' argument. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (evenp (length pairs)) + (signal 'wrong-number-of-arguments (list 'setopt-local (length pairs)))) + (let ((expr nil)) + (while pairs + (unless (symbolp (car pairs)) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(setopt--set-local ',(car pairs) ,(cadr pairs)) + expr) + (setq pairs (cddr pairs))) + (macroexp-progn (nreverse expr)))) + +;;;###autoload +(defun setopt--set-local (variable value) + (custom-load-symbol variable) + ;; Check that the type is correct. + (when-let* ((type (get variable 'custom-type))) + (unless (widget-apply (widget-convert type) :match value) + (warn "Value does not match %S's type `%S': %S" variable type value))) + (condition-case _ + (funcall (or (get variable 'custom-set) + (lambda (x v &optional _) (set-local x v))) + variable value 'buffer-local) + (wrong-number-of-arguments + (error "The setter of %S does not support setopt-local" variable)))) + ;;;###autoload (defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 0e3c8bf6a5f..9fe2904c415 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -398,7 +398,11 @@ then it searches *all* buffers." ;; Set it so `dabbrev-capf' won't reset the vars. (setq dabbrev--last-abbrev-location (point-marker)) (let ((completion-at-point-functions '(dabbrev-capf))) - (completion-at-point))) + (unless (completion-at-point) + (user-error "No dynamic expansion for \"%s\" found%s" + (dabbrev--abbrev-at-point) + (if dabbrev--check-other-buffers + "" " in this-buffer"))))) (defun dabbrev-capf () "Dabbrev completion function for `completion-at-point-functions'." diff --git a/lisp/desktop.el b/lisp/desktop.el index f478cf2307b..0cdd554e295 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -775,6 +775,7 @@ if different)." ;; Don't delete daemon's initial frame, or ;; we'll never be able to close the last ;; client's frame (Bug#26912). + ;; Use `frame-initial-p'? (and (daemonp) (eq frame terminal-frame)) (frame-parameter frame 'desktop-dont-clear)) (delete-frame frame)) @@ -1067,9 +1068,8 @@ DIRNAME must be the directory in which the desktop file will be saved." (and (not (frame-parameter frame 'desktop-dont-save)) ;; Don't save daemon initial frames, since we cannot (and don't ;; need to) restore them. - (not (and (daemonp) - (equal (terminal-name (frame-terminal frame)) - "initial_terminal"))))) + (not (and (daemonp) ;; FIXME: Remove `daemonp'? + (frame-initial-p frame))))) (defconst desktop--app-id `(desktop . ,desktop-file-version)) @@ -1260,7 +1260,7 @@ This function also sets `desktop-dirname' to nil." "True if calling `desktop-restore-frameset' will actually restore it." (and desktop-restore-frames desktop-saved-frameset ;; Don't restore frames when the selected frame is the daemon's - ;; initial frame. + ;; initial frame. Use `frame-initial-p'? (not (and (daemonp) (eq (selected-frame) terminal-frame))) t)) diff --git a/lisp/dired.el b/lisp/dired.el index 7f598433a9d..4aded86e40d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -649,6 +649,10 @@ The match starts at the beginning of the line and ends after the end of the line. Subexpression 2 must end right before the \\n.") +(defvar dired--ls-error-buffer nil + "Non-nil if the current dired invocation yields an `ls' error. +The non-nil value is the buffer containing the error message.") + ;;; Faces @@ -1230,7 +1234,16 @@ Type \\[describe-mode] after entering Dired for more info. If DIRNAME is already in a Dired buffer, that buffer is used without refresh." ;; Cannot use (interactive "D") because of wildcards. (interactive (dired-read-dir-and-switches "")) - (pop-to-buffer-same-window (dired-noselect dirname switches))) + (prog1 (pop-to-buffer-same-window (dired-noselect dirname switches)) + (dired--display-ls-error))) + +;; This is needed to let clicks on the menu bar invoke Dired even if +;; some feature remaps the Dired command to another command. +;;;###autoload +(defun dired-from-menubar (dirname &optional switches) + "Edit an existing directory." + (interactive (dired-read-dir-and-switches "")) + (dired dirname switches)) ;;;###autoload (keymap-set ctl-x-4-map "d" #'dired-other-window) ;;;###autoload @@ -1240,21 +1253,24 @@ If this command needs to split the current window, it by default obeys the user options `split-height-threshold' and `split-width-threshold', when it decides whether to split the window horizontally or vertically." (interactive (dired-read-dir-and-switches "in other window ")) - (switch-to-buffer-other-window (dired-noselect dirname switches))) + (prog1 (switch-to-buffer-other-window (dired-noselect dirname switches)) + (dired--display-ls-error))) ;;;###autoload (keymap-set ctl-x-5-map "d" #'dired-other-frame) ;;;###autoload (defun dired-other-frame (dirname &optional switches) "\"Edit\" directory DIRNAME. Like `dired' but make a new frame." (interactive (dired-read-dir-and-switches "in other frame ")) - (switch-to-buffer-other-frame (dired-noselect dirname switches))) + (prog1 (switch-to-buffer-other-frame (dired-noselect dirname switches)) + (dired--display-ls-error))) ;;;###autoload (keymap-set tab-prefix-map "d" #'dired-other-tab) ;;;###autoload (defun dired-other-tab (dirname &optional switches) "\"Edit\" directory DIRNAME. Like `dired' but make a new tab." (interactive (dired-read-dir-and-switches "in other tab ")) - (switch-to-buffer-other-tab (dired-noselect dirname switches))) + (prog1 (switch-to-buffer-other-tab (dired-noselect dirname switches)) + (dired--display-ls-error))) ;;;###autoload (defun dired-noselect (dir-or-list &optional switches) @@ -1439,10 +1455,19 @@ The return value is the target column for the file names." (let ((failed t)) (unwind-protect (progn (dired-readin) - (setq failed nil)) - ;; dired-readin can fail if parent directories are inaccessible. - ;; Don't leave an empty buffer around in that case. - (if failed (kill-buffer buffer)))) + ;; Check for file entries (they are listed below the + ;; directory name and (if present) wildcard lines). + (while (and (skip-syntax-forward "\s") + (looking-at "\\(.+:$\\|wildcard\\)")) + (forward-line)) + (unless (eobp) + (setq failed nil))) + ;; No file entries indicates an `ls' error, and `dired-readin' + ;; can fail if parent directories are inaccessible. In either + ;; case don't leave the Dired buffer around. + (when failed + (kill-buffer buffer) + (setq buffer nil)))) (goto-char (point-min)) (dired-initial-position dirname)) (when (consp dired-directory) @@ -4003,20 +4028,11 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (not (memq buffer1 (memq buffer2 (buffer-list)))))) (defun dired--filename-with-newline-p () - "Check if a file name in this directory has a newline. -Return non-nil if at least one file name in this directory contains -either a literal newline or the string \"\\n\")." - (save-excursion - (goto-char (point-min)) - (catch 'found - (while (not (eobp)) - (when (dired-move-to-filename) - (let ((fn (buffer-substring-no-properties - (point) (dired-move-to-end-of-filename)))) - (when (or (memq 10 (seq-into fn 'list)) - (string-search "\\n" fn)) - (throw 'found t)))) - (forward-line))))) + "Check whether a file name in this directory has a newline. +Return non-nil if at least one file name in this directory contains a +newline character (regardless of whether Dired displays the character as +a literal newline or as \"\\n\")." + (directory-files default-directory nil "\n")) (defun dired--remove-b-switch () "Remove all variants of the `b' switch from `dired-actual-switches'. @@ -4094,6 +4110,13 @@ See `%s' for other alternatives and more information.")) (set-window-point (get-buffer-window) (search-backward "Warning (dired)"))))) +(defun dired--display-ls-error () + "Pop up a buffer displaying the current `ls' error, if any." + (when dired--ls-error-buffer + (let* ((errwin (display-buffer dired--ls-error-buffer))) + (fit-window-to-buffer errwin)) + (setq dired--ls-error-buffer nil))) + ;;; Deleting files diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el index 349a470ab41..b661f20e22a 100644 --- a/lisp/display-fill-column-indicator.el +++ b/lisp/display-fill-column-indicator.el @@ -102,6 +102,7 @@ See Info node `Displaying Boundaries' for details." (defun display-fill-column-indicator--turn-on () "Turn on `display-fill-column-indicator-mode'." (unless (or (minibufferp) + ;; Use `frame-initial-p'? (and (daemonp) (eq (selected-frame) terminal-frame))) (display-fill-column-indicator-mode))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ce2d8ac47c4..7ed71346451 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1901,6 +1901,8 @@ See Info node `(elisp) Integer Basics'." sqlite-available-p sqlitep ;; syntax.c standard-syntax-table syntax-table syntax-table-p + ;; terminal.c + frame-initial-p ;; thread.c current-thread ;; timefns.c diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 3019ada1bbd..ec2aa0ad728 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -195,8 +195,7 @@ the debugger will not be entered." ;; backtrace to stdout. This happens for example while ;; handling an error in code from early-init.el with ;; --debug-init. - (and (eq t (framep (selected-frame))) - (equal "initial_terminal" (terminal-name))))) + (frame-initial-p))) ;; Don't let `inhibit-message' get in our way (especially important if ;; `non-interactive-frame' evaluated to a non-nil value. (inhibit-message nil) diff --git a/lisp/emacs-lisp/shortdoc-doc.el b/lisp/emacs-lisp/shortdoc-doc.el new file mode 100644 index 00000000000..eb642c1600b --- /dev/null +++ b/lisp/emacs-lisp/shortdoc-doc.el @@ -0,0 +1,1528 @@ +;;; shortdoc-doc.el --- Builtin shortdoc groups -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2026 Free Software Foundation, Inc. + +;; Keywords: lisp, help +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file defines builtin Emacs shortdoc groups. +;; +;; If a shortdoc group describes builtin functions, functions from +;; subr.el or simple.el or otherwise preloaded files, or functions from +;; different files, then you should probably define it in this file. +;; Otherwise, you might as well define the shortdoc group in the file +;; where the documented functions live, like treesit.el does it. + +;;; Code: + +(define-short-documentation-group alist + "Alist Basics" + (assoc + :eval (assoc 'foo '((foo . bar) (zot . baz)))) + (rassoc + :eval (rassoc 'bar '((foo . bar) (zot . baz)))) + (assq + :eval (assq 'foo '((foo . bar) (zot . baz)))) + (rassq + :eval (rassq 'bar '((foo . bar) (zot . baz)))) + (assoc-string + :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) + "Manipulating Alists" + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) + (alist-get + :eval (let ((foo '((bar . baz)))) + (setf (alist-get 'bar foo) 'zot) + foo)) + "Misc" + (assoc-default + :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) + (copy-alist + :eval (let* ((old '((foo . bar))) + (new (copy-alist old))) + (eq old new))) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be + ;; better if that could be cleaned up. + (let-alist + :eval (let ((colors '((rose . red) + (lily . white)))) + (let-alist colors + (if (eq .rose 'red) + .lily))))) + +(define-short-documentation-group map + "Map Basics" + (mapp + :eval (mapp (list 'bar 1 'foo 2 'baz 3)) + :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (mapp [bar foo baz]) + :eval (mapp "this is a string") + :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) + :eval (mapp '()) + :eval (mapp nil) + :eval (mapp (make-char-table 'shortdoc-test))) + (map-empty-p + :args (map) + :eval (map-empty-p nil) + :eval (map-empty-p []) + :eval (map-empty-p '())) + (map-elt + :args (map key) + :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-elt [bar foo baz] 1) + :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-contains-key + :args (map key) + :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-contains-key [bar foo baz] 1) + :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-put! + :args (map key value) + :eval +"(let ((map (list 'bar 1 'baz 3))) + (map-put! map 'foo 2) + map)" +;; This signals map-not-inplace when used in shortdoc.el :-( +;; :eval +;; "(let ((map (list '(bar . 1) '(baz . 3)))) +;; (map-put! map 'foo 2) +;; map)" + :eval +"(let ((map [bar bot baz])) + (map-put! map 1 'foo) + map)" + :eval +"(let ((map #s(hash-table data (bar 1 baz 3)))) + (map-put! map 'foo 2) + map)") + (map-insert + :args (map key value) + :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) + :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) + :eval (map-insert [bar bot baz] 1 'foo) + :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) + (map-delete + :args (map key) + :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) + :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) + :eval (map-delete [bar foo baz] 1) + :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) + (map-keys + :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) + :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-keys [bar foo baz]) + :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-values + :args (map) + :eval (map-values (list 'bar 1 'foo 2 'baz 3)) + :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-values [bar foo baz]) + :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-pairs + :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) + :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-pairs [bar foo baz]) + :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-length + :args (map) + :eval (map-length (list 'bar 1 'foo 2 'baz 3)) + :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-length [bar foo baz]) + :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) + (map-copy + :args (map) + :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) + :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) + :eval (map-copy [bar foo baz]) + :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) + "Doing things to maps and their contents" + (map-apply + :args (function map) + :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) + (map-do + :args (function map) + :eval +"(let ((map (list '(1 . 1) '(2 . 3))) + acc) + (map-do (lambda (k v) (push (+ k v) acc)) map) + (nreverse acc))") + (map-keys-apply + :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) + (map-values-apply + :args (function map) + :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) + (map-filter + :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-remove + :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-some + :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) + (map-every-p + :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) + :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) + "Combining and changing maps" + (map-merge + :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) + :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) + (map-merge-with + :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) + :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) + :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) + (map-into + :args (map type) + :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) + :eval (map-into '((5 . 6) (7 . 8)) 'plist) + :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) + +(define-short-documentation-group string + "Making Strings" + (make-string + :args (length init) + :eval "(make-string 5 ?x)") + (string + :eval "(string ?a ?b ?c)") + (concat + :eval (concat "foo" "bar" "zot")) + (string-join + :no-manual t + :eval (string-join '("foo" "bar" "zot") " ")) + (mapconcat + :eval (mapconcat (lambda (a) (concat "[" a "]")) + '("foo" "bar" "zot") " ")) + (string-pad + :eval (string-pad "foo" 5) + :eval (string-pad "foobar" 5) + :eval (string-pad "foo" 5 ?- t)) + (mapcar + :eval (mapcar #'identity "123")) + (format + :eval (format "This number is %d" 4)) + "Manipulating Strings" + (substring + :eval (substring "abcde" 1 3) + :eval (substring "abcde" 2) + :eval (substring "abcde" 1 -1) + :eval (substring "abcde" -4 4)) + (string-limit + :eval (string-limit "foobar" 3) + :eval (string-limit "foobar" 3 t) + :eval (string-limit "foobar" 10) + :eval (string-limit "foε₯½" 3 nil 'utf-8)) + (truncate-string-to-width + :eval (truncate-string-to-width "foobar" 3) + :eval (truncate-string-to-width "δ½ ε₯½bar" 5)) + (split-string + :eval (split-string "foo bar") + :eval (split-string "|foo|bar|" "|") + :eval (split-string "|foo|bar|" "|" t)) + (split-string-and-unquote + :eval (split-string-and-unquote "foo \"bar zot\"")) + (split-string-shell-command + :eval (split-string-shell-command "ls /tmp/'foo bar'")) + (string-lines + :eval (string-lines "foo\n\nbar") + :eval (string-lines "foo\n\nbar" t)) + (string-replace + :eval (string-replace "foo" "bar" "foozot")) + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-trim + :args (string) + :doc "Trim STRING of leading and trailing white space." + :eval (string-trim " foo ")) + (string-trim-left + :eval (string-trim-left "oofoo" "o+")) + (string-trim-right + :eval (string-trim-right "barkss" "s+")) + (string-truncate-left + :no-manual t + :eval (string-truncate-left "longstring" 8)) + (string-remove-suffix + :no-manual t + :eval (string-remove-suffix "bar" "foobar")) + (string-remove-prefix + :no-manual t + :eval (string-remove-prefix "foo" "foobar")) + (string-chop-newline + :eval (string-chop-newline "foo\n")) + (string-clean-whitespace + :eval (string-clean-whitespace " foo bar ")) + (string-fill + :eval (string-fill "Three short words" 12) + :eval (string-fill "Long-word" 3)) + (reverse + :eval (reverse "foo")) + (substring-no-properties + :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) + (try-completion + :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) + "Unicode Strings" + (string-glyph-split + :eval (string-glyph-split "Hello, πŸ‘ΌπŸ»πŸ§‘πŸΌβ€πŸ€β€πŸ§‘πŸ»")) + (string-glyph-compose + :eval (string-glyph-compose "Å")) + (string-glyph-decompose + :eval (string-glyph-decompose "β„«")) + "Predicates for Strings" + (string-equal + :eval (string-equal "abc" "abc") + :eval (string-equal "abc" "ABC")) + (string-equal-ignore-case + :eval (string-equal-ignore-case "foo" "FOO")) + (equal + :eval (equal "foo" "foo")) + (cl-equalp + :eval (cl-equalp "Foo" "foo")) + (stringp + :eval (stringp "a") + :eval (stringp 'a) + :eval "(stringp ?a)") + (string-or-null-p + :eval (string-or-null-p "a") + :eval (string-or-null-p nil)) + (char-or-string-p + :eval "(char-or-string-p ?a)" + :eval (char-or-string-p "a")) + (string-empty-p + :no-manual t + :eval (string-empty-p "")) + (string-blank-p + :no-manual t + :eval (string-blank-p " \n")) + (string-lessp + :eval (string-lessp "abc" "def") + :eval (string-lessp "pic4.png" "pic32.png") + :eval (string-lessp "1.1" "1.2")) + (string-greaterp + :eval (string-greaterp "foo" "bar")) + (string-version-lessp + :eval (string-version-lessp "pic4.png" "pic32.png") + :eval (string-version-lessp "1.9.3" "1.10.2")) + (string-collate-lessp + :eval (string-collate-lessp "abc" "abd")) + (string-prefix-p + :eval (string-prefix-p "foo" "foobar")) + (string-suffix-p + :eval (string-suffix-p "bar" "foobar")) + "Case Manipulation" + (upcase + :eval (upcase "foo")) + (downcase + :eval (downcase "FOObar")) + (capitalize + :eval (capitalize "foo bar zot")) + (upcase-initials + :eval (upcase-initials "The CAT in the hAt")) + "Converting Strings" + (string-to-number + :eval (string-to-number "42") + :eval (string-to-number "deadbeef" 16) + :eval (string-to-number "2.5e+03")) + (number-to-string + :eval (number-to-string 42)) + (char-uppercase-p + :eval "(char-uppercase-p ?A)" + :eval "(char-uppercase-p ?a)") + "Data About Strings" + (length + :eval (length "foo") + :eval (length "avocado: πŸ₯‘")) + (string-width + :eval (string-width "foo") + :eval (string-width "avocado: πŸ₯‘")) + (string-pixel-width + :eval (string-pixel-width "foo") + :eval (string-pixel-width "avocado: πŸ₯‘")) + (string-search + :eval (string-search "bar" "foobarzot")) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (seq-position + :eval "(seq-position \"foobarzot\" ?z)")) + +(define-short-documentation-group file-name + "File Name Manipulation" + (file-name-directory + :eval (file-name-directory "/tmp/foo") + :eval (file-name-directory "/tmp/foo/")) + (file-name-nondirectory + :eval (file-name-nondirectory "/tmp/foo") + :eval (file-name-nondirectory "/tmp/foo/")) + (file-name-sans-versions + :args (filename) + :eval (file-name-sans-versions "/tmp/foo~")) + (file-name-extension + :eval (file-name-extension "/tmp/foo.txt")) + (file-name-sans-extension + :eval (file-name-sans-extension "/tmp/foo.txt")) + (file-name-with-extension + :eval (file-name-with-extension "foo.txt" "bin") + :eval (file-name-with-extension "foo" "bin")) + (file-name-base + :eval (file-name-base "/tmp/foo.txt")) + (file-relative-name + :eval (file-relative-name "/tmp/foo" "/tmp")) + (file-name-split + :eval (file-name-split "/tmp/foo") + :eval (file-name-split "foo/bar")) + (make-temp-name + :eval (make-temp-name "/tmp/foo-")) + (file-name-concat + :eval (file-name-concat "/tmp/" "foo") + :eval (file-name-concat "/tmp" "foo") + :eval (file-name-concat "/tmp" "foo" "bar/" "zot") + :eval (file-name-concat "/tmp" "~")) + (expand-file-name + :eval (expand-file-name "foo" "/tmp/") + :eval (expand-file-name "foo" "/tmp///") + :eval (expand-file-name "foo" "/tmp/foo/.././") + :eval (expand-file-name "~" "/tmp/")) + (substitute-in-file-name + :eval (substitute-in-file-name "$HOME/foo")) + "Directory Functions" + (file-name-as-directory + :eval (file-name-as-directory "/tmp/foo")) + (directory-file-name + :eval (directory-file-name "/tmp/foo/")) + (abbreviate-file-name + :no-eval (abbreviate-file-name "/home/some-user") + :eg-result "~some-user") + (file-name-parent-directory + :eval (file-name-parent-directory "/foo/bar") + :eval (file-name-parent-directory "/foo/") + :eval (file-name-parent-directory "foo/bar") + :eval (file-name-parent-directory "foo")) + "Quoted File Names" + (file-name-quote + :args (name) + :eval (file-name-quote "/tmp/foo")) + (file-name-unquote + :args (name) + :eval (file-name-unquote "/:/tmp/foo")) + "Predicates" + (file-name-absolute-p + :eval (file-name-absolute-p "/tmp/foo") + :eval (file-name-absolute-p "foo")) + (directory-name-p + :eval (directory-name-p "/tmp/foo/")) + (file-name-quoted-p + :eval (file-name-quoted-p "/:/tmp/foo"))) + +(define-short-documentation-group file + "Inserting Contents" + (insert-file-contents + :no-eval (insert-file-contents "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (insert-file-contents-literally + :no-eval (insert-file-contents-literally "/tmp/foo") + :eg-result ("/tmp/foo" 6)) + (find-file + :no-eval (find-file "/tmp/foo") + :eg-result-string "#") + "Predicates" + (file-symlink-p + :no-eval (file-symlink-p "/tmp/foo") + :eg-result t) + (file-directory-p + :no-eval (file-directory-p "/tmp") + :eg-result t) + (file-regular-p + :no-eval (file-regular-p "/tmp/foo") + :eg-result t) + (file-exists-p + :no-eval (file-exists-p "/tmp/foo") + :eg-result t) + (file-readable-p + :no-eval (file-readable-p "/tmp/foo") + :eg-result t) + (file-writable-p + :no-eval (file-writable-p "/tmp/foo") + :eg-result t) + (file-accessible-directory-p + :no-eval (file-accessible-directory-p "/tmp") + :eg-result t) + (file-executable-p + :no-eval (file-executable-p "/bin/cat") + :eg-result t) + (file-newer-than-file-p + :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") + :eg-result nil) + (file-has-changed-p + :no-eval (file-has-changed-p "/tmp/foo") + :eg-result t) + (file-equal-p + :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") + :eg-result nil) + (file-in-directory-p + :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") + :eg-result t) + (file-locked-p + :no-eval (file-locked-p "/tmp/foo") + :eg-result nil) + "Information" + (file-attributes + :no-eval* (file-attributes "/tmp")) + (file-truename + :no-eval (file-truename "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (file-chase-links + :no-eval (file-chase-links "/tmp/foo/bar") + :eg-result "/tmp/foo/zot") + (vc-responsible-backend + :args (file &optional no-error) + :no-eval (vc-responsible-backend "/src/foo/bar.c") + :eg-result Git) + (file-acl + :no-eval (file-acl "/tmp/foo") + :eg-result "user::rw-\ngroup::r--\nother::r--\n") + (file-extended-attributes + :no-eval* (file-extended-attributes "/tmp/foo")) + (file-selinux-context + :no-eval* (file-selinux-context "/tmp/foo")) + (locate-file + :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) + :eg-result "/var/log/syslog") + (executable-find + :no-eval (executable-find "ls") + :eg-result "/usr/bin/ls") + "Creating" + (make-temp-file + :no-eval (make-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-ZcXFMj") + (make-nearby-temp-file + :no-eval (make-nearby-temp-file "/tmp/foo-") + :eg-result "/tmp/foo-xe8iON") + (write-region + :no-value (write-region (point-min) (point-max) "/tmp/foo")) + "Directories" + (make-directory + :no-value (make-directory "/tmp/bar/zot/" t)) + (directory-files + :no-eval (directory-files "/tmp/") + :eg-result ("." ".." ".ICE-unix" ".Test-unix")) + (directory-files-recursively + :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") + :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) + (directory-files-and-attributes + :no-eval* (directory-files-and-attributes "/tmp/foo")) + (file-expand-wildcards + :no-eval (file-expand-wildcards "/tmp/*.png") + :eg-result ("/tmp/foo.png" "/tmp/zot.png") + :no-eval (file-expand-wildcards "/*/foo.png") + :eg-result ("/tmp/foo.png" "/var/foo.png")) + (locate-dominating-file + :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") + :eg-result "/tmp/foo.png") + (copy-directory + :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) + (delete-directory + :no-value (delete-directory "/tmp/bar/")) + "File Operations" + (rename-file + :no-value (rename-file "/tmp/foo" "/tmp/newname")) + (copy-file + :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) + (delete-file + :no-value (delete-file "/tmp/foo")) + (make-empty-file + :no-value (make-empty-file "/tmp/foo")) + (make-symbolic-link + :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) + (add-name-to-file + :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) + (set-file-modes + :no-value "(set-file-modes \"/tmp/foo\" #o644)") + (set-file-times + :no-value (set-file-times "/tmp/foo")) + "File Modes" + (set-default-file-modes + :no-value "(set-default-file-modes #o755)") + (default-file-modes + :no-eval (default-file-modes) + :eg-result-string "#o755") + (file-modes-symbolic-to-number + :no-eval (file-modes-symbolic-to-number "a+r") + :eg-result-string "#o444") + (file-modes-number-to-symbolic + :eval "(file-modes-number-to-symbolic #o444)") + (set-file-extended-attributes + :no-eval (set-file-extended-attributes + "/tmp/foo" '((acl . "group::rxx"))) + :eg-result t) + (set-file-selinux-context + :no-eval (set-file-selinux-context + "/tmp/foo" '(unconfined_u object_r user_home_t s0)) + :eg-result t) + (set-file-acl + :no-eval (set-file-acl "/tmp/foo" "group::rxx") + :eg-result t)) + +(define-short-documentation-group hash-table + "Hash Table Basics" + (make-hash-table + :no-eval (make-hash-table) + :result-string "#s(hash-table ...)") + (puthash + :no-eval (puthash 'key "value" table)) + (gethash + :no-eval (gethash 'key table) + :eg-result "value") + (remhash + :no-eval (remhash 'key table) + :result nil) + (clrhash + :no-eval (clrhash table) + :result-string "#s(hash-table ...)") + (maphash + :no-eval (maphash (lambda (key value) (message value)) table) + :result nil) + "Other Hash Table Functions" + (hash-table-p + :eval (hash-table-p 123)) + (hash-table-contains-p + :no-eval (hash-table-contains-p 'key table)) + (copy-hash-table + :no-eval (copy-hash-table table) + :result-string "#s(hash-table ...)") + (hash-table-count + :no-eval (hash-table-count table) + :eg-result 15)) + +(define-short-documentation-group list + "Making Lists" + (make-list + :eval (make-list 5 'a)) + (cons + :eval (cons 1 '(2 3 4))) + (list + :eval (list 1 2 3)) + (number-sequence + :eval (number-sequence 5 8)) + (ensure-list + :eval (ensure-list "foo") + :eval (ensure-list '(1 2 3)) + :eval (ensure-list '(1 . 2))) + (ensure-proper-list + :eval (ensure-proper-list "foo") + :eval (ensure-proper-list '(1 2 3)) + :eval (ensure-proper-list '(1 . 2))) + "Operations on Lists" + (append + :eval (append '("foo" "bar") '("zot"))) + (copy-tree + :eval (copy-tree '(1 (2 3) 4))) + (flatten-tree + :eval (flatten-tree '(1 (2 3) 4))) + (car + :eval (car '(one two three)) + :eval (car '(one . two)) + :eval (car nil)) + (cdr + :eval (cdr '(one two three)) + :eval (cdr '(one . two)) + :eval (cdr nil)) + (last + :eval (last '(one two three))) + (butlast + :eval (butlast '(one two three))) + (nbutlast + :eval (nbutlast (list 'one 'two 'three))) + (nth + :eval (nth 1 '(one two three))) + (nthcdr + :eval (nthcdr 1 '(one two three))) + (take + :eval (take 3 '(one two three four))) + (ntake + :eval (ntake 3 (list 'one 'two 'three 'four))) + (take-while + :eval (take-while #'numberp '(1 2 three 4 five))) + (drop-while + :eval (drop-while #'numberp '(1 2 three 4 five))) + (any + :eval (any #'symbolp '(1 2 three 4 five))) + (all + :eval (all #'symbolp '(one 2 three)) + :eval (all #'symbolp '(one two three))) + (elt + :eval (elt '(one two three) 1)) + (car-safe + :eval (car-safe '(one two three))) + (cdr-safe + :eval (cdr-safe '(one two three))) + (push + :no-eval* (push 'a list)) + (pop + :no-eval* (pop list)) + (setcar + :no-eval (setcar list 'c) + :result c) + (setcdr + :no-eval (setcdr list (list c)) + :result '(c)) + (nconc + :eval (nconc (list 1) (list 2 3 4))) + (delq + :eval (delq 'a (list 'a 'b 'c 'd))) + (delete + :eval (delete 2 (list 1 2 3 4)) + :eval (delete "a" (list "a" "b" "c" "d"))) + (remq + :eval (remq 'b '(a b c))) + (remove + :eval (remove 2 '(1 2 3 4)) + :eval (remove "a" '("a" "b" "c" "d"))) + (delete-dups + :eval (delete-dups (list 1 2 4 3 2 4))) + "Mapping Over Lists" + (mapcar + :eval (mapcar #'list '(1 2 3))) + (mapcan + :eval (mapcan #'list '(1 2 3))) + (mapc + :eval (mapc #'insert '("1" "2" "3"))) + (seq-reduce + :eval (seq-reduce #'+ '(1 2 3) 0)) + (mapconcat + :eval (mapconcat #'identity '("foo" "bar") "|")) + "Predicates" + (listp + :eval (listp '(1 2 3)) + :eval (listp nil) + :eval (listp '(1 . 2))) + (consp + :eval (consp '(1 2 3)) + :eval (consp nil)) + (proper-list-p + :eval (proper-list-p '(1 2 3)) + :eval (proper-list-p nil) + :eval (proper-list-p '(1 . 2))) + (null + :eval (null nil)) + (atom + :eval (atom 'a)) + (nlistp + :eval (nlistp '(1 2 3)) + :eval (nlistp t) + :eval (nlistp '(1 . 2))) + "Finding Elements" + (memq + :eval (memq 'b '(a b c))) + (memql + :eval (memql 2.0 '(1.0 2.0 3.0))) + (member + :eval (member 2 '(1 2 3)) + :eval (member "b" '("a" "b" "c"))) + (member-ignore-case + :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) + "Association Lists" + (assoc + :eval (assoc "b" '(("a" . 1) ("b" . 2)))) + (rassoc + :eval (rassoc "b" '((1 . "a") (2 . "b")))) + (assq + :eval (assq 'b '((a . 1) (b . 2)))) + (rassq + :eval (rassq 'b '((1 . a) (2 . b)))) + (assoc-string + :eval (assoc-string "foo" '(("a" 1) (foo 2)))) + (alist-get + :eval (alist-get 2 '((1 . a) (2 . b)))) + (assoc-default + :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) + (copy-alist + :eval (copy-alist '((1 . a) (2 . b)))) + (assoc-delete-all + :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) + (assq-delete-all + :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) + (rassq-delete-all + :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) + "Property Lists" + (plist-get + :eval (plist-get '(a 1 b 2 c 3) 'b)) + (plist-put + :no-eval (setq plist (plist-put plist 'd 4)) + :eg-result (a 1 b 2 c 3 d 4)) + (plist-member + :eval (plist-member '(a 1 b 2 c 3) 'b)) + "Data About Lists" + (length + :eval (length '(a b c))) + (length< + :eval (length< '(a b c) 1)) + (length> + :eval (length> '(a b c) 1)) + (length= + :eval (length= '(a b c) 3)) + (safe-length + :eval (safe-length '(a b c)))) + +(define-short-documentation-group symbol + "Making symbols" + (intern + :eval (intern "abc")) + (intern-soft + :eval (intern-soft "list") + :eval (intern-soft "Phooey!")) + (make-symbol + :eval (make-symbol "abc")) + (gensym + :no-eval (gensym) + :eg-result g37) + "Comparing symbols" + (eq + :eval (eq 'abc 'abc) + :eval (eq 'abc 'abd)) + (eql + :eval (eql 'abc 'abc)) + (equal + :eval (equal 'abc 'abc)) + "Name" + (symbol-name + :eval (symbol-name 'abc)) + "Obarrays" + (obarray-make + :eval (obarray-make)) + (obarrayp + :eval (obarrayp (obarray-make)) + :eval (obarrayp nil)) + (unintern + :no-eval (unintern "abc" my-obarray) + :eg-result t) + (mapatoms + :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) + (obarray-clear + :no-eval (obarray-clear my-obarray))) + +(define-short-documentation-group comparison + "General-purpose" + (eq + :eval (eq 'a 'a) + :eval "(eq ?A ?A)" + :eval (let ((x (list 'a "b" '(c) 4 5.0))) + (eq x x))) + (eql + :eval (eql 2 2) + :eval (eql 2.0 2.0) + :eval (eql 2.0 2)) + (equal + :eval (equal "abc" "abc") + :eval (equal 2.0 2.0) + :eval (equal 2.0 2) + :eval (equal '(a "b" (c) 4.0) '(a "b" (c) 4.0))) + (cl-equalp + :eval (cl-equalp 2 2.0) + :eval (cl-equalp "ABC" "abc")) + "Numeric" + (= + :args (number &rest numbers) + :eval (= 2 2) + :eval (= 2.0 2.0) + :eval (= 2.0 2) + :eval (= 4 4 4 4)) + (/= + :eval (/= 4 4)) + (< + :args (number &rest numbers) + :eval (< 4 4) + :eval (< 1 2 3)) + (<= + :args (number &rest numbers) + :eval (<= 4 4) + :eval (<= 1 2 2 3)) + (> + :args (number &rest numbers) + :eval (> 4 4) + :eval (> 3 2 1)) + (>= + :args (number &rest numbers) + :eval (>= 4 4) + :eval (>= 3 2 2 1)) + "String" + (string-equal + :eval (string-equal "abc" "abc") + :eval (string-equal "abc" "ABC")) + (string-equal-ignore-case + :eval (string-equal-ignore-case "abc" "ABC")) + (string-lessp + :eval (string-lessp "abc" "abd") + :eval (string-lessp "abc" "abc") + :eval (string-lessp "pic4.png" "pic32.png")) + (string-greaterp + :eval (string-greaterp "abd" "abc") + :eval (string-greaterp "abc" "abc")) + (string-version-lessp + :eval (string-version-lessp "pic4.png" "pic32.png") + :eval (string-version-lessp "1.9.3" "1.10.2")) + (string-collate-lessp + :eval (string-collate-lessp "abc" "abd"))) + +(define-short-documentation-group vector + "Making Vectors" + (make-vector + :eval (make-vector 5 "foo")) + (vector + :eval (vector 1 "b" 3)) + "Operations on Vectors" + (vectorp + :eval (vectorp [1]) + :eval (vectorp "1")) + (vconcat + :eval (vconcat '(1 2) [3 4])) + (append + :eval (append [1 2] nil)) + (length + :eval (length [1 2 3])) + (seq-reduce + :eval (seq-reduce #'+ [1 2 3] 0)) + (seq-subseq + :eval (seq-subseq [1 2 3 4 5] 1 3) + :eval (seq-subseq [1 2 3 4 5] 1)) + (copy-tree + :eval (copy-tree [1 (2 3) [4 5]] t)) + "Mapping Over Vectors" + (mapcar + :eval (mapcar #'identity [1 2 3])) + (mapc + :eval (mapc #'insert ["1" "2" "3"]))) + +(define-short-documentation-group regexp + "Matching Strings" + (replace-regexp-in-string + :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) + (string-match-p + :eval (string-match-p "^[fo]+" "foobar")) + "Looking in Buffers" + (re-search-forward + :no-eval (re-search-forward "^foo$" nil t) + :eg-result 43) + (re-search-backward + :no-eval (re-search-backward "^foo$" nil t) + :eg-result 43) + (looking-at-p + :no-eval (looking-at-p "f[0-9]") + :eg-result t) + "Match Data" + (match-string + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + (match-string 0 "foobar"))) + (match-beginning + :no-eval (match-beginning 1) + :eg-result 0) + (match-end + :no-eval (match-end 1) + :eg-result 3) + (save-match-data + :no-eval (save-match-data ...)) + "Replacing Match" + (replace-match + :no-eval (replace-match "new") + :eg-result nil) + (match-substitute-replacement + :no-eval (match-substitute-replacement "new") + :eg-result "new") + (replace-regexp-in-region + :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) + "Utilities" + (regexp-quote + :eval (regexp-quote "foo.*bar")) + (regexp-opt + :eval (regexp-opt '("foo" "bar"))) + (regexp-opt-depth + :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) + (regexp-opt-charset + :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) + "The `rx' Structured Regexp Notation" + (rx + :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) + (rx-to-string + :eval (rx-to-string '(| "foo" "bar"))) + (rx-define + :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) + (rx haskell-comment))" + :result "--.*") + (rx-let + :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) + (number (1+ digit)) + (numbers (comma-separated number))) + (rx \"(\" numbers \")\"))" + :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") + (rx-let-eval + :eval "(rx-let-eval + '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) + (rx-to-string + '(ponder (or \"flowers\" \"cars\" \"socks\"))))" + :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) + +(define-short-documentation-group sequence + "Sequence Predicates" + (seq-contains-p + :eval (seq-contains-p '(a b c) 'b) + :eval (seq-contains-p '(a b c) 'd)) + (seq-every-p + :eval (seq-every-p #'numberp '(1 2 3))) + (seq-empty-p + :eval (seq-empty-p [])) + (seq-set-equal-p + :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) + (seq-some + :eval (seq-some #'floatp '(1 2.0 3))) + "Building Sequences" + (seq-concatenate + :eval (seq-concatenate 'vector '(1 2) '(c d))) + (seq-copy + :eval (seq-copy '(a 2))) + (seq-into + :eval (seq-into '(1 2 3) 'vector)) + "Utility Functions" + (seq-count + :eval (seq-count #'numberp '(1 b c 4))) + (seq-elt + :eval (seq-elt '(a b c) 1)) + (seq-random-elt + :no-eval (seq-random-elt '(a b c)) + :eg-result c) + (seq-find + :eval (seq-find #'numberp '(a b 3 4 f 6))) + (seq-position + :eval (seq-position '(a b c) 'c)) + (seq-positions + :eval (seq-positions '(a b c a d) 'a) + :eval (seq-positions '(a b c a d) 'z) + :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) + (seq-length + :eval (seq-length "abcde")) + (seq-max + :eval (seq-max [1 2 3])) + (seq-min + :eval (seq-min [1 2 3])) + (seq-first + :eval (seq-first [a b c])) + (seq-rest + :eval (seq-rest '[1 2 3])) + (seq-reverse + :eval (seq-reverse '(1 2 3))) + (seq-sort + :eval (seq-sort #'> '(1 2 3))) + (seq-sort-by + :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) + "Mapping Over Sequences" + (seq-map + :eval (seq-map #'1+ '(1 2 3))) + (seq-map-indexed + :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) + (seq-mapcat + :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) + (seq-doseq + :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) + :eg-result ("foo" "bar")) + (seq-do + :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) + :eg-result ("foo" "bar")) + (seq-do-indexed + :no-eval (seq-do-indexed + (lambda (a index) (message "%s:%s" index a)) + '("foo" "bar")) + :eg-result nil) + (seq-reduce + :eval (seq-reduce #'* [1 2 3] 2)) + "Excerpting Sequences" + (seq-drop + :eval (seq-drop '(a b c) 2)) + (seq-drop-while + :eval (seq-drop-while #'numberp '(1 2 c d 5))) + (seq-filter + :eval (seq-filter #'numberp '(a b 3 4 f 6))) + (seq-keep + :eval (seq-keep #'car-safe '((1 2) 3 t (a . b)))) + (seq-remove + :eval (seq-remove #'numberp '(1 2 c d 5))) + (seq-remove-at-position + :eval (seq-remove-at-position '(a b c d e) 3) + :eval (seq-remove-at-position [a b c d e] 0)) + (seq-group-by + :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6))) + (seq-union + :eval (seq-union '(1 2 3) '(3 5))) + (seq-difference + :eval (seq-difference '(1 2 3) '(2 3 4))) + (seq-intersection + :eval (seq-intersection '(1 2 3) '(2 3 4))) + (seq-partition + :eval (seq-partition '(a b c d e f g h) 3)) + (seq-subseq + :eval (seq-subseq '(a b c d e) 2 4)) + (seq-take + :eval (seq-take '(a b c d e) 3)) + (seq-split + :eval (seq-split [0 1 2 3 5] 2)) + (seq-take-while + :eval (seq-take-while #'integerp [1 2 3.0 4])) + (seq-uniq + :eval (seq-uniq '(a b d b a c)))) + +(define-short-documentation-group buffer + "Buffer Basics" + (current-buffer + :no-eval (current-buffer) + :eg-result-string "#") + (bufferp + :eval (bufferp 23)) + (buffer-live-p + :no-eval (buffer-live-p some-buffer) + :eg-result t) + (buffer-modified-p + :eval (buffer-modified-p (current-buffer))) + (buffer-name + :eval (buffer-name)) + (window-buffer + :eval (window-buffer)) + "Selecting Buffers" + (get-buffer-create + :no-eval (get-buffer-create "*foo*") + :eg-result-string "#") + (pop-to-buffer + :no-eval (pop-to-buffer "*foo*") + :eg-result-string "#") + (with-current-buffer + :no-eval* (with-current-buffer buffer (buffer-size))) + "Points and Positions" + (point + :eval (point)) + (point-min + :eval (point-min)) + (point-max + :eval (point-max)) + (pos-bol + :eval (pos-bol)) + (pos-eol + :eval (pos-eol)) + (bolp + :eval (bolp)) + (eolp + :eval (eolp)) + (line-beginning-position + :eval (line-beginning-position)) + (line-end-position + :eval (line-end-position)) + (buffer-size + :eval (buffer-size)) + (bobp + :eval (bobp)) + (eobp + :eval (eobp)) + "Moving Around" + (goto-char + :no-eval (goto-char (point-max)) + :eg-result 342) + (search-forward + :no-eval (search-forward "some-string" nil t) + :eg-result 245) + (re-search-forward + :no-eval (re-search-forward "some-s.*g" nil t) + :eg-result 245) + (forward-line + :no-eval (forward-line 1) + :eg-result 0 + :no-eval (forward-line -2) + :eg-result 0) + "Strings from Buffers" + (buffer-string + :no-eval* (buffer-string)) + (buffer-substring + :eval (buffer-substring (point-min) (+ (point-min) 10))) + (buffer-substring-no-properties + :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) + (following-char + :no-eval (following-char) + :eg-result 67) + (preceding-char + :no-eval (preceding-char) + :eg-result 38) + (char-after + :eval (char-after 45)) + (char-before + :eval (char-before 13)) + (get-byte + :no-eval (get-byte 45) + :eg-result-string "#xff") + "Altering Buffers" + (delete-region + :no-value (delete-region (point-min) (point-max))) + (erase-buffer + :no-value (erase-buffer)) + (delete-line + :no-value (delete-line)) + (insert + :no-value (insert "This string will be inserted in the buffer\n")) + (subst-char-in-region + :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") + (replace-string-in-region + :no-value (replace-string-in-region "foo" "bar")) + "Locking" + (lock-buffer + :no-value (lock-buffer "/tmp/foo")) + (unlock-buffer + :no-value (unlock-buffer))) + +(define-short-documentation-group overlay + "Predicates" + (overlayp + :no-eval (overlayp some-overlay) + :eg-result t) + "Creation and Deletion" + (make-overlay + :args (beg end &optional buffer) + :no-eval (make-overlay 1 10) + :eg-result-string "#") + (delete-overlay + :no-eval (delete-overlay foo) + :eg-result t) + "Searching Overlays" + (overlays-at + :no-eval (overlays-at 15) + :eg-result-string "(#)") + (overlays-in + :no-eval (overlays-in 1 30) + :eg-result-string "(#)") + (next-overlay-change + :no-eval (next-overlay-change 1) + :eg-result 20) + (previous-overlay-change + :no-eval (previous-overlay-change 30) + :eg-result 20) + "Overlay Properties" + (overlay-start + :no-eval (overlay-start foo) + :eg-result 1) + (overlay-end + :no-eval (overlay-end foo) + :eg-result 10) + (overlay-put + :no-eval (overlay-put foo 'happy t) + :eg-result t) + (overlay-get + :no-eval (overlay-get foo 'happy) + :eg-result t) + (overlay-buffer + :no-eval (overlay-buffer foo)) + "Moving Overlays" + (move-overlay + :no-eval (move-overlay foo 5 20) + :eg-result-string "#")) + +(define-short-documentation-group process + (make-process + :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) + :eg-result-string "#") + (processp + :eval (processp t)) + (process-status + :no-eval (process-status process) + :eg-result exit) + (delete-process + :no-value (delete-process process)) + (kill-process + :no-value (kill-process process)) + (set-process-sentinel + :no-value (set-process-sentinel process (lambda (proc string)))) + (process-buffer + :no-eval (process-buffer process) + :eg-result-string "#") + (get-buffer-process + :no-eval (get-buffer-process buffer) + :eg-result-string "#") + (process-live-p + :no-eval (process-live-p process) + :eg-result t)) + +(define-short-documentation-group number + "Arithmetic" + (+ + :args (&rest numbers) + :eval (+ 1 2) + :eval (+ 1 2 3 4)) + (- + :args (&rest numbers) + :eval (- 3 2) + :eval (- 6 3 2)) + (* + :args (&rest numbers) + :eval (* 3 4 5)) + (/ + :eval (/ 10 5) + :eval (/ 10 6) + :eval (/ 10.0 6) + :eval (/ 10.0 3 3)) + (% + :eval (% 10 5) + :eval (% 10 6)) + (mod + :eval (mod 10 5) + :eval (mod 10 6) + :eval (mod 10.5 6)) + (1+ + :eval (1+ 2) + :eval (let ((x 2)) (1+ x) x)) + (1- + :eval (1- 4) + :eval (let ((x 4)) (1- x) x)) + (incf + :eval (let ((x 2)) (incf x) x) + :eval (let ((x 2)) (incf x 2) x)) + (decf + :eval (let ((x 4)) (decf x) x) + :eval (let ((x 4)) (decf x 2) x)) + "Predicates" + (= + :args (number &rest numbers) + :eval (= 4 4) + :eval (= 4.0 4.0) + :eval (= 4 4.0) + :eval (= 4 4 4 4)) + (eql + :eval (eql 4 4) + :eval (eql 4.0 4.0)) + (/= + :eval (/= 4 4)) + (< + :args (number &rest numbers) + :eval (< 4 4) + :eval (< 1 2 3)) + (<= + :args (number &rest numbers) + :eval (<= 4 4) + :eval (<= 1 2 2 3)) + (> + :args (number &rest numbers) + :eval (> 4 4) + :eval (> 3 2 1)) + (>= + :args (number &rest numbers) + :eval (>= 4 4) + :eval (>= 3 2 2 1)) + (zerop + :eval (zerop 0)) + (natnump + :eval (natnump -1) + :eval (natnump 0) + :eval (natnump 23)) + (plusp + :eval (plusp 0) + :eval (plusp 1)) + (minusp + :eval (minusp 0) + :eval (minusp -1)) + (oddp + :eval (oddp 3)) + (evenp + :eval (evenp 6)) + (bignump + :eval (bignump 4) + :eval (bignump (expt 2 90))) + (fixnump + :eval (fixnump 4) + :eval (fixnump (expt 2 90))) + (floatp + :eval (floatp 5.4)) + (integerp + :eval (integerp 5.4)) + (numberp + :eval (numberp "5.4")) + (cl-digit-char-p + :eval (cl-digit-char-p ?5 10) + :eval (cl-digit-char-p ?f 16)) + "Operations" + (max + :args (number &rest numbers) + :eval (max 7 9 3)) + (min + :args (number &rest numbers) + :eval (min 7 9 3)) + (abs + :eval (abs -4)) + (float + :eval (float 2)) + (truncate + :eval (truncate 1.2) + :eval (truncate -1.2) + :eval (truncate 5.4 2)) + (floor + :eval (floor 1.2) + :eval (floor -1.2) + :eval (floor 5.4 2)) + (ceiling + :eval (ceiling 1.2) + :eval (ceiling -1.2) + :eval (ceiling 5.4 2)) + (round + :eval (round 1.2) + :eval (round -1.2) + :eval (round 5.4 2)) + (random + :eval (random 6)) + "Bit Operations" + (ash + :eval (ash 1 4) + :eval (ash 16 -1)) + (logand + :no-eval "(logand #b10 #b111)" + :result-string "#b10") + (logior + :eval (logior 4 16)) + (logxor + :eval (logxor 4 16)) + (lognot + :eval (lognot 5)) + (logcount + :eval (logcount 5)) + "Floating Point" + (isnan + :eval (isnan 5.0)) + (frexp + :eval (frexp 5.7)) + (ldexp + :eval (ldexp 0.7125 3)) + (logb + :eval (logb 10.5)) + (ffloor + :eval (ffloor 1.2)) + (fceiling + :eval (fceiling 1.2)) + (ftruncate + :eval (ftruncate 1.2)) + (fround + :eval (fround 1.2)) + "Standard Math Functions" + (sin + :eval (sin float-pi)) + (cos + :eval (cos float-pi)) + (tan + :eval (tan float-pi)) + (asin + :eval (asin float-pi)) + (acos + :eval (acos float-pi)) + (atan + :eval (atan float-pi)) + (exp + :eval (exp 4)) + (log + :eval (log 54.59)) + (expt + :eval (expt 2 16)) + (sqrt + :eval (sqrt -1))) + +(define-short-documentation-group text-properties + "Examining Text Properties" + (get-text-property + :eval (get-text-property 0 'foo (propertize "x" 'foo t))) + (get-char-property + :eval (get-char-property 0 'foo (propertize "x" 'foo t))) + (get-pos-property + :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) + (get-char-property-and-overlay + :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) + (text-properties-at + :eval (text-properties-at (point))) + "Changing Text Properties" + (put-text-property + :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) + :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) + (add-text-properties + :no-eval (add-text-properties (point) (1+ (point)) '(face error))) + (remove-text-properties + :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) + (remove-list-of-text-properties + :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) + (set-text-properties + :no-eval (set-text-properties (point) (1+ (point)) '(face error))) + (add-face-text-property + :no-eval (add-face-text-property START END '(:foreground "green"))) + (propertize + :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) + "Searching for Text Properties" + (next-property-change + :no-eval (next-property-change (point) (current-buffer))) + (previous-property-change + :no-eval (previous-property-change (point) (current-buffer))) + (next-single-property-change + :no-eval (next-single-property-change (point) 'face (current-buffer))) + (previous-single-property-change + :no-eval (previous-single-property-change (point) 'face (current-buffer))) + ;; TODO: There are some more that could be added here. + (text-property-search-forward + :no-eval (text-property-search-forward 'face nil t)) + (text-property-search-backward + :no-eval (text-property-search-backward 'face nil t))) + +(define-short-documentation-group keymaps + "Defining keymaps or adding bindings to existing keymaps" + (define-keymap + :no-eval (define-keymap "C-c C-c" #'quit-buffer) + :no-eval (define-keymap :keymap ctl-x-map + "C-r" #'recentf-open + "k" #'kill-current-buffer)) + (defvar-keymap + :no-eval (defvar-keymap my-keymap "C-c C-c" #'quit-buffer)) + "Setting keys" + (keymap-set + :no-eval (keymap-set map "C-c C-c" #'quit-buffer)) + (keymap-local-set + :no-eval (keymap-local-set "C-c C-c" #'quit-buffer)) + (keymap-global-set + :no-eval (keymap-global-set "C-c C-c" #'quit-buffer)) + (keymap-unset + :no-eval (keymap-unset map "C-c C-c")) + (keymap-local-unset + :no-eval (keymap-local-unset "C-c C-c")) + (keymap-global-unset + :no-eval (keymap-global-unset "C-c C-c")) + (keymap-substitute + :no-eval (keymap-substitute map "C-c C-c" "M-a")) + (keymap-set-after + :no-eval (keymap-set-after map "" menu-bar-separator)) + "Predicates" + (keymapp + :eval (keymapp (define-keymap))) + (key-valid-p + :eval (key-valid-p "C-c C-c") + :eval (key-valid-p "C-cC-c")) + "Lookup" + (keymap-lookup + :eval (keymap-lookup (current-global-map) "C-x x g"))) + +(provide 'shortdoc-doc) + +;;; shortdoc-doc.el ends here diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index ea6910c60fc..e8ba6ededc0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -25,8 +25,8 @@ ;; This package lists functions based on various groupings. ;; ;; For instance, `string-trim' and `mapconcat' are `string' functions, -;; so `M-x shortdoc RET string RET' will give an overview of functions -;; that operate on strings. +;; so `M-x shortdoc RET string RET' will give an overview of these and +;; other functions that operate on strings. ;; ;; The documentation groups are created with the ;; `define-short-documentation-group' macro. @@ -50,23 +50,109 @@ '((t :inherit variable-pitch)) "Face used for a section.") -;;;###autoload -(defun shortdoc--check (group functions) - (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* - :result :result-string :eg-result :eg-result-string :doc))) - (dolist (f functions) - (when (consp f) - (dolist (x f) - (when (and (keywordp x) (not (memq x keywords))) - (error "Shortdoc %s function `%s': bad keyword `%s'" - group (car f) x))))))) + +;; Almost all past Emacs versions (but see note on Emacs 30 below) +;; understand the following shortdoc group structure: +;; +;; (SYMBOL ;; shortdoc group name +;; (:group [:KEYWORD VALUE ...]) ;; group properties +;; STRING ;; shortdoc section title +;; (:section [:KEYWORD VALUE ...]) ;; section properties +;; +;; (SYMBOL ;; shortdoc item +;; [:KEYWORD VALUE ...]) ;; item properties +;; ([:item] FORM ;; generalized shortdoc item +;; [:KEYWORD VALUE ...])) ;; item properties +;; +;; Where: +;; - a group definition must contain at least one section title or item; +;; - group and section properties must occur at most once after the +;; group name and a section title, respectively; +;; - the leading `:item' keyword of a generalized shortdoc item may be +;; omitted if the shortdoc group is not intended to be used on Emacs +;; versions older than Emacs 32; +;; - the group, secion, or item properties may be empty. +;; +;; That does not mean that any such shortdoc group is meaningful. And +;; that does not mean that past Emacs version actually use all the bits +;; available in such a definition. But they will not error out when +;; processing a definition with the format layed out above, they will +;; simply silently ignore those bits unknown to them (specifically +;; unknown keywords) and attempt to make the best out of the rest. +;; +;; Why is this important? Because it gives package authors a guarantee +;; that they can use shortdoc features of newer Emacs versions without +;; older Emacs versions breaking on them. +;; +;; So Emacs developers, please +;; +;; - stick to above structure when extending shortdoc.el (so that past +;; Emacs versions can grok your extensions without breaking); and +;; +;; - do not impose any additional restrictions on the format described +;; above and on the allowed keywords (so that you do not limit the +;; options of future Emacs versions). +;; +;; Emacs 30, for example, had introduced some restrictions on item +;; property keywords. As a result, we need that hack mentioned in the +;; "boilerplate template for Emacs package authors" above. + +(defun shortdoc--keyword-plist-p (object) + "Return non-nil if OBJECT is a plist with keywords as property names." + (let ((ok (proper-list-p object))) + (while (and ok object) + (setq ok (and (keywordp (car object)) (cdr object)) + object (cddr object))) + ok)) + +(defun shortdoc--check (group definition) + "Ensure that (GROUP DEFINITION) is a valid shortdoc group definition. +Signal an error if that is not the case." + (unless (symbolp group) + (signal 'wrong-type-argument (list 'symbolp group))) + (unless (proper-list-p definition) + (signal 'wrong-type-argument (list 'proper-list-p definition))) + (let ((has-content nil) + entry keyword type + (prev-type 'group-name)) + (while definition + (setq entry (car definition) + keyword (car-safe entry) + type (cond + ((and (eq keyword :group) + (shortdoc--keyword-plist-p (cdr entry))) + 'group-properties) + ((stringp entry) 'section-title) + ((and (eq keyword :section) + (shortdoc--keyword-plist-p (cdr entry))) + 'section-properties) + ((and (eq keyword :item) + (shortdoc--keyword-plist-p entry)) + 'item-definition) + ((and (consp entry) + (shortdoc--keyword-plist-p (cdr entry))) + 'item-definition) + (t 'invalid))) + (cond ((memq type '(section-title item-definition)) + (setq has-content t)) + ((and (eq type 'group-properties) + (eq prev-type 'group-name))) + ((and (eq type 'section-properties) + (eq prev-type 'section-title))) + (t + (error "Shortdoc group %s with invalid entry %S" + group entry))) + (setq prev-type type + definition (cdr definition))) + (unless has-content + (error "Shortdoc group %s without content" group)))) ;;;###autoload -(progn - (defvar shortdoc--groups nil) +(defvar shortdoc--groups nil) - (defmacro define-short-documentation-group (group &rest functions) - "Add GROUP to the list of defined documentation groups. +;;;###autoload +(defmacro define-short-documentation-group (group &rest functions) + "Add GROUP to the list of defined documentation groups. FUNCTIONS is a list of elements on the form: (FUNC @@ -128,1504 +214,28 @@ execution of the documented form depends on some conditions. A FUNC form can have any number of `:no-eval' (or `:no-value'), `:no-eval*', `:result', `:result-string', `:eg-result' and `:eg-result-string' properties." - (declare (indent defun)) - (shortdoc--check group functions) - `(progn - (setq shortdoc--groups (delq (assq ',group shortdoc--groups) - shortdoc--groups)) - (push (cons ',group ',functions) shortdoc--groups)))) + (declare (indent defun)) + (let ((err + (condition-case err + (progn (shortdoc--check group functions) nil) + (error err))) + (exp + `(progn + (setq shortdoc--groups (delq (assq ',group shortdoc--groups) + shortdoc--groups)) + (push (cons ',group ',functions) shortdoc--groups)))) + (if (null err) + exp + (macroexp-warn-and-return + (error-message-string err) exp nil t)))) -(define-short-documentation-group alist - "Alist Basics" - (assoc - :eval (assoc 'foo '((foo . bar) (zot . baz)))) - (rassoc - :eval (rassoc 'bar '((foo . bar) (zot . baz)))) - (assq - :eval (assq 'foo '((foo . bar) (zot . baz)))) - (rassq - :eval (rassq 'bar '((foo . bar) (zot . baz)))) - (assoc-string - :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) - "Manipulating Alists" - (assoc-delete-all - :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) - (rassq-delete-all - :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) - (alist-get - :eval (let ((foo '((bar . baz)))) - (setf (alist-get 'bar foo) 'zot) - foo)) - "Misc" - (assoc-default - :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) - (copy-alist - :eval (let* ((old '((foo . bar))) - (new (copy-alist old))) - (eq old new))) - ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be - ;; better if that could be cleaned up. - (let-alist - :eval (let ((colors '((rose . red) - (lily . white)))) - (let-alist colors - (if (eq .rose 'red) - .lily))))) - -(define-short-documentation-group map - "Map Basics" - (mapp - :eval (mapp (list 'bar 1 'foo 2 'baz 3)) - :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (mapp [bar foo baz]) - :eval (mapp "this is a string") - :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) - :eval (mapp '()) - :eval (mapp nil) - :eval (mapp (make-char-table 'shortdoc-test))) - (map-empty-p - :args (map) - :eval (map-empty-p nil) - :eval (map-empty-p []) - :eval (map-empty-p '())) - (map-elt - :args (map key) - :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-elt [bar foo baz] 1) - :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-contains-key - :args (map key) - :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-contains-key [bar foo baz] 1) - :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-put! - (map key value) - :eval -"(let ((map (list 'bar 1 'baz 3))) - (map-put! map 'foo 2) - map)" -;; This signals map-not-inplace when used in shortdoc.el :-( -;; :eval -;; "(let ((map (list '(bar . 1) '(baz . 3)))) -;; (map-put! map 'foo 2) -;; map)" - :eval -"(let ((map [bar bot baz])) - (map-put! map 1 'foo) - map)" - :eval -"(let ((map #s(hash-table data (bar 1 baz 3)))) - (map-put! map 'foo 2) - map)") - (map-insert - :args (map key value) - :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) - :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) - :eval (map-insert [bar bot baz] 1 'foo) - :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) - (map-delete - :args (map key) - :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) - :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) - :eval (map-delete [bar foo baz] 1) - :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) - (map-keys - :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) - :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-keys [bar foo baz]) - :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-values - :args (map) - :eval (map-values (list 'bar 1 'foo 2 'baz 3)) - :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-values [bar foo baz]) - :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-pairs - :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) - :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-pairs [bar foo baz]) - :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-length - :args (map) - :eval (map-length (list 'bar 1 'foo 2 'baz 3)) - :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-length [bar foo baz]) - :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) - (map-copy - :args (map) - :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) - :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) - :eval (map-copy [bar foo baz]) - :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) - "Doing things to maps and their contents" - (map-apply - :args (function map) - :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) - (map-do - :args (function map) - :eval -"(let ((map (list '(1 . 1) '(2 . 3))) - acc) - (map-do (lambda (k v) (push (+ k v) acc)) map) - (nreverse acc))") - (map-keys-apply - :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) - (map-values-apply - :args (function map) - :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) - (map-filter - :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-remove - :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-some - :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) - (map-every-p - :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) - :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) - "Combining and changing maps" - (map-merge - :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) - :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) - (map-merge-with - :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) - :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) - :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) - (map-into - :args (map type) - :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) - :eval (map-into '((5 . 6) (7 . 8)) 'plist) - :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) - -(define-short-documentation-group string - "Making Strings" - (make-string - :args (length init) - :eval "(make-string 5 ?x)") - (string - :eval "(string ?a ?b ?c)") - (concat - :eval (concat "foo" "bar" "zot")) - (string-join - :no-manual t - :eval (string-join '("foo" "bar" "zot") " ")) - (mapconcat - :eval (mapconcat (lambda (a) (concat "[" a "]")) - '("foo" "bar" "zot") " ")) - (string-pad - :eval (string-pad "foo" 5) - :eval (string-pad "foobar" 5) - :eval (string-pad "foo" 5 ?- t)) - (mapcar - :eval (mapcar #'identity "123")) - (format - :eval (format "This number is %d" 4)) - "Manipulating Strings" - (substring - :eval (substring "abcde" 1 3) - :eval (substring "abcde" 2) - :eval (substring "abcde" 1 -1) - :eval (substring "abcde" -4 4)) - (string-limit - :eval (string-limit "foobar" 3) - :eval (string-limit "foobar" 3 t) - :eval (string-limit "foobar" 10) - :eval (string-limit "foε₯½" 3 nil 'utf-8)) - (truncate-string-to-width - :eval (truncate-string-to-width "foobar" 3) - :eval (truncate-string-to-width "δ½ ε₯½bar" 5)) - (split-string - :eval (split-string "foo bar") - :eval (split-string "|foo|bar|" "|") - :eval (split-string "|foo|bar|" "|" t)) - (split-string-and-unquote - :eval (split-string-and-unquote "foo \"bar zot\"")) - (split-string-shell-command - :eval (split-string-shell-command "ls /tmp/'foo bar'")) - (string-lines - :eval (string-lines "foo\n\nbar") - :eval (string-lines "foo\n\nbar" t)) - (string-replace - :eval (string-replace "foo" "bar" "foozot")) - (replace-regexp-in-string - :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) - (string-trim - :args (string) - :doc "Trim STRING of leading and trailing white space." - :eval (string-trim " foo ")) - (string-trim-left - :eval (string-trim-left "oofoo" "o+")) - (string-trim-right - :eval (string-trim-right "barkss" "s+")) - (string-truncate-left - :no-manual t - :eval (string-truncate-left "longstring" 8)) - (string-remove-suffix - :no-manual t - :eval (string-remove-suffix "bar" "foobar")) - (string-remove-prefix - :no-manual t - :eval (string-remove-prefix "foo" "foobar")) - (string-chop-newline - :eval (string-chop-newline "foo\n")) - (string-clean-whitespace - :eval (string-clean-whitespace " foo bar ")) - (string-fill - :eval (string-fill "Three short words" 12) - :eval (string-fill "Long-word" 3)) - (reverse - :eval (reverse "foo")) - (substring-no-properties - :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) - (try-completion - :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) - "Unicode Strings" - (string-glyph-split - :eval (string-glyph-split "Hello, πŸ‘ΌπŸ»πŸ§‘πŸΌβ€πŸ€β€πŸ§‘πŸ»")) - (string-glyph-compose - :eval (string-glyph-compose "Å")) - (string-glyph-decompose - :eval (string-glyph-decompose "β„«")) - "Predicates for Strings" - (string-equal - :eval (string-equal "abc" "abc") - :eval (string-equal "abc" "ABC")) - (string-equal-ignore-case - :eval (string-equal-ignore-case "foo" "FOO")) - (equal - :eval (equal "foo" "foo")) - (cl-equalp - :eval (cl-equalp "Foo" "foo")) - (stringp - :eval (stringp "a") - :eval (stringp 'a) - :eval "(stringp ?a)") - (string-or-null-p - :eval (string-or-null-p "a") - :eval (string-or-null-p nil)) - (char-or-string-p - :eval "(char-or-string-p ?a)" - :eval (char-or-string-p "a")) - (string-empty-p - :no-manual t - :eval (string-empty-p "")) - (string-blank-p - :no-manual t - :eval (string-blank-p " \n")) - (string-lessp - :eval (string-lessp "abc" "def") - :eval (string-lessp "pic4.png" "pic32.png") - :eval (string-lessp "1.1" "1.2")) - (string-greaterp - :eval (string-greaterp "foo" "bar")) - (string-version-lessp - :eval (string-version-lessp "pic4.png" "pic32.png") - :eval (string-version-lessp "1.9.3" "1.10.2")) - (string-collate-lessp - :eval (string-collate-lessp "abc" "abd")) - (string-prefix-p - :eval (string-prefix-p "foo" "foobar")) - (string-suffix-p - :eval (string-suffix-p "bar" "foobar")) - "Case Manipulation" - (upcase - :eval (upcase "foo")) - (downcase - :eval (downcase "FOObar")) - (capitalize - :eval (capitalize "foo bar zot")) - (upcase-initials - :eval (upcase-initials "The CAT in the hAt")) - "Converting Strings" - (string-to-number - :eval (string-to-number "42") - :eval (string-to-number "deadbeef" 16) - :eval (string-to-number "2.5e+03")) - (number-to-string - :eval (number-to-string 42)) - (char-uppercase-p - :eval "(char-uppercase-p ?A)" - :eval "(char-uppercase-p ?a)") - "Data About Strings" - (length - :eval (length "foo") - :eval (length "avocado: πŸ₯‘")) - (string-width - :eval (string-width "foo") - :eval (string-width "avocado: πŸ₯‘")) - (string-pixel-width - :eval (string-pixel-width "foo") - :eval (string-pixel-width "avocado: πŸ₯‘")) - (string-search - :eval (string-search "bar" "foobarzot")) - (assoc-string - :eval (assoc-string "foo" '(("a" 1) (foo 2)))) - (seq-position - :eval "(seq-position \"foobarzot\" ?z)")) - -(define-short-documentation-group file-name - "File Name Manipulation" - (file-name-directory - :eval (file-name-directory "/tmp/foo") - :eval (file-name-directory "/tmp/foo/")) - (file-name-nondirectory - :eval (file-name-nondirectory "/tmp/foo") - :eval (file-name-nondirectory "/tmp/foo/")) - (file-name-sans-versions - :args (filename) - :eval (file-name-sans-versions "/tmp/foo~")) - (file-name-extension - :eval (file-name-extension "/tmp/foo.txt")) - (file-name-sans-extension - :eval (file-name-sans-extension "/tmp/foo.txt")) - (file-name-with-extension - :eval (file-name-with-extension "foo.txt" "bin") - :eval (file-name-with-extension "foo" "bin")) - (file-name-base - :eval (file-name-base "/tmp/foo.txt")) - (file-relative-name - :eval (file-relative-name "/tmp/foo" "/tmp")) - (file-name-split - :eval (file-name-split "/tmp/foo") - :eval (file-name-split "foo/bar")) - (make-temp-name - :eval (make-temp-name "/tmp/foo-")) - (file-name-concat - :eval (file-name-concat "/tmp/" "foo") - :eval (file-name-concat "/tmp" "foo") - :eval (file-name-concat "/tmp" "foo" "bar/" "zot") - :eval (file-name-concat "/tmp" "~")) - (expand-file-name - :eval (expand-file-name "foo" "/tmp/") - :eval (expand-file-name "foo" "/tmp///") - :eval (expand-file-name "foo" "/tmp/foo/.././") - :eval (expand-file-name "~" "/tmp/")) - (substitute-in-file-name - :eval (substitute-in-file-name "$HOME/foo")) - "Directory Functions" - (file-name-as-directory - :eval (file-name-as-directory "/tmp/foo")) - (directory-file-name - :eval (directory-file-name "/tmp/foo/")) - (abbreviate-file-name - :no-eval (abbreviate-file-name "/home/some-user") - :eg-result "~some-user") - (file-name-parent-directory - :eval (file-name-parent-directory "/foo/bar") - :eval (file-name-parent-directory "/foo/") - :eval (file-name-parent-directory "foo/bar") - :eval (file-name-parent-directory "foo")) - "Quoted File Names" - (file-name-quote - :args (name) - :eval (file-name-quote "/tmp/foo")) - (file-name-unquote - :args (name) - :eval (file-name-unquote "/:/tmp/foo")) - "Predicates" - (file-name-absolute-p - :eval (file-name-absolute-p "/tmp/foo") - :eval (file-name-absolute-p "foo")) - (directory-name-p - :eval (directory-name-p "/tmp/foo/")) - (file-name-quoted-p - :eval (file-name-quoted-p "/:/tmp/foo"))) - -(define-short-documentation-group file - "Inserting Contents" - (insert-file-contents - :no-eval (insert-file-contents "/tmp/foo") - :eg-result ("/tmp/foo" 6)) - (insert-file-contents-literally - :no-eval (insert-file-contents-literally "/tmp/foo") - :eg-result ("/tmp/foo" 6)) - (find-file - :no-eval (find-file "/tmp/foo") - :eg-result-string "#") - "Predicates" - (file-symlink-p - :no-eval (file-symlink-p "/tmp/foo") - :eg-result t) - (file-directory-p - :no-eval (file-directory-p "/tmp") - :eg-result t) - (file-regular-p - :no-eval (file-regular-p "/tmp/foo") - :eg-result t) - (file-exists-p - :no-eval (file-exists-p "/tmp/foo") - :eg-result t) - (file-readable-p - :no-eval (file-readable-p "/tmp/foo") - :eg-result t) - (file-writable-p - :no-eval (file-writable-p "/tmp/foo") - :eg-result t) - (file-accessible-directory-p - :no-eval (file-accessible-directory-p "/tmp") - :eg-result t) - (file-executable-p - :no-eval (file-executable-p "/bin/cat") - :eg-result t) - (file-newer-than-file-p - :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") - :eg-result nil) - (file-has-changed-p - :no-eval (file-has-changed-p "/tmp/foo") - :eg-result t) - (file-equal-p - :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") - :eg-result nil) - (file-in-directory-p - :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") - :eg-result t) - (file-locked-p - :no-eval (file-locked-p "/tmp/foo") - :eg-result nil) - "Information" - (file-attributes - :no-eval* (file-attributes "/tmp")) - (file-truename - :no-eval (file-truename "/tmp/foo/bar") - :eg-result "/tmp/foo/zot") - (file-chase-links - :no-eval (file-chase-links "/tmp/foo/bar") - :eg-result "/tmp/foo/zot") - (vc-responsible-backend - :args (file &optional no-error) - :no-eval (vc-responsible-backend "/src/foo/bar.c") - :eg-result Git) - (file-acl - :no-eval (file-acl "/tmp/foo") - :eg-result "user::rw-\ngroup::r--\nother::r--\n") - (file-extended-attributes - :no-eval* (file-extended-attributes "/tmp/foo")) - (file-selinux-context - :no-eval* (file-selinux-context "/tmp/foo")) - (locate-file - :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) - :eg-result "/var/log/syslog") - (executable-find - :no-eval (executable-find "ls") - :eg-result "/usr/bin/ls") - "Creating" - (make-temp-file - :no-eval (make-temp-file "/tmp/foo-") - :eg-result "/tmp/foo-ZcXFMj") - (make-nearby-temp-file - :no-eval (make-nearby-temp-file "/tmp/foo-") - :eg-result "/tmp/foo-xe8iON") - (write-region - :no-value (write-region (point-min) (point-max) "/tmp/foo")) - "Directories" - (make-directory - :no-value (make-directory "/tmp/bar/zot/" t)) - (directory-files - :no-eval (directory-files "/tmp/") - :eg-result ("." ".." ".ICE-unix" ".Test-unix")) - (directory-files-recursively - :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") - :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) - (directory-files-and-attributes - :no-eval* (directory-files-and-attributes "/tmp/foo")) - (file-expand-wildcards - :no-eval (file-expand-wildcards "/tmp/*.png") - :eg-result ("/tmp/foo.png" "/tmp/zot.png") - :no-eval (file-expand-wildcards "/*/foo.png") - :eg-result ("/tmp/foo.png" "/var/foo.png")) - (locate-dominating-file - :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") - :eg-result "/tmp/foo.png") - (copy-directory - :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) - (delete-directory - :no-value (delete-directory "/tmp/bar/")) - "File Operations" - (rename-file - :no-value (rename-file "/tmp/foo" "/tmp/newname")) - (copy-file - :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) - (delete-file - :no-value (delete-file "/tmp/foo")) - (make-empty-file - :no-value (make-empty-file "/tmp/foo")) - (make-symbolic-link - :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) - (add-name-to-file - :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) - (set-file-modes - :no-value "(set-file-modes \"/tmp/foo\" #o644)") - (set-file-times - :no-value (set-file-times "/tmp/foo")) - "File Modes" - (set-default-file-modes - :no-value "(set-default-file-modes #o755)") - (default-file-modes - :no-eval (default-file-modes) - :eg-result-string "#o755") - (file-modes-symbolic-to-number - :no-eval (file-modes-symbolic-to-number "a+r") - :eg-result-string "#o444") - (file-modes-number-to-symbolic - :eval "(file-modes-number-to-symbolic #o444)") - (set-file-extended-attributes - :no-eval (set-file-extended-attributes - "/tmp/foo" '((acl . "group::rxx"))) - :eg-result t) - (set-file-selinux-context - :no-eval (set-file-selinux-context - "/tmp/foo" '(unconfined_u object_r user_home_t s0)) - :eg-result t) - (set-file-acl - :no-eval (set-file-acl "/tmp/foo" "group::rxx") - :eg-result t)) - -(define-short-documentation-group hash-table - "Hash Table Basics" - (make-hash-table - :no-eval (make-hash-table) - :result-string "#s(hash-table ...)") - (puthash - :no-eval (puthash 'key "value" table)) - (gethash - :no-eval (gethash 'key table) - :eg-result "value") - (remhash - :no-eval (remhash 'key table) - :result nil) - (clrhash - :no-eval (clrhash table) - :result-string "#s(hash-table ...)") - (maphash - :no-eval (maphash (lambda (key value) (message value)) table) - :result nil) - "Other Hash Table Functions" - (hash-table-p - :eval (hash-table-p 123)) - (hash-table-contains-p - :no-eval (hash-table-contains-p 'key table)) - (copy-hash-table - :no-eval (copy-hash-table table) - :result-string "#s(hash-table ...)") - (hash-table-count - :no-eval (hash-table-count table) - :eg-result 15)) - -(define-short-documentation-group list - "Making Lists" - (make-list - :eval (make-list 5 'a)) - (cons - :eval (cons 1 '(2 3 4))) - (list - :eval (list 1 2 3)) - (number-sequence - :eval (number-sequence 5 8)) - (ensure-list - :eval (ensure-list "foo") - :eval (ensure-list '(1 2 3)) - :eval (ensure-list '(1 . 2))) - (ensure-proper-list - :eval (ensure-proper-list "foo") - :eval (ensure-proper-list '(1 2 3)) - :eval (ensure-proper-list '(1 . 2))) - "Operations on Lists" - (append - :eval (append '("foo" "bar") '("zot"))) - (copy-tree - :eval (copy-tree '(1 (2 3) 4))) - (flatten-tree - :eval (flatten-tree '(1 (2 3) 4))) - (car - :eval (car '(one two three)) - :eval (car '(one . two)) - :eval (car nil)) - (cdr - :eval (cdr '(one two three)) - :eval (cdr '(one . two)) - :eval (cdr nil)) - (last - :eval (last '(one two three))) - (butlast - :eval (butlast '(one two three))) - (nbutlast - :eval (nbutlast (list 'one 'two 'three))) - (nth - :eval (nth 1 '(one two three))) - (nthcdr - :eval (nthcdr 1 '(one two three))) - (take - :eval (take 3 '(one two three four))) - (ntake - :eval (ntake 3 (list 'one 'two 'three 'four))) - (take-while - :eval (take-while #'numberp '(1 2 three 4 five))) - (drop-while - :eval (drop-while #'numberp '(1 2 three 4 five))) - (any - :eval (any #'symbolp '(1 2 three 4 five))) - (all - :eval (all #'symbolp '(one 2 three)) - :eval (all #'symbolp '(one two three))) - (elt - :eval (elt '(one two three) 1)) - (car-safe - :eval (car-safe '(one two three))) - (cdr-safe - :eval (cdr-safe '(one two three))) - (push - :no-eval* (push 'a list)) - (pop - :no-eval* (pop list)) - (setcar - :no-eval (setcar list 'c) - :result c) - (setcdr - :no-eval (setcdr list (list c)) - :result '(c)) - (nconc - :eval (nconc (list 1) (list 2 3 4))) - (delq - :eval (delq 'a (list 'a 'b 'c 'd))) - (delete - :eval (delete 2 (list 1 2 3 4)) - :eval (delete "a" (list "a" "b" "c" "d"))) - (remq - :eval (remq 'b '(a b c))) - (remove - :eval (remove 2 '(1 2 3 4)) - :eval (remove "a" '("a" "b" "c" "d"))) - (delete-dups - :eval (delete-dups (list 1 2 4 3 2 4))) - "Mapping Over Lists" - (mapcar - :eval (mapcar #'list '(1 2 3))) - (mapcan - :eval (mapcan #'list '(1 2 3))) - (mapc - :eval (mapc #'insert '("1" "2" "3"))) - (seq-reduce - :eval (seq-reduce #'+ '(1 2 3) 0)) - (mapconcat - :eval (mapconcat #'identity '("foo" "bar") "|")) - "Predicates" - (listp - :eval (listp '(1 2 3)) - :eval (listp nil) - :eval (listp '(1 . 2))) - (consp - :eval (consp '(1 2 3)) - :eval (consp nil)) - (proper-list-p - :eval (proper-list-p '(1 2 3)) - :eval (proper-list-p nil) - :eval (proper-list-p '(1 . 2))) - (null - :eval (null nil)) - (atom - :eval (atom 'a)) - (nlistp - :eval (nlistp '(1 2 3)) - :eval (nlistp t) - :eval (nlistp '(1 . 2))) - "Finding Elements" - (memq - :eval (memq 'b '(a b c))) - (memql - :eval (memql 2.0 '(1.0 2.0 3.0))) - (member - :eval (member 2 '(1 2 3)) - :eval (member "b" '("a" "b" "c"))) - (member-ignore-case - :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) - "Association Lists" - (assoc - :eval (assoc "b" '(("a" . 1) ("b" . 2)))) - (rassoc - :eval (rassoc "b" '((1 . "a") (2 . "b")))) - (assq - :eval (assq 'b '((a . 1) (b . 2)))) - (rassq - :eval (rassq 'b '((1 . a) (2 . b)))) - (assoc-string - :eval (assoc-string "foo" '(("a" 1) (foo 2)))) - (alist-get - :eval (alist-get 2 '((1 . a) (2 . b)))) - (assoc-default - :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) - (copy-alist - :eval (copy-alist '((1 . a) (2 . b)))) - (assoc-delete-all - :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) - (assq-delete-all - :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) - (rassq-delete-all - :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) - "Property Lists" - (plist-get - :eval (plist-get '(a 1 b 2 c 3) 'b)) - (plist-put - :no-eval (setq plist (plist-put plist 'd 4)) - :eg-result (a 1 b 2 c 3 d 4)) - (plist-member - :eval (plist-member '(a 1 b 2 c 3) 'b)) - "Data About Lists" - (length - :eval (length '(a b c))) - (length< - :eval (length< '(a b c) 1)) - (length> - :eval (length> '(a b c) 1)) - (length= - :eval (length= '(a b c) 3)) - (safe-length - :eval (safe-length '(a b c)))) - -(define-short-documentation-group symbol - "Making symbols" - (intern - :eval (intern "abc")) - (intern-soft - :eval (intern-soft "list") - :eval (intern-soft "Phooey!")) - (make-symbol - :eval (make-symbol "abc")) - (gensym - :no-eval (gensym) - :eg-result g37) - "Comparing symbols" - (eq - :eval (eq 'abc 'abc) - :eval (eq 'abc 'abd)) - (eql - :eval (eql 'abc 'abc)) - (equal - :eval (equal 'abc 'abc)) - "Name" - (symbol-name - :eval (symbol-name 'abc)) - "Obarrays" - (obarray-make - :eval (obarray-make)) - (obarrayp - :eval (obarrayp (obarray-make)) - :eval (obarrayp nil)) - (unintern - :no-eval (unintern "abc" my-obarray) - :eg-result t) - (mapatoms - :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) - (obarray-clear - :no-eval (obarray-clear my-obarray))) - -(define-short-documentation-group comparison - "General-purpose" - (eq - :eval (eq 'a 'a) - :eval "(eq ?A ?A)" - :eval (let ((x (list 'a "b" '(c) 4 5.0))) - (eq x x))) - (eql - :eval (eql 2 2) - :eval (eql 2.0 2.0) - :eval (eql 2.0 2)) - (equal - :eval (equal "abc" "abc") - :eval (equal 2.0 2.0) - :eval (equal 2.0 2) - :eval (equal '(a "b" (c) 4.0) '(a "b" (c) 4.0))) - (cl-equalp - :eval (cl-equalp 2 2.0) - :eval (cl-equalp "ABC" "abc")) - "Numeric" - (= - :args (number &rest numbers) - :eval (= 2 2) - :eval (= 2.0 2.0) - :eval (= 2.0 2) - :eval (= 4 4 4 4)) - (/= - :eval (/= 4 4)) - (< - :args (number &rest numbers) - :eval (< 4 4) - :eval (< 1 2 3)) - (<= - :args (number &rest numbers) - :eval (<= 4 4) - :eval (<= 1 2 2 3)) - (> - :args (number &rest numbers) - :eval (> 4 4) - :eval (> 3 2 1)) - (>= - :args (number &rest numbers) - :eval (>= 4 4) - :eval (>= 3 2 2 1)) - "String" - (string-equal - :eval (string-equal "abc" "abc") - :eval (string-equal "abc" "ABC")) - (string-equal-ignore-case - :eval (string-equal-ignore-case "abc" "ABC")) - (string-lessp - :eval (string-lessp "abc" "abd") - :eval (string-lessp "abc" "abc") - :eval (string-lessp "pic4.png" "pic32.png")) - (string-greaterp - :eval (string-greaterp "abd" "abc") - :eval (string-greaterp "abc" "abc")) - (string-version-lessp - :eval (string-version-lessp "pic4.png" "pic32.png") - :eval (string-version-lessp "1.9.3" "1.10.2")) - (string-collate-lessp - :eval (string-collate-lessp "abc" "abd"))) - -(define-short-documentation-group vector - "Making Vectors" - (make-vector - :eval (make-vector 5 "foo")) - (vector - :eval (vector 1 "b" 3)) - "Operations on Vectors" - (vectorp - :eval (vectorp [1]) - :eval (vectorp "1")) - (vconcat - :eval (vconcat '(1 2) [3 4])) - (append - :eval (append [1 2] nil)) - (length - :eval (length [1 2 3])) - (seq-reduce - :eval (seq-reduce #'+ [1 2 3] 0)) - (seq-subseq - :eval (seq-subseq [1 2 3 4 5] 1 3) - :eval (seq-subseq [1 2 3 4 5] 1)) - (copy-tree - :eval (copy-tree [1 (2 3) [4 5]] t)) - "Mapping Over Vectors" - (mapcar - :eval (mapcar #'identity [1 2 3])) - (mapc - :eval (mapc #'insert ["1" "2" "3"]))) - -(define-short-documentation-group regexp - "Matching Strings" - (replace-regexp-in-string - :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) - (string-match-p - :eval (string-match-p "^[fo]+" "foobar")) - "Looking in Buffers" - (re-search-forward - :no-eval (re-search-forward "^foo$" nil t) - :eg-result 43) - (re-search-backward - :no-eval (re-search-backward "^foo$" nil t) - :eg-result 43) - (looking-at-p - :no-eval (looking-at-p "f[0-9]") - :eg-result t) - "Match Data" - (match-string - :eval (and (string-match "^\\([fo]+\\)b" "foobar") - (match-string 0 "foobar"))) - (match-beginning - :no-eval (match-beginning 1) - :eg-result 0) - (match-end - :no-eval (match-end 1) - :eg-result 3) - (save-match-data - :no-eval (save-match-data ...)) - "Replacing Match" - (replace-match - :no-eval (replace-match "new") - :eg-result nil) - (match-substitute-replacement - :no-eval (match-substitute-replacement "new") - :eg-result "new") - (replace-regexp-in-region - :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) - "Utilities" - (regexp-quote - :eval (regexp-quote "foo.*bar")) - (regexp-opt - :eval (regexp-opt '("foo" "bar"))) - (regexp-opt-depth - :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) - (regexp-opt-charset - :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) - "The `rx' Structured Regexp Notation" - (rx - :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) - (rx-to-string - :eval (rx-to-string '(| "foo" "bar"))) - (rx-define - :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) - (rx haskell-comment))" - :result "--.*") - (rx-let - :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) - (number (1+ digit)) - (numbers (comma-separated number))) - (rx \"(\" numbers \")\"))" - :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") - (rx-let-eval - :eval "(rx-let-eval - '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) - (rx-to-string - '(ponder (or \"flowers\" \"cars\" \"socks\"))))" - :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) - -(define-short-documentation-group sequence - "Sequence Predicates" - (seq-contains-p - :eval (seq-contains-p '(a b c) 'b) - :eval (seq-contains-p '(a b c) 'd)) - (seq-every-p - :eval (seq-every-p #'numberp '(1 2 3))) - (seq-empty-p - :eval (seq-empty-p [])) - (seq-set-equal-p - :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) - (seq-some - :eval (seq-some #'floatp '(1 2.0 3))) - "Building Sequences" - (seq-concatenate - :eval (seq-concatenate 'vector '(1 2) '(c d))) - (seq-copy - :eval (seq-copy '(a 2))) - (seq-into - :eval (seq-into '(1 2 3) 'vector)) - "Utility Functions" - (seq-count - :eval (seq-count #'numberp '(1 b c 4))) - (seq-elt - :eval (seq-elt '(a b c) 1)) - (seq-random-elt - :no-eval (seq-random-elt '(a b c)) - :eg-result c) - (seq-find - :eval (seq-find #'numberp '(a b 3 4 f 6))) - (seq-position - :eval (seq-position '(a b c) 'c)) - (seq-positions - :eval (seq-positions '(a b c a d) 'a) - :eval (seq-positions '(a b c a d) 'z) - :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) - (seq-length - :eval (seq-length "abcde")) - (seq-max - :eval (seq-max [1 2 3])) - (seq-min - :eval (seq-min [1 2 3])) - (seq-first - :eval (seq-first [a b c])) - (seq-rest - :eval (seq-rest '[1 2 3])) - (seq-reverse - :eval (seq-reverse '(1 2 3))) - (seq-sort - :eval (seq-sort #'> '(1 2 3))) - (seq-sort-by - :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) - "Mapping Over Sequences" - (seq-map - :eval (seq-map #'1+ '(1 2 3))) - (seq-map-indexed - :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) - (seq-mapcat - :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) - (seq-doseq - :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) - :eg-result ("foo" "bar")) - (seq-do - :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) - :eg-result ("foo" "bar")) - (seq-do-indexed - :no-eval (seq-do-indexed - (lambda (a index) (message "%s:%s" index a)) - '("foo" "bar")) - :eg-result nil) - (seq-reduce - :eval (seq-reduce #'* [1 2 3] 2)) - "Excerpting Sequences" - (seq-drop - :eval (seq-drop '(a b c) 2)) - (seq-drop-while - :eval (seq-drop-while #'numberp '(1 2 c d 5))) - (seq-filter - :eval (seq-filter #'numberp '(a b 3 4 f 6))) - (seq-keep - :eval (seq-keep #'car-safe '((1 2) 3 t (a . b)))) - (seq-remove - :eval (seq-remove #'numberp '(1 2 c d 5))) - (seq-remove-at-position - :eval (seq-remove-at-position '(a b c d e) 3) - :eval (seq-remove-at-position [a b c d e] 0)) - (seq-group-by - :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6))) - (seq-union - :eval (seq-union '(1 2 3) '(3 5))) - (seq-difference - :eval (seq-difference '(1 2 3) '(2 3 4))) - (seq-intersection - :eval (seq-intersection '(1 2 3) '(2 3 4))) - (seq-partition - :eval (seq-partition '(a b c d e f g h) 3)) - (seq-subseq - :eval (seq-subseq '(a b c d e) 2 4)) - (seq-take - :eval (seq-take '(a b c d e) 3)) - (seq-split - :eval (seq-split [0 1 2 3 5] 2)) - (seq-take-while - :eval (seq-take-while #'integerp [1 2 3.0 4])) - (seq-uniq - :eval (seq-uniq '(a b d b a c)))) - -(define-short-documentation-group buffer - "Buffer Basics" - (current-buffer - :no-eval (current-buffer) - :eg-result-string "#") - (bufferp - :eval (bufferp 23)) - (buffer-live-p - :no-eval (buffer-live-p some-buffer) - :eg-result t) - (buffer-modified-p - :eval (buffer-modified-p (current-buffer))) - (buffer-name - :eval (buffer-name)) - (window-buffer - :eval (window-buffer)) - "Selecting Buffers" - (get-buffer-create - :no-eval (get-buffer-create "*foo*") - :eg-result-string "#") - (pop-to-buffer - :no-eval (pop-to-buffer "*foo*") - :eg-result-string "#") - (with-current-buffer - :no-eval* (with-current-buffer buffer (buffer-size))) - "Points and Positions" - (point - :eval (point)) - (point-min - :eval (point-min)) - (point-max - :eval (point-max)) - (pos-bol - :eval (pos-bol)) - (pos-eol - :eval (pos-eol)) - (bolp - :eval (bolp)) - (eolp - :eval (eolp)) - (line-beginning-position - :eval (line-beginning-position)) - (line-end-position - :eval (line-end-position)) - (buffer-size - :eval (buffer-size)) - (bobp - :eval (bobp)) - (eobp - :eval (eobp)) - "Moving Around" - (goto-char - :no-eval (goto-char (point-max)) - :eg-result 342) - (search-forward - :no-eval (search-forward "some-string" nil t) - :eg-result 245) - (re-search-forward - :no-eval (re-search-forward "some-s.*g" nil t) - :eg-result 245) - (forward-line - :no-eval (forward-line 1) - :eg-result 0 - :no-eval (forward-line -2) - :eg-result 0) - "Strings from Buffers" - (buffer-string - :no-eval* (buffer-string)) - (buffer-substring - :eval (buffer-substring (point-min) (+ (point-min) 10))) - (buffer-substring-no-properties - :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) - (following-char - :no-eval (following-char) - :eg-result 67) - (preceding-char - :no-eval (preceding-char) - :eg-result 38) - (char-after - :eval (char-after 45)) - (char-before - :eval (char-before 13)) - (get-byte - :no-eval (get-byte 45) - :eg-result-string "#xff") - "Altering Buffers" - (delete-region - :no-value (delete-region (point-min) (point-max))) - (erase-buffer - :no-value (erase-buffer)) - (delete-line - :no-value (delete-line)) - (insert - :no-value (insert "This string will be inserted in the buffer\n")) - (subst-char-in-region - :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") - (replace-string-in-region - :no-value (replace-string-in-region "foo" "bar")) - "Locking" - (lock-buffer - :no-value (lock-buffer "/tmp/foo")) - (unlock-buffer - :no-value (unlock-buffer))) - -(define-short-documentation-group overlay - "Predicates" - (overlayp - :no-eval (overlayp some-overlay) - :eg-result t) - "Creation and Deletion" - (make-overlay - :args (beg end &optional buffer) - :no-eval (make-overlay 1 10) - :eg-result-string "#") - (delete-overlay - :no-eval (delete-overlay foo) - :eg-result t) - "Searching Overlays" - (overlays-at - :no-eval (overlays-at 15) - :eg-result-string "(#)") - (overlays-in - :no-eval (overlays-in 1 30) - :eg-result-string "(#)") - (next-overlay-change - :no-eval (next-overlay-change 1) - :eg-result 20) - (previous-overlay-change - :no-eval (previous-overlay-change 30) - :eg-result 20) - "Overlay Properties" - (overlay-start - :no-eval (overlay-start foo) - :eg-result 1) - (overlay-end - :no-eval (overlay-end foo) - :eg-result 10) - (overlay-put - :no-eval (overlay-put foo 'happy t) - :eg-result t) - (overlay-get - :no-eval (overlay-get foo 'happy) - :eg-result t) - (overlay-buffer - :no-eval (overlay-buffer foo)) - "Moving Overlays" - (move-overlay - :no-eval (move-overlay foo 5 20) - :eg-result-string "#")) - -(define-short-documentation-group process - (make-process - :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) - :eg-result-string "#") - (processp - :eval (processp t)) - (process-status - :no-eval (process-status process) - :eg-result exit) - (delete-process - :no-value (delete-process process)) - (kill-process - :no-value (kill-process process)) - (set-process-sentinel - :no-value (set-process-sentinel process (lambda (proc string)))) - (process-buffer - :no-eval (process-buffer process) - :eg-result-string "#") - (get-buffer-process - :no-eval (get-buffer-process buffer) - :eg-result-string "#") - (process-live-p - :no-eval (process-live-p process) - :eg-result t)) - -(define-short-documentation-group number - "Arithmetic" - (+ - :args (&rest numbers) - :eval (+ 1 2) - :eval (+ 1 2 3 4)) - (- - :args (&rest numbers) - :eval (- 3 2) - :eval (- 6 3 2)) - (* - :args (&rest numbers) - :eval (* 3 4 5)) - (/ - :eval (/ 10 5) - :eval (/ 10 6) - :eval (/ 10.0 6) - :eval (/ 10.0 3 3)) - (% - :eval (% 10 5) - :eval (% 10 6)) - (mod - :eval (mod 10 5) - :eval (mod 10 6) - :eval (mod 10.5 6)) - (1+ - :eval (1+ 2) - :eval (let ((x 2)) (1+ x) x)) - (1- - :eval (1- 4) - :eval (let ((x 4)) (1- x) x)) - (incf - :eval (let ((x 2)) (incf x) x) - :eval (let ((x 2)) (incf x 2) x)) - (decf - :eval (let ((x 4)) (decf x) x) - :eval (let ((x 4)) (decf x 2)) x) - "Predicates" - (= - :args (number &rest numbers) - :eval (= 4 4) - :eval (= 4.0 4.0) - :eval (= 4 4.0) - :eval (= 4 4 4 4)) - (eql - :eval (eql 4 4) - :eval (eql 4.0 4.0)) - (/= - :eval (/= 4 4)) - (< - :args (number &rest numbers) - :eval (< 4 4) - :eval (< 1 2 3)) - (<= - :args (number &rest numbers) - :eval (<= 4 4) - :eval (<= 1 2 2 3)) - (> - :args (number &rest numbers) - :eval (> 4 4) - :eval (> 3 2 1)) - (>= - :args (number &rest numbers) - :eval (>= 4 4) - :eval (>= 3 2 2 1)) - (zerop - :eval (zerop 0)) - (natnump - :eval (natnump -1) - :eval (natnump 0) - :eval (natnump 23)) - (plusp - :eval (plusp 0) - :eval (plusp 1)) - (minusp - :eval (minusp 0) - :eval (minusp -1)) - (oddp - :eval (oddp 3)) - (evenp - :eval (evenp 6)) - (bignump - :eval (bignump 4) - :eval (bignump (expt 2 90))) - (fixnump - :eval (fixnump 4) - :eval (fixnump (expt 2 90))) - (floatp - :eval (floatp 5.4)) - (integerp - :eval (integerp 5.4)) - (numberp - :eval (numberp "5.4")) - (cl-digit-char-p - :eval (cl-digit-char-p ?5 10) - :eval (cl-digit-char-p ?f 16)) - "Operations" - (max - :args (number &rest numbers) - :eval (max 7 9 3)) - (min - :args (number &rest numbers) - :eval (min 7 9 3)) - (abs - :eval (abs -4)) - (float - :eval (float 2)) - (truncate - :eval (truncate 1.2) - :eval (truncate -1.2) - :eval (truncate 5.4 2)) - (floor - :eval (floor 1.2) - :eval (floor -1.2) - :eval (floor 5.4 2)) - (ceiling - :eval (ceiling 1.2) - :eval (ceiling -1.2) - :eval (ceiling 5.4 2)) - (round - :eval (round 1.2) - :eval (round -1.2) - :eval (round 5.4 2)) - (random - :eval (random 6)) - "Bit Operations" - (ash - :eval (ash 1 4) - :eval (ash 16 -1)) - (logand - :no-eval "(logand #b10 #b111)" - :result-string "#b10") - (logior - :eval (logior 4 16)) - (logxor - :eval (logxor 4 16)) - (lognot - :eval (lognot 5)) - (logcount - :eval (logcount 5)) - "Floating Point" - (isnan - :eval (isnan 5.0)) - (frexp - :eval (frexp 5.7)) - (ldexp - :eval (ldexp 0.7125 3)) - (logb - :eval (logb 10.5)) - (ffloor - :eval (ffloor 1.2)) - (fceiling - :eval (fceiling 1.2)) - (ftruncate - :eval (ftruncate 1.2)) - (fround - :eval (fround 1.2)) - "Standard Math Functions" - (sin - :eval (sin float-pi)) - (cos - :eval (cos float-pi)) - (tan - :eval (tan float-pi)) - (asin - :eval (asin float-pi)) - (acos - :eval (acos float-pi)) - (atan - :eval (atan float-pi)) - (exp - :eval (exp 4)) - (log - :eval (log 54.59)) - (expt - :eval (expt 2 16)) - (sqrt - :eval (sqrt -1))) - -(define-short-documentation-group text-properties - "Examining Text Properties" - (get-text-property - :eval (get-text-property 0 'foo (propertize "x" 'foo t))) - (get-char-property - :eval (get-char-property 0 'foo (propertize "x" 'foo t))) - (get-pos-property - :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) - (get-char-property-and-overlay - :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) - (text-properties-at - :eval (text-properties-at (point))) - "Changing Text Properties" - (put-text-property - :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) - :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) - (add-text-properties - :no-eval (add-text-properties (point) (1+ (point)) '(face error))) - (remove-text-properties - :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) - (remove-list-of-text-properties - :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) - (set-text-properties - :no-eval (set-text-properties (point) (1+ (point)) '(face error))) - (add-face-text-property - :no-eval (add-face-text-property START END '(:foreground "green"))) - (propertize - :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) - "Searching for Text Properties" - (next-property-change - :no-eval (next-property-change (point) (current-buffer))) - (previous-property-change - :no-eval (previous-property-change (point) (current-buffer))) - (next-single-property-change - :no-eval (next-single-property-change (point) 'face (current-buffer))) - (previous-single-property-change - :no-eval (previous-single-property-change (point) 'face (current-buffer))) - ;; TODO: There are some more that could be added here. - (text-property-search-forward - :no-eval (text-property-search-forward 'face nil t)) - (text-property-search-backward - :no-eval (text-property-search-backward 'face nil t))) - -(define-short-documentation-group keymaps - "Defining keymaps or adding bindings to existing keymaps" - (define-keymap - :no-eval (define-keymap "C-c C-c" #'quit-buffer) - :no-eval (define-keymap :keymap ctl-x-map - "C-r" #'recentf-open - "k" #'kill-current-buffer)) - (defvar-keymap - :no-eval (defvar-keymap my-keymap "C-c C-c" #'quit-buffer)) - "Setting keys" - (keymap-set - :no-eval (keymap-set map "C-c C-c" #'quit-buffer)) - (keymap-local-set - :no-eval (keymap-local-set "C-c C-c" #'quit-buffer)) - (keymap-global-set - :no-eval (keymap-global-set "C-c C-c" #'quit-buffer)) - (keymap-unset - :no-eval (keymap-unset map "C-c C-c")) - (keymap-local-unset - :no-eval (keymap-local-unset "C-c C-c")) - (keymap-global-unset - :no-eval (keymap-global-unset "C-c C-c")) - (keymap-substitute - :no-eval (keymap-substitute map "C-c C-c" "M-a")) - (keymap-set-after - :no-eval (keymap-set-after map "" menu-bar-separator)) - "Predicates" - (keymapp - :eval (keymapp (define-keymap))) - (key-valid-p - :eval (key-valid-p "C-c C-c") - :eval (key-valid-p "C-cC-c")) - "Lookup" - (keymap-lookup - :eval (keymap-lookup (current-global-map) "C-x x g"))) +;; FIXME: As long as we do not have a better mechanism to load shortdoc +;; definitions on demand, we must require `shortdoc-doc' after above +;; macro to avoid loading cycles. But at least we do not require +;; `shortdoc-doc' while compiling this file, only when loading it. +(if t (require 'shortdoc-doc)) + ;;;###autoload (defun shortdoc-display-group (group &optional function same-window) "Pop to a buffer with short documentation summary for functions in GROUP. @@ -1650,6 +260,9 @@ If SAME-WINDOW, don't pop to a new window." (text-property-search-forward 'shortdoc-function function t) (beginning-of-line))) +;;;###autoload +(defalias 'shortdoc #'shortdoc-display-group) + (defun shortdoc--insert-group-in-buffer (group &optional buf) "Insert a short documentation summary for functions in GROUP in buffer BUF. BUF defaults to the current buffer if nil or omitted." @@ -1685,9 +298,6 @@ BUF defaults to the current buffer if nil or omitted." (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))))) -;;;###autoload -(defalias 'shortdoc #'shortdoc-display-group) - (defun shortdoc--display-function (data) (let ((function (pop data)) (start-section (point)) @@ -1875,6 +485,10 @@ Example: (shortdoc-add-function \\='file \"Predicates\" \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))" + ;; Rely on `shortdoc--check' checking GROUP. + (unless (stringp section) + (signal 'wrong-type-argument (list 'stringp section))) + (shortdoc--check group (list section elem)) (let ((glist (assq group shortdoc--groups))) (unless glist (setq glist (list group)) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index ddf3b594e12..7db316acda7 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -372,6 +372,7 @@ entirely by setting `warning-suppress-types' or (if (bolp) (forward-char -1)) (message "%s" (buffer-substring start (point)))))) + ;; Use `frame-initial-p'? ((and (daemonp) (eq (selected-frame) terminal-frame)) ;; Display daemon startup warnings on the first client frame. (letrec ((afterfun diff --git a/lisp/epa-file.el b/lisp/epa-file.el index b2a89907867..95202851544 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -232,7 +232,22 @@ encryption is used." (epa-file-decode-and-insert string file visit beg end replace)))) (if visit - (set-visited-file-modtime)))) + (set-visited-file-modtime))) + ;; The decoded file could still need another massage from a + ;; file name handler, for example a file like + ;; "folder.sym.tar.gz.gpg". (Bug#80641) + (when (find-file-name-handler + (file-name-sans-extension file) + 'insert-file-contents) + (let ((tmpfile + (make-temp-file + nil nil + (file-name-extension (file-name-base file) 'period)))) + (let (file-name-handler-alist) (write-region nil nil tmpfile)) + (erase-buffer) + (insert-file-contents tmpfile) + (setq length (- (point-max) (point-min))) + (delete-file tmpfile)))) (if (and local-copy (file-exists-p local-copy)) (delete-file local-copy))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index f5ea63ae764..6306df3fa2a 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -1006,7 +1006,7 @@ Failing that, choose the first face in both NEW-FACES and NORMALS." (dolist (candidate (cdr ranks)) (when (and (not (equal candidate choice)) (gethash candidate (car new-faces)) - (gethash choice normals)) + (gethash candidate normals)) (throw 'face candidate))) ;; Otherwise, go with any "normal" face other than ;; `choice' in the region. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 572b73188e3..6facb7966b0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1693,11 +1693,18 @@ time `erc-mode-hook' runs for any connection." (declare (indent 1)) (cl-assert (stringp (car args))) (if (derived-mode-p 'erc-mode) - (unless (or (erc-with-server-buffer ; needs `erc-server-process' - (apply #'erc-button--display-error-notice-with-keys - (current-buffer) args) - t) - erc--target) ; unlikely + (unless + (or (erc-with-server-buffer ; needs `erc-server-process' + (let ((fn + (lambda (buffer) + (erc-with-buffer (buffer) + (apply #'erc-button--display-error-notice-with-keys + buffer args))))) + (if erc--msg-props + (run-at-time nil nil fn (current-buffer)) + (funcall fn (current-buffer)))) + t) + erc--target) ; unlikely (let (hook) (setq hook (lambda (_) diff --git a/lisp/files.el b/lisp/files.el index f9af75187cb..e05a4b99497 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1790,7 +1790,10 @@ If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name. If TEXT is a string, insert it into the new file; DIR-FLAG should be nil. -Otherwise the file will be empty." +Otherwise the file will be empty. + +On Posix systems, the file/directory is created with access mode bits +that limit access to the current user." (let ((absolute-prefix (if (or (zerop (length prefix)) (member prefix '("." ".."))) (concat (file-name-as-directory temporary-file-directory) prefix) @@ -8320,41 +8323,24 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." (forward-line -1)) (if (let ((case-fold-search nil)) (looking-at "//DIRED//")) (let ((end (line-end-position)) - (linebeg (point)) - error-lines) - ;; Find all the lines that are error messages, - ;; and record the bounds of each one. - (goto-char beg) - (while (< (point) linebeg) - (or (eql (following-char) ?\s) - (push (list (point) (line-end-position)) error-lines)) - (forward-line 1)) - (setq error-lines (nreverse error-lines)) - ;; Now read the numeric positions of file names. + (linebeg (point))) + ;; Read the numeric positions of file names. (goto-char linebeg) (forward-word-strictly 1) (forward-char 3) (while (< (point) end) - (let ((start (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines)) - (end (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines))) - (if (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|)) - ;; End is followed by \n or by output of -F. - (put-text-property start end 'dired-filename t) - ;; It seems that we can't trust ls's output as to - ;; byte positions of filenames. - (put-text-property beg (point) 'dired-filename nil) - (end-of-line)))) + (let ((start (+ beg (read (current-buffer)))) + (end (+ beg (read (current-buffer))))) + (when (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|)) + ;; End is followed by \n or by output of -F. + (put-text-property start end 'dired-filename t)))) (goto-char end) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point)))) ;; Take care of the case where the ls output contains a ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line ;; and we went one line too far back (see above). - (forward-line 1)) + (unless (bobp) (forward-line 1))) (if (let ((case-fold-search nil)) (looking-at "//DIRED-OPTIONS//")) (delete-region (point) (progn (forward-line 1) (point)))))) @@ -8363,12 +8349,12 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." ;; FULL-DIRECTORY-P is nil. ;; The single line of output must display FILE's name as it was ;; given, namely, an absolute path name. -;; - must insert exactly one line for each file if WILDCARD or +;; - must insert exactly one entry for each file if WILDCARD or ;; FULL-DIRECTORY-P is t, plus one optional "total" line ;; before the file lines, plus optional text after the file lines. -;; Lines are delimited by "\n", so filenames containing "\n" are not -;; allowed. -;; File lines should display the basename. +;; Entries are delimited by "\n", but file names containing "\n" are +;; allowed and by default the "\n" is displayed as a literal newline. +;; File entries should display the basename. ;; - must be consistent with ;; - functions dired-move-to-filename, (these two define what a file line is) ;; dired-move-to-end-of-filename, @@ -8410,10 +8396,10 @@ normally equivalent short `-D' option is just passed on to (declare-function ls-lisp--insert-directory "ls-lisp") (ls-lisp--insert-directory file switches wildcard full-directory-p)) (t - (let (result (beg (point))) + (let ((beg (point)) + (errfile (make-temp-file "lserr"))) ;; Read the actual directory using `insert-directory-program'. - ;; RESULT gets the status code. (let* (;; We at first read by no-conversion, then after ;; putting text property `dired-filename, decode one ;; bunch by one to preserve that property. @@ -8423,143 +8409,88 @@ normally equivalent short `-D' option is just passed on to (and enable-multibyte-characters (or file-name-coding-system default-file-name-coding-system)))) - (setq result - (if wildcard - ;; If the wildcard is just in the file part, then run ls in - ;; the directory part of the file pattern using the last - ;; component as argument. Otherwise, run ls in the longest - ;; subdirectory of the directory part free of wildcards; use - ;; the remaining of the file pattern as argument. - (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) - (default-directory - (cond (dir-wildcard (car dir-wildcard)) - (t - (if (file-name-absolute-p file) - (file-name-directory file) - (file-name-directory (expand-file-name file)))))) - (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) - ;; NB since switches is passed to the shell, be - ;; careful of malicious values, eg "-l;reboot". - ;; See eg dired-safe-switches-p. - (call-process - shell-file-name nil t nil - shell-command-switch - (concat (if (memq system-type '(ms-dos windows-nt)) - "" - "\\") ; Disregard Unix shell aliases! - insert-directory-program - " -d " - ;; Quote switches that require quoting - ;; such as "--block-size='1". But don't - ;; quote switches that use patterns - ;; such as "--ignore=PATTERN" (bug#71935). - (mapconcat #'shell-quote-wildcard-pattern - (if (stringp switches) - (split-string-and-unquote switches) - switches) - " ") - " -- " - ;; Quote some characters that have - ;; special meanings in shells; but - ;; don't quote the wildcards--we want - ;; them to be special. We also - ;; currently don't quote the quoting - ;; characters in case people want to - ;; use them explicitly to quote - ;; wildcard characters. - (shell-quote-wildcard-pattern pattern)))) - ;; SunOS 4.1.3, SVr4 and others need the "." to list the - ;; directory if FILE is a symbolic link. - (unless full-directory-p - (setq switches - (cond - ((stringp switches) (concat switches " -d")) - ((member "-d" switches) switches) - (t (append switches '("-d")))))) - (if (string-match "\\`~" file) - (setq file (expand-file-name file))) - (apply #'call-process - insert-directory-program nil t nil - (append - (if (listp switches) switches - (unless (equal switches "") - ;; Split the switches at any spaces so we can - ;; pass separate options as separate args. - (split-string-and-unquote switches))) - ;; Avoid lossage if FILE starts with `-'. - '("--") - (list file)))))) + (if wildcard + ;; If the wildcard is just in the file part, then run ls in + ;; the directory part of the file pattern using the last + ;; component as argument. Otherwise, run ls in the longest + ;; subdirectory of the directory part free of wildcards; use + ;; the remaining of the file pattern as argument. + (let* ((dir-wildcard + (insert-directory-wildcard-in-dir-p file)) + (default-directory + (cond (dir-wildcard (car dir-wildcard)) + (t + (if (file-name-absolute-p file) + (file-name-directory file) + (file-name-directory + (expand-file-name file)))))) + (pattern (if dir-wildcard + (cdr dir-wildcard) + (file-name-nondirectory file)))) + ;; NB since switches is passed to the shell, be + ;; careful of malicious values, eg "-l;reboot". + ;; See eg dired-safe-switches-p. + (call-process + shell-file-name nil (list t errfile) nil + shell-command-switch + (concat (if (memq system-type '(ms-dos windows-nt)) + "" + "\\") ; Disregard Unix shell aliases! + insert-directory-program + " -d " + ;; Quote switches that require quoting + ;; such as "--block-size='1". But don't + ;; quote switches that use patterns + ;; such as "--ignore=PATTERN" (bug#71935). + (mapconcat #'shell-quote-wildcard-pattern + (if (stringp switches) + (split-string-and-unquote switches) + switches) + " ") + " -- " + ;; Quote some characters that have + ;; special meanings in shells; but + ;; don't quote the wildcards--we want + ;; them to be special. We also + ;; currently don't quote the quoting + ;; characters in case people want to + ;; use them explicitly to quote + ;; wildcard characters. + (shell-quote-wildcard-pattern pattern)))) + ;; SunOS 4.1.3, SVr4 and others need the "." to list the + ;; directory if FILE is a symbolic link. + (unless full-directory-p + (setq switches + (cond + ((stringp switches) (concat switches " -d")) + ((member "-d" switches) switches) + (t (append switches '("-d")))))) + (if (string-match "\\`~" file) + (setq file (expand-file-name file))) + (apply #'call-process + insert-directory-program nil (list t errfile) nil + (append + (if (listp switches) switches + (unless (equal switches "") + ;; Split the switches at any spaces so we can + ;; pass separate options as separate args. + (split-string-and-unquote switches))) + ;; Avoid lossage if FILE starts with `-'. + '("--") + (list file))))) - ;; If we got "//DIRED//" in the output, it means we got a real - ;; directory listing, even if `ls' returned nonzero. - ;; So ignore any errors. - (when (if (stringp switches) - (string-match "--dired\\>" switches) - (member "--dired" switches)) - (save-excursion - (let ((case-fold-search nil)) - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (forward-line -1)) - (if (looking-at "//DIRED//") - (setq result 0))))) + ;; If `ls' emits an error message, copy it to a buffer that will + ;; be displayed when a Dired invocation results in the `ls' + ;; error. + (when (> (file-attribute-size (file-attributes errfile)) 0) + (defvar dired--ls-error-buffer) ; Pacify byte-compiler. + (let ((errbuf (get-buffer-create "*ls error*"))) + (with-current-buffer errbuf + (erase-buffer) + (insert-file-contents errfile)) + (setq dired--ls-error-buffer errbuf))) + (delete-file errfile) - (when (and (not (eq 0 result)) - (eq insert-directory-ls-version 'unknown)) - ;; The first time ls returns an error, - ;; find the version numbers of ls, - ;; and set insert-directory-ls-version - ;; to > if it is more than 5.2.1, < if it is less, nil if it - ;; is equal or if the info cannot be obtained. - ;; (That can mean it isn't GNU ls.) - (let ((version-out - (with-temp-buffer - (call-process "ls" nil t nil "--version") - (buffer-string)))) - (setq insert-directory-ls-version - (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) - (let* ((version (match-string 1 version-out)) - (split (split-string version "[.]")) - (numbers (mapcar #'string-to-number split)) - (min '(5 2 1)) - comparison) - (while (and (not comparison) (or numbers min)) - (cond ((null min) - (setq comparison #'>)) - ((null numbers) - (setq comparison #'<)) - ((> (car numbers) (car min)) - (setq comparison #'>)) - ((< (car numbers) (car min)) - (setq comparison #'<)) - (t - (setq numbers (cdr numbers) - min (cdr min))))) - (or comparison #'=)) - nil)))) - - ;; For GNU ls versions 5.2.2 and up, ignore minor errors. - (when (and (eq 1 result) (eq insert-directory-ls-version #'>)) - (setq result 0)) - - ;; If `insert-directory-program' failed, signal an error. - (unless (eq 0 result) - ;; Delete the error message it may have output. - (delete-region beg (point)) - ;; On non-Posix systems, we cannot open a directory, so - ;; don't even try, because that will always result in - ;; the ubiquitous "Access denied". Instead, show the - ;; command line so the user can try to guess what went wrong. - (if (and (file-directory-p file) - (memq system-type '(ms-dos windows-nt))) - (error - "Reading directory: \"%s %s -- %s\" exited with status %s" - insert-directory-program - (if (listp switches) (concat switches) switches) - file result) - ;; Unix. Access the file to get a suitable error. - (access-file file "Reading directory") - (error "Listing directory failed but `access-file' worked"))) (insert-directory-clean beg switches) ;; Now decode what read if necessary. (let ((coding (or coding-system-for-read @@ -8594,18 +8525,6 @@ normally equivalent short `-D' option is just passed on to (put-text-property pos (point) 'dired-filename t)))))))))))) -(defun insert-directory-adj-pos (pos error-lines) - "Convert `ls --dired' file name position value POS to a buffer position. -File name position values returned in ls --dired output -count only stdout; they don't count the error messages sent to stderr. -So this function converts to them to real buffer positions. -ERROR-LINES is a list of buffer positions of error message lines, -of the form (START END)." - (while (and error-lines (< (caar error-lines) pos)) - (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines))))) - (pop error-lines)) - pos) - (defun insert-directory-safely (file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. diff --git a/lisp/frame.el b/lisp/frame.el index da48e695297..85b58cee070 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -493,6 +493,7 @@ there (in decreasing order of priority)." (setq parms (append initial-frame-alist window-system-frame-alist default-frame-alist parms nil)) ;; Don't enable tab-bar in daemon's initial frame. + ;; Use `frame-initial-p'? (when (and (daemonp) (eq (selected-frame) terminal-frame)) (setq parms (delq (assq 'tab-bar-lines parms) parms))) parms)) diff --git a/lisp/frameset.el b/lisp/frameset.el index e11a1da7e9b..0dde10869fd 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1370,12 +1370,10 @@ All keyword parameters default to nil." ;; frame, as that would only trigger ;; warnings. (not - (and (daemonp) - (equal (terminal-name (frame-terminal - frame)) - "initial_terminal")))) - (delete-frame frame))) - cleanup-frames))) + (and (daemonp) ;; FIXME: Remove `daemonp'? + (frame-initial-p frame)))) + (delete-frame frame))) + cleanup-frames))) (maphash (lambda (frame _action) (push frame map)) frameset--action-map) (dolist (frame (sort map ;; Minibufferless frames must go first to avoid diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index b8fefabacbb..d3088b4001f 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -70,6 +70,9 @@ DELAY is a string, giving the length of the time. Possible values are: * YYYY-MM-DD for a specific date. The time of day is given by the variable `gnus-delay-default-hour', minute and second are zero. +* YYYY-MM-DD hh:mm(:ss) for a specific date and time. If seconds are left + out, they will be zero. + * hh:mm for a specific time. Use 24h format. If it is later than this time, then the deadline is tomorrow, else today. @@ -82,8 +85,21 @@ generated when the article is sent." message-mode) ;; Allow spell checking etc. (run-hooks 'message-send-hook) - (let (num unit year month day hour minute deadline) ;; days + (let (num unit year month day hour minute deadline second) ;; days (cond ((string-match + "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\):?\\([0-9]\\{2\\}\\)?" + delay) + (setq year (string-to-number (match-string 1 delay)) + month (string-to-number (match-string 2 delay)) + day (string-to-number (match-string 3 delay)) + hour (string-to-number (match-string 4 delay)) + minute (string-to-number (match-string 5 delay)) + second (if (match-string 6 delay) (string-to-number (match-string 6 delay)) 0)) + (setq deadline + (message-make-date + (encode-time second minute hour + day month year)))) + ((string-match "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" delay) (setq year (string-to-number (match-string 1 delay)) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index ad1c4c2731a..0097f590b43 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -36,6 +36,10 @@ ;;; Code: (require 'icalendar) +(require 'icalendar-parser) +(eval-when-compile (require 'icalendar-macs)) +(require 'icalendar-ast) +(require 'icalendar-utils) (require 'eieio) (require 'gmm-utils) (require 'mm-decode) @@ -82,8 +86,8 @@ :type (or null t)) (recur :initarg :recur :accessor gnus-icalendar-event:recur - :initform "" - :type (or null string)) + :initform nil + :type (or null list)) (uid :initarg :uid :accessor gnus-icalendar-event:uid :type string) @@ -127,295 +131,212 @@ (cl-defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) "Return recurring frequency of EVENT." - (let ((rrule (gnus-icalendar-event:recur event))) - (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) - (match-string 1 rrule))) + (ical:recur-freq (gnus-icalendar-event:recur event))) (cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) "Return recurring interval of EVENT." - (let ((rrule (gnus-icalendar-event:recur event)) - (default-interval "1")) - - (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) - (match-string 1 rrule) - default-interval))) + (ical:recur-interval-size (gnus-icalendar-event:recur event))) (cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) "Return, when available, the week day numbers on which the EVENT recurs." - (let ((rrule (gnus-icalendar-event:recur event)) - (weekday-map '(("SU" . 0) - ("MO" . 1) - ("TU" . 2) - ("WE" . 3) - ("TH" . 4) - ("FR" . 5) - ("SA" . 6)))) - (when (and rrule (string-match "BYDAY=\\([^;]+\\)" rrule)) - (let ((bydays (split-string (match-string 1 rrule) ","))) - (seq-map - (lambda (x) (cdr (assoc x weekday-map))) - (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays)))))) + (let ((rrule (gnus-icalendar-event:recur event))) + (when rrule + (mapcar (lambda (el) (if (consp el) (car el) el)) + (ical:recur-by* 'BYDAY rrule))))) (cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) -(defun gnus-icalendar-event--decode-datefield (event field zone-map) - (let* ((dtdate (icalendar--get-event-property event field)) - (dtdate-zone (icalendar--find-time-zone - (icalendar--get-event-property-attributes - event field) zone-map)) - (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) - (when dtdate-dec (encode-time dtdate-dec)))) +(defun gnus-icalendar-event--find-attendee (attendees ids) + "Return the first `icalendar-attendee' in ATTENDEES matching IDS. +IDS should be a list of strings. The first attendee is returned whose +name (as `icalendar-cnparam') or email address (without \"mailto:\") +is a member of IDS." + (catch 'found + (dolist (attendee attendees) + (ical:with-property attendee ((ical:cnparam :value name)) + (let ((email (ical:strip-mailto value))) + (when (or (member name ids) + (member email ids)) + (throw 'found attendee))))))) -(defun gnus-icalendar-event--find-attendee (ical name-or-email) - (let* ((event (car (icalendar--all-events ical))) - (event-props (caddr event))) - (cl-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) - (attendee-email - (att) - (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) - (attendee-prop-matches-p - (prop) - (and (eq (car prop) 'ATTENDEE) - (or (member (attendee-name prop) name-or-email) - (let ((att-email (attendee-email prop))) - (gnus-icalendar-find-if - (lambda (str-or-fun) - (if (functionp str-or-fun) - (funcall str-or-fun att-email) - (string-match str-or-fun att-email))) - name-or-email)))))) - (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) +(defun gnus-icalendar-event--attendees-by-type (attendees) + "Return lists of required and optional participants in ATTENDEES. +ATTENDEES must be a list of `icalendar-attendee' nodes. The returned +list has the form (REQUIRED OPTIONAL), where each is a list of +`icalendar-attendee' nodes." + (let (required optional) + (dolist (attendee attendees) + (ical:with-property attendee ((ical:roleparam :value role)) + (when (or (null role) ; "REQ-PARTICIPANT" is the default + (equal role "REQ-PARTICIPANT")) + (push attendee required)) + (when (equal role "OPT-PARTICIPANT") + (push attendee optional)))) + (list (nreverse required) + (nreverse optional)))) -(defun gnus-icalendar-event--get-attendee-names (ical) - (let* ((event (car (icalendar--all-events ical))) - (attendee-props (seq-filter - (lambda (p) (eq (car p) 'ATTENDEE)) - (caddr event)))) +(defun gnus-icalendar-event-from-ical (vcalendar &optional ids) + "Initialize an event instance with the first `icalendar-vevent' in VCALENDAR. +IDS should be a list of strings representing names and email addresses +by which to identify an `icalendar-attendee' in the event as the +recipient." + (ical:with-component vcalendar + ((ical:vevent vevent) + (ical:method :value method)) + (ical:with-component vevent + ((ical:organizer :value organizer) + (ical:attendee :all attendees) + (ical:summary :value summary) + (ical:description :value description) + (ical:dtstart :value dtstart) + (ical:dtend :value dtend) + (ical:location :value location) + (ical:rrule :value rrule) + (ical:uid :value uid)) - (cl-labels - ((attendee-role (prop) - ;; RFC5546: default ROLE is REQ-PARTICIPANT - (and prop - (or (plist-get (cadr prop) 'ROLE) - "REQ-PARTICIPANT"))) - (attendee-name - (prop) - (or (plist-get (cadr prop) 'CN) - (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) - (attendees-by-type (type) - (seq-filter - (lambda (p) (string= (attendee-role p) type)) - attendee-props)) - (attendee-names-by-type - (type) - (mapcar #'attendee-name (attendees-by-type type)))) - (list - (attendee-names-by-type "REQ-PARTICIPANT") - (attendee-names-by-type "OPT-PARTICIPANT"))))) - -(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) - (let* ((event (car (icalendar--all-events ical))) - (organizer (replace-regexp-in-string - "^.*MAILTO:" "" - (or (icalendar--get-event-property event 'ORGANIZER) ""))) - (prop-map '((summary . SUMMARY) - (description . DESCRIPTION) - (location . LOCATION) - (recur . RRULE) - (uid . UID))) - (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) - (attendee (when attendee-name-or-email - (gnus-icalendar-event--find-attendee - ical attendee-name-or-email))) - (attendee-names (gnus-icalendar-event--get-attendee-names ical)) + (let* ((attendee (when ids (gnus-icalendar-event--find-attendee attendees ids))) + (rsvp-p (ical:with-param-of attendee 'ical:rsvpparam)) ;; RFC5546: default ROLE is REQ-PARTICIPANT - (role (and attendee - (or (plist-get (cadr attendee) 'ROLE) - "REQ-PARTICIPANT"))) + (role (when attendee + (or (ical:with-param-of attendee 'ical:roleparam) + "REQ-PARTICIPANT"))) (participation-type (pcase role ("REQ-PARTICIPANT" 'required) ("OPT-PARTICIPANT" 'optional) (_ 'non-participant))) - (zone-map (icalendar--convert-all-timezones ical)) + (req/opt (gnus-icalendar-event--attendees-by-type attendees)) (args (list :method method - :organizer organizer - :start-time (gnus-icalendar-event--decode-datefield - event 'DTSTART zone-map) - :end-time (gnus-icalendar-event--decode-datefield - event 'DTEND zone-map) - :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") + :organizer (when organizer (ical:strip-mailto organizer)) + :summary summary + :description description + :location location + :recur rrule + :start-time (encode-time dtstart) + :end-time (encode-time dtend) + :rsvp rsvp-p :participation-type participation-type - :req-participants (car attendee-names) - :opt-participants (cadr attendee-names))) - (event-class - (cond - ((string= method "REQUEST") 'gnus-icalendar-event-request) - ((string= method "CANCEL") 'gnus-icalendar-event-cancel) - ((string= method "REPLY") 'gnus-icalendar-event-reply) - (t 'gnus-icalendar-event)))) - (cl-labels - ((map-property - (prop) - (let ((value (icalendar--get-event-property event prop))) - (when value - ;; ugly, but cannot get - ;;replace-regexp-in-string work with "\\" as - ;;REP, plus we should also handle "\\;" - (string-replace - "\\," "," - (string-replace - "\\n" "\n" (substring-no-properties value)))))) - (accumulate-args - (mapping) - (cl-destructuring-bind (slot . ical-property) mapping - (setq args (append (list - (intern (concat ":" (symbol-name slot))) - (map-property ical-property)) - args))))) - (mapc #'accumulate-args prop-map) - (apply - #'make-instance - event-class - (cl-loop for slot in (eieio-class-slots event-class) - for keyword = (intern - (format ":%s" (eieio-slot-descriptor-name slot))) - when (plist-member args keyword) - append (list keyword - (if (eq keyword :uid) - ;; The UID has to be a string. - (or (plist-get args keyword) "") - (plist-get args keyword)))))))) + :req-participants (car req/opt) + :opt-participants (cadr req/opt) + :uid (or uid ""))) ; UID must be a string + (event-class (pcase method + ("REQUEST" 'gnus-icalendar-event-request) + ("CANCEL" 'gnus-icalendar-event-cancel) + ("REPLY" 'gnus-icalendar-event-reply) + (_ 'gnus-icalendar-event)))) + ;; Initialize and return the instance: + (apply + #'make-instance + event-class + (cl-loop for slot in (eieio-class-slots event-class) + for keyword = (intern + (format ":%s" (eieio-slot-descriptor-name slot))) + when (plist-member args keyword) + append (list keyword (plist-get args keyword)))))))) -(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) +(defun gnus-icalendar-event-from-buffer (buf &optional ids) "Parse RFC5545 iCalendar in buffer BUF and return an event object. Return a gnus-icalendar-event object representing the first event contained in the invitation. Return nil for calendars without an event entry. -ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched -against the event's attendee names and emails. Invitation rsvp -status will be retrieved from the first matching attendee record." - (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) - (goto-char (point-min)) - (icalendar--read-element nil nil)))) - - (when ical - (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) +IDS is a list of strings that identify the recipient +`icalendar-attendee' by name or email address. Invitation rsvp status +will be retrieved from the first matching attendee record." + (let ((vcalendar (ical:parse buf))) + (when vcalendar + (gnus-icalendar-event-from-ical vcalendar ids)))) ;;; ;;; gnus-icalendar-event-reply ;;; -(defun gnus-icalendar-event--build-reply-event-body (ical-request status identities &optional comment) +(defun gnus-icalendar-event--build-reply (vcalendar status ids &optional comment) + "Return an `icalendar-vcalendar' based on VCALENDAR with updated STATUS. +STATUS should one of \\='accepted, \\='declined, or \\='tentative. The +recipient whose participation status is updated to STATUS is identified +in EVENT by finding an `icalendar-attendee' whose name or email address +matches one of the strings in IDS. If no such attendee is found, a new +`icalendar-attendee' is added from the values of `user-mail-address' and +`user-full-name'. COMMENT, if provided, will be added as an +`icalendar-comment' to the returned event." (let ((summary-status (capitalize (symbol-name status))) (attendee-status (upcase (symbol-name status))) - reply-event-lines) - (cl-labels - ((update-summary - (line) - (if (string-match "^[^:]+:" line) - (replace-match (format "\\&%s: " summary-status) t nil line) - line)) - (update-comment - (line) - (if comment (format "COMMENT:%s" comment) - line)) - (update-dtstamp () - (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) - (attendee-matches-identity - (line) - (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) - identities)) - (update-attendee-status - (line) - (when (and (attendee-matches-identity line) - (string-match "\\(PARTSTAT=\\)[^;]+" line)) - (replace-match (format "\\1%s" attendee-status) t nil line))) - (process-event-line - (line) - (when (string-match "^\\([^;:]+\\)" line) - (let* ((key (match-string 0 line)) - ;; NOTE: not all of the below fields are mandatory, - ;; but they are often present in other clients' - ;; replies. Can be helpful for debugging, too. - (new-line - (cond - ((string= key "ATTENDEE") (update-attendee-status line)) - ((string= key "SUMMARY") (update-summary line)) - ((string= key "COMMENT") (update-comment line)) - ((string= key "DTSTAMP") (update-dtstamp)) - ((member key '("ORGANIZER" "DTSTART" "DTEND" - "LOCATION" "DURATION" "SEQUENCE" - "RECURRENCE-ID" "UID")) - line) - (t nil)))) - (when new-line - (push new-line reply-event-lines)))))) + recipient) + (ical:with-component vcalendar + ((ical:vtimezone :all tz-nodes) + (ical:vevent :first vevent)) + (ical:with-component vevent + ((ical:summary :value summary) + (ical:attendee :all attendees) + (ical:uid :value uid) + (ical:comment :value old-comment) + ;; The nodes below are copied unchanged to the reply. Not all + ;; of them are mandatory, but they are often present in other + ;; clients' replies. Can be helpful for debugging, too. + (ical:organizer :first organizer-node) + (ical:dtstart :first dtstart-node) + (ical:dtend :first dtend-node) + (ical:duration :first duration-node) + (ical:location :first location-node) + (ical:sequence :first sequence-node) + (ical:recurrence-id :first recid-node)) - (mapc #'process-event-line (split-string ical-request "\n")) + (setq recipient (gnus-icalendar-event--find-attendee attendees ids)) + (if recipient + (ical:with-property recipient + ((ical:partstatparam :first partstat-node)) + (ical:ast-node-set-value partstat-node attendee-status)) + ;; RFC5546 refers to uninvited attendees as "party crashers". + ;; This situation is common if the invitation is sent to a group + ;; of people via a mailing list. + (lwarn 'gnus-icalendar :warning + "Could not find a matching event attendee; creating new.") + (setq recipient + (ical:make-property ical:attendee + (concat "mailto:" user-mail-address) + (ical:partstatparam attendee-status) + (ical:cnparam user-full-name))) + (push recipient attendees)) - ;; RFC5546 refers to uninvited attendees as "party crashers". - ;; This situation is common if the invitation is sent to a group - ;; of people via a mailing list. - (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) - reply-event-lines) - (lwarn 'gnus-icalendar :warning - "Could not find an event attendee matching given identity") - (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s" - attendee-status user-full-name user-mail-address) - reply-event-lines)) + ;; Build the reply: + (ical:make-vcalendar + (ical:method "REPLY") + (@ tz-nodes) + (ical:vevent + (ical:uid uid) + recid-node + sequence-node + organizer-node + dtstart-node + dtend-node + duration-node + location-node + (ical:summary + (if (string-match "^[^:]+:" summary) + (replace-match (format "\\&%s: " summary-status) t nil summary) + summary)) + (ical:comment (or comment old-comment)) + (@ attendees))))))) - ;; add comment line if not existing - (when (and comment - (not (gnus-icalendar-find-if - (lambda (x) - (string-match "^COMMENT" x)) - reply-event-lines))) - (push (format "COMMENT:%s" comment) reply-event-lines)) - - (mapconcat #'identity `("BEGIN:VEVENT" - ,@(nreverse reply-event-lines) - "END:VEVENT") - "\n")))) - -(defun gnus-icalendar-event-reply-from-buffer (buf status identities &optional comment) +(defun gnus-icalendar-event-reply-from-buffer (buf status ids + &optional comment) "Build a calendar event reply for request contained in BUF. -The reply will have STATUS (`accepted', `tentative' or `declined'). -The reply will be composed for attendees matching any entry -on the IDENTITIES list. -Optional argument COMMENT will be placed in the comment field of the -reply. -" - (cl-labels - ((extract-block - (blockname) - (save-excursion - (let ((block-start-re (format "^BEGIN:%s" blockname)) - (block-end-re (format "^END:%s" blockname)) - start) - (when (re-search-forward block-start-re nil t) - (setq start (line-beginning-position)) - (re-search-forward block-end-re) - (buffer-substring-no-properties start (line-end-position))))))) - (let (zone event) - (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) - (goto-char (point-min)) - (setq zone (extract-block "VTIMEZONE") - event (extract-block "VEVENT"))) - - (when event - (let ((contents (list "BEGIN:VCALENDAR" - "METHOD:REPLY" - "PRODID:Gnus" - "VERSION:2.0" - zone - (gnus-icalendar-event--build-reply-event-body event status identities comment) - "END:VCALENDAR"))) - - (mapconcat #'identity (delq nil contents) "\n")))))) +The reply will have STATUS (`accepted', `tentative' or `declined'). The +reply will be composed for attendees matching any entry in the +IDS list. Optional argument COMMENT will be placed in the +comment field of the reply." + (let (vcalendar reply) + (with-current-buffer (ical:unfolded-buffer-from-buffer (get-buffer buf)) + (setq vcalendar (ical:parse)) + (unless vcalendar + (error "Could not parse invitation; see buffer %s" + (buffer-name (ical:error-buffer)))) + (setq reply + (gnus-icalendar-event--build-reply vcalendar status ids comment)) + (ical:print-calendar-node reply)))) ;;; ;;; gnus-icalendar-org @@ -455,15 +376,17 @@ reply. "Return `org-mode' timestamp repeater string for recurring EVENT. Return nil for non-recurring EVENT." (when (gnus-icalendar-event:recurring-p event) - (let* ((freq-map '(("HOURLY" . "h") - ("DAILY" . "d") - ("WEEKLY" . "w") - ("MONTHLY" . "m") - ("YEARLY" . "y"))) - (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event) freq-map)))) + (let* ((freq-map '((HOURLY . "h") + (DAILY . "d") + (WEEKLY . "w") + (MONTHLY . "m") + (YEARLY . "y"))) + (org-freq + (alist-get (gnus-icalendar-event:recurring-freq event) freq-map)) + (interval-size (gnus-icalendar-event:recurring-interval event))) (when org-freq - (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) + (format "+%d%s" interval-size org-freq))))) (defun gnus-icalendar--find-day (start-date end-date day) (let ((time-1-day 86400)) @@ -550,7 +473,18 @@ Return nil for non-recurring EVENT." (defun gnus-icalendar--format-participant-list (participants) - (mapconcat #'identity participants ", ")) + "Format PARTICIPANTS as a comma-separated list. + +Each `icalendar-attendee' in PARTICIPANTS will be represented like + A. Person +or simply: , if no `icalendar-cnparam' is present." + (mapconcat + (lambda (attendee) + (ical:with-property attendee ((ical:cnparam :value cn)) + (if cn + (format "%s <%s>" cn value) + (format "<%s>" value)))) + participants ", ")) ;; TODO: make the template customizable (cl-defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) @@ -1110,3 +1044,7 @@ means prompt for a comment to include in the reply." (provide 'gnus-icalendar) ;;; gnus-icalendar.el ends here + +;; Local Variables: +;; read-symbol-shorthands: (("ical:" . "icalendar-")) +;; End: diff --git a/lisp/help.el b/lisp/help.el index 49d4659ab02..1576fb61dc8 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2356,11 +2356,13 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." "Return a formal argument list for the function DEF. If PRESERVE-NAMES is non-nil, return a formal arglist that uses the same names as used in the original source code, when possible." - (let ((orig-def def) - ;; Advice wrappers have "catch all" args, so fetch the actual underlying - ;; function to find the real arguments. - (def (advice--cd*r - (indirect-function def)))) ;; Follow aliases to other symbols. + (let ((orig-def def)) + (let ((seen nil)) + ;; Advice wrappers have "catch all" args, so fetch the actual underlying + ;; function to find the real arguments. Also follow aliases. + (while (not (memq def seen)) + (push def seen) + (setq def (advice--cd*r (indirect-function def))))) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond diff --git a/lisp/info.el b/lisp/info.el index 368255092a1..320ac7de65c 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1897,8 +1897,10 @@ of NODENAME; if none is found it then tries a case-insensitive match (if (equal nodename "") "Top" nodename) nil strict-case))) (defun Info-goto-node-web (node) - "Use `browse-url' to go to the gnu.org web server's version of NODE. -By default, go to the current Info node." + "Use `browse-url' to go to the gnu.org Web server's version of NODE. +By default, go to the URL corresponding to the current Info node. + +This uses `Info-url-for-node' to determine the URL that corresponds to NODE." (interactive (list (Info-read-node-name "Go to node (default current page): " Info-current-node)) Info-mode) @@ -1924,7 +1926,10 @@ By default, go to the current Info node." (defun Info-url-for-node (node) "Return the URL corresponding to NODE. -NODE should be a string of the form \"(manual)Node\"." +NODE should be a string of the form \"(manual)Node\". + +The correspondence between Info manuals and their Web URLs is +established by `Info-url-alist', which see." ;; GNU Texinfo skips whitespaces and newlines between the closing ;; parenthesis and the node-name, i.e. space, tab, line feed and ;; carriage return. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index ba994daa852..d19802c46fd 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1782,15 +1782,15 @@ Setup `char-width-table' appropriate for non-CJK language environment." (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL" "BS" nil nil "VT" "FF" "CR" "SO" "SI" "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" - "CAN" "EM" "SUB" "ESC" "FC" "GS" "RS" "US"))) + "CAN" "EM" "SUB" "ESC" "FS" "GS" "RS" "US"))) (dotimes (i 32) (aset char-acronym-table i (car c0-acronyms)) (setq c0-acronyms (cdr c0-acronyms)))) (let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" - "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1" + "HTS" "HTJ" "VTS" "PLD" "PLU" "RI" "SS2" "SS3" "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA" - "SOS" "SGCI" "SC1" "CSI" "ST" "OSC" "PM" "APC"))) + "SOS" "SGCI" "SCI" "CSI" "ST" "OSC" "PM" "APC"))) (dotimes (i 32) (aset char-acronym-table (+ #x0080 i) (car c1-acronyms)) (setq c1-acronyms (cdr c1-acronyms)))) diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index d8e779f7d8d..56a8134be81 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -155,9 +155,13 @@ and also consults the `emoji-alternate-names' alist." ;;;###autoload (defun emoji-list () - "List emojis and allow selecting and inserting one of them. + "List Emoji and allow selecting and inserting one of them. +If you are displaying Emoji on a text-only terminal, and some +of them look incorrect, or there are display artifacts when +scrolling the display, turn off `auto-composition-mode'. + Select the emoji by typing \\\\[emoji-list-select] on its picture. -The glyph will be inserted into the buffer that was current +The selected glyph will be inserted into the buffer that was current when the command was invoked." (interactive) (let ((buf (current-buffer))) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index fca00dd2fc7..e8930fd2d4e 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: JoΓ£o TΓ‘vora ;; Keywords: processes, languages, extensions -;; Version: 1.0.27 +;; Version: 1.0.28 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 982ae38f47d..b88c716f0b3 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -219,7 +219,7 @@ macro to be executed before appending to it." ;;;###autoload (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) (if kmacro-call-mouse-event - (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-call-mouse)) + (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-and-call-macro)) ;;; Called from keyboard-quit @@ -742,8 +742,8 @@ With numeric ARG, repeat the macro that many times, counting the definition just completed as the first repetition. An argument of zero means repeat until error." (interactive "p") - ;; Isearch may push the kmacro-end-macro key sequence onto the macro. - ;; Just ignore it when executing the macro. + ;; Isearch may push the kmacro-end-macro key sequence onto the macro. + ;; Just ignore it when executing the macro. FIXME: When?Why? (unless executing-kbd-macro (end-kbd-macro arg #'kmacro-loop-setup-function) (when (and last-kbd-macro (= (length last-kbd-macro) 0)) @@ -880,35 +880,25 @@ With \\[universal-argument], call second macro in macro ring." ;;;###autoload -(defun kmacro-end-and-call-macro (arg &optional no-repeat) +(defun kmacro-end-and-call-macro (arg &optional no-repeat event) "Call last keyboard macro, ending it first if currently being defined. With numeric prefix ARG, repeat macro that many times. Zero argument means repeat until there is an error. +If triggered via a mouse EVENT, moves point to the position clicked +with the mouse before calling the macro. To give a macro a name, so you can call it even after defining other macros, use \\[kmacro-name-last-macro]." - (interactive "p") + (interactive (list current-prefix-arg nil + (if (consp last-input-event) last-input-event))) (if defining-kbd-macro (kmacro-end-macro nil)) + (if event (mouse-set-point event)) (kmacro-call-macro arg no-repeat)) - ;;;###autoload -(defun kmacro-end-call-mouse (event) - "Move point to the position clicked with the mouse and call last kbd macro. -If kbd macro currently being defined end it before activating it." - (interactive "e") - (when defining-kbd-macro - (end-kbd-macro) - (when (and last-kbd-macro (= (length last-kbd-macro) 0)) - (setq last-kbd-macro nil) - (message "Ignore empty macro") - ;; Don't call `kmacro-ring-empty-p' to avoid its messages. - (while (and (null last-kbd-macro) kmacro-ring) - (kmacro-pop-ring1)))) - (mouse-set-point event) - (kmacro-call-macro nil t)) - +(define-obsolete-function-alias 'kmacro-end-call-mouse + #'kmacro-end-and-call-macro "31.1") ;;; Misc. commands diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index da91e692719..cca702f71b0 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -27,13 +27,22 @@ ;;; Code: +(defgroup korean nil + "Options for writing Korean." + :version "31.1" + :group 'languages) + ;;;###autoload -(defvar default-korean-keyboard +(defcustom default-korean-keyboard (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "") "The kind of Korean keyboard for Korean (Hangul) input method. -\"\" for 2, \"3\" for 3, and \"3f\" for 3f.") +\"\" for 2, \"3\" for 3, and \"3f\" for 3f." + :initialize #'custom-initialize-delay + :group 'korean + :version "31.1" + :type 'string) ;; functions useful for Korean text input diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 44e8665eebd..f96cd43eca6 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -231,8 +231,8 @@ in the tool bar will close the current window where possible." '(menu-item "Open Project Directory" project-dired :enable (menu-bar-non-minibuffer-window-p) :help "Read the root directory of the current project, to operate on its files")) - (define-key menu [dired] - '(menu-item "Open Directory..." dired + (define-key menu [open-directory] + '(menu-item "Open Directory..." dired-from-menubar :enable (menu-bar-non-minibuffer-window-p) :help "Read a directory, to operate on its files")) (define-key menu [project-open-file] @@ -2287,7 +2287,7 @@ this frame." (and menu-bar-close-window (window-parent (selected-window))))) -(put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p)) +(put 'dired-from-menubar 'menu-enable '(menu-bar-non-minibuffer-window-p)) ;; Permit deleting frame if it would leave a visible or iconified frame. (defun delete-frame-enabled-p () @@ -2496,8 +2496,7 @@ It must accept a buffer as its only required argument.") ;; Ignore the initial frame if present. It can happen if ;; Emacs was started as a daemon. (bug#53740) (dolist (frame (frame-list)) - (unless (equal (terminal-name (frame-terminal frame)) - "initial_terminal") + (unless (frame-initial-p frame) (push frame frames))) ;; Make the menu of buffers proper. (setq buffers-menu diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 13d0e712821..94fc63440b4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2807,7 +2807,7 @@ has been requested by the completion table." "Update displayed *Completions* buffer after change in buffer contents." (if (not (or (minibufferp nil t) completion-in-region-mode)) (remove-hook 'after-change-functions #'completions--after-change t) - (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (get-buffer-window "*Completions*" 'visible))) (when completion-auto-deselect (with-selected-window window (completions--deselect)))) @@ -3480,7 +3480,7 @@ in the minibuffer window." (defun minibuffer--completions-visible () "Return the window where the current *Completions* buffer is visible, if any." - (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (get-buffer-window "*Completions*" 'visible))) (let ((reference-buffer (buffer-local-value 'completion-reference-buffer (window-buffer window)))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index bb298d11d3c..a09cd730c0f 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -870,7 +870,8 @@ t if it successfully authenticates, nil otherwise." (base64-encode-string (format "\000%s\000%s" (imap-quote-specials user) - (imap-quote-specials passwd))))))))) + (imap-quote-specials passwd)) + t))))))) (defun imap-anonymous-p (_buffer) t) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c20b5df9b59..f6bfd9ebbea 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -451,21 +451,13 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (when (tramp-adb-do-ls v "-a" localname) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n" 'omit)))))))))) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (when (tramp-adb-do-ls v "-a" localname) + (with-current-buffer (tramp-get-buffer v) + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n" 'omit))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 91d9b239a70..fec2e16a624 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -266,7 +266,7 @@ BODY is the backend specific code." tramp--last-hop-directory) tramp-compat-temporary-file-directory)) (program (let ((tramp-verbose 0)) - (tramp-get-method-parameter + (tramp-expand-args (make-tramp-file-name :method ,method) 'tramp-login-program))) (vec (when (tramp-tramp-file-p default-directory) @@ -656,10 +656,9 @@ see its function help for a description of the format." '((tramp-config-check . tramp-kubernetes--current-context-data) ;; This variable will be eval'ed in `tramp-expand-args'. (tramp-extra-expand-args - . (?a (tramp-kubernetes--container (car tramp-current-connection)) - ?h (tramp-kubernetes--pod (car tramp-current-connection)) - ?x (tramp-kubernetes--context-namespace - (car tramp-current-connection))))) + ?a (tramp-kubernetes--container (car tramp-current-connection)) + ?h (tramp-kubernetes--pod (car tramp-current-connection)) + ?x (tramp-kubernetes--context-namespace (car tramp-current-connection)))) "Default connection-local variables for remote kubernetes connections.") (connection-local-set-profile-variables diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 59e4cea2edb..4400f4fecd3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -741,18 +741,16 @@ absolute file names." (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (let* (completion-regexp-list - tramp-crypt-enabled - (directory (file-name-as-directory directory)) - (enc-dir (tramp-crypt-encrypt-file-name directory))) - (mapcar - (lambda (x) - (substring - (tramp-crypt-decrypt-file-name (concat enc-dir x)) - (length directory))) - (file-name-all-completions "" enc-dir)))))) + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 7e140a0e372..601690befd6 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -49,7 +49,7 @@ present for backward compatibility." (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist)) (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist))) (setq file-name-handler-alist - (delete a1 (delete a2 file-name-handler-alist))))) + (seq-difference file-name-handler-alist (list a1 a2))))) (with-eval-after-load 'ange-ftp (tramp-disable-ange-ftp)) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index b3e59063cd8..f7abddab1a1 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -102,10 +102,7 @@ "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory (tramp-fuse-remove-hidden-files - (all-completions - filename - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)))))) + (file-name-all-completions "" (tramp-fuse-local-file-name directory))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0f68e4d768a..a5919e071c3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1479,19 +1479,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (unless (string-search "/" filename) - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files. - (dolist (item - (tramp-gvfs-get-directory-attributes directory) - result) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory (car item)) result) - (push (car item) result)))))))))) + (mapcar #'car (tramp-gvfs-get-directory-attributes directory)))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1545,11 +1533,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Fix action names. - string (string-replace "attributes changed" "attribute-changed" string) - string (string-replace "changes done" "changes-done-hint" string) - string (string-replace "renamed to" "moved" string)) + (setq string + (thread-last + (concat rest-string string) + ;; Fix action names. + (string-replace "attributes changed" "attribute-changed") + (string-replace "changes done" "changes-done-hint") + (string-replace "renamed to" "moved"))) ;; https://bugs.launchpad.net/bugs/1742946 (when (string-match-p diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c83a7a9978d..9aec9e38f65 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1993,48 +1993,39 @@ ID-FORMAT valid values are `string' and `integer'." "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory (with-parsed-tramp-file-name (expand-file-name directory) nil - (when (and (not (string-search "/" filename)) - (tramp-connectable-p v)) - (unless (string-search "/" filename) - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including - ;; reliably tagging the directories with a trailing "/". - ;; Because I rock. --daniel@danann.net - (if (tramp-get-remote-perl v) - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (tramp-maybe-send-script - v tramp-shell-file-name-all-completions - "tramp_shell_file_name_all_completions")) + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (if (tramp-get-remote-perl v) + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (tramp-maybe-send-script + v tramp-shell-file-name-all-completions + "tramp_shell_file_name_all_completions")) - (dolist - (elt - (tramp-send-command-and-read - v (format - "%s %s" - (if (tramp-get-remote-perl v) - "tramp_perl_file_name_all_completions" - "tramp_shell_file_name_all_completions") - (tramp-shell-quote-argument localname)) - 'noerror) - result) - ;; Don't cache "." and "..". - (when (string-match-p - directory-files-no-dot-files-regexp - (file-name-nondirectory (car elt))) - (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) - (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) - (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) - (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) + (dolist + (elt + (tramp-send-command-and-read + v (format + "%s %s" + (if (tramp-get-remote-perl v) + "tramp_perl_file_name_all_completions" + "tramp_shell_file_name_all_completions") + (tramp-shell-quote-argument localname)) + 'noerror) + result) + ;; Don't cache "." and "..". + (when (string-match-p + directory-files-no-dot-files-regexp + (file-name-nondirectory (car elt))) + (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) + (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) + (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) + (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) - (push - (concat - (file-name-nondirectory (car elt)) (and (nth 3 elt) "/")) - result)))))))))) + (push (file-name-nondirectory (car elt)) result)))))) ;; cp, mv and ln @@ -2803,7 +2794,7 @@ The method used must be an out-of-band method." (append switches (split-string (tramp-sh--quoting-style-options v)) (when dired `(,dired)))) (unless dired - (setq switches (delete "-N" (delete "--dired" switches))))) + (setq switches (seq-difference switches '("-N" "--dired"))))) (when wildcard (setq wildcard (tramp-run-real-handler #'file-name-nondirectory (list localname))) @@ -3917,11 +3908,13 @@ Fall back to normal file name handler if no Tramp handler exists." (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) - (setq string (concat rest-string string) - ;; Fix action names. - string (string-replace "attributes changed" "attribute-changed" string) - string (string-replace "changes done" "changes-done-hint" string) - string (string-replace "renamed to" "moved" string)) + (setq string + (thread-last + (concat rest-string string) + ;; Fix action names. + (string-replace "attributes changed" "attribute-changed") + (string-replace "changes done" "changes-done-hint") + (string-replace "renamed to" "moved"))) (catch 'doesnt-work ;; https://bugs.launchpad.net/bugs/1742946 @@ -5044,7 +5037,7 @@ Goes through the list `tramp-inline-compress-commands'." ;; Use plink options. ((string-match-p (rx "plink" (? ".exe") eol) - (tramp-get-method-parameter vec 'tramp-login-program)) + (tramp-expand-args vec 'tramp-login-program)) (concat (if (eq tramp-use-connection-share 'suppress) "-noshare" "-share") @@ -5405,7 +5398,7 @@ connection if a previous connection has died for some reason." hop 'tramp-connection-timeout tramp-connection-timeout)) (command - (tramp-get-method-parameter + (tramp-expand-args hop 'tramp-login-program)) ;; We don't create the temporary file. In ;; fact, it is just a prefix for the diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 554aa354c00..8eec0e1bd08 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -603,12 +603,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (copy-directory filename newname keep-date 'parents 'copy-contents) (tramp-barf-if-file-missing v filename - ;; `file-local-copy' returns a file name also for a local - ;; file with `jka-compr-handler', so we cannot trust its - ;; result as indication for a remote file name. - (if-let* ((tmpfile - (and (tramp-tramp-file-p filename) - (file-local-copy filename)))) + ;; Suppress `jka-compr-handler'. + (if-let* ((jka-compr-inhibit t) + (tmpfile (file-local-copy filename))) ;; Remote filename. (condition-case err (rename-file tmpfile newname ok-if-already-exists) @@ -1068,18 +1065,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (when (file-directory-p directory) - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (mapcar - (lambda (x) - (list - (if (string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory)))))))) + (mapcar #'car (tramp-smb-get-file-entries directory)))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1752,9 +1738,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (unless share (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself. - (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; Return entries. (delq nil res))))) @@ -2295,9 +2278,6 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." ;; * Return more comprehensive file permission string. ;; -;; * Try to remove the inclusion of dummy "" directory. Seems to be at -;; several places, especially in `tramp-smb-handle-insert-directory'. -;; ;; * Keep a separate connection process per share. ;; ;; * Keep a permanent connection process for `process-file'. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2cb5b5b1ed1..f4073158683 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -269,7 +269,7 @@ arguments to pass to the OPERATION." (setq ret (apply #'tramp-call-process - v (tramp-get-method-parameter v 'tramp-login-program) + v (tramp-expand-args v 'tramp-login-program) nil outbuf display (tramp-expand-args v 'tramp-login-args nil diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 9511c899b2b..8bf6a9f50b0 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -498,24 +498,16 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-skeleton-file-name-all-completions filename directory - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-sudoedit-send-command - v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" - (if (tramp-string-empty-or-nil-p localname) - "" (file-name-unquote localname))) - (mapcar - (lambda (f) - (if (ignore-errors (file-directory-p (expand-file-name f directory))) - (file-name-as-directory f) - f)) - (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit)))))))) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (tramp-sudoedit-send-command + v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" + (if (tramp-string-empty-or-nil-p localname) + "" (file-name-unquote localname))) + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5441a26d7a0..03089dffb55 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2002,12 +2002,11 @@ expected to be a string, which will be used." "Construct a Tramp hop name from VEC." (concat (tramp-file-name-hop vec) - (replace-regexp-in-string - tramp-prefix-regexp "" - (replace-regexp-in-string - (rx (regexp tramp-postfix-host-regexp) eos) - tramp-postfix-hop-format - (tramp-make-tramp-file-name (tramp-file-name-unify vec)))))) + (thread-last + (replace-regexp-in-string + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format + (tramp-make-tramp-file-name (tramp-file-name-unify vec))) + (replace-regexp-in-string tramp-prefix-regexp "")))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. @@ -2957,7 +2956,7 @@ not in completion mode." (or (and (cond ;; Completion styles like `flex' and `substring' check for ;; the file name "/". This does exist. - ((string-equal filename "/")) + ((string-equal filename tramp-prefix-format)) ;; Is it a valid method? ((and (not (string-empty-p tramp-postfix-method-format)) (string-match @@ -3001,30 +3000,59 @@ not in completion mode." (tramp-run-real-handler #'file-exists-p (list filename)))) +(defvar tramp-fnac-add-trailing-slash t + "Whether `file-name-all-completions' shall add a trailing slash. +This is not desired, if that function is used in `directory-files', or +in `tramp-completion-handle-file-name-all-completions'.") + (defmacro tramp-skeleton-file-name-all-completions (filename directory &rest body) "Skeleton for `tramp-*-handle-filename-all-completions'. BODY is the backend specific code." (declare (indent 2) (debug t)) `(ignore-error file-missing - (seq-uniq (delq nil (delete "" - (let* ((case-fold-search read-file-name-completion-ignore-case) - (result (progn ,@body))) - ;; Some storage systems do not return "." and "..". - (when (tramp-tramp-file-p ,directory) - (dolist (elt '(".." ".")) - (when (string-prefix-p ,filename elt) - (setq result (cons (concat elt "/") result))))) - (if (consp completion-regexp-list) - ;; Discriminate over `completion-regexp-list'. - (mapcar - (lambda (x) - (when (stringp x) - (catch 'match - (dolist (elt completion-regexp-list x) - (unless (string-match-p elt x) (throw 'match nil)))))) - result) - result))))))) + (all-completions + ,filename + (when (file-directory-p ,directory) + (seq-uniq (delq nil + (let* ((case-fold-search read-file-name-completion-ignore-case) + (result + (if (tramp-tramp-file-p ,directory) + (with-parsed-tramp-file-name + (expand-file-name ,directory) nil + (when (and (not (string-search "/" ,filename)) + (tramp-connectable-p v)) + (with-tramp-file-property + v localname + (format + "file-name-all-completions-%s" + tramp-fnac-add-trailing-slash) + ;; Mark symlinked directories. Other + ;; directories are already marked. + (mapcar + (lambda (x) + (let ((f (file-name-concat ,directory x))) + (if (and tramp-fnac-add-trailing-slash + (not (string-suffix-p "/" x)) + (file-directory-p + (if (file-symlink-p f) + (file-truename f) f))) + (concat x "/") x))) + ;; Some storage systems do not return "." and "..". + (seq-union + (seq-difference (progn ,@body) '("." "..")) + '("./" "../")))))) + ,@body))) + ;; Discriminate over `completion-regexp-list'. + (if (consp completion-regexp-list) + (mapcar + (lambda (x) + (when (stringp x) + (catch 'match + (dolist (elt completion-regexp-list x) + (unless (string-match-p elt x) (throw 'match nil)))))) + result) + result)))))))) (defvar tramp--last-hop-directory nil "Tracks the directory from which to run login programs.") @@ -3035,72 +3063,74 @@ BODY is the backend specific code." ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (tramp-skeleton-file-name-all-completions filename directory - (let ((fullname - (tramp-drop-volume-letter (expand-file-name filename directory))) - (directory (tramp-drop-volume-letter directory)) - tramp--last-hop-directory hop result result1) + (let (tramp-fnac-add-trailing-slash) + (tramp-skeleton-file-name-all-completions filename directory + (let ((fullname + (tramp-drop-volume-letter (expand-file-name filename directory))) + (directory (tramp-drop-volume-letter directory)) + tramp--last-hop-directory hop result result1) - ;; Suppress hop from completion. - (when (string-match - (rx - (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - fullname) - (setq hop (match-string 1 fullname) - fullname (replace-match "" nil nil fullname 1) - tramp--last-hop-directory - (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) + ;; Suppress hop from completion. + (when (string-match + (rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + fullname) + (setq hop (match-string 1 fullname) + fullname (replace-match "" nil nil fullname 1) + tramp--last-hop-directory + (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) - (let (tramp-default-user tramp-default-user-alist - tramp-default-host tramp-default-host-alist) + (let (tramp-default-user tramp-default-user-alist + tramp-default-host tramp-default-host-alist) - ;; Possible completion structures. - (dolist (elt (tramp-completion-dissect-file-name fullname)) - (let* ((method (tramp-file-name-method elt)) - (user (tramp-file-name-user elt)) - (host (tramp-file-name-host elt)) - (localname (tramp-file-name-localname elt)) - (m (tramp-find-method method user host)) - all-user-hosts) + ;; Possible completion structures. + (dolist (elt (tramp-completion-dissect-file-name fullname)) + (let* ((method (tramp-file-name-method elt)) + (user (tramp-file-name-user elt)) + (host (tramp-file-name-host elt)) + (localname (tramp-file-name-localname elt)) + (m (tramp-find-method method user host)) + all-user-hosts) - (unless localname ;; Nothing to complete. - (if (or user host) - ;; Method dependent user / host combinations. - (progn - (mapc - (lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) - (tramp-get-completion-function m)) + (unless localname ;; Nothing to complete. + (if (or user host) + ;; Method dependent user / host combinations. + (progn + (mapc + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) + (tramp-get-completion-function m)) - (setq result - (append result - (mapcar - (lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) - all-user-hosts)))) + (setq result + (append result + (mapcar + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) + all-user-hosts)))) - ;; Possible methods. - (setq result - (append result (tramp-get-completion-methods m hop))))))) + ;; Possible methods. + (setq result + (append result (tramp-get-completion-methods m hop))))))) - ;; Add hop. - (dolist (elt result) - (when elt - (setq elt (replace-regexp-in-string - tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) - (push (substring elt (length directory)) result1))) + ;; Add hop. + (dolist (elt result) + (when elt + (setq elt (replace-regexp-in-string + tramp-prefix-regexp + (concat tramp-prefix-format hop) elt)) + (push (substring elt (length directory)) result1))) - ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))))) + ;; Complete local parts. + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3659,9 +3689,10 @@ BODY is the backend specific code." (signal 'error nil) (setf ,directory (file-name-as-directory (expand-file-name ,directory))) - (let ((temp - (with-tramp-file-property v localname "directory-files" ,@body)) - result item) + (let* (tramp-fnac-add-trailing-slash + (temp + (with-tramp-file-property v localname "directory-files" ,@body)) + result item) (while temp (setq item (directory-file-name (pop temp))) (when (or (null ,match) (string-match-p ,match item)) @@ -4496,8 +4527,8 @@ Let-bind it when necessary.") ;; "." and ".." are never interesting as completions, and are ;; actually in the way in a directory with only one file. See ;; file_name_completion() in dired.c. - (when (and (consp fnac) (length= (delete "./" (delete "../" fnac)) 1)) - (setq fnac (delete "./" (delete "../" fnac)))) + (when (and (consp fnac) (length= (seq-difference fnac '("./" "../")) 1)) + (setq fnac (seq-difference fnac '("./" "../")))) (or (try-completion filename fnac @@ -5294,7 +5325,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defvar tramp-extra-expand-args nil "Method specific arguments.") -(defun tramp-expand-args (vec parameter default &rest spec-list) +(defun tramp-expand-args (vec parameter &optional default &rest spec-list) "Expand login arguments as given by PARAMETER in `tramp-methods'. PARAMETER is a symbol like `tramp-login-args', denoting a list of list of strings from `tramp-methods', containing %-sequences for @@ -5317,12 +5348,15 @@ a connection-local variable." (setq spec-list (cddr spec-list))) (setq spec (apply #'format-spec-make extra-spec-list)) ;; Expand format spec. - (flatten-tree - (mapcar - (lambda (x) - (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) - (unless (member "" x) x)) - args)))) + (cond + ((consp args) + (flatten-tree + (mapcar + (lambda (x) + (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) + (unless (member "" x) x)) + args))) + (args (tramp-format-spec args spec))))) (defun tramp-post-process-creation (proc vec) "Apply actions after creation of process PROC." @@ -5444,8 +5478,7 @@ processes." (tramp-get-method-parameter v 'tramp-direct-async) `(,(string-join command " "))) command)) - (login-program - (tramp-get-method-parameter v 'tramp-login-program)) + (login-program (tramp-expand-args v 'tramp-login-program)) ;; We don't create the temporary file. In fact, it is just ;; a prefix for the ControlPath option of ssh; the real ;; temporary file has another name, and it is created and @@ -5487,7 +5520,7 @@ processes." v 'tramp-login-args nil ?h (or host "") ?u (or user "") ?p (or port "") ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) - ?d (or device "") ?a (or pta "") ?l "")))) + ?w "" ?d (or device "") ?a (or pta "") ?l "")))) ;; Suppress `internal-default-process-sentinel', which is set ;; when :sentinel is nil. (Bug#71049) p (make-process diff --git a/lisp/obsolete/linum.el b/lisp/obsolete/linum.el index 5a0a67ebff0..9b0efaf223a 100644 --- a/lisp/obsolete/linum.el +++ b/lisp/obsolete/linum.el @@ -129,6 +129,7 @@ Linum mode is a buffer-local minor mode." ;; Note that nowadays, this actually doesn't show line ;; numbers in client frames at all, because we visit the ;; file before creating the client frame. See bug#35726. + ;; Use `frame-initial-p'? (and (daemonp) (eq (selected-frame) terminal-frame))) (linum-mode 1))) diff --git a/lisp/outline.el b/lisp/outline.el index 4fb953b0f7c..ea66ee5c8e9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -326,10 +326,10 @@ non-nil and point is located on the heading line.") (defcustom outline-minor-mode-use-buttons nil "Whether to display clickable buttons on the headings. These buttons can be used to hide and show the body under the heading. -When the value is `insert', additional placeholders for buttons are +When the value is \\+`insert', additional placeholders for buttons are inserted to the buffer, so buttons are not only clickable, but also typing `RET' on them can hide and show the body. -Using the value `insert' is not recommended in editable +Using the value \\+`insert' is not recommended in editable buffers because it modifies them. When the value is `in-margins', then clickable buttons are displayed in the margins before the headings. @@ -513,7 +513,7 @@ font-lock faces defined by the major mode. Thus, a non-nil value will work well only when there's no such conflict. If the value is t, use outline faces only if there are no major mode's font-lock faces on headings. When `override', completely overwrite major -mode's font-lock faces with outline faces. When `append', try to append +mode's font-lock faces with outline faces. When \\+`append', try to append outline font-lock faces to those of major mode." :type '(choice (const :tag "Do not use outline font-lock highlighting" nil) (const :tag "Overwrite major mode font-lock faces" override) diff --git a/lisp/paren.el b/lisp/paren.el index 1ab3f9a32cf..10c72dadc79 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -434,9 +434,10 @@ It is the default value of `show-paren-data-function'." (overlay-put show-paren--context-overlay 'priority show-paren-priority) (overlay-put show-paren--context-overlay - 'face `(:box - ( :line-width (1 . -1) - :color ,(face-attribute 'shadow :foreground)))) + 'face `( :inherit default + :box + ( :line-width (1 . -1) + :color ,(face-attribute 'shadow :foreground)))) (add-hook 'post-command-hook #'show-paren--delete-context-overlay nil 'local)) diff --git a/lisp/printing.el b/lisp/printing.el index b6be982f5cb..3f31472d176 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1431,7 +1431,7 @@ COMMAND Name of the program for printing a text file. On MS-DOS and specially, using NAME as the destination for output; any other program is treated like `lpr' except that an explicit filename is given as the last argument. - If COMMAND is nil, it's used the default printing program: + If COMMAND is nil, it stands for the default printing program: `print' for Windows system, `lp' for lp system and `lpr' for all other systems. See also `pr-path-alist'. Examples: @@ -1506,7 +1506,10 @@ Useful links: :type '(repeat (list :tag "Text Printer" (symbol :tag "Printer Symbol Name") - (string :tag "Printer Command") + (choice :menu-tag "Printer Command" + :tag "Printer Command" + (const :tag "Default print command" nil) + (string :tag "Explicit print command")) (repeat :tag "Printer Switches" (sexp :tag "Switch" :value "")) (choice :menu-tag "Printer Name" @@ -1577,7 +1580,7 @@ COMMAND Name of the program for printing a PostScript file. On MS-DOS specially, using NAME as the destination for output; any other program is treated like `lpr' except that an explicit filename is given as the last argument. - If COMMAND is nil, it's used the default printing program: + If COMMAND is nil, it stands for the default printing program: `print' for Windows system, `lp' for lp system and `lpr' for all other systems. See also `pr-path-alist'. Examples: @@ -1756,7 +1759,10 @@ Useful links: (list :tag "PostScript Printer" (symbol :tag "Printer Symbol Name") - (string :tag "Printer Command") + (choice :menu-tag "Printer Command" + :tag "Printer Command" + (const :tag "Default print command" nil) + (string :tag "Explicit print command")) (repeat :tag "Printer Switches" (sexp :tag "Switch" :value "")) (choice :menu-tag "Printer Name Switch" diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 87273ec91c0..be67e8db78f 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1567,6 +1567,7 @@ recommended to enable `electric-pair-mode' with this mode." (funcall c-ts-mode-indent-style) (c-ts-mode--simple-indent-rules 'cpp c-ts-mode-indent-style))) + (setq-local editorconfig-indent-size-vars '(c-ts-indent-offset)) ;; Font-lock. (setq-local treesit-font-lock-settings diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 27b2e59409d..07974906a90 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -991,6 +991,8 @@ You might also use mode hooks to specify it in certain modes, like this: (file-name-sans-extension buffer-file-name)))))))) It's often useful to leave a space at the end of the value." + :group 'compilation + :initialize #'custom-initialize-delay :type 'string) ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (if (boundp 'compilation-read-command) compilation-read-command t)))) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a4f076a6197..0e1ed519b43 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. -;; Version: 1.21 +;; Version: 1.23 ;; Author: JoΓ£o TΓ‘vora ;; Maintainer: JoΓ£o TΓ‘vora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.2") (jsonrpc "1.0.26") (project "0.11.2") (seq "2.23") (xref "1.6.2")) +;; Package-Requires: ((emacs "26.3") (eldoc "1.16.0") (external-completion "0.1") (flymake "1.4.5") (jsonrpc "1.0.28") (project "0.11.2") (seq "2.23") (xref "1.7.0")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -2710,10 +2710,11 @@ still unanswered LSP requests to the server\n")))) (defconst eglot-mode-line-progress '(:eval - (when-let ((server (eglot-current-server))) + (when-let ((s (eglot-current-server))) (cl-loop - for pr hash-values of (eglot--progress-reporters server) - when (eq (car pr) 'eglot--mode-line-reporter) + for pr in (cl-delete 'eglot--mode-line-reporter + (hash-table-values (eglot--progress-reporters s)) + :key #'car :test-not #'eq) for v = (nth 4 pr) when v sum 1 into n and sum v into acc collect (format "(%s) %s %s" (nth 1 pr) (nth 2 pr) (nth 3 pr)) @@ -4092,7 +4093,7 @@ for which LSP on-type-formatting should be requested." parameter ;; ...perhaps highlight it in the formals list (when (eq i active-param) - (save-excursion ;; FIXME: Sink into the `if' or hoist out of loop? + (save-excursion (goto-char (point-min)) (pcase-let ((`(,beg ,end) @@ -4100,8 +4101,7 @@ for which LSP on-type-formatting should be requested." (let ((case-fold-search nil)) (and (search-forward parlabel (line-end-position) t) (list (match-beginning 0) (match-end 0)))) - (list (+ (point-min) (aref parlabel 0)) - (+ (point-min) (aref parlabel 1)))))) + (list (1+ (aref parlabel 0)) (1+ (aref parlabel 1)))))) (if (and beg end) (add-face-text-property beg end diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4e828eba8a0..f62f9f5ce3c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1330,6 +1330,8 @@ Interactively, with a prefix arg, FORCE is t." (buffer (current-buffer))) (cl-labels ((visible-buffer-window () + ;; This can use `frame-initial-p' once + ;; we can assume Emacs 31 or later. (and (or (not (daemonp)) (not (eq (selected-frame) terminal-frame))) (get-buffer-window (current-buffer)))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 128952a2dd4..72a05a082bb 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1089,11 +1089,15 @@ list is empty)." match) (while (setq match (text-property-search-forward 'compilation-annotation)) (add-text-properties (prop-match-beginning match) (prop-match-end match) - '(read-only t))) + '(read-only t front-sticky t))) (goto-char (point-min)) (while (setq match (text-property-search-forward 'compilation-message)) (add-text-properties (prop-match-beginning match) (prop-match-end match) - '(read-only t occur-prefix t)) + '( read-only t occur-prefix t + ;; Allow insertion of text right + ;; after prefix, but not before. + front-sticky t + rear-nonsticky t)) (let ((loc (compilation--message->loc (prop-match-value match))) m) ;; Update the markers if necessary. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index ebf8df9f795..2c21d08d448 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -73,6 +73,7 @@ (require 'cl-lib) (require 'ring) (require 'project) +(require 'text-property-search) (eval-and-compile (when (version< emacs-version "28.0.60") @@ -628,7 +629,7 @@ If SELECT is non-nil, select the target window." (run-hooks 'xref-after-jump-hook))) -;;; XREF buffer (part of the UI) +;;; Xref buffer (part of the UI) ;; The xref buffer is used to display a set of xrefs. (defconst xref-buffer-name "*xref*" @@ -1004,12 +1005,13 @@ point." (define-key map (kbd ".") #'xref-next-line) (define-key map (kbd ",") #'xref-prev-line) (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) + (define-key map (kbd "e") #'xref-change-to-xref-edit-mode) map)) (declare-function outline-search-text-property "outline" (property &optional value bound move backward looking-at)) -(define-derived-mode xref--xref-buffer-mode special-mode "XREF" +(define-derived-mode xref--xref-buffer-mode special-mode "Xref" "Mode for displaying cross-references." (setq buffer-read-only t) (setq next-error-function #'xref--next-error-function) @@ -1039,7 +1041,7 @@ point." (define-derived-mode xref--transient-buffer-mode xref--xref-buffer-mode - "XREF Transient.") + "Xref Transient") (defun xref--imenu-prev-index-position () "Move point to previous line in `xref' buffer. @@ -1470,6 +1472,106 @@ between them by typing in the minibuffer with completion." (define-obsolete-function-alias 'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1") + +(defun xref-edit--prepare-buffer () + "Mark relevant regions read-only, and add relevant occur text-properties." + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + match) + (while (setq match (text-property-search-forward 'xref-group)) + (add-text-properties (prop-match-beginning match) (prop-match-end match) + '( read-only t + front-sticky t))) + (goto-char (point-min)) + (while (setq match (text-property-search-forward 'xref-item)) + (let ((line-number-end (save-excursion + (forward-line 0) + (and (looking-at " *[0-9]+:") + (match-end 0))))) + (when line-number-end + (add-text-properties (prop-match-beginning match) line-number-end + '( read-only t + occur-prefix t + ;; Allow insertion of text right + ;; after prefix, but not before. + front-sticky t + rear-nonsticky t)))))))) + +(defvar xref-edit-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'xref-edit-save-changes) + (define-key map (kbd "RET") #'xref-goto-xref) + (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) + (define-key map (kbd "C-o") #'xref-show-location-at-point) + map) + "Keymap for `xref-edit-mode'.") + +(defvar xref-edit-mode-hook nil + "Hooks run when changing to Xref-Edit mode.") + +(defun xref-edit-mode () + "Major mode for editing *xref* buffers. +In this mode, changes to the *xref* buffer are applied to the +originating files. +\\ +Type \\[xref-edit-save-changes] to exit Xref-Edit mode, return to Xref +mode. + +The only editable texts in an Xref-Edit buffer are the match results." + (interactive) + (error "This mode can be enabled only by `xref-change-to-xref-edit-mode'")) +(put 'xref-edit-mode 'mode-class 'special) + +(defun xref-change-to-xref-edit-mode () + "Switch to `xref-edit-mode' to edit *xref* buffer." + (interactive) + (unless (derived-mode-p 'xref--xref-buffer-mode) + (error "Not an Xref buffer")) + (use-local-map xref-edit-mode-map) + (xref-edit--prepare-buffer) + (setq buffer-read-only nil) + (setq major-mode 'xref-edit-mode) + (setq mode-name "Xref-Edit") + (buffer-enable-undo) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (add-hook 'before-change-functions #'xref-edit--before-change-function nil t) + (add-hook 'after-change-functions #'occur-after-change-function nil t) + (run-mode-hooks 'xref-edit-mode-hook) + (message (substitute-command-keys + "Editing: Type \\[xref-edit-save-changes] to return to Xref mode"))) + +(defun xref-edit-save-changes () + "Switch back to Xref mode." + (interactive) + (unless (derived-mode-p 'xref-edit-mode) + (error "Not a Xref-Edit buffer")) + (remove-hook 'before-change-functions #'xref-edit--before-change-function t) + (remove-hook 'after-change-functions #'occur-after-change-function t) + (use-local-map xref--xref-buffer-mode-map) + (setq buffer-read-only t) + (setq major-mode 'xref--xref-buffer-mode) + (setq mode-name "Xref") + (force-mode-line-update) + (buffer-disable-undo) + (setq buffer-undo-list t) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(occur-target nil occur-prefix nil))) + (message "Switching to Xref mode")) + +(defun xref-edit--before-change-function (_beg _end) + (when (and (not (get-text-property (pos-bol) 'occur-target)) + (get-text-property (pos-bol) 'occur-prefix)) + (let ((m (xref-location-marker (xref-item-location + (get-text-property (pos-bol) 'xref-item)))) + (inhibit-read-only t) + (inhibit-modification-hooks t) + (buffer-undo-list t)) + (add-text-properties (pos-bol) (pos-eol) + `(occur-target ((,m . ,m))))))) + (defcustom xref-show-xrefs-function 'xref--show-xref-buffer "Function to display a list of search results. diff --git a/lisp/server.el b/lisp/server.el index fcfc6c01972..f5dea9c590f 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -706,6 +706,7 @@ the `server-process' variable." ;; when we can't get user input, which may happen when ;; doing emacsclient --eval "(kill-emacs)" in daemon mode. (cond + ;; Use `frame-initial-p'? ((and (daemonp) (null (cdr (frame-list))) (eq (selected-frame) terminal-frame)) @@ -1429,6 +1430,7 @@ The following commands are accepted by the client: (or (eq use-current-frame 'always) ;; We can't use the Emacs daemon's ;; terminal frame. + ;; Use `frame-initial-p'? (not (and (daemonp) (null (cdr (frame-list))) (eq (selected-frame) @@ -1453,6 +1455,7 @@ The following commands are accepted by the client: ;; If there won't be a current frame to use, fall ;; back to trying to create a new one. ((and use-current-frame + ;; Use `frame-initial-p'? (daemonp) (null (cdr (frame-list))) (eq (selected-frame) terminal-frame) diff --git a/lisp/subr.el b/lisp/subr.el index a1d718ca5b7..b0e04bc5f99 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -160,6 +160,10 @@ of previous VARs. (push `(set-default ',(pop args) ,(pop args)) exps)) `(progn . ,(nreverse exps)))) +(defun set-local (variable value) + "Make VARIABLE buffer local and set it to VALUE." + (set (make-local-variable variable) value)) + (defmacro setq-local (&rest pairs) "Make each VARIABLE local to current buffer and set it to corresponding VALUE. @@ -181,7 +185,7 @@ In some corner cases you may need to resort to \(fn [VARIABLE VALUE]...)" (declare (debug setq)) (unless (evenp (length pairs)) - (error "PAIRS must have an even number of variable/value members")) + (signal 'wrong-number-of-arguments (list 'setq-local (length pairs)))) (let ((expr nil)) (while pairs (unless (symbolp (car pairs)) @@ -229,7 +233,7 @@ in order to restore the state of the local variables set via this macro. \(fn [VARIABLE VALUE]...)" (declare (debug setq)) (unless (evenp (length pairs)) - (error "PAIRS must have an even number of variable/value members")) + (signal 'wrong-number-of-arguments (list 'buffer-local-set-state (length pairs)))) (let ((vars nil) (tmp pairs)) (while tmp (push (car tmp) vars) (setq tmp (cddr tmp))) @@ -1226,8 +1230,13 @@ with (member-if (lambda (x) (foo (bar x))) items)" (declare (compiler-macro (lambda (_) - (let ((x (make-symbol "x"))) - `(drop-while (lambda (,x) (not (funcall ,pred ,x))) ,list))))) + (let* ((x (make-symbol "x")) + (f (and (not (internal--effect-free-fun-arg-p pred)) + (make-symbol "f"))) + (form `(drop-while (lambda (,x) + (not (funcall ,(or f pred) ,x))) + ,list))) + (if f `(let ((,f ,pred)) ,form) form))))) (drop-while (lambda (x) (not (funcall pred x))) list)) ;; This is good to have for improved readability in certain uses, but diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index ad749557987..3399e5ef93e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -292,6 +292,7 @@ a list of frames to update." (and (eq auto-resize-tab-bars 'grow-only) (> (frame-parameter frame 'tab-bar-lines) 1)) ;; Don't enable tab-bar in daemon's initial frame. + ;; Use `frame-initial-p'? (and (daemonp) (eq frame terminal-frame))) (set-frame-parameter frame 'tab-bar-lines (tab-bar--tab-bar-lines-for-frame frame))))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index a56fc018e18..355555df090 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2006-2026 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Maintainer: Simen HeggestΓΈyl +;; Maintainer: Simen HeggestΓΈyl ;; Keywords: hypermedia ;; This file is part of GNU Emacs. @@ -66,7 +66,7 @@ (defconst css-pseudo-class-ids '("active" "checked" "default" "disabled" "empty" "enabled" "first" - "first-child" "first-of-type" "focus" "focus-within" "hover" + "first-child" "first-of-type" "focus" "focus-within" "has" "hover" "in-range" "indeterminate" "invalid" "lang" "last-child" "last-of-type" "left" "link" "not" "nth-child" "nth-last-child" "nth-last-of-type" "nth-of-type" "only-child" "only-of-type" diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index a269cae0c9b..c5ae2a15557 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -390,6 +390,16 @@ which can be the value of the `face' text property." (list (list "x-color" (cadr face)))) ((and (listp face) (eq (car face) :background)) (list (list "x-bg-color" (cadr face)))) + ((and (listp face) (eq (car face) :underline)) + (list (list "underline"))) + ((and (listp face) + (eq (car face) :weight) + (eq (cadr face) 'bold)) + (list (list "bold"))) + ((and (listp face) + (eq (car face) :slant) + (memq (cadr face) '(italic oblique))) + (list (list "italic"))) ((listp face) (apply #'append (mapcar #'enriched-face-ans face))) ((let* ((fg (face-attribute face :foreground)) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 9445b4a6b9a..c1ccdf2ec5f 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1700,7 +1700,7 @@ and URL `https://rhodesmill.org/brandon/2012/one-sentence-per-line/'." (to (copy-marker (max from to) t)) pfx) (goto-char from) - (let ((fill-column (* 2 (point-max)))) ; Wide characters span up to two columns. + (let ((fill-column most-positive-fixnum)) (setq pfx (or (save-excursion (fill-region-as-paragraph-default (point) to diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index cc3eaf03e15..657d6bc466d 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -40,6 +40,7 @@ (require 'treesit) (require 'subr-x) (require 'outline) +(require 'seq) (treesit-declare-unavailable-functions) @@ -296,7 +297,12 @@ the same features enabled in MODE." (plist-get configs :simple-indent))) (setq treesit-range-settings (append treesit-range-settings - (plist-get configs :range))) + ;; Filter out function queries, because they are + ;; usually some hack and might escape the code block. + ;; Case in point: c-ts-mode's range setting. + (seq-filter (lambda (setting) + (not (functionp (car setting)))) + (plist-get configs :range)))) (setq-local indent-line-function #'treesit-indent) (setq-local indent-region-function #'treesit-indent-region))) diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index b7f72f2619c..671cf5a1547 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -53,7 +53,7 @@ with %, which are converted as follows: %H 24-hour clock hour %I 12-hour clock hour %m month number %M minute -%p meridian indicator: `AM', `PM' +%p meridiem indicator: `AM', `PM' %S seconds %w day number of week, Sunday is 0 %Y 4-digit year %y 2-digit year @@ -1039,39 +1039,45 @@ This is an internal function called by `time-stamp'." offset-secs) "Format a time offset according to a %z variation. -With no flags, the output includes hours and minutes: +-HHMM -unless there is a non-zero seconds part, in which case the seconds -are included: +-HHMMSS - -FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the -output may be limited to hours if minutes and seconds are zero. - -FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil, -seconds must be output, so that any padding can be spaces only. - -FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil, -padding to the requested FIELD-WIDTH (if any) is done by adding -00 seconds before padding with spaces. - -COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or -two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS). -Three colons outputs only hours if minutes and seconds are zero and -includes colon separators if minutes and seconds are output. - -FIELD-WIDTH is a whole number giving the minimum number of characters -in the output; 0 specifies no minimum. Additional characters will be -added on the right if necessary. The added characters will be spaces -unless FLAG-PAD-ZEROS-FIRST is non-nil. - -OFFSET-SECS is the time zone offset (in seconds east of UTC) to be -formatted according to the preceding parameters. +Format parts FLAG-MINIMIZE, FLAG-PAD-SPACES-ONLY, +FLAG-PAD-ZEROS-FIRST, COLON-COUNT, and FIELD-WIDTH +are used to format time zone offset OFFSET-SECS. This is an internal function used by `time-stamp'." + ;; Callers of this function need to have already parsed the %z ;; format string; this function accepts just the parts of the format. ;; `time-stamp-string-preprocess' is the full-fledged parser normally ;; used. The unit test (in time-stamp-tests.el) defines the simpler ;; parser `format-time-offset'. + + ;; OFFSET-SECS is the time zone offset (in seconds east of UTC) to be + ;; formatted according to the following parameters. + + ;; FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the + ;; output may be limited to hours if minutes and seconds are zero. + + ;; FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil, + ;; seconds must be output, so that any padding can be spaces only. + + ;; FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil, + ;; padding to the requested FIELD-WIDTH (if any) is done by adding + ;; 00 seconds before padding with spaces. + + ;; COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or + ;; two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS). + ;; Three colons outputs only hours if minutes and seconds are zero and + ;; includes colon separators if minutes and seconds are output. + + ;; FIELD-WIDTH is a whole number giving the minimum number of characters + ;; in the output; 0 specifies no minimum. Additional characters will be + ;; added on the right if necessary. The added characters will be spaces + ;; unless FLAG-PAD-ZEROS-FIRST is non-nil. + + ;; With no flags set, the output includes hours and minutes: +-HHMM + ;; unless there is a non-zero seconds part, in which case the seconds + ;; are included: +-HHMMSS + (let ((hrs (/ (abs offset-secs) 3600)) (mins (/ (% (abs offset-secs) 3600) 60)) (secs (% (abs offset-secs) 60)) diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 73df2e0bca8..d9b1f50b40c 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -330,7 +330,7 @@ holds a keymap." :vert-only t) (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil :label "Open" :vert-only t) - (tool-bar-add-item-from-menu 'dired "diropen" nil :vert-only t) + (tool-bar-add-item-from-menu 'dired-from-menubar "diropen" nil :vert-only t) (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) (tool-bar-add-item-from-menu 'save-buffer "save" nil :label "Save") diff --git a/lisp/treesit.el b/lisp/treesit.el index 7d6113e3249..14c05b0dd16 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -753,10 +753,10 @@ that encompasses the region between START and END." (numberp (cdr range-offset))) (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) (setq offset range-offset))) - (:range-fn (let ((range-fn (pop query-specs))) - (unless (functionp range-fn) - (signal 'treesit-error (list "Value of :range-fn option should be a function" range-fn))) - (setq range-fn range-fn))) + (:range-fn (let ((fn (pop query-specs))) + (unless (functionp fn) + (signal 'treesit-error (list "Value of :range-fn option should be a function" fn))) + (setq range-fn fn))) (query (if (functionp query) (push (list query nil nil) result) (when (null embed) @@ -1423,22 +1423,31 @@ LANGUAGE is the language of QUERY.") (setf (nth 1 new-setting) t) new-setting)) -(defun treesit--font-lock-level-setter (sym val) +(defun treesit--font-lock-level-setter (sym val &optional buffer-local) "Custom setter for `treesit-font-lock-level'. Set the default value of SYM to VAL, recompute fontification features and refontify for every buffer where tree-sitter-based -fontification is enabled." - (set-default sym val) - (when (treesit-available-p) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - ;; FIXME: This doesn't re-run major mode hooks, meaning any - ;; customization done in major mode hooks (e.g., with - ;; `treesit-font-lock-recompute-features') is lost. - (when treesit-font-lock-settings - (treesit-font-lock-recompute-features) - (treesit-font-lock-fontify-region - (point-min) (point-max))))))) +fontification is enabled. + +If optional BUFFER-LOCAL is non-nil, only affect the current buffer. +Set SYM buffer locally and refontify." + ;; FIXME: This doesn't re-run major mode hooks, meaning any + ;; customization done in major mode hooks (e.g., with + ;; `treesit-font-lock-recompute-features') may be overridden. + (cond (buffer-local + (set-local sym val) + (when (and (treesit-available-p) + treesit-font-lock-settings) + (treesit-font-lock-recompute-features) + (font-lock-flush))) + (t + (set-default sym val) + (when (treesit-available-p) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when treesit-font-lock-settings + (treesit-font-lock-recompute-features) + (font-lock-flush)))))))) (defcustom treesit-font-lock-level 3 "Decoration level to be used by tree-sitter fontifications. @@ -2050,9 +2059,8 @@ If LOUDLY is non-nil, display some debugging information." (pcase-let ((`(,max-depth ,max-width) (treesit-subtree-stat (treesit-buffer-root-node language)))) - (if (or (> max-depth 100) (> max-width 4000)) - (setq treesit--font-lock-fast-mode t) - (setq treesit--font-lock-fast-mode nil)))) + (setq treesit--font-lock-fast-mode + (or (> max-depth 100) (> max-width 4000))))) ;; Only activate if ENABLE flag is t. (when-let* @@ -5849,7 +5857,7 @@ language." "Pattern matching" (treesit-query-capture :no-eval (treesit-query-capture node '((identifier) @id "return" @ret)) - :eg-result-string "((id . #) (ret . #))") + :eg-result-string "((id . #) (ret . #))") (treesit-query-compile :no-eval (treesit-query-compile 'c '((identifier) @id "return" @ret)) :eg-result-string "#") diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 042733f4c61..2dcae7362b7 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -977,6 +977,7 @@ In the latter case, VC mode is deactivated for this buffer." noninteractive ;; Copied from server-start. Seems like there should ;; be a better way to ask "can we get user input?"... + ;; Use `frame-initial-p'? (and (daemonp) (null (cdr (frame-list))) (eq (selected-frame) terminal-frame)) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9eb88eb35d0..50a687fe16b 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -907,9 +907,9 @@ means that `whitespace-mode' is turned on for buffers in C and C++ modes only. Global `whitespace-mode' will not automatically turn on in internal -buffers (with name starting from space) and special buffers (with name -starting from \"*\"), except \"*scratch*\" buffer. Use -`whitespace-global-mode-buffers' to customize this behavior." +buffers (whose names start with a space) and special buffers (whose +names start with \"*\"), with the exception of the \"*scratch*\" buffer. +Use `whitespace-global-mode-buffers' to customize this behavior." :type '(choice :tag "Global Modes" (const :tag "None" nil) (const :tag "All" t) @@ -919,11 +919,11 @@ starting from \"*\"), except \"*scratch*\" buffer. Use (repeat :inline t (symbol :tag "Mode"))))) -(defcustom whitespace-global-mode-buffers (list (regexp-quote "*scratch*")) +(defcustom whitespace-global-mode-buffers (list (rx bos "*scratch*" eos)) "Buffer name regexps where global `whitespace-mode' can be auto-enabled. The value is a list of regexps. Set this custom option when you need -`whitespace-mode' in special buffers like *Org Src*." - :type '(list (regexp :tag "Regexp matching buffer name")) +`whitespace-mode' in special buffers like \"*Org Src*\"." + :type '(repeat (regexp :tag "Regexp matching buffer name")) :version "31.1") (defcustom whitespace-action nil @@ -1049,14 +1049,13 @@ See also `whitespace-newline' and `whitespace-display-mappings'." ;; ...we have a display (not running a batch job) (not noninteractive) ;; ...the buffer is not internal (name starts with a space) - (not (eq (aref (buffer-name) 0) ?\ )) + (not (eq (aref (buffer-name) 0) ?\s)) ;; ...the buffer is not special (name starts with *) (or (not (eq (aref (buffer-name) 0) ?*)) - ;; except the scratch buffer. - (seq-find - (lambda (re) - (string-match-p re (buffer-name))) - whitespace-global-mode-buffers)))) + ;; except, e.g., the scratch buffer. + (any (lambda (re) + (string-match-p re (buffer-name))) + whitespace-global-mode-buffers)))) "Predicate to decide which buffers obey `global-whitespace-mode'. This function is called with no argument and should return non-nil if the current buffer should obey `global-whitespace-mode'. diff --git a/lisp/window.el b/lisp/window.el index 1f7ae726f49..bd0653fe0d4 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1010,6 +1010,14 @@ and may be called only if no window on SIDE exists yet." (cons `(dedicated . ,(or display-buffer-mark-dedicated 'side)) alist)))) (when window + ;; Protect the sibling (the main-window group) from recombination. + ;; Without this, deleting a side window can flatten the group into + ;; the root, causing subsequent side windows on other sides to be + ;; placed incorrectly (Bug#80665). + (when-let* ((sibling (or (window-prev-sibling window) + (window-next-sibling window))) + ((window-child sibling))) + (set-window-combination-limit sibling t)) ;; Initialize `window-side' parameter of new window to SIDE and ;; make that parameter persistent. (set-window-parameter window 'window-side side) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 67c475d563a..b93d914380f 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -509,16 +509,14 @@ enable, ?l to disable)." "Enable xterm mouse tracking on TERMINAL." (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) ;; Avoid the initial terminal which is not a termcap device. - ;; FIXME: is there more elegant way to detect the initial - ;; terminal? - (not (string= (terminal-name terminal) "initial_terminal"))) + (not (frame-initial-p terminal))) (unless (terminal-parameter terminal 'xterm-mouse-mode) ;; Simulate selecting a terminal by selecting one of its frames ;; so that we can set the terminal-local `input-decode-map'. ;; Use the tty-top-frame to avoid accidentally making an invisible ;; child frame visible by selecting it (bug#79960). - ;; The test for match mode is here because xt-mouse-tests run in - ;; match mode, and there is no top-frame in that case. + ;; The test for batch mode is here because xt-mouse-tests run in + ;; batch mode, and there is no top-frame in that case. (with-selected-frame (if noninteractive (car (frame-list)) (tty-top-frame terminal)) diff --git a/src/bidi.c b/src/bidi.c index f4bca186177..9cf53787c4b 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -367,6 +367,8 @@ bidi_isolate_fmt_char (bidi_type_t ch_type) return (ch_type == LRI || ch_type == RLI || ch_type == PDI || ch_type == FSI); } +static void bidi_initialize (void); + /* Return the mirrored character of C, if it has one. If C has no mirrored counterpart, return C. Note: The conditions in UAX#9 clause L4 regarding the surrounding @@ -381,6 +383,14 @@ bidi_mirror_char (int c) if (c < 0 || c > MAX_CHAR) emacs_abort (); + /* We can be called at the very beginning of init_iterator, via + produce_special_glyphs, and the first such call in a session might + happen when the bidi-mirroring table was not yet initialized. Make + sure we do this now. */ + if (!CHAR_TABLE_P (bidi_mirror_table) + && !bidi_initialized) + bidi_initialize (); + val = CHAR_TABLE_REF (bidi_mirror_table, c); if (FIXNUMP (val)) { diff --git a/src/charset.c b/src/charset.c index 041f350cf8e..524966d5fbc 100644 --- a/src/charset.c +++ b/src/charset.c @@ -799,7 +799,7 @@ Optional 4th and 5th arguments FROM-CODE and TO-CODE specify the range of code points (in CHARSET) of target characters on which to map the FUNCTION. Note that these are not character codes, but code points of CHARSET; for the difference see `decode-char' and -`list-charset-chars'. If FROM-CODE is nil or imitted, it stands for +`list-charset-chars'. If FROM-CODE is nil or omitted, it stands for the first code point of CHARSET; if TO-CODE is nil or omitted, it stands for the last code point of CHARSET. @@ -840,7 +840,7 @@ TO-CODE, which are CHARSET code points. */) /* Define a charset according to the arguments. The Nth argument is the Nth attribute of the charset (the last attribute `charset-id' is not included). See the docstring of `define-charset' for the - detail. */ + details. */ DEFUN ("define-charset-internal", Fdefine_charset_internal, Sdefine_charset_internal, charset_arg_max, MANY, 0, @@ -1530,7 +1530,7 @@ BEG and END are buffer positions. Optional arg TABLE if non-nil is a translation table to look up. If the current buffer is unibyte, the returned list may contain -only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) +only `ascii' and `eight-bit'. */) (Lisp_Object beg, Lisp_Object end, Lisp_Object table) { Lisp_Object charsets; @@ -1581,7 +1581,7 @@ DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string, Optional arg TABLE if non-nil is a translation table to look up. If STR is unibyte, the returned list may contain -only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) +only `ascii' and `eight-bit'. */) (Lisp_Object str, Lisp_Object table) { CHECK_STRING (str); @@ -2036,7 +2036,7 @@ ASCII characters are an exception: for them, this function always returns `ascii'. If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets from which to find the charset. It may also be a coding system. In -that case, find the charset from what supported by that coding system. */) +that case, find the charset in those supported by that coding system. */) (Lisp_Object ch, Lisp_Object restriction) { struct charset *charset; diff --git a/src/chartab.c b/src/chartab.c index 3076f72c06e..7d2710f20a3 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -78,7 +78,7 @@ sub_char_table_ref_and_range (Lisp_Object, int, int *, int *, /* Nonzero iff OBJ is a string representing uniprop values of 128 succeeding characters (the bottom level of a char-table) by a compressed format. We are sure that no property value has a string - starting with '\001' nor '\002'. */ + starting with '\001' or '\002'. */ #define UNIPROP_COMPRESSED_FORM_P(OBJ) \ (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) diff --git a/src/dispnew.c b/src/dispnew.c index 15d3c2a599a..45211b9d2e9 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6826,8 +6826,7 @@ FILE = nil means just close any termscript file currently open. */) { struct tty_display_info *tty; - if (! FRAME_TERMCAP_P (SELECTED_FRAME ()) - && ! FRAME_MSDOS_P (SELECTED_FRAME ())) + if (!is_tty_frame (SELECTED_FRAME ())) error ("Current frame is not on a tty device"); tty = CURTTY (); @@ -7394,7 +7393,7 @@ init_display_interactive (void) t = init_tty (0, terminal_type, 1); /* Errors are fatal. */ /* Convert the initial frame to use the new display. */ - if (f->output_method != output_initial) + if (!FRAME_INITIAL_P (f)) emacs_abort (); f->output_method = t->type; f->terminal = t; @@ -7404,7 +7403,7 @@ init_display_interactive (void) f->output_data.tty = &the_only_tty_output; f->output_data.tty->display_info = &the_only_display_info; #else - if (f->output_method == output_termcap) + if (FRAME_TERMCAP_P (f)) create_tty_output (f); #endif t->display_info.tty->top_frame = selected_frame; diff --git a/src/dosfns.c b/src/dosfns.c index 414cc550510..07d553b0d78 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -681,8 +681,7 @@ dos_cleanup (void) { struct frame *sf = XFRAME (selected_frame); - if (FRAME_LIVE_P (sf) - && (FRAME_MSDOS_P (sf) || FRAME_TERMCAP_P (sf))) + if (FRAME_LIVE_P (sf) && is_tty_frame (sf)) { tty = CURTTY (); if (tty->termscript) diff --git a/src/fileio.c b/src/fileio.c index 2d62bb21c17..cf77bfec695 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -774,6 +774,9 @@ Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs working directory. If TEXT is a string, insert it into the newly created file. +On Posix systems, the file/directory is created with access mode bits +that limit access to the current user. + Signal an error if the file could not be created. This function does not grok magic file names. */) diff --git a/src/frame.c b/src/frame.c index 20481c230d1..2475eb84df3 100644 --- a/src/frame.c +++ b/src/frame.c @@ -214,7 +214,7 @@ frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter) && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) || (!horizontal && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) - || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)))); + || is_tty_frame (f)))); } @@ -349,8 +349,6 @@ If FRAME is nil, use the selected frame. Return nil if the id has not been set. */) (Lisp_Object frame) { - if (NILP (frame)) - frame = selected_frame; struct frame *f = decode_live_frame (frame); if (f->id == 0) return Qnil; @@ -562,7 +560,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, /* Don't allow too small height of text-mode frames, or else cm.c might abort in cmcheckmagic. */ - if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) && NILP (horizontal)) + if (is_tty_frame (f) && NILP (horizontal)) { int min_height = (FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f) + FRAME_WANTS_MODELINE_P (f) @@ -1573,7 +1571,7 @@ make_terminal_frame (struct terminal *terminal, Lisp_Object parent, f->output_data.tty->display_info = &the_only_display_info; if (!inhibit_window_system && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)) - || XFRAME (selected_frame)->output_method == output_msdos_raw)) + || FRAME_MSDOS_P (XFRAME (selected_frame)))) f->output_method = output_msdos_raw; else f->output_method = output_termcap; @@ -1763,13 +1761,12 @@ affects all frames on the same terminal device. */) struct frame *sf = SELECTED_FRAME (); #ifdef MSDOS - if (sf->output_method != output_msdos_raw - && sf->output_method != output_termcap) + if (!is_tty_frame (sf)) emacs_abort (); #else /* not MSDOS */ #ifdef WINDOWSNT /* This should work now! */ - if (sf->output_method != output_termcap) + if (!FRAME_TERMCAP_P (sf)) error ("Not using an ASCII terminal now; cannot make a new ASCII frame"); #endif #endif /* not MSDOS */ @@ -1986,7 +1983,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor if (!for_deletion && FRAME_HAS_MINIBUF_P (sf)) resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1); - if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) + if (is_tty_frame (f)) { struct tty_display_info *tty = FRAME_TTY (f); Lisp_Object top_frame = tty->top_frame; @@ -2800,7 +2797,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) && FRAME_LIVE_P (f1) && !FRAME_TOOLTIP_P (f1)) { - if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1)) + if (is_tty_frame (f1)) { Lisp_Object top_frame = FRAME_TTY (f1)->top_frame; diff --git a/src/keyboard.c b/src/keyboard.c index c63440059e5..3da42d61bad 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2453,7 +2453,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, #else struct frame *frame = XFRAME (selected_frame); struct terminal *terminal = frame->terminal; - if (!((FRAME_TERMCAP_P (frame) || FRAME_MSDOS_P (frame)) + if (!(is_tty_frame (frame) /* Don't apply decoding if we're just reading a raw event (e.g. reading bytes sent by the xterm to specify the position of a mouse click). */ @@ -13032,7 +13032,7 @@ The elements of this list correspond to the arguments of Lisp_Object interrupt = interrupt_input ? Qt : Qnil; Lisp_Object flow, meta; - if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)) + if (is_tty_frame (sf)) { flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil; meta = (FRAME_TTY (sf)->meta_key == 2 diff --git a/src/lisp.h b/src/lisp.h index 05ea874a4bb..2081a45458f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5754,7 +5754,7 @@ extern void *w32_daemon_event; /* True if handling a fatal error already. */ extern bool fatal_error_in_progress; -/* True means don't do use window-system-specific display code. */ +/* True means don't use window-system-specific display code. */ extern bool inhibit_window_system; /* True means that a filter or a sentinel is running. */ extern bool running_asynch_code; diff --git a/src/menu.c b/src/menu.c index 747a87e9f3c..cb474a1b53e 100644 --- a/src/menu.c +++ b/src/menu.c @@ -405,8 +405,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk } } - if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)) - || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame))) + if (is_tty_frame (XFRAME (Vmenu_updating_frame)) && !NILP (map)) /* Indicate visually that this is a submenu. */ { diff --git a/src/msdos.c b/src/msdos.c index 7e89d549706..4d111b30969 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1787,7 +1787,7 @@ internal_terminal_init (void) #endif /* If this is the initial terminal, we are done here. */ - if (sf->output_method == output_initial) + if (FRAME_INITIAL_P (sf)) return; internal_terminal diff --git a/src/nsterm.m b/src/nsterm.m index 118463a13c9..e186c16e725 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -72,6 +72,12 @@ Updated by Christian Limpach (chris@nice.ch) #include "macfont.h" #include #include +/* ApplicationServices provides the macOS accessibility Zoom API + UAZoomEnabled and UAZoomChangeFocus (UniversalAccess framework). + Carbon.h already pulls in ApplicationServices on most SDK versions, + but the explicit import makes the dependency visible and guards + against SDK changes. */ +#import #endif static EmacsMenu *dockMenu; @@ -1086,6 +1092,126 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) [view lockFocus]; } +/* -------------------------------------------------------------------------- + macOS Accessibility Zoom Support + -------------------------------------------------------------------------- */ +#ifdef NS_IMPL_COCOA + +static BOOL ns_is_UAZoomEnabled = NO; +static unsigned long ns_UAZoomEnabled_last_called_time_ns = 0; +static const unsigned long NS_UAZOOMENABLED_CACHE_INTERVAL_NS = + (unsigned long)(500 * NSEC_PER_MSEC); /* 500ms. */ +static NSTimeInterval NS_UAZOOMENABLED_DEFER_INTERVAL_SECS = 0.2; /* 200ms. */ +static NSTimer *ns_deferred_UAZoomChangeFocus_timer = nil; + +static BOOL +ns_ua_zoom_enabled_p (void) +/* -------------------------------------------------------------------------- + Return the cached result of UAZoomEnabled. Refresh the cache every + NS_UAZOOMENABLED_CACHE_INTERVAL_NS nanoseconds. + + We cache the result to avoid the macOS Mach IPC Accessibility Server + round trip cost on every Emacs cursor update. Since enabling Zoom + requires an explicit user UI action that takes real user time, the + cache TTL should be invisible to the user. + + Use clock_gettime_nsec_np not CFAbsoluteTimeGetCurrent which depends + on the wall clock which can be reset by the user or by NTP. + + Main-thread-only and called from ns_update_end, below. + -------------------------------------------------------------------------- */ +{ + /* User-space equivalent to mach_absolute_time. */ + unsigned long now_ns = clock_gettime_nsec_np (CLOCK_UPTIME_RAW); + if (now_ns - ns_UAZoomEnabled_last_called_time_ns + > NS_UAZOOMENABLED_CACHE_INTERVAL_NS) + { + ns_is_UAZoomEnabled = UAZoomEnabled (); + ns_UAZoomEnabled_last_called_time_ns = now_ns; + } + return ns_is_UAZoomEnabled; +} + +static inline CGRect +ns_cg_rect_flip_y (CGRect r) +/* -------------------------------------------------------------------------- + Convert a CGRect from Cocoa screen coordinates (origin at bottom-left + of the primary display) to CoreGraphics coordinates (origin at + top-left of the primary display). CoreGraphics defines its + coordinate origin at the top-left corner of the primary display and + all screens share this global coordinate space, so the flip always + uses the primary display height regardless of which screen R is on. + -------------------------------------------------------------------------- */ +{ + CGDirectDisplayID mainID = CGMainDisplayID (); + if (mainID == kCGNullDirectDisplay) + return r; + CGFloat primaryH = CGDisplayBounds (mainID).size.height; + if (primaryH <= 0) + return r; + r.origin.y = primaryH - r.origin.y - r.size.height; + return r; +} + +/* Cache cursor rects to call UAZoomChangeFocus only when the cursor + position has changed, not merely when the cursor is blinking. + See ns_draw_window_cursor and ns_update_end. */ +static NSRect ns_UAZoom_cursor_rect_new; +static NSRect ns_UAZoom_cursor_rect_old; + +/* Track Zoom state per display cycle. Update the macOS Zoom cursor + position when Zoom transitions to enabled. */ +static BOOL ns_update_was_UAZoomEnabled = NO; + +static void +ns_UAZoomChangeFocus (EmacsView *view, BOOL force) +/* -------------------------------------------------------------------------- + Advise macOS Accessibility Zoom UAZoomChangeFocus of a potentially + new cursor position. Force an updated position when Zoom transitions + to enabled, or when the frame gets focus. + -------------------------------------------------------------------------- */ +{ + if (ns_ua_zoom_enabled_p ()) + { + force = force || !ns_update_was_UAZoomEnabled; + ns_update_was_UAZoomEnabled = YES; + if (NSIsEmptyRect (ns_UAZoom_cursor_rect_new)) + return; + if (force || !NSEqualRects (ns_UAZoom_cursor_rect_new, + ns_UAZoom_cursor_rect_old)) + { + ns_UAZoom_cursor_rect_old = ns_UAZoom_cursor_rect_new; + NSRect windowRect = [view convertRect:ns_UAZoom_cursor_rect_new + toView:nil]; + NSRect screenRect = [[view window] convertRectToScreen:windowRect]; + CGRect cgRect = ns_cg_rect_flip_y (NSRectToCGRect (screenRect)); + /* Some versions of macOS can ignore tiny rects, so we + slightly expand a tiny one. Since we care mostly about its + origin, this should be innocuous. */ + cgRect.size.width = MAX (cgRect.size.width, 6); + cgRect.size.height = MAX (cgRect.size.height, 10); + if (force) + { + /* UAZoomChangeFocus needs old and new cursor positions to + be different, and also it sometimes needs a kick. In + both cases, we fake a cursor move followed by the real + cursor move. */ + CGRect cgRectJiggle = CGRectOffset (cgRect, 1.0, 1.0); + if (UAZoomChangeFocus (&cgRectJiggle, NULL, + kUAZoomFocusTypeInsertionPoint)) + NSLog (@"UAZoomChangeFocus jiggle failed"); + } + if (UAZoomChangeFocus (&cgRect, NULL, + kUAZoomFocusTypeInsertionPoint)) + NSLog (@"UAZoomChangeFocus failed"); + NSAccessibilityPostNotification + (view, NSAccessibilityFocusedUIElementChangedNotification); + } + } + else + ns_update_was_UAZoomEnabled = NO; +} +#endif /* NS_IMPL_COCOA */ static void ns_update_end (struct frame *f) @@ -1108,6 +1234,10 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) [[view window] flushWindow]; #endif +#ifdef NS_IMPL_COCOA + ns_UAZoomChangeFocus (view, false); +#endif + unblock_input (); ns_updating_frame = NULL; } @@ -3238,6 +3368,16 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. /* Prevent the cursor from being drawn outside the text area. */ r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); +#ifdef NS_IMPL_COCOA + /* Cache the cursor rect for macOS Accessibility Zoom integration (see + ns_update_end). Only store the rect for the active cursor --- + inactive windows must not overwrite the value because redisplay may + draw multiple windows per frame and the drawing order is not + guaranteed. */ + if (active_p) + ns_UAZoom_cursor_rect_new = r; +#endif + ns_focus (f, NULL, 0); NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; @@ -6384,6 +6524,14 @@ - (void)applicationDidFinishLaunching: (NSNotification *)notification } #endif +#ifdef NS_IMPL_COCOA + /* Is accessibility enabled for this process/bundle? */ + if (AXIsProcessTrusted()) + NSLog (@"Emacs is macOS AXIsProcessTrusted"); + else + NSLog (@"Emacs is not macOS AXIsProcessTrusted"); +#endif + ns_send_appdefined (-2); } @@ -7300,6 +7448,12 @@ - (NSRect) firstRectForCharacterRange: (NSRange) range return [self firstRectForCharacterRange: range]; } +- (NSRect)accessibilityFrame +{ + EmacsView *view = FRAME_NS_VIEW (*emacsframe); + return [[view window] convertRectToScreen: ns_UAZoom_cursor_rect_new]; +} + #endif /* NS_IMPL_COCOA */ /*********************************************************************** @@ -8257,12 +8411,48 @@ - (void)windowDidBecomeKey /* for direct calls */ ns_frame_rehighlight (*emacsframe); [self adjustEmacsFrameRect]; +#ifdef NS_IMPL_COCOA + EmacsView *view = FRAME_NS_VIEW (*emacsframe); + /* Make sure we have focus and the timer isn't already scheduled. */ + if (self.window.firstResponder == view + && !ns_deferred_UAZoomChangeFocus_timer) + { + /* Calls to ns_UAZoomChangeFocus are synchronous. We defer the + call to give macOS time to finish window compositing or the + calls can be silently ignored by the Zoom daemon and with no + errors reported. This also helps ensure ns_draw_window_cursor + has populated ns_UAZoom_cursor_rect_new. The 200 ms delay was + chosen as a balance between macOS headroom and user + perception. */ + ns_deferred_UAZoomChangeFocus_timer + = [[NSTimer + scheduledTimerWithTimeInterval: + NS_UAZOOMENABLED_DEFER_INTERVAL_SECS + target: self + selector: + @selector (deferred_UAZoomChangeFocus_handler:) + userInfo: 0 + repeats: NO] + retain]; + } +#endif + event.kind = FOCUS_IN_EVENT; XSETFRAME (event.frame_or_window, *emacsframe); kbd_buffer_store_event (&event); ns_send_appdefined (-1); // Kick main loop } +#ifdef NS_IMPL_COCOA +- (void)deferred_UAZoomChangeFocus_handler: (NSTimer *)timer +{ + EmacsView *view = FRAME_NS_VIEW (*emacsframe); + ns_UAZoomChangeFocus (view, true); + [ns_deferred_UAZoomChangeFocus_timer invalidate]; + [ns_deferred_UAZoomChangeFocus_timer release]; + ns_deferred_UAZoomChangeFocus_timer = nil; +} +#endif - (void)windowDidResignKey: (NSNotification *)notification /* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */ @@ -8365,6 +8555,13 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f FRAME_NS_VIEW (f) = self; *emacsframe = f; + +#ifdef NS_IMPL_COCOA + /* macOS Accessibility Zoom Support. */ + ns_UAZoom_cursor_rect_new = NSZeroRect; + ns_UAZoom_cursor_rect_old = NSZeroRect; +#endif + #ifdef NS_IMPL_COCOA old_title = 0; maximizing_resize = NO; diff --git a/src/pgtkterm.c b/src/pgtkterm.c index e0eb81bf81c..c1e00347343 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -703,33 +703,16 @@ pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) static void pgtk_set_window_size (struct frame *f, bool change_gravity, - int width, int height) + int pixelwidth, int pixelheight) /* -------------------------------------------------------------------------- - Adjust window pixel size based on given character grid size - Impl is a bit more complex than other terms, need to do some - internal clipping. + Adjust window pixel size based on given width and height. -------------------------------------------------------------------------- */ { - int pixelwidth, pixelheight; - block_input (); - gtk_widget_get_size_request (FRAME_GTK_WIDGET (f), &pixelwidth, - &pixelheight); - - pixelwidth = width; - pixelheight = height; - - for (GtkWidget * w = FRAME_GTK_WIDGET (f); w != NULL; - w = gtk_widget_get_parent (w)) - { - gint wd, hi; - gtk_widget_get_size_request (w, &wd, &hi); - } - f->output_data.pgtk->preferred_width = pixelwidth; f->output_data.pgtk->preferred_height = pixelheight; - xg_wm_set_size_hint (f, 0, 0); + xg_frame_set_char_size (f, pixelwidth, pixelheight); gtk_widget_queue_resize (FRAME_WIDGET (f)); @@ -5722,10 +5705,11 @@ pgtk_focus_changed (gboolean is_enter, int state, /* Don't stop displaying the initial startup message for a switch-frame event we don't need. */ - /* When run as a daemon, Vterminal_frame is always NIL. */ + /* When run as a daemon, Vterminal_frame is always nil. + FIXME: Isn't it actually the other way around? */ bufp->ie.arg = (((NILP (Vterminal_frame) || !FRAME_PGTK_P (XFRAME (Vterminal_frame)) - || EQ (Fdaemonp (), Qt)) + || IS_DAEMON) && CONSP (Vframe_list) && !NILP (XCDR (Vframe_list))) ? Qt : Qnil); bufp->ie.kind = FOCUS_IN_EVENT; diff --git a/src/sysdep.c b/src/sysdep.c index 8895655566e..10269e4d0ce 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1341,8 +1341,7 @@ init_sys_modes (struct tty_display_info *tty_out) frame_garbaged = 1; FOR_EACH_FRAME (tail, frame) { - if ((FRAME_TERMCAP_P (XFRAME (frame)) - || FRAME_MSDOS_P (XFRAME (frame))) + if (is_tty_frame (XFRAME (frame)) && FRAME_TTY (XFRAME (frame)) == tty_out) FRAME_GARBAGED_P (XFRAME (frame)) = 1; } diff --git a/src/term.c b/src/term.c index afc36be434e..15be02c6514 100644 --- a/src/term.c +++ b/src/term.c @@ -2969,9 +2969,7 @@ Gpm-mouse can only be activated for one tty at a time. */) (void) { struct frame *f = SELECTED_FRAME (); - struct tty_display_info *tty - = ((f)->output_method == output_termcap - ? (f)->terminal->display_info.tty : NULL); + struct tty_display_info *tty = FRAME_TERMCAP_P (f) ? FRAME_TTY (f) : NULL; Gpm_Connect connection; if (!tty) @@ -3017,9 +3015,7 @@ DEFUN ("gpm-mouse-stop", Fgpm_mouse_stop, Sgpm_mouse_stop, (void) { struct frame *f = SELECTED_FRAME (); - struct tty_display_info *tty - = ((f)->output_method == output_termcap - ? (f)->terminal->display_info.tty : NULL); + struct tty_display_info *tty = FRAME_TERMCAP_P (f) ? FRAME_TTY (f) : NULL; if (!tty || gpm_tty != tty) return Qnil; /* Not activated on this terminal, nothing to do. */ @@ -4214,7 +4210,7 @@ tty_free_frame_resources (struct frame *f) static void tty_free_frame_resources (struct frame *f) { - eassert (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)); + eassert (is_tty_frame (f)); free_frame_faces (f); /* Deleting a child frame means we have to thoroughly redisplay its root frame to make sure the child disappears from the display. */ diff --git a/src/terminal.c b/src/terminal.c index 1b15d1f26be..5c4852c5b6f 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -251,8 +251,8 @@ decode_live_terminal (Lisp_Object terminal) return t; } -/* Like decode_terminal, but ensure that the resulting terminal object refers - to a text-based terminal device. */ +/* Like decode_live_terminal, but ensure that the resulting terminal + object refers to a text-based terminal device. */ struct terminal * decode_tty_terminal (Lisp_Object terminal) @@ -508,6 +508,25 @@ return values. */) } } +DEFUN ("frame-initial-p", Fframe_initial_p, Sframe_initial_p, 0, 1, 0, + doc: /* Return non-nil if FRAME is the initial frame. +That is, the initial text frame used internally during daemon mode, +batch mode, and the early stages of startup. +If FRAME is a terminal object, return non-nil if it holds +the initial frame. FRAME defaults to the selected frame. */) + (Lisp_Object frame) +{ + if (NILP (frame)) + frame = selected_frame; + if (FRAMEP (frame)) + { + struct frame *f = XFRAME (frame); + return FRAME_LIVE_P (f) && FRAME_INITIAL_P (f) ? Qt : Qnil; + } + struct terminal *t = decode_terminal (frame); + return t && t->type == output_initial ? Qt : Qnil; +} + DEFUN ("terminal-list", Fterminal_list, Sterminal_list, 0, 0, 0, doc: /* Return a list of all terminal devices. */) (void) @@ -680,8 +699,6 @@ init_initial_terminal (void) #else initial_terminal_lisp = make_lisp_ptr (create_terminal (output_initial, NULL), Lisp_Vectorlike); #endif - /* Note: menu-bar.el:menu-bar-update-buffers knows about this - special name of the initial terminal. */ initial_terminal->name = xstrdup ("initial_terminal"); initial_terminal->kboard = initial_kboard; initial_terminal->delete_terminal_hook = &delete_initial_terminal; @@ -725,6 +742,7 @@ or some time later. */); Vdelete_terminal_functions = Qnil; DEFSYM (Qterminal_live_p, "terminal-live-p"); + DEFSYM (Qframe_initial_p, "frame-initial-p"); DEFSYM (Qdelete_terminal_functions, "delete-terminal-functions"); DEFSYM (Qrun_hook_with_args, "run-hook-with-args"); @@ -734,6 +752,7 @@ or some time later. */); defsubr (&Sdelete_terminal); defsubr (&Sframe_terminal); defsubr (&Sterminal_live_p); + defsubr (&Sframe_initial_p); defsubr (&Sterminal_list); defsubr (&Sterminal_name); defsubr (&Sterminal_parameters); diff --git a/src/w32xfns.c b/src/w32xfns.c index f920e407343..df3d42c9d28 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -177,7 +177,7 @@ get_frame_dc (struct frame *f) HGDIOBJ obj; struct w32_output *output; - if (f->output_method != output_w32) + if (!FRAME_W32_P (f)) emacs_abort (); enter_crit (); diff --git a/src/xdisp.c b/src/xdisp.c index fd2ce49e031..3251750cd2a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13665,7 +13665,7 @@ clear_garbaged_frames (void) selected frame, and might leave the selected frame with corrupted display, if it happens not to be marked garbaged. */ - && !(f != sf && (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)))) + && !(f != sf && is_tty_frame (f))) redraw_frame (f); else clear_current_matrices (f); @@ -16653,11 +16653,8 @@ hscroll_window_tree (Lisp_Object window) } } if (cursor_row->truncated_on_left_p) - { - /* On TTY frames, don't count the left truncation glyph. */ - struct frame *f = XFRAME (WINDOW_FRAME (w)); - x_offset -= (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)); - } + /* On TTY frames, don't count the left truncation glyph. */ + x_offset -= is_tty_frame (XFRAME (WINDOW_FRAME (w))); text_area_width = window_box_width (w, TEXT_AREA); @@ -17391,7 +17388,7 @@ redisplay_internal (void) windows_or_buffers_changed = 47; struct frame *previous_frame; - if ((FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)) + if (is_tty_frame (sf) && (previous_frame = FRAME_TTY (sf)->previous_frame, previous_frame != sf)) { @@ -17836,8 +17833,7 @@ redisplay_internal (void) } retry_frame: - if (FRAME_WINDOW_P (f) - || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f) || f == sf) + if (FRAME_WINDOW_P (f) || is_tty_frame (f) || f == sf) { /* Only GC scrollbars when we redisplay the whole frame. */ bool gcscrollbars = f->redisplay || !REDISPLAY_SOME_P (); @@ -32864,6 +32860,8 @@ produce_special_glyphs (struct it *it, enum display_element_type what, /* Mirror for R2L. */ if (direction == R2L) { + face_id = GLYPH_CODE_FACE (gc); + /* Try bidi mirroring first. */ int c = bidi_mirror_char (GLYPH_CODE_CHAR (gc)); @@ -32877,16 +32875,23 @@ produce_special_glyphs (struct it *it, enum display_element_type what, { c = XFIXNUM (val); - /* If something goes wrong defaults to '/'. */ + /* If something goes wrong, fall back to '/'. */ if (CHAR_VALID_P (c)) SET_GLYPH (glyph, c, face_id); else SET_GLYPH (glyph, '/', face_id); } + else + SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); } else + { + struct face *face = FACE_FROM_ID (it->f, face_id); + int id = FACE_FOR_CHAR (it->f, face, c, -1, Qnil); + /* Bidi mirroring. */ - SET_GLYPH (glyph, c, face_id); + SET_GLYPH (glyph, c, id); + } } else /* No mirroring. */ @@ -32925,6 +32930,8 @@ produce_special_glyphs (struct it *it, enum display_element_type what, if (((it->bidi_it.paragraph_dir == R2L) && !left_edge_p) || ((it->bidi_it.paragraph_dir == L2R) && left_edge_p)) { + face_id = GLYPH_CODE_FACE (gc); + /* Try bidi mirroring first. */ int c = bidi_mirror_char (GLYPH_CODE_CHAR (gc)); @@ -32938,12 +32945,14 @@ produce_special_glyphs (struct it *it, enum display_element_type what, { c = XFIXNUM (val); - /* If something goes wrong defaults to '$'. */ + /* If something goes wrong, fall back to '$'. */ if (CHAR_VALID_P (c)) SET_GLYPH (glyph, c, face_id); else SET_GLYPH (glyph, '$', face_id); } + else + SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); } else { diff --git a/src/xfaces.c b/src/xfaces.c index 567a56d229c..fdc08391fb7 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -5827,7 +5827,7 @@ face for italic. */) } /* Dispatch to the appropriate handler. */ - if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) + if (is_tty_frame (f)) supports = tty_supports_face_attributes_p (f, attrs, def_face); #ifdef HAVE_WINDOW_SYSTEM else @@ -6121,7 +6121,7 @@ realize_default_face (struct frame *f) ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color)); else if (FRAME_WINDOW_P (f)) return false; - else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) + else if (FRAME_INITIAL_P (f) || is_tty_frame (f)) ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg)); else emacs_abort (); @@ -6136,7 +6136,7 @@ realize_default_face (struct frame *f) ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color)); else if (FRAME_WINDOW_P (f)) return false; - else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) + else if (FRAME_INITIAL_P (f) || is_tty_frame (f)) ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg)); else emacs_abort (); @@ -6247,7 +6247,7 @@ realize_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE], if (FRAME_WINDOW_P (cache->f)) face = realize_gui_face (cache, attrs); - else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f)) + else if (is_tty_frame (cache->f)) face = realize_tty_face (cache, attrs); else if (FRAME_INITIAL_P (cache->f)) { @@ -6760,7 +6760,7 @@ realize_tty_face (struct face_cache *cache, struct frame *f = cache->f; /* Frame must be a termcap frame. */ - eassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f)); + eassert (is_tty_frame (cache->f)); /* Allocate a new realized face. */ face = make_realized_face (attrs); diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 15fd9ed7007..2afd803240e 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -91,7 +91,10 @@ This function is intended to be set to `auth-source-debug'." ((symbol-function 'auth-source-pass-entries) (lambda () (mapcar #'car ,store)))) (let ((auth-source-debug #'auth-source-pass--debug) (auth-source-pass--debug-log nil) - (auth-source-pass--parse-log nil)) + (auth-source-pass--parse-log nil) + ;; Any existing directory will do, since we shouldn't do I/O + ;; except for the guard in `auth-source-pass-search'. + (auth-source-pass-filename default-directory)) ,@body))) (defun auth-source-pass--explain-match-entry-p (entry hostname &optional user port) diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 67a377e9073..770a1549c56 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -90,7 +90,7 @@ (erase-buffer)) (setopt cus-edit-test-foo1 :foo) (buffer-substring-no-properties (point-min) (point-max))))) - (should (string-search "Value `:foo' for variable `cus-edit-test-foo1' does not match its type \"number\"" + (should (string-search "Value does not match cus-edit-test-foo1's type `number': :foo\n" warn-txt)))) (defcustom cus-edit-test-bug63290-option nil diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 7d0ea1692ff..77ed07fcc42 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -658,5 +658,155 @@ The current directory at call time should not affect the result (Bug#50630)." (let ((default-directory test-dir-other)) (files-tests--insert-directory-shows-given-free test-dir))))) +(ert-deftest dired-test-filename-with-newline-1 () ; bug#79528, bug#80499 + "Test handling of file name with literal embedded newline." + ;; File names with embedded newlines are not allowed on MS-Windows and + ;; MS-DOS. + (skip-when (memq system-type '(windows-nt ms-dos))) + (with-current-buffer "*Messages*" + (let ((inhibit-read-only t)) + (erase-buffer))) + (let* ((dired-auto-toggle-b-switch nil) + (dir (ert-resource-file + (file-name-as-directory "filename-with-newline"))) + (file (concat dir "filename\nwith newline")) + (buf (progn (make-empty-file file t) + (dired (file-name-directory file)))) + (warnbuf (get-buffer "*Warnings*"))) + (should (dired--filename-with-newline-p)) + (let ((beg (point)) ; beginning of file name + (_ (dired-move-to-end-of-filename))) + (should (search-backward "with newline")) ; literal space in file name + (should (search-backward "\n" beg))) ; literal newline in file name + (if noninteractive + (with-current-buffer "*Messages*" + (goto-char (point-min)) + (should (search-forward + "Warning (dired): Literal newline in file name."))) + (should (get-buffer-window warnbuf)) + (with-current-buffer warnbuf + (goto-char (point-min)) + (should (string-match + (regexp-quote "Warning (dired): Literal newline in file name.") + (buffer-substring (pos-bol) (pos-eol)))))) + (kill-buffer buf) + (kill-buffer warnbuf) + (delete-directory dir t))) + +(ert-deftest dired-test-filename-with-newline-2 () ; bug#79528, bug#80499 + "Test handling of file name with embedded newline using `b' switch." + ;; File names with embedded newlines are not allowed on MS-Windows and + ;; MS-DOS. + (skip-when (memq system-type '(windows-nt ms-dos))) + (with-current-buffer "*Messages*" + (let ((inhibit-read-only t)) + (erase-buffer))) + (let* ((dired-auto-toggle-b-switch t) + (dir (ert-resource-file + (file-name-as-directory "filename-with-newline"))) + (file (concat dir "filename\nwith newline")) + (buf (progn (make-empty-file file t) + (dired-noselect (file-name-directory file)))) + (warnbuf (get-buffer "*Warnings*"))) + (with-current-buffer buf + (should (dired--filename-with-newline-p)) + (dired--toggle-b-switch) + (let ((beg (point)) ; beginning of file name + (_ (dired-move-to-end-of-filename))) + (should (search-backward "with\\ newline")) ; result of ls -b switch + (should (search-backward "\\n" beg)))) ; result of ls -b switch + (if noninteractive + (with-current-buffer "*Messages*" + (goto-char (point-min)) + (should-error (search-forward + "Warning (dired): Literal newline in file name."))) + (should-not (get-buffer "*Warnings*"))) + (kill-buffer buf) + (kill-buffer warnbuf) + (delete-directory dir t))) + +(ert-deftest dired-test-ls-error-message () ; bug#80499 + "Test invoking `dired' on a nonexisting file. +A buffer should pop up containing the error emitted by ls. The buffer +visiting the nonexisting file should killed before `dired' returns, +hence another buffer should be returned." + (let* ((dir (ert-resource-file (file-name-as-directory "empty-dir"))) + (name (concat dir "bla")) + ;; Use PARENT = t in make-directory call to avoid failing if + ;; the directyory already exists for some reason. + (buf (progn (make-directory dir t) + (dired name)))) + ;; This is for MS-Windows and MS-DOS in the default configuration. + (when (and (featurep 'ls-lisp) + (boundp 'ls-lisp-use-insert-directory-program) + (null ls-lisp-use-insert-directory-program)) + (should (bufferp buf)) + (should (equal (buffer-name buf) (file-name-nondirectory name))) + (with-current-buffer buf + ;; 'ls-lisp' creates a Dired buffer of just 3 lines, with + ;; "(No match)" on the last line + (should (string-match "(No match)" (buffer-string))) + (should (= 3 (line-number-at-pos (buffer-size) t))))) + ;; This is for Posix systems and for MS-Windows/DOS when they use 'ls'. + (unless (and (featurep 'ls-lisp) + (boundp 'ls-lisp-use-insert-directory-program) + (null ls-lisp-use-insert-directory-program)) + (let ((errbuf (get-buffer "*ls error*"))) + (should (get-buffer-window errbuf)) + (should-not (equal (buffer-name buf) (file-name-nondirectory name))) + (with-current-buffer errbuf + (should (string-match-p + (format + ;; Use .* around file name to account for different + ;; file-name quoting styles, or no quoting at all. + "%s: cannot access .*%s.*: No such file or directory\n" + insert-directory-program (file-name-nondirectory name)) + (buffer-string)))) + (kill-buffer errbuf)) + (delete-directory dir t)))) + + +(defun dired-test--filename-with-backslash-n () + "Core of test `dired-test-filename-with-backslash-n'." + (let* ((dir (ert-resource-file + (file-name-as-directory "filename-with-backslash"))) + (file (concat dir "C:\\nppdf32log\\debuglog.txt")) + (buf (progn (make-empty-file file t) + (dired-noselect (file-name-directory file)))) + (warnbuf (get-buffer "*Warnings*"))) + (with-current-buffer buf + (should-not (dired--filename-with-newline-p)) + (dired--toggle-b-switch) + (should-not (dired--filename-with-newline-p)) + (let ((fn (car (directory-files dir t + directory-files-no-dot-files-regexp)))) + (should (equal fn file)))) + (if noninteractive + (with-current-buffer "*Messages*" + (goto-char (point-min)) + (should-error (search-forward + "Warning (dired): Literal newline in file name."))) + (should-not (get-buffer "*Warnings*"))) + (kill-buffer buf) + (kill-buffer warnbuf) + (delete-directory dir t))) + +(ert-deftest dired-test-filename-with-backslash-n () ; bug#80608 + "Test file name containing literal backslash-n sequence. +Dired should not treat this sequence as a newline character, regardless +of the value of `dired-auto-toggle-b-switch'." + ;; File names with backslashes in basename are not allowed on MS systems. + (skip-when (memq system-type '(windows-nt ms-dos))) + (with-current-buffer "*Messages*" + (let ((inhibit-read-only t)) + (erase-buffer))) + (let ((dired-auto-toggle-b-switch nil)) + (dired-test--filename-with-backslash-n)) + (with-current-buffer "*Messages*" + (let ((inhibit-read-only t)) + (erase-buffer))) + (let ((dired-auto-toggle-b-switch nil)) + (dired-test--filename-with-backslash-n))) + (provide 'dired-tests) ;;; dired-tests.el ends here diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el index da4a4d0fad7..cce28360eff 100644 --- a/test/lisp/erc/erc-track-tests.el +++ b/test/lisp/erc/erc-track-tests.el @@ -478,12 +478,28 @@ (funcall set-faces '(erc-notice-face)) (erc-track-modified-channels) (should (equal (alist-get (current-buffer) erc-modified-channels-alist) - '(5 . erc-notice-face)))) + (if (gethash 'erc-notice-face erc-track--normal-faces) + '(5 . erc-notice-face) + '(5 erc-button-nick-default-face erc-nick-default-face))))) (ert-deftest erc-track-modified-channels/baseline () (erc-tests-common-track-modified-channels #'erc-track-tests--modified-channels/baseline)) +;; This "baseline" variant simulates `erc-notice-face' being absent from +;; `erc-track-faces-normal-list' by removing it from the cached local +;; copy in `erc-track--normal-faces'. When absent and a message +;; highlighted in `erc-notice-face' is inserted, the mode line should +;; not change if it's currently showing a face ranked higher in +;; `erc-track-faces-priority-list'. ERC 5.6 and 5.6.1 featured a +;; regression that caused the mode line to keep alternating regardless. +;; See Bug#80659: erc: Faces not being updated correctly. +(ert-deftest erc-track-modified-channels/baseline/nonotice () + (erc-tests-common-track-modified-channels + (lambda (set-faces) + (remhash 'erc-notice-face erc-track--normal-faces) + (funcall #'erc-track-tests--modified-channels/baseline set-faces)))) + (ert-deftest erc-track-modified-channels/baseline/mention () (erc-tests-common-track-modified-channels (lambda (set-faces) @@ -613,6 +629,15 @@ (erc-tests-common-track-modified-channels #'erc-track-tests--modified-channels/baseline))) +;; Option `erc-track-priority-faces-only' does not affect Bug#80659 (see +;; baseline test without the option above). +(ert-deftest erc-track-modified-channels/priority-only-all/baseline/nonotice () + (let ((erc-track-priority-faces-only 'all)) + (erc-tests-common-track-modified-channels + (lambda (set-faces) + (remhash 'erc-notice-face erc-track--normal-faces) + (funcall #'erc-track-tests--modified-channels/baseline set-faces))))) + ;; This test simulates a common configuration that combines an ;; `erc-track-faces-priority-list' removed of `erc-notice-face' with ;; `erc-track-priority-faces-only' being `all'. It also features in the diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index e6b2a0eb078..6781c4a3d8b 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1027,7 +1027,23 @@ unquoted file names." (buffer-string))))) (files-tests--with-temp-non-special-and-file-name-handler (tmpdir nospecial-dir t) - (should-error (with-temp-buffer (insert-directory nospecial-dir ""))))) + (if (memq system-type '(windows-nt ms-dos)) + (should-error (with-temp-buffer (insert-directory nospecial-dir ""))) + (with-temp-buffer (insert-directory nospecial-dir "")) + (let ((errbuf (get-buffer "*ls error*")) + ;; By the time `ls' is called in `insert-directory', the + ;; handler prefix has been removed. + (nospecial-dir (string-remove-prefix "/:" nospecial-dir))) + (should errbuf) + (with-current-buffer errbuf + (should (string-match-p + (format + ;; Use .* around file name to account for different + ;; file-name quoting styles, or no quoting at all. + "%s: cannot access .*%s.*: No such file or directory\n" + insert-directory-program nospecial-dir) + (buffer-string)))) + (kill-buffer errbuf))))) (ert-deftest files-tests-file-name-non-special-insert-file-contents () (files-tests--with-temp-non-special (tmpfile nospecial) diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el index df9358b96c5..e668becd54d 100644 --- a/test/lisp/gnus/gnus-icalendar-tests.el +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -35,7 +35,7 @@ (let (event) (with-temp-buffer (insert ical-string) - (setq event (gnus-icalendar-event-from-buffer (buffer-name) participant))) + (setq event (gnus-icalendar-event-from-buffer (current-buffer) participant))) event)) (ert-deftest gnus-icalendar-parse () @@ -94,7 +94,8 @@ END:VCALENDAR (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) (should (not (gnus-icalendar-event:recurring-p event))) - (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00")) + (should (equal (gnus-icalendar-event:start event) + "2020-12-08 15:00")) (with-slots (organizer summary description location end-time uid rsvp participation-type) event (should (string= organizer "anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) (should (string= summary "Townhall | All Company Meeting")) @@ -106,9 +107,20 @@ END:VCALENDAR (should (eq participation-type 'non-participant)))) (setenv "TZ" tz)))) +(defun gnus-icalendar-at/@ () + "Replace \" \" with \"@\" before parsing." + (goto-char (point-min)) + (while (re-search-forward " " nil t) + (replace-match "@"))) + +;; FIXME: is "icalendary" (not "icalendar") intentional, here and below? (ert-deftest gnus-icalendary-byday () "" - (let ((tz (getenv "TZ")) + (let* ((tz (getenv "TZ")) + (icalendar-pre-parsing-hook + ;; clean up " " addresses so the parser doesn't choke... + ;; FIXME: can we just change the test data, or is this a real example? + '(gnus-icalendar-at/@)) (event (gnus-icalendar-tests--get-ical-event "\ BEGIN:VCALENDAR PRODID:Zimbra-Calendar-Provider @@ -138,8 +150,8 @@ SUMMARY:appointment every weekday\\, start jul 24\\, 2020\\, end aug 24\\, 2020 ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP =TRUE:mailto:hexmode gmail.com ORGANIZER;CN=Mark A. Hershberger:mailto:mah nichework.com -DTSTART;TZID=\"America/New_York\":20200724T090000 -DTEND;TZID=\"America/New_York\":20200724T093000 +DTSTART;TZID=America/New_York:20200724T090000 +DTEND;TZID=America/New_York:20200724T093000 STATUS:CONFIRMED CLASS:PUBLIC X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY @@ -163,10 +175,12 @@ END:VCALENDAR" (list "Mark Hershberger")))) (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) (should (gnus-icalendar-event:recurring-p event)) - (should (string= (gnus-icalendar-event:recurring-interval event) "1")) + (should (= 1 (gnus-icalendar-event:recurring-interval event))) (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00")) (with-slots (organizer summary description location end-time uid rsvp participation-type) event - (should (string= organizer "mah nichework.com")) + (should (string= organizer + (replace-regexp-in-string " " "@" + "mah nichework.com"))) (should (string= summary "appointment every weekday, start jul 24, 2020, end aug 24, 2020")) (should (string= description "The following is a new meeting request:")) (should (null location)) @@ -236,7 +250,7 @@ END:VCALENDAR" (list "participant@anoncompany.com")))) (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) (should (gnus-icalendar-event:recurring-p event)) - (should (string= (gnus-icalendar-event:recurring-interval event) "1")) + (should (= 1 (gnus-icalendar-event:recurring-interval event))) (should (string= (gnus-icalendar-event:start event) "2020-09-15 14:00")) (with-slots (organizer summary description location end-time uid rsvp participation-type) event (should (string= organizer "anon@anoncompany.com")) @@ -258,6 +272,29 @@ END:VCALENDAR" (list "participant@anoncompany.com")))) (ert-deftest gnus-icalendar-accept-with-comment () "" (let ((event "\ +BEGIN:VCALENDAR +PRODID:-//Google Inc//Google Calendar 70.9054//EN +VERSION:2.0 +CALSCALE:GREGORIAN +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:Europe/Berlin +X-LIC-LOCATION:Europe/Berlin +BEGIN:DAYLIGHT +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +TZNAME:CEST +DTSTART:19700329T020000 +RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +TZNAME:CET +DTSTART:19701025T030000 +RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU +END:STANDARD +END:VTIMEZONE BEGIN:VEVENT DTSTART;TZID=Europe/Berlin:20200915T140000 DTEND;TZID=Europe/Berlin:20200915T143000 @@ -275,7 +312,8 @@ SEQUENCE:0 STATUS:CONFIRMED SUMMARY:Casual coffee talk TRANSP:OPAQUE -END:VEVENT") +END:VEVENT +END:VCALENDAR") (icalendar-identities '("participant@anoncompany.com"))) (let* ((reply (with-temp-buffer (insert event) @@ -292,6 +330,29 @@ END:VEVENT") (ert-deftest gnus-icalendar-decline-without-changing-comment () "" (let ((event "\ +BEGIN:VCALENDAR +PRODID:-//Google Inc//Google Calendar 70.9054//EN +VERSION:2.0 +CALSCALE:GREGORIAN +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:Europe/Berlin +X-LIC-LOCATION:Europe/Berlin +BEGIN:DAYLIGHT +TZOFFSETFROM:+0100 +TZOFFSETTO:+0200 +TZNAME:CEST +DTSTART:19700329T020000 +RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:+0200 +TZOFFSETTO:+0100 +TZNAME:CET +DTSTART:19701025T030000 +RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU +END:STANDARD +END:VTIMEZONE BEGIN:VEVENT DTSTART;TZID=Europe/Berlin:20200915T140000 DTEND;TZID=Europe/Berlin:20200915T143000 @@ -310,7 +371,8 @@ SEQUENCE:0 STATUS:CONFIRMED SUMMARY:Casual coffee talk TRANSP:OPAQUE -END:VEVENT") +END:VEVENT +END:VCALENDAR") (icalendar-identities '("participant@anoncompany.com"))) (let* ((reply (with-temp-buffer (insert event) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 149fa1d2537..3972e5faa45 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5078,6 +5078,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (sort (file-name-all-completions "b" tmp-name) #'string-lessp) '("bold" "boz/"))) (should-not (file-name-all-completions "a" tmp-name)) + ;; Symbolic links. + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link + (file-name-concat tmp-name "foo") + (file-name-concat tmp-name "link1")) + (should (file-exists-p (expand-file-name "link1" tmp-name))) + (make-symbolic-link + (file-name-concat tmp-name "boz") + (file-name-concat tmp-name "link2")) + (should (file-exists-p (expand-file-name "link2" tmp-name))) + (should (equal (file-name-completion "li" tmp-name) "link")) + (should (member "link1" (file-name-all-completions "" tmp-name))) + (should (member "link2/" (file-name-all-completions "" tmp-name))) + (delete-file (file-name-concat tmp-name "link1")) + (delete-file (file-name-concat tmp-name "link2"))) ;; `completion-regexp-list' restricts the completion to ;; files which match all expressions in this list. ;; Ange-FTP does not complete "". @@ -6329,9 +6344,12 @@ INPUT, if non-nil, is a string sent to the process." this-shell-command "echo foo >&2; echo bar" (current-buffer) stderr) (should (string-equal "bar\n" (buffer-string))) - ;; Check stderr. + ;; Check stderr. Some shells echo, for example the + ;; "adb" or container methods. (should - (string-equal "foo\n" (tramp-get-buffer-string stderr)))) + (string-match-p + (rx bol (** 1 2 "foo\n") eol) + (tramp-get-buffer-string stderr)))) ;; Cleanup. (ignore-errors (kill-buffer stderr)))))) @@ -6896,8 +6914,7 @@ INPUT, if non-nil, is a string sent to the process." "Check `vc-registered'." :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-processes-p)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, in @@ -6912,17 +6929,9 @@ INPUT, if non-nil, is a string sent to the process." (inhibit-message (not (ignore-errors (edebug-mode)))) (vc-handled-backends (cond - ((tramp-find-executable - tramp-test-vec vc-git-program - (tramp-get-remote-path tramp-test-vec)) - '(Git)) - ((tramp-find-executable - tramp-test-vec vc-hg-program - (tramp-get-remote-path tramp-test-vec)) - '(Hg)) - ((tramp-find-executable - tramp-test-vec vc-bzr-program - (tramp-get-remote-path tramp-test-vec)) + ((executable-find vc-git-program 'remote) '(Git)) + ((executable-find vc-hg-program 'remote) '(Hg)) + ((executable-find vc-bzr-program 'remote) (setq tramp-remote-process-environment (cons (format "BZR_HOME=%s" (file-remote-p tmp-name1 'localname)) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1c625d79ca2..4d9e468bee1 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -8012,6 +8012,7 @@ always located at the beginning of buffer." def test():" (setopt treesit-font-lock-level 4) + (font-lock-ensure) (dolist (test '("pytest" "mark" "skip")) (search-forward test) (goto-char (match-beginning 0)) @@ -8022,6 +8023,7 @@ always located at the beginning of buffer." "all()" ;; enable 'function' feature from 4th level (setopt treesit-font-lock-level 4) + (font-lock-ensure) (should (eq (face-at-point) 'font-lock-builtin-face)))) (ert-deftest python-ts-mode-interpolation-nested-string () @@ -8050,6 +8052,7 @@ always located at the beginning of buffer." "t = f\"beg {True + var}\"" (setopt treesit-font-lock-level 2) + (font-lock-ensure) (search-forward "f") (goto-char (match-beginning 0)) (should (not (eq (face-at-point) 'font-lock-string-face))) @@ -8068,6 +8071,7 @@ always located at the beginning of buffer." (setf (nth 2 treesit-font-lock-feature-list) (remq 'string-interpolation (nth 2 treesit-font-lock-feature-list))) (setopt treesit-font-lock-level 3) + (font-lock-ensure) (search-forward "f") (goto-char (match-beginning 0)) diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index 73f7be3145d..c1afa197c64 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -41,6 +41,19 @@ (defvar B2) (defvar ses--toto)) +;; Check no border effects +;; ====================================================================== +(defun ses-tests-check-no-border-effect () + (dolist (symb ses-localvars) + (when (consp symb) (setq symb (car symb))) + (when (string-match "\\`ses--" (symbol-name symb)) + (should (null (boundp symb)))))) + +(defun ses-tests-unbind-local-vars () + (dolist (symb ses-localvars) + (when (consp symb) (setq symb (car symb))) + (when (string-match "\\`ses--" (symbol-name symb)) (makunbound symb)))) + ;; PLAIN FORMULA TESTS ;; ====================================================================== @@ -48,24 +61,28 @@ "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value equal to 2. This is done with low level functions calls, not like interactively." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) (dolist (c '((0 0 1) (1 0 (1+ A1)))) (apply 'ses-cell-set-formula c) (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) - (should (eq (bound-and-true-p A2) 2))))) + (should (eq (bound-and-true-p A2) 2)))) + (ses-tests-check-no-border-effect)) (ert-deftest ses-tests-plain-formula () "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value equal to 2. This is done using interactive calls." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) (dolist (c '((0 0 1) (1 0 (1+ A1)))) (apply 'funcall-interactively 'ses-edit-cell c)) (ses-command-hook) - (should (eq (bound-and-true-p A2) 2))))) + (should (eq (bound-and-true-p A2) 2)))) + (ses-tests-check-no-border-effect)) ;; PLAIN CELL RENAMING TESTS ;; ====================================================================== @@ -75,6 +92,7 @@ equal to 2. This is done using interactive calls." This is done using low level functions, `ses-rename-cell' is not called but instead we use text replacement in the buffer previously passed in text mode." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) @@ -90,11 +108,13 @@ previously passed in text mode." (should-not (local-variable-p 'A1)) (should (eq ses--foo 1)) (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ ses--foo)))) - (should (eq (bound-and-true-p A2) 2))))) + (should (eq (bound-and-true-p A2) 2)))) + (ses-tests-check-no-border-effect)) (ert-deftest ses-tests-renamed-cell () "Check that renaming A1 to `ses--foo' and setting `ses--foo' to 1 and A2 to (1+ ses--foo), makes A2 value equal to 2." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) @@ -105,11 +125,13 @@ to (1+ ses--foo), makes A2 value equal to 2." (should-not (local-variable-p 'A1)) (should (eq ses--foo 1)) (should (equal (ses-cell-formula 1 0) '(1+ ses--foo))) - (should (eq (bound-and-true-p A2) 2))))) + (should (eq (bound-and-true-p A2) 2)))) + (ses-tests-check-no-border-effect)) (ert-deftest ses-tests-renamed-cell-after-setting () "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `ses--foo' makes `ses--foo' value equal to 2." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) @@ -120,12 +142,14 @@ renaming A1 to `ses--foo' makes `ses--foo' value equal to 2." (should-not (local-variable-p 'A1)) (should (eq ses--foo 1)) (should (equal (ses-cell-formula 1 0) '(1+ ses--foo))) - (should (eq (bound-and-true-p A2) 2))))) + (should (eq (bound-and-true-p A2) 2)))) + (ses-tests-check-no-border-effect)) (ert-deftest ses-tests-renaming-cell-with-one-symbol-formula () "Check that setting A1 to 1 and A2 to A1, and then renaming A1 to `ses--foo' makes `ses--foo' value equal to 1. Then set A1 to 2 and check that `ses--foo' becomes 2." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(3 . 1))) (with-temp-buffer (ses-mode) @@ -141,7 +165,8 @@ that `ses--foo' becomes 2." (funcall-interactively 'ses-edit-cell 0 0 2) (ses-command-hook); deferred recalc (should (eq (bound-and-true-p A2) 2)) - (should (eq ses--foo 2))))) + (should (eq ses--foo 2)))) + (ses-tests-check-no-border-effect)) ;; ROW INSERTION TESTS @@ -151,6 +176,7 @@ that `ses--foo' becomes 2." "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping to A2 and inserting a row, makes A2 value empty, and A3 equal to 2." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) @@ -161,13 +187,15 @@ to A2 and inserting a row, makes A2 value empty, and A3 equal to (ses-insert-row 1) (ses-command-hook) (should-not (bound-and-true-p A2)) - (should (eq (bound-and-true-p A3) 2))))) + (should (eq (bound-and-true-p A3) 2)))) + (ses-tests-check-no-border-effect)) (ert-deftest ses-tests-renamed-cells-row-insertion () "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `ses--foo' and A2 to `ses--bar' jumping to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to 2." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) @@ -183,13 +211,15 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to (ses-insert-row 1) (ses-command-hook) (should-not (bound-and-true-p A2)) - (should (eq ses--bar 2))))) + (should (eq ses--bar 2)))) + (ses-tests-check-no-border-effect)) ;; JUMP tests ;; ====================================================================== -(ert-deftest ses-jump-B2-prefix-arg () +(ert-deftest ses-tests-jump-B2-prefix-arg () "Test jumping to cell B2 by use of prefix argument" + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(3 . 3)) ses-after-entry-functions) (with-temp-buffer @@ -197,41 +227,49 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to ;; C-u 4 M-x ses-jump (let ((current-prefix-arg 4)) (call-interactively 'ses-jump)) - (should (eq (ses--cell-at-pos (point)) 'B2))))) + (should (eq (ses--cell-at-pos (point)) 'B2)))) + (ses-tests-check-no-border-effect)) -(ert-deftest ses-jump-B2-lowcase () +(ert-deftest ses-tests-jump-B2-lowcase () "Test jumping to cell B2 by use of lowercase cell name string" - (let ((ses-initial-size '(3 . 3)) - ses-after-entry-functions) - (with-temp-buffer - (ses-mode) - (funcall-interactively 'ses-jump "b2") - (ses-command-hook) - (should (eq (ses--cell-at-pos (point)) 'B2))))) + (ses-tests-unbind-local-vars) + (let ((ses-initial-size '(3 . 3)) + ses-after-entry-functions) + (with-temp-buffer + (ses-mode) + (funcall-interactively 'ses-jump "b2") + (ses-command-hook) + (should (eq (ses--cell-at-pos (point)) 'B2)))) + (ses-tests-check-no-border-effect)) -(ert-deftest ses-jump-B2-lowcase-keys () +(ert-deftest ses-tests-jump-B2-lowcase-keys () "Test jumping to cell B2 by use of lowercase cell name string with simulating keys" - (let ((ses-initial-size '(3 . 3)) - ses-after-entry-functions) - (with-temp-buffer - (ses-mode) - (ert-simulate-keys [ ?b ?2 return] (ses-jump)) - (ses-command-hook) - (should (eq (ses--cell-at-pos (point)) 'B2))))) + (ses-tests-unbind-local-vars) + (let ((ses-initial-size '(3 . 3)) + ses-after-entry-functions) + (with-temp-buffer + (ses-mode) + (ert-simulate-keys [ ?b ?2 return] (ses-jump)) + (ses-command-hook) + (should (eq (ses--cell-at-pos (point)) 'B2)))) + (ses-tests-check-no-border-effect)) -(ert-deftest ses-jump-B2-symbol () +(ert-deftest ses-tests-jump-B2-symbol () "Test jumping to cell B2 by use of cell name symbol" + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(3 . 3)) ses-after-entry-functions) (with-temp-buffer (ses-mode) (funcall-interactively 'ses-jump 'B2) (ses-command-hook) - (should (eq (ses--cell-at-pos (point)) 'B2))))) + (should (eq (ses--cell-at-pos (point)) 'B2)))) + (ses-tests-check-no-border-effect)) -(ert-deftest ses-jump-B2-renamed () +(ert-deftest ses-tests-jump-B2-renamed () "Test jumping to cell B2 after renaming it `ses--toto'." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(3 . 3)) ses-after-entry-functions) (with-temp-buffer @@ -239,12 +277,14 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to (ses-rename-cell 'ses--toto (ses-get-cell 1 1)) (ses-jump 'ses--toto) (ses-command-hook) - (should (eq (ses--cell-at-pos (point)) 'ses--toto))))) + (should (eq (ses--cell-at-pos (point)) 'ses--toto)))) + (ses-tests-check-no-border-effect)) -(ert-deftest ses-set-formula-write-cells-with-changed-references () +(ert-deftest ses-tests-set-formula-write-cells-with-changed-references () "Test fix of bug#5852. When setting a formula has some cell with changed references, this cell has to be rewritten to data area." + (ses-tests-unbind-local-vars) (let ((ses-initial-size '(4 . 3)) (ses-after-entry-functions nil)) (with-temp-buffer @@ -261,7 +301,8 @@ cell has to be rewritten to data area." (ses-command-hook) (should (equal (ses-cell-references 1 1) '(B3))) (ses-mode) - (should (equal (ses-cell-references 1 1) '(B3)))))) + (should (equal (ses-cell-references 1 1) '(B3))))) + (ses-tests-check-no-border-effect)) (provide 'ses-tests) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 3d4f524d630..791b06f9edf 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1700,32 +1700,38 @@ final or penultimate step during initialization.")) (should (equal (funcall (subr--identity #'all) #'plusp ls) nil)) (should (equal (funcall (subr--identity #'all) #'numberp ls) t)))) -(ert-deftest subr-any () - (should (equal (any #'hash-table-p nil) nil)) +(ert-deftest subr-member-if () + (should (equal (member-if #'hash-table-p nil) nil)) (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) - (should (equal (any #'numberp ls) ls)) - (should (equal (any (lambda (x) (numberp x)) ls) ls)) - (should (equal (any #'plusp ls) ls)) - (should (equal (any #'zerop ls) '(0 -1 -2 -3))) - (should (equal (any #'bufferp ls) nil)) + (should (equal (member-if #'numberp ls) ls)) + (should (equal (member-if (lambda (x) (numberp x)) ls) ls)) + (should (equal (member-if #'plusp ls) ls)) + (should (equal (member-if #'zerop ls) '(0 -1 -2 -3))) + (should (equal (member-if #'bufferp ls) nil)) (let ((z 9)) - (should (equal (any (lambda (x) (< x z)) ls) ls)) - (should (equal (any (lambda (x) (< x (- z 9))) ls) '(-1 -2 -3))) - (should (equal (any (lambda (x) (> x z)) ls) nil))) - (should (equal (funcall (subr--identity #'any) #'minusp ls) '(-1 -2 -3))) - (should (equal (funcall (subr--identity #'any) #'stringp ls) nil)))) + (should (equal (member-if (lambda (x) (< x z)) ls) ls)) + (should (equal (member-if (lambda (x) (< x (- z 9))) ls) + '(-1 -2 -3))) + (should (equal (member-if (lambda (x) (> x z)) ls) nil))) + (should (equal (funcall (subr--identity #'member-if) #'minusp ls) + '(-1 -2 -3))) + (should (equal (funcall (subr--identity #'member-if) #'stringp ls) nil)))) -(defun subr-tests--any-memql (x xs) - "Like `memql', but exercising the `compiler-macro' of `any'. +(defun subr-tests--member-if-memql (x xs) + "Like `memql', but exercising the `compiler-macro' of `member-if'. The argument names are important." - (any (lambda (y) (eql x y)) xs)) + (member-if (lambda (y) (eql x y)) xs)) -(ert-deftest subr-any-compiler-macro () - "Test `compiler-macro' of `any'." +(ert-deftest subr-member-if-compiler-macro () + "Test `compiler-macro' of `member-if'." (let ((xs (number-sequence 0 4))) (dotimes (x (1+ (length xs))) - (should (eq (subr-tests--any-memql x xs) - (memql x xs)))))) + (should (eq (subr-tests--member-if-memql x xs) + (memql x xs))))) + (let ((n 0)) + (member-if (prog1 (lambda (x) (eq x 5)) (incf n)) + (number-sequence 0 4)) + (should (eq n 1)))) (ert-deftest total-line-spacing () (progn diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index 26fe5002b68..b065fda5eed 100644 --- a/test/lisp/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el @@ -50,8 +50,7 @@ ;; `xterm-mouse-mode' doesn't work in the initial ;; terminal. Since we can't create a second ;; terminal in batch mode, fake it temporarily. - (cl-letf (((symbol-function 'terminal-name) - (lambda (&optional _terminal) "fake-terminal"))) + (cl-letf (((symbol-function 'frame-initial-p) #'ignore)) (xterm-mouse-mode 1)) ,@body) (xterm-mouse-mode 0)))) diff --git a/test/src/terminal-tests.el b/test/src/terminal-tests.el new file mode 100644 index 00000000000..85c4fa04efc --- /dev/null +++ b/test/src/terminal-tests.el @@ -0,0 +1,55 @@ +;;; terminal-tests.el --- tests for terminal.c -*- lexical-binding: t -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) + +(ert-deftest frame-initial-p () + "Test `frame-initial-p' behavior." + (should-not (frame-initial-p t)) + (should-not (frame-initial-p (current-buffer))) + (should-not (frame-initial-p (selected-window))) + ;; "Initial frame" implies "initial terminal", and + ;; no other terminal can have the initial frame. + (should-not (xor (equal (terminal-name) "initial_terminal") + (frame-initial-p))) + ;; Initial frame implies its terminal is a termcap-like + ;; text-mode terminal. + (should (or (not (frame-initial-p)) + (eq (terminal-live-p nil) t))) + ;; It similarly implies a termcap-like text-mode frame. + (should (or (not (frame-initial-p)) + (eq (frame-live-p (selected-frame)) t))) + (dolist (ft (append '(nil) (frame-list) (terminal-list))) + (ert-info ((prin1-to-string ft) :prefix "Argument: ") + (should-not (xor (equal (terminal-name ft) "initial_terminal") + (frame-initial-p ft))) + (should (or (not (frame-initial-p ft)) + (eq (terminal-live-p ft) t))))) + (cond (noninteractive + ;; Batch mode should have an initial frame. + (should (any #'frame-initial-p (frame-list))) + (should (any #'frame-initial-p (terminal-list)))) + ((not (daemonp)) + ;; Non-daemon interactive mode should have none. + (should-not (any #'frame-initial-p (frame-list))) + (should-not (any #'frame-initial-p (terminal-list)))))) + +;;; terminal-tests.el ends here