commit 5325d815af43a36ea8571851e272c3d39bc19252 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon Dec 12 19:21:10 2022 +0800 Add variable to make resizing frames sometimes faster * etc/PROBLEMS: Add documentation about new variable. * src/xterm.c (x_set_offset, x_set_window_size_1): Respect new variable. (syms_of_xterm): Add a new variable to prevent Emacs from syncing upon resize or movement. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 68f7cdb0560..b6d2d63660c 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1712,8 +1712,8 @@ which can be carried out at the same time: 7) If selecting text with the mouse is slow, the main culprit is likely `select-active-regions', coupled with a program monitoring - the clipboard on the X server you are connected to. Try turning - that off. + the clipboard or primary selection on the X server you are + connected to. Try turning that off. However, over networks with moderate to high latency, with no clipboard monitor running, the bottleneck is likely to be @@ -1723,6 +1723,12 @@ which can be carried out at the same time: cause Emacs features that relies on accurate mouse position reporting to stop working reliably. +8) If creating or resizing frames is slow, turn off + `frame-resize-pixelwise' (this will not take effect until you + create a new frame); then, enable `x-lax-frame-geometry'. This + means frame placement will be less accurate, but makes frame + creation, movement, and resize visibly faster. + *** Emacs gives the error, Couldn't find per display information. This can result if the X server runs out of memory because Emacs uses diff --git a/src/xterm.c b/src/xterm.c index 38775c3f52e..3c8dbce30e7 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -26693,38 +26693,43 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) modified_left, modified_top); #endif - /* 'x_sync_with_move' is too costly for dragging child frames. */ - if (!FRAME_PARENT_FRAME (f) - /* If no window manager exists, just calling XSync will be - sufficient to ensure that the window geometry has been - updated. */ - && NILP (Vx_no_window_manager)) - { - x_sync_with_move (f, f->left_pos, f->top_pos, - FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); - - /* change_gravity is non-zero when this function is called from Lisp to - programmatically move a frame. In that case, we call - x_check_expected_move to discover if we have a "Type A" or "Type B" - window manager, and, for a "Type A" window manager, adjust the position - of the frame. - - We call x_check_expected_move if a programmatic move occurred, and - either the window manager type (A/B) is unknown or it is Type A but we - need to compute the top/left offset adjustment for this frame. */ - - if (change_gravity != 0 - && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN - || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A - && (FRAME_X_OUTPUT (f)->move_offset_left == 0 - && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) - x_check_expected_move (f, modified_left, modified_top); - } - /* Instead, just wait for the last ConfigureWindow request to - complete. No window manager is involved when moving child - frames. */ - else - XSync (FRAME_X_DISPLAY (f), False); + /* The following code is too slow over a latent network + connection. */ + if (NILP (Vx_lax_frame_positioning)) + { + /* 'x_sync_with_move' is too costly for dragging child frames. */ + if (!FRAME_PARENT_FRAME (f) + /* If no window manager exists, just calling XSync will be + sufficient to ensure that the window geometry has been + updated. */ + && NILP (Vx_no_window_manager)) + { + x_sync_with_move (f, f->left_pos, f->top_pos, + FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); + + /* change_gravity is non-zero when this function is called from Lisp to + programmatically move a frame. In that case, we call + x_check_expected_move to discover if we have a "Type A" or "Type B" + window manager, and, for a "Type A" window manager, adjust the position + of the frame. + + We call x_check_expected_move if a programmatic move occurred, and + either the window manager type (A/B) is unknown or it is Type A but we + need to compute the top/left offset adjustment for this frame. */ + + if (change_gravity != 0 + && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN + || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A + && (FRAME_X_OUTPUT (f)->move_offset_left == 0 + && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) + x_check_expected_move (f, modified_left, modified_top); + } + /* Instead, just wait for the last ConfigureWindow request to + complete. No window manager is involved when moving child + frames. */ + else + XSync (FRAME_X_DISPLAY (f), False); + } unblock_input (); } @@ -27533,6 +27538,12 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, we have to make sure to do it here. */ SET_FRAME_GARBAGED (f); + /* The following code is too slow over a latent network + connection, so skip it when the user says so. */ + + if (!NILP (Vx_lax_frame_positioning)) + return; + /* Now, strictly speaking, we can't be sure that this is accurate, but the window manager will get around to dealing with the size change request eventually, and we'll hear how it went when the @@ -31859,4 +31870,15 @@ syms_of_xterm (void) server. If the X server reports the error, Emacs will disable certain features that do not work for untrusted clients. */); Vx_detect_server_trust = Qnil; + + DEFVAR_LISP ("x-lax-frame-geometry", Vx_lax_frame_positioning, + doc: /* If non-nil nil, Emacs won't compensate for WM geometry behavior. + +Setting this to non-nil is useful when the compensation proves to be +too slow, which is usually true when the X server is located over a +network connection with high latency. Doing so will make frame +creation and placement faster at the cost of reducing the accuracy of +frame placement via frame properties, `set-frame-position', and +`set-frame-size'. */); + Vx_lax_frame_positioning = Qnil; } commit fcd0b377e0e25b7b68bd51229098edb30972352b Merge: b889eced444 06ef030f936 Author: Stefan Kangas Date: Mon Dec 12 09:05:53 2022 +0100 Merge from origin/emacs-29 06ef030f936 use-package.texi: New section "Manual installation" f4ce6fa7d3e Revert "Revert "Improve last change to xfaces.c" (05ece1e... b8d2ec920f3 Revert "Improve last change to xfaces.c" (05ece1eb8b) 24c8c28ae61 Do not pare arguments unnecessarily. 9c0d7bb73bb Add automated tests for Eglot d3669cfe156 Eglot: allow skipping compile-time warnings about LSP int... 04b7e01885d ; project.el: Bump version. f2876014adb Add customizale faces for tree-sitter explorer 3e349ee1198 Fix error message when installing non-existent package 733cdeabfb9 Don't use diff-mode buffer as a patch when it's visiting ... 87475f4af21 Fix pcase rx patterns using rx-let bindings (bug#59814) 4893a156317 Fix use-package-defaults defcustom type (bug#59941) 074b7e6f4d1 ; * lisp/use-package/bind-key.el: Remove ineffective back... 864ed9dfa1f ; * lisp/progmodes/dockerfile-ts-mode.el: use \' instead ... 9f7e5584a4f * lisp/language/indian.el: Improve Brahmi composition rul... 78ad33bb05f ; Minor cleanup of last change in xfaces.c. 2024ade271d ; Improve docs of relaxing face-font attribute match (bug... commit 06ef030f9363a33646369e8583cbac695810fe80 Author: Stefan Kangas Date: Mon Dec 12 08:45:40 2022 +0100 use-package.texi: New section "Manual installation" * doc/misc/use-package.texi (Manual installation): New section. (Load path, Manual autoloads): Make into subsections of above new section. diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi index 0aa8975f30a..c587d23d74b 100644 --- a/doc/misc/use-package.texi +++ b/doc/misc/use-package.texi @@ -248,10 +248,6 @@ Loading Packages this automatically for you. Packages shipped with Emacs (built-in packages) are always available. -If you install packages manually, you must make sure they are -available on your @code{load-path}. @xref{Lisp Libraries,,, emacs, -GNU Emacs Manual}, for details. - Some packages have more than one library. In those cases, you might need more than one @code{use-package} declaration to make sure the package is properly loaded. For complex configurations, you might @@ -267,8 +263,7 @@ Loading Packages * Conditional loading:: Loading packages conditionally. * Loading sequentially:: Loading packages in sequence. * Load dependencies:: Don't load without dependencies. -* Load path:: Using a custom @code{load-path}. -* Manual autoloads:: Setting up autoloads manually. +* Manual installation:: Loading manually installed packages. @end menu @node Loading basics @@ -623,36 +618,54 @@ Load dependencies For more complex logic, such as that supported by @code{:after}, simply use @code{:if} and the appropriate Lisp expression. +@node Manual installation +@section Manually installed package + +When installing packages manually, without Emacs' built-in package +manager (@file{package.el}), it will obviously not help you set up +autoloads or add it to your @code{load-path}. You must do it +yourself. However, use-package makes this more convenient. + +@menu +* Load path:: Using a custom @code{load-path}. +* Manual autoloads:: Setting up autoloads manually. +@end menu + @node Load path -@section Setting a custom @code{load-path} +@subsection Setting a custom @code{load-path} @cindex custom @code{load-path} for loading a package @cindex @code{load-path}, add directories for loading a package +When installing packages manually, you must make sure its libraries +are available on your @code{load-path}. @xref{Lisp Libraries,,, +emacs, GNU Emacs Manual}, for more details about package loading. + @findex :load-path -If a package resides in some directory that is not in your -@code{load-path}, use the @code{:load-path} keyword to add it. It -takes as argument a symbol, a function, a string or a list of strings. -If a directory is specified as a relative file name, it is expanded -relative to @code{user-emacs-directory}. +The @code{:load-path} keyword provides a convenient way to add +directories to your load path. It takes as argument a symbol, a +function, a string or a list of strings. If a directory is specified +as a relative file name, it is expanded relative to +@code{user-emacs-directory}. For example: @lisp @group -(use-package ess-site - :load-path "site-lisp/ess/lisp/" - :commands R) +(use-package org + :load-path "site-lisp/org/lisp/" + :commands org-mode) @end group @end lisp -Note that when using a symbol or a function to provide a dynamically -generated list of directories, you must inform the byte-compiler of this -definition so that the value is available at byte-compilation time. +When using a symbol or a function to provide a dynamically generated +list of directories, you must inform the byte-compiler of this +definition, so that the value is available at byte-compilation time. This is done by using the special form @code{eval-and-compile} (as opposed to @code{eval-when-compile}, @pxref{Eval During Compile,,, -elisp, GNU Emacs Lisp Reference Manual}). Further, this value is fixed at -whatever was determined during compilation, to avoid looking up the -same information again on each startup. For example: +elisp, GNU Emacs Lisp Reference Manual}). Furthermore, this value is +fixed to the value it had during compilation. If the operation is +costly, you do not have to repeat it again on each startup. For +example: @lisp @group @@ -669,20 +682,25 @@ Load path @end lisp @node Manual autoloads -@section Setting up autoloads manually +@subsection Setting up autoloads manually + +Packages often document how to set up its autoloads when it is being +manually installed. If it does, follow those instructions. +Otherwise, you might want to set them up manually. + @cindex autoloads for packages, setting up manually @cindex package autoloads, setting up manually @findex :commands @findex :autoload -To autoload an interactive command, use the @code{:commands} keyword. -When you use the @code{:commands} keyword, it creates autoloads for -those commands (which defers loading of the module until those commands are -used). The @code{:commands} keyword takes either a symbol or a list -of symbols as its argument. - -The @code{:autoload} keyword works like @code{:commands}, but is used -to autoload non-interactive functions. Here is an example: +To autoload an interactive command, use the @code{:commands} keyword, +which takes either a symbol or a list of symbols as its argument. It +creates autoloads for those commands (which defers loading of the +module until those commands are used). + +The @code{:autoload} keyword takes the same arguments as +@code{:commands}, but is used to autoload non-interactive functions. +Here is an example: @lisp @group commit f4ce6fa7d3e90fc41fa9067049edd585f7d28924 Author: Po Lu Date: Mon Dec 12 10:41:38 2022 +0800 Revert "Revert "Improve last change to xfaces.c" (05ece1eb8b)" This reverts commit b8d2ec920f37f5d77d32440eefc97dd5e8c2c7dc. Not only does it make debugging Emacs harder for users, that change is unsafe for the Haiku port. diff --git a/src/xfaces.c b/src/xfaces.c index 643f4365896..7dbcacb35ac 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6014,6 +6014,21 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, } #endif /* HAVE_WINDOW_SYSTEM */ +/* Remove the attribute at INDEX from the font object if SYMBOL + appears in `font-fallback-ignored-attributes'. */ + +static void +font_maybe_unset_attribute (Lisp_Object font_object, + enum font_property_index index, Lisp_Object symbol) +{ + Lisp_Object tail = Vface_font_lax_matched_attributes; + + FOR_EACH_TAIL_SAFE (tail) + { + if (EQ (XCAR (tail), symbol)) + ASET (font_object, index, Qnil); + } +} /* Realize the fully-specified face with attributes ATTRS in face cache CACHE for ASCII characters. Do it for GUI frame CACHE->f. @@ -6073,38 +6088,33 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) { Lisp_Object spec = copy_font_spec (attrs[LFACE_FONT_INDEX]); -#define MAYBE_UNSET_ATTRIBUTE(ATTR) \ - if (realize_gui_face_ignored_spec_attributes \ - & (1 << FONT_##ATTR##_INDEX)) \ - ASET (spec, FONT_##ATTR##_INDEX, Qnil); - /* The default value of - realize_gui_face_ignored_spec_attributes unsets the - weight, slant and width in spec. The best possible - values for these attributes is determined in - font_find_for_lface, called by font_load_for_lface, when - the candidate list returned by font_list_entities is - sorted by font_select_entity (which calls - font_sort_entities, which calls font_score). If these - attributes are not unset here, the candidate font list - returned by font_list_entities only contains fonts that - are exact matches for these weight, slant and width - attributes, which leads to suboptimal or wrong font - choices. See bug#59347. */ - MAYBE_UNSET_ATTRIBUTE (WEIGHT); - MAYBE_UNSET_ATTRIBUTE (SLANT); - MAYBE_UNSET_ATTRIBUTE (WIDTH); + + /* Maybe unset several values in SPEC, usually the width, + slant, and weight. The best possible values for these + attributes are determined in font_find_for_lface, called + by font_load_for_lface, when the list of candidate fonts + returned by font_list_entities is sorted by font_select_entity + (which calls font_sort_entities, which calls font_score). + If these attributes are not unset here, the candidate + font list returned by font_list_entities only contains + fonts that are exact matches for these weight, slant, and + width attributes, which could lead to suboptimal or wrong + font selection. (bug#5934) */ + font_maybe_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight); + font_maybe_unset_attribute (spec, FONT_SLANT_INDEX, QCslant); + font_maybe_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth); /* Also allow unsetting other attributes for debugging - purposes. */ - MAYBE_UNSET_ATTRIBUTE (FAMILY); - MAYBE_UNSET_ATTRIBUTE (FOUNDRY); - MAYBE_UNSET_ATTRIBUTE (REGISTRY); - MAYBE_UNSET_ATTRIBUTE (ADSTYLE); - MAYBE_UNSET_ATTRIBUTE (SIZE); - MAYBE_UNSET_ATTRIBUTE (DPI); - MAYBE_UNSET_ATTRIBUTE (SPACING); - MAYBE_UNSET_ATTRIBUTE (AVGWIDTH); - MAYBE_UNSET_ATTRIBUTE (EXTRA); -#undef MAYBE_UNSET_ATTRIBUTE + purposes. But not FONT_EXTRA_INDEX; that is not safe to + touch, at least in the Haiku font backend. */ + font_maybe_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily); + font_maybe_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry); + font_maybe_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry); + font_maybe_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle); + font_maybe_unset_attribute (spec, FONT_SIZE_INDEX, QCsize); + font_maybe_unset_attribute (spec, FONT_DPI_INDEX, QCdpi); + font_maybe_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing); + font_maybe_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth); + attrs[LFACE_FONT_INDEX] = font_load_for_lface (f, attrs, spec); } if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) @@ -7394,27 +7404,24 @@ syms_of_xfaces (void) clear the face cache, see `clear-face-cache'. */); face_near_same_color_threshold = 30000; - DEFVAR_INT ("realize-gui-face-ignored-spec-attributes", - realize_gui_face_ignored_spec_attributes, - doc: /* Ignored font-spec attributes in realize_gui_face. - -The value is an integer number and represents a bit mask. -The attribute corresponding to each bit that is set is cleared in -realize_gui_face. The bits are: 1 = :foundry, 2 = :family, -3 = :adstyle, 4 = :registry, 5 = :weight, 6 = :slant, 7 = :width, -8 = :size, 9 = :dpi, 10 = :spacing, 11 = :avgwidth, 12 = extra -attributes (:name, :script, :lang and :otf). - -Bits 5 to 7 are set in the default value. When these bits are not -set, and when the font chosen for the default face has a weight, slant -or width that is not supported by other available fonts on the system, -such as 'medium', Emacs may select suboptimal fonts for other faces. - -There is no reason to change that value except for debugging purposes. */); - realize_gui_face_ignored_spec_attributes = - (1 << FONT_WEIGHT_INDEX) | - (1 << FONT_SLANT_INDEX) | - (1 << FONT_WIDTH_INDEX); + DEFVAR_LISP ("face-font-lax-matched-attributes", + Vface_font_lax_matched_attributes, + doc: /* Font-related face attributes to match in lax manner when realizing faces. + +The value should be a list of font-related face attribute symbols; +see `set-face-attribute' for the full list of attributes. The +corresponding face attributes will be treated as "soft" constraints +when looking for suitable fonts: if an exact match is not possible, +a font can be selected that is a close, but not an exact, match. For +example, looking for a semi-bold font might select a bold or a medium +font if no semi-bold font matching other attributes is found. Emacs +still tries to find a font that is the closest possible match; in +particular, if a font is available that matches the face attributes +exactly, it will be selected. + +Note that if the `:extra' attribute is present in the value, it +will be ignored. */); + Vface_font_lax_matched_attributes = list3 (QCweight, QCslant, QCwidth); #ifdef HAVE_WINDOW_SYSTEM defsubr (&Sbitmap_spec_p); commit b8d2ec920f37f5d77d32440eefc97dd5e8c2c7dc Author: Gregory Heytings Date: Mon Dec 12 02:12:09 2022 +0100 Revert "Improve last change to xfaces.c" (05ece1eb8b) * src/xfaces.c: Revert 05ece1eb8b. See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=59347#331. diff --git a/src/xfaces.c b/src/xfaces.c index 7dbcacb35ac..643f4365896 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6014,21 +6014,6 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, } #endif /* HAVE_WINDOW_SYSTEM */ -/* Remove the attribute at INDEX from the font object if SYMBOL - appears in `font-fallback-ignored-attributes'. */ - -static void -font_maybe_unset_attribute (Lisp_Object font_object, - enum font_property_index index, Lisp_Object symbol) -{ - Lisp_Object tail = Vface_font_lax_matched_attributes; - - FOR_EACH_TAIL_SAFE (tail) - { - if (EQ (XCAR (tail), symbol)) - ASET (font_object, index, Qnil); - } -} /* Realize the fully-specified face with attributes ATTRS in face cache CACHE for ASCII characters. Do it for GUI frame CACHE->f. @@ -6088,33 +6073,38 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) { Lisp_Object spec = copy_font_spec (attrs[LFACE_FONT_INDEX]); - - /* Maybe unset several values in SPEC, usually the width, - slant, and weight. The best possible values for these - attributes are determined in font_find_for_lface, called - by font_load_for_lface, when the list of candidate fonts - returned by font_list_entities is sorted by font_select_entity - (which calls font_sort_entities, which calls font_score). - If these attributes are not unset here, the candidate - font list returned by font_list_entities only contains - fonts that are exact matches for these weight, slant, and - width attributes, which could lead to suboptimal or wrong - font selection. (bug#5934) */ - font_maybe_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight); - font_maybe_unset_attribute (spec, FONT_SLANT_INDEX, QCslant); - font_maybe_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth); +#define MAYBE_UNSET_ATTRIBUTE(ATTR) \ + if (realize_gui_face_ignored_spec_attributes \ + & (1 << FONT_##ATTR##_INDEX)) \ + ASET (spec, FONT_##ATTR##_INDEX, Qnil); + /* The default value of + realize_gui_face_ignored_spec_attributes unsets the + weight, slant and width in spec. The best possible + values for these attributes is determined in + font_find_for_lface, called by font_load_for_lface, when + the candidate list returned by font_list_entities is + sorted by font_select_entity (which calls + font_sort_entities, which calls font_score). If these + attributes are not unset here, the candidate font list + returned by font_list_entities only contains fonts that + are exact matches for these weight, slant and width + attributes, which leads to suboptimal or wrong font + choices. See bug#59347. */ + MAYBE_UNSET_ATTRIBUTE (WEIGHT); + MAYBE_UNSET_ATTRIBUTE (SLANT); + MAYBE_UNSET_ATTRIBUTE (WIDTH); /* Also allow unsetting other attributes for debugging - purposes. But not FONT_EXTRA_INDEX; that is not safe to - touch, at least in the Haiku font backend. */ - font_maybe_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily); - font_maybe_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry); - font_maybe_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry); - font_maybe_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle); - font_maybe_unset_attribute (spec, FONT_SIZE_INDEX, QCsize); - font_maybe_unset_attribute (spec, FONT_DPI_INDEX, QCdpi); - font_maybe_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing); - font_maybe_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth); - + purposes. */ + MAYBE_UNSET_ATTRIBUTE (FAMILY); + MAYBE_UNSET_ATTRIBUTE (FOUNDRY); + MAYBE_UNSET_ATTRIBUTE (REGISTRY); + MAYBE_UNSET_ATTRIBUTE (ADSTYLE); + MAYBE_UNSET_ATTRIBUTE (SIZE); + MAYBE_UNSET_ATTRIBUTE (DPI); + MAYBE_UNSET_ATTRIBUTE (SPACING); + MAYBE_UNSET_ATTRIBUTE (AVGWIDTH); + MAYBE_UNSET_ATTRIBUTE (EXTRA); +#undef MAYBE_UNSET_ATTRIBUTE attrs[LFACE_FONT_INDEX] = font_load_for_lface (f, attrs, spec); } if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) @@ -7404,24 +7394,27 @@ syms_of_xfaces (void) clear the face cache, see `clear-face-cache'. */); face_near_same_color_threshold = 30000; - DEFVAR_LISP ("face-font-lax-matched-attributes", - Vface_font_lax_matched_attributes, - doc: /* Font-related face attributes to match in lax manner when realizing faces. - -The value should be a list of font-related face attribute symbols; -see `set-face-attribute' for the full list of attributes. The -corresponding face attributes will be treated as "soft" constraints -when looking for suitable fonts: if an exact match is not possible, -a font can be selected that is a close, but not an exact, match. For -example, looking for a semi-bold font might select a bold or a medium -font if no semi-bold font matching other attributes is found. Emacs -still tries to find a font that is the closest possible match; in -particular, if a font is available that matches the face attributes -exactly, it will be selected. - -Note that if the `:extra' attribute is present in the value, it -will be ignored. */); - Vface_font_lax_matched_attributes = list3 (QCweight, QCslant, QCwidth); + DEFVAR_INT ("realize-gui-face-ignored-spec-attributes", + realize_gui_face_ignored_spec_attributes, + doc: /* Ignored font-spec attributes in realize_gui_face. + +The value is an integer number and represents a bit mask. +The attribute corresponding to each bit that is set is cleared in +realize_gui_face. The bits are: 1 = :foundry, 2 = :family, +3 = :adstyle, 4 = :registry, 5 = :weight, 6 = :slant, 7 = :width, +8 = :size, 9 = :dpi, 10 = :spacing, 11 = :avgwidth, 12 = extra +attributes (:name, :script, :lang and :otf). + +Bits 5 to 7 are set in the default value. When these bits are not +set, and when the font chosen for the default face has a weight, slant +or width that is not supported by other available fonts on the system, +such as 'medium', Emacs may select suboptimal fonts for other faces. + +There is no reason to change that value except for debugging purposes. */); + realize_gui_face_ignored_spec_attributes = + (1 << FONT_WEIGHT_INDEX) | + (1 << FONT_SLANT_INDEX) | + (1 << FONT_WIDTH_INDEX); #ifdef HAVE_WINDOW_SYSTEM defsubr (&Sbitmap_spec_p); commit 24c8c28ae617df018ee2c8b2f9df93608467d392 Author: Gregory Heytings Date: Sat Dec 10 21:40:31 2022 +0000 Do not pare arguments unnecessarily. * lisp/pcomplete.el (pcomplete-here-using-help): Do not pare arguments. Fixes bug#59803. diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 8be026b5a82..4e3a88bbda8 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1456,7 +1456,7 @@ pcomplete-here-using-help (pcomplete-match-string 1 0))) ((string-prefix-p "-" (pcomplete-arg 0)) (pcomplete-here (apply #'pcomplete-from-help command args))) - (t (pcomplete-here (pcomplete-entries)))))) + (t (pcomplete-here* (pcomplete-entries)))))) (provide 'pcomplete) commit 9c0d7bb73bb6a8d81b476d3fa497569c3061bdca Author: João Távora Date: Sun Dec 11 18:10:43 2022 +0000 Add automated tests for Eglot Most of the tests require a specific LSP server to do their thing, and skip themselves if this server isn't found. This file is a modified/overhauled version of the original Eglot automated tests that were developed in the old GitHub upstream. * test/lisp/progmodes/eglot-tests.el: New file. diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el new file mode 100644 index 00000000000..2b4de8c27d0 --- /dev/null +++ b/test/lisp/progmodes/eglot-tests.el @@ -0,0 +1,1308 @@ +;;; eglot-tests.el --- Tests for eglot.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2018-2022 Free Software Foundation, Inc. + +;; Author: João Távora +;; Keywords: tests + +;; 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: + +;; Tests for lisp/progmodes/eglot.el +;; +;; Many of these tests rely on the availability of third-party LSP +;; servers. They are automatically skipped if the program is not +;; available. +;; +;; Some of these tests rely on the GNU ELPA package company.el and +;; yasnippet.el being available. + +;;; Code: +(require 'eglot) +(require 'cl-lib) +(require 'ert) +(require 'ert-x) ; ert-simulate-command +(require 'edebug) +(require 'python) ; some tests use pylsp +(require 'cc-mode) ; c-mode-hook +(require 'company nil t) +(require 'yasnippet nil t) +(require 'tramp) +(require 'tramp-sh) +(require 'subr-x) +(require 'flymake) ; project-diagnostics + +;;; Helpers + +(defmacro eglot--with-fixture (fixture &rest body) + "Setup FIXTURE, call BODY, teardown FIXTURE. +FIXTURE is a list. Its elements are of the form (FILE . CONTENT) +to create a readable FILE with CONTENT. FILE may be a directory +name and CONTENT another (FILE . CONTENT) list to specify a +directory hierarchy. FIXTURE's elements can also be (SYMBOL +VALUE) meaning SYMBOL should be bound to VALUE during BODY and +then restored." + (declare (indent 1) (debug t)) + `(eglot--call-with-fixture + ,fixture #'(lambda () ,@body))) + +(defun eglot--make-file-or-dir (ass) + (let ((file-or-dir-name (car ass)) + (content (cdr ass))) + (cond ((listp content) + (make-directory file-or-dir-name 'parents) + (let ((default-directory (concat default-directory "/" file-or-dir-name))) + (mapcan #'eglot--make-file-or-dir content))) + ((stringp content) + (with-temp-buffer + (insert content) + (write-region nil nil file-or-dir-name nil 'nomessage)) + (list (expand-file-name file-or-dir-name))) + (t + (eglot--error "Expected a string or a directory spec"))))) + +(defun eglot--call-with-fixture (fixture fn) + "Helper for `eglot--with-fixture'. Run FN under FIXTURE." + (let* ((fixture-directory (make-temp-file "eglot--fixture" t)) + (default-directory fixture-directory) + file-specs created-files + syms-to-restore + new-servers + test-body-successful-p) + (dolist (spec fixture) + (cond ((symbolp spec) + (push (cons spec (symbol-value spec)) syms-to-restore) + (set spec nil)) + ((symbolp (car spec)) + (push (cons (car spec) (symbol-value (car spec))) syms-to-restore) + (set (car spec) (cadr spec))) + ((stringp (car spec)) (push spec file-specs)))) + (unwind-protect + (let* ((home (getenv "HOME")) + (process-environment + (append + `(;; Set XDF_CONFIG_HOME to /dev/null to prevent + ;; user-configuration to have an influence on + ;; language servers. (See github#441) + "XDG_CONFIG_HOME=/dev/null" + ;; ... on the flip-side, a similar technique by + ;; Emacs's test makefiles means that HOME is set to + ;; /nonexistent. This breaks some common + ;; installations for LSP servers like pylsp, making + ;; these tests mostly useless, so we hack around it + ;; here with a great big hack. + ,(format "HOME=%s" + (if (file-exists-p home) home + (format "/home/%s" (getenv "USER"))))) + process-environment)) + ;; Prevent "Can't guess python-indent-offset ..." messages. + (python-indent-guess-indent-offset-verbose . nil) + (eglot-server-initialized-hook + (lambda (server) (push server new-servers)))) + (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) + (prog1 (funcall fn) + (setq test-body-successful-p t))) + (eglot--message + "Test body was %s" (if test-body-successful-p "OK" "A FAILURE")) + (unwind-protect + (let ((eglot-autoreconnect nil)) + (dolist (server new-servers) + (when (jsonrpc-running-p server) + (condition-case oops + (eglot-shutdown + server nil 3 (not test-body-successful-p)) + (error + (eglot--message "Non-critical shutdown error after test: %S" + oops)))) + (when (not test-body-successful-p) + ;; We want to do this after the sockets have + ;; shut down such that any pending data has been + ;; consumed and is available in the process + ;; buffers. + (let ((buffers (delq nil (list + ;; FIXME: Accessing "internal" symbol here. + (process-buffer (jsonrpc--process server)) + (jsonrpc-stderr-buffer server) + (jsonrpc-events-buffer server))))) + (cond (noninteractive + (dolist (buffer buffers) + (eglot--message "%s:" (buffer-name buffer)) + (princ (with-current-buffer buffer (buffer-string)) + 'external-debugging-output))) + (t + (eglot--message "Preserved for inspection: %s" + (mapconcat #'buffer-name buffers ", ")))))))) + (eglot--cleanup-after-test fixture-directory created-files syms-to-restore))))) + +(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore) + (let ((buffers-to-delete + (delete nil (mapcar #'find-buffer-visiting created-files)))) + (eglot--message "Killing %s, wiping %s, restoring %s" + buffers-to-delete + fixture-directory + (mapcar #'car syms-to-restore)) + (cl-loop for (sym . val) in syms-to-restore + do (set sym val)) + (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted + (with-current-buffer buf (save-buffer) (kill-buffer))) + (delete-directory fixture-directory 'recursive))) + +(cl-defmacro eglot--with-timeout (timeout &body body) + (declare (indent 1) (debug t)) + `(eglot--call-with-timeout ,timeout (lambda () ,@body))) + +(defun eglot--call-with-timeout (timeout fn) + (let* ((tag (gensym "eglot-test-timeout")) + (timed-out (make-symbol "timeout")) + (timeout-and-message + (if (listp timeout) timeout + (list timeout "waiting for test to finish"))) + (timeout (car timeout-and-message)) + (message (cadr timeout-and-message)) + (timer) + (retval)) + (unwind-protect + (setq retval + (catch tag + (setq timer + (run-with-timer timeout nil + (lambda () + (unless edebug-active + (throw tag timed-out))))) + (funcall fn))) + (cancel-timer timer) + (when (eq retval timed-out) + (error "%s" (concat "Timed out " message)))))) + +(defun eglot--find-file-noselect (file &optional noerror) + (unless (or noerror + (file-readable-p file)) (error "%s does not exist" file)) + (find-file-noselect file)) + +(cl-defmacro eglot--sniffing ((&key server-requests + server-notifications + server-replies + client-requests + client-notifications + client-replies) + &rest body) + "Run BODY saving LSP JSON messages in variables, most recent first." + (declare (indent 1) (debug (sexp &rest form))) + (let ((log-event-ad-sym (make-symbol "eglot--event-sniff"))) + `(unwind-protect + (let ,(delq nil (list server-requests + server-notifications + server-replies + client-requests + client-notifications + client-replies)) + (advice-add + #'jsonrpc--log-event :before + (lambda (_proc message &optional type) + (cl-destructuring-bind (&key method id _error &allow-other-keys) + message + (let ((req-p (and method id)) + (notif-p method) + (reply-p id)) + (cond + ((eq type 'server) + (cond (req-p ,(when server-requests + `(push message ,server-requests))) + (notif-p ,(when server-notifications + `(push message ,server-notifications))) + (reply-p ,(when server-replies + `(push message ,server-replies))))) + ((eq type 'client) + (cond (req-p ,(when client-requests + `(push message ,client-requests))) + (notif-p ,(when client-notifications + `(push message ,client-notifications))) + (reply-p ,(when client-replies + `(push message ,client-replies))))))))) + '((name . ,log-event-ad-sym))) + ,@body) + (advice-remove #'jsonrpc--log-event ',log-event-ad-sym)))) + +(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body) + "Spin until FN match in EVENTS-SYM, flush events after it. +Pass TIMEOUT to `eglot--with-timeout'." + (declare (indent 2) (debug (sexp sexp sexp &rest form))) + `(eglot--with-timeout '(,timeout ,(or message + (format "waiting for:\n%s" (pp-to-string body)))) + (let ((event + (cl-loop thereis (cl-loop for json in ,events-sym + for method = (plist-get json :method) + when (keywordp method) + do (plist-put json :method + (substring + (symbol-name method) + 1)) + when (funcall + (jsonrpc-lambda ,args ,@body) json) + return (cons json before) + collect json into before) + for i from 0 + when (zerop (mod i 5)) + ;; do (eglot--message "still struggling to find in %s" + ;; ,events-sym) + do + ;; `read-event' is essential to have the file + ;; watchers come through. + (read-event "[eglot] Waiting a bit..." nil 0.1) + (accept-process-output nil 0.1)))) + (setq ,events-sym (cdr event)) + (eglot--message "Event detected:\n%s" + (pp-to-string (car event)))))) + +;; `rust-mode' is not a part of Emacs, so we define these two shims +;; which should be more than enough for testing. +(unless (functionp 'rust-mode) + (define-derived-mode rust-mode prog-mode "Rust") + (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode))) + +;; `typescript-mode' is not a part of Emacs, so we define these two +;; shims which should be more than enough for testing. +(unless (functionp 'typescript-mode) + (define-derived-mode typescript-mode prog-mode "TypeScript") + (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode))) + +(defun eglot--tests-connect (&optional timeout) + (let* ((timeout (or timeout 10)) + (eglot-sync-connect t) + (eglot-connect-timeout timeout)) + (apply #'eglot--connect (eglot--guess-contact)))) + +(defun eglot--simulate-key-event (char) + "Like (execute-kbd-macro (vector char)), but with `call-interactively'." + ;; Also, this is a bit similar to what electric-tests.el does. + (setq last-input-event char) + (setq last-command-event char) + (call-interactively (key-binding (vector char)))) + + +;;; Unit tests + +(ert-deftest eclipse-connect () + "Connect to eclipse.jdt.ls server." + (skip-unless (executable-find "jdtls")) + (eglot--with-fixture + '(("project/src/main/java/foo" . (("Main.java" . ""))) + ("project/.git/" . nil)) + (with-current-buffer + (eglot--find-file-noselect "project/src/main/java/foo/Main.java") + (eglot--sniffing (:server-notifications s-notifs) + (should (eglot--tests-connect 20)) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "language/status")))))) + +(defun eglot-tests--auto-detect-running-server-1 () + (let (server) + (eglot--with-fixture + `(("project" . (("coiso.c" . "bla") + ("merdix.c" . "bla"))) + ("anotherproject" . (("cena.c" . "bla")))) + (with-current-buffer + (eglot--find-file-noselect "project/coiso.c") + (should (setq server (eglot--tests-connect))) + (should (eglot-current-server))) + (with-current-buffer + (eglot--find-file-noselect "project/merdix.c") + (should (eglot-current-server)) + (should (eq (eglot-current-server) server))) + (with-current-buffer + (eglot--find-file-noselect "anotherproject/cena.c") + (should-error (eglot--current-server-or-lose)))))) + +(ert-deftest auto-detect-running-server () + "Visit a file and \\[eglot], then visit a neighbour." + (skip-unless (executable-find "clangd")) + (eglot-tests--auto-detect-running-server-1)) + +(ert-deftest auto-shutdown () + "Visit a file and \\[eglot], then kill buffer." + (skip-unless (executable-find "clangd")) + (let (server + buffer) + (eglot--with-fixture + `(("project" . (("thingy.c" . "int main() {return 0;}")))) + (with-current-buffer + (setq buffer (eglot--find-file-noselect "project/thingy.c")) + (should (setq server (eglot--tests-connect))) + (should (eglot-current-server)) + (let ((eglot-autoshutdown nil)) (kill-buffer buffer)) + (should (jsonrpc-running-p server)) + ;; re-find file... + (setq buffer (eglot--find-file-noselect (buffer-file-name buffer))) + ;; ;; but now kill it with `eglot-autoshutdown' set to t + (let ((eglot-autoshutdown t)) (kill-buffer buffer)) + (should (not (jsonrpc-running-p server))))))) + +(ert-deftest auto-reconnect () + "Start a server. Kill it. Watch it reconnect." + (skip-unless (executable-find "clangd")) + (let (server (eglot-autoreconnect 1)) + (eglot--with-fixture + `(("project" . (("thingy.c" . "bla") + ("thingy2.c" . "bla")))) + (with-current-buffer + (eglot--find-file-noselect "project/thingy.c") + (should (setq server (eglot--tests-connect))) + ;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We + ;; should have a automatic reconnection. + (run-with-timer 1.2 nil (lambda () (delete-process + (jsonrpc--process server)))) + (while (jsonrpc-running-p server) (accept-process-output nil 0.5)) + (should (eglot-current-server)) + ;; Now try again too quickly + (setq server (eglot-current-server)) + (let ((proc (jsonrpc--process server))) + (run-with-timer 0.5 nil (lambda () (delete-process proc))) + (while (process-live-p proc) (accept-process-output nil 0.5))) + (should (not (eglot-current-server))))))) + +(ert-deftest rust-analyzer-watches-files () + "Start rust-analyzer. Notify it when a critical file changes." + (skip-unless (executable-find "rust-analyzer")) + (skip-unless (executable-find "cargo")) + (let ((eglot-autoreconnect 1)) + (eglot--with-fixture + '(("watch-project" . (("coiso.rs" . "bla") + ("merdix.rs" . "bla")))) + (with-current-buffer + (eglot--find-file-noselect "watch-project/coiso.rs") + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing ( + :server-requests s-requests + :client-notifications c-notifs + :client-replies c-replies + ) + (should (eglot--tests-connect)) + (let (register-id) + (eglot--wait-for (s-requests 1) + (&key id method &allow-other-keys) + (setq register-id id) + (string= method "client/registerCapability")) + (eglot--wait-for (c-replies 1) + (&key id error &allow-other-keys) + (and (eq id register-id) (null error)))) + (delete-file "Cargo.toml") + (eglot--wait-for + (c-notifs 3 "waiting for didChangeWatchedFiles notification") + (&key method params &allow-other-keys) + (and (string= method "workspace/didChangeWatchedFiles") + (cl-destructuring-bind (&key uri type) + (elt (plist-get params :changes) 0) + (and (string= (eglot--path-to-uri "Cargo.toml") uri) + (= type 3)))))))))) + +(ert-deftest basic-diagnostics () + "Test basic diagnostics." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("diag-project" . + (("main.c" . "int main(){froat a = 42.2; return 0;}")))) + (with-current-buffer + (eglot--find-file-noselect "diag-project/main.c") + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (eglot--wait-for (s-notifs 2) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (flymake-start) + (goto-char (point-min)) + (flymake-goto-next-error 1 '() t) + (should (eq 'flymake-error (face-at-point))))))) + +(ert-deftest diagnostic-tags-unnecessary-code () + "Test rendering of diagnostics tagged \"unnecessary\"." + (skip-unless (executable-find "rust-analyzer")) + (eglot--with-fixture + '(("diagnostic-tag-project" . + (("main.rs" . + "fn main() -> () { let test=3; }")))) + (with-current-buffer + (eglot--find-file-noselect "diagnostic-tag-project/main.rs") + (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (flymake-start) + (goto-char (point-min)) + (flymake-goto-next-error 1 '() t) + (should (eq 'eglot-diagnostic-tag-unnecessary-face (face-at-point)))))))) + +(defun eglot--eldoc-on-demand () + ;; Trick Eldoc 1.1.0 into accepting on-demand calls. + (eldoc t)) + +(defun eglot--tests-force-full-eldoc () + ;; FIXME: This uses some Eldoc implementation defatils. + (when (buffer-live-p eldoc--doc-buffer) + (with-current-buffer eldoc--doc-buffer + (let ((inhibit-read-only t)) + (erase-buffer)))) + (eglot--eldoc-on-demand) + (cl-loop + repeat 10 + for retval = (and (buffer-live-p eldoc--doc-buffer) + (with-current-buffer eldoc--doc-buffer + (let ((bs (buffer-string))) + (unless (zerop (length bs)) bs)))) + when retval return retval + do (sit-for 0.5) + finally (error "eglot--tests-force-full-eldoc didn't deliver"))) + +(ert-deftest rust-analyzer-hover-after-edit () + "Hover and highlightChanges." + (skip-unless (executable-find "rust-analyzer")) + (skip-unless (executable-find "cargo")) + (eglot--with-fixture + '(("hover-project" . + (("main.rs" . + "fn test() -> i32 { let test=3; return te; }")))) + (with-current-buffer + (eglot--find-file-noselect "hover-project/main.rs") + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing ( + :server-replies s-replies + :client-requests c-reqs + ) + (eglot--tests-connect) + (goto-char (point-min)) + (search-forward "return te") + (insert "st") + (progn + ;; simulate these two which don't happen when buffer isn't + ;; visible in a window. + (eglot--signal-textDocument/didChange) + (eglot--eldoc-on-demand)) + (let (pending-id) + (eglot--wait-for (c-reqs 2) + (&key id method &allow-other-keys) + (setq pending-id id) + (string= method "textDocument/documentHighlight")) + (eglot--wait-for (s-replies 2) + (&key id &allow-other-keys) + (eq id pending-id))))))) + +(ert-deftest rename-a-symbol () + "Test basic symbol renaming." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("rename-project" + . (("main.c" . + "int foo() {return 42;} int main() {return foo();}")))) + (with-current-buffer + (eglot--find-file-noselect "rename-project/main.c") + (eglot--tests-connect) + (goto-char (point-min)) (search-forward "foo") + (eglot-rename "bar") + (should (equal (buffer-string) + "int bar() {return 42;} int main() {return bar();}"))))) + +(ert-deftest basic-completions () + "Test basic autocompletion in a python LSP." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("something.py" . "import sys\nsys.exi")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + (completion-at-point) + (should (looking-back "sys.exit"))))) + +(ert-deftest non-unique-completions () + "Test completion resulting in 'Complete, but not unique'." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + '(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + (completion-at-point)) + ;; FIXME: `current-message' doesn't work here :-( + (with-current-buffer (messages-buffer) + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (should (looking-at "Complete, but not unique")))))) + +(ert-deftest basic-xref () + "Test basic xref functionality in a python LSP." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (search-forward "bar(): f") + (call-interactively 'xref-find-definitions) + (should (looking-at "foo(): pass"))))) + +(defvar eglot--test-python-buffer + "\ +def foobarquux(a, b, c=True): pass +def foobazquuz(d, e, f): pass +") + +(declare-function yas-minor-mode nil) + +(ert-deftest snippet-completions () + "Test simple snippet completion in a python LSP." + (skip-unless (and (executable-find "pylsp") + (functionp 'yas-minor-mode))) + (eglot--with-fixture + `(("project" . (("something.py" . ,eglot--test-python-buffer)))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (yas-minor-mode 1) + (let ((eglot-workspace-configuration + `((:pylsp . (:plugins (:jedi_completion (:include_params t))))))) + (should (eglot--tests-connect))) + (goto-char (point-max)) + (insert "foobar") + (completion-at-point) + (should (looking-back "foobarquux(")) + (should (looking-at "a, b)"))))) + +(defvar company-candidates) +(declare-function company-mode nil) +(declare-function company-complete nil) + +(ert-deftest snippet-completions-with-company () + "Test simple snippet completion in a python LSP." + (skip-unless (and (executable-find "pylsp") + (functionp 'yas-minor-mode) + (functionp 'company-complete))) + (eglot--with-fixture + `(("project" . (("something.py" . ,eglot--test-python-buffer)))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (yas-minor-mode 1) + (let ((eglot-workspace-configuration + `((:pylsp . (:plugins (:jedi_completion (:include_params t))))))) + (should (eglot--tests-connect))) + (goto-char (point-max)) + (insert "foo") + (company-mode) + (company-complete) + (should (looking-back "fooba")) + (should (= 2 (length company-candidates))) + ;; this last one is brittle, since there it is possible that + ;; pylsp will change the representation of this candidate + (should (member "foobazquuz(d, e, f)" company-candidates))))) + +(ert-deftest eglot-eldoc-after-completions () + "Test documentation echo in a python LSP." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("something.py" . "import sys\nsys.exi")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + (completion-at-point) + (should (looking-back "sys.exit")) + (should (string-match "^exit" (eglot--tests-force-full-eldoc)))))) + +(ert-deftest eglot-multiline-eldoc () + "Test if suitable amount of lines of hover info are shown." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("hover-first.py" . "from datetime import datetime")))) + (with-current-buffer + (eglot--find-file-noselect "project/hover-first.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + ;; one-line + (let* ((eldoc-echo-area-use-multiline-p t) + (captured-message (eglot--tests-force-full-eldoc))) + (should (string-match "datetim" captured-message)) + (should (cl-find ?\n captured-message)))))) + +(ert-deftest eglot-single-line-eldoc () + "Test if suitable amount of lines of hover info are shown." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("hover-first.py" . "from datetime import datetime")))) + (with-current-buffer + (eglot--find-file-noselect "project/hover-first.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + ;; one-line + (let* ((eldoc-echo-area-use-multiline-p nil) + (captured-message (eglot--tests-force-full-eldoc))) + (should (string-match "datetim" captured-message)) + (should (not (cl-find ?\n eldoc-last-message))))))) + +(ert-deftest python-autopep-formatting () + "Test formatting in the pylsp python LSP. +pylsp prefers autopep over yafp, despite its README stating the contrary." + ;; Beware, default autopep rules can change over time, which may + ;; affect this test. + (skip-unless (and (executable-find "pylsp") + (executable-find "autopep8"))) + (eglot--with-fixture + `(("project" . (("something.py" . "def a():pass\n\ndef b():pass")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + ;; Try to format just the second line + (search-forward "b():pa") + (eglot-format (line-beginning-position) (line-end-position)) + (should (looking-at "ss")) + (should + (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n")) + ;; now format the whole buffer + (eglot-format-buffer) + (should + (string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n"))))) + +(ert-deftest python-yapf-formatting () + "Test formatting in the pylsp python LSP." + (skip-unless (and (executable-find "pylsp") + (not (executable-find "autopep8")) + (or (executable-find "yapf") + (executable-find "yapf3")))) + (eglot--with-fixture + `(("project" . (("something.py" . "def a():pass\ndef b():pass")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + ;; Try to format just the second line + (search-forward "b():pa") + (eglot-format (line-beginning-position) (line-end-position)) + (should (looking-at "ss")) + (should + (string= (buffer-string) "def a():pass\n\n\ndef b():\n pass\n")) + ;; now format the whole buffer + (eglot-format-buffer) + (should + (string= (buffer-string) "def a():\n pass\n\n\ndef b():\n pass\n"))))) + +(ert-deftest rust-on-type-formatting () + "Test textDocument/onTypeFormatting agains rust-analyzer." + (skip-unless (executable-find "rust-analyzer")) + (skip-unless (executable-find "cargo")) + (eglot--with-fixture + '(("on-type-formatting-project" . + (("main.rs" . + "fn main() -> () {\n foo\n .bar()\n ")))) + (with-current-buffer + (eglot--find-file-noselect "on-type-formatting-project/main.rs") + (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing (:server-notifications s-notifs) + (should (eglot--tests-connect)) + (eglot--wait-for (s-notifs 10) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics"))) + (goto-char (point-max)) + (eglot--simulate-key-event ?.) + (should (looking-back "^ \\.")))))) + +(ert-deftest javascript-basic () + "Test basic autocompletion in a JavaScript LSP." + (skip-unless (executable-find "typescript-language-server")) + (eglot--with-fixture + '(("project" . (("hello.js" . "console.log('Hello world!');")))) + (with-current-buffer + (eglot--find-file-noselect "project/hello.js") + (let ((eglot-server-programs + '((js-mode . ("typescript-language-server" "--stdio"))))) + (goto-char (point-max)) + (eglot--sniffing (:server-notifications + s-notifs + :client-notifications + c-notifs) + (should (eglot--tests-connect)) + (eglot--wait-for (s-notifs 2) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (should (not (eq 'flymake-error (face-at-point)))) + (insert "{") + (eglot--signal-textDocument/didChange) + (eglot--wait-for (c-notifs 1) (&key method &allow-other-keys) + (string= method "textDocument/didChange")) + (eglot--wait-for (s-notifs 2) (&key params method &allow-other-keys) + (and (string= method "textDocument/publishDiagnostics") + (cl-destructuring-bind (&key _uri diagnostics) params + (cl-find-if (jsonrpc-lambda (&key severity &allow-other-keys) + (= severity 1)) + diagnostics))))))))) + +(ert-deftest project-wide-diagnostics-typescript () + "Test diagnostics through multiple files in a TypeScript LSP." + (skip-unless (executable-find "typescript-language-server")) + (eglot--with-fixture + '(("project" . (("hello.ts" . "const thing = 5;\nexport { thin }") + ("hello2.ts" . "import { thing } from './hello'")))) + (eglot--make-file-or-dir '(".git")) + (let ((eglot-server-programs + '((typescript-mode . ("typescript-language-server" "--stdio"))))) + ;; Check both files because typescript-language-server doesn't + ;; report all errors on startup, at least not with such a simple + ;; setup. + (with-current-buffer (eglot--find-file-noselect "project/hello2.ts") + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (should (= 2 (length (flymake--project-diagnostics))))) + (with-current-buffer (eglot--find-file-noselect "hello.ts") + (eglot--sniffing (:server-notifications s-notifs) + (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (should (= 4 (length (flymake--project-diagnostics)))))))))) + +(ert-deftest project-wide-diagnostics-rust-analyzer () + "Test diagnostics through multiple files in a TypeScript LSP." + (skip-unless (executable-find "rust-analyzer")) + (eglot--with-fixture + '(("project" . + (("main.rs" . + "fn main() -> () { let test=3; }") + ("other-file.rs" . + "fn foo() -> () { let hi=3; }")))) + (eglot--make-file-or-dir '(".git")) + (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) + ;; Open other-file, and see diagnostics arrive for main.rs + (with-current-buffer (eglot--find-file-noselect "project/other-file.rs") + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (let ((diags (flymake--project-diagnostics))) + (should (= 2 (length diags))) + ;; Check that we really get a diagnostic from main.rs, and + ;; not from other-file.rs + (should (string-suffix-p + "main.rs" + (flymake-diagnostic-buffer (car diags)))))))))) + +(ert-deftest json-basic () + "Test basic autocompletion in vscode-json-languageserver." + (skip-unless (executable-find "vscode-json-languageserver")) + (eglot--with-fixture + '(("project" . + (("p.json" . "{\"foo.b") + ("s.json" . "{\"properties\":{\"foo.bar\":{\"default\":\"fb\"}}}") + (".git" . nil)))) + (with-current-buffer + (eglot--find-file-noselect "project/p.json") + (yas-minor-mode) + (goto-char 2) + (insert "\"$schema\": \"file://" + (file-name-directory buffer-file-name) "s.json\",") + (let ((eglot-server-programs + '((js-mode . ("vscode-json-languageserver" "--stdio"))))) + (goto-char (point-max)) + (should (eglot--tests-connect)) + (completion-at-point) + (should (looking-back "\"foo.bar\": \"")) + (should (looking-at "fb\"$")))))) + +(defun eglot-tests--lsp-abiding-column-1 () + (eglot--with-fixture + '(("project" . + (("foo.c" . "const char write_data[] = u8\"🚂🚃🚄🚅🚆🚈🚇🚈🚉🚊🚋🚌🚎🚝🚞🚟🚠🚡🛤🛲\";")))) + (let ((eglot-server-programs + '((c-mode . ("clangd"))))) + (with-current-buffer + (eglot--find-file-noselect "project/foo.c") + (setq-local eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column) + (setq-local eglot-current-column-function #'eglot-lsp-abiding-column) + (eglot--sniffing (:client-notifications c-notifs) + (eglot--tests-connect) + (end-of-line) + (insert "p ") + (eglot--signal-textDocument/didChange) + (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys) + (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0)))))) + (beginning-of-line) + (should (eq eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column)) + (funcall eglot-move-to-column-function 71) + (should (looking-at "p"))))))) + +(ert-deftest eglot-lsp-abiding-column () + "Test basic `eglot-lsp-abiding-column' and `eglot-move-to-lsp-abiding-column'." + (skip-unless (executable-find "clangd")) + (eglot-tests--lsp-abiding-column-1)) + +(ert-deftest eglot-ensure () + "Test basic `eglot-ensure' functionality." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("foo.c" . "int foo() {return 42;}") + ("bar.c" . "int bar() {return 42;}"))) + (c-mode-hook (eglot-ensure))) + (let (server) + ;; need `ert-simulate-command' because `eglot-ensure' + ;; relies on `post-command-hook'. + (with-current-buffer + (ert-simulate-command + '(find-file "project/foo.c")) + ;; FIXME: This test fails without this sleep on my machine. + ;; Figure out why and solve this more cleanly. + (sleep-for 0.1) + (should (setq server (eglot-current-server)))) + (with-current-buffer + (ert-simulate-command + '(find-file "project/bar.c")) + (should (eq server (eglot-current-server))))))) + +(ert-deftest slow-sync-connection-wait () + "Connect with `eglot-sync-connect' set to t." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect t) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 1 && clangd"))))) + (should (eglot--tests-connect 3)))))) + +(ert-deftest slow-sync-connection-intime () + "Connect synchronously with `eglot-sync-connect' set to 2." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect 2) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 1 && clangd"))))) + (should (eglot--tests-connect 3)))))) + +(ert-deftest slow-async-connection () + "Connect asynchronously with `eglot-sync-connect' set to 2." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect 1) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 2 && clangd"))))) + (should-not (apply #'eglot--connect (eglot--guess-contact))) + (eglot--with-timeout 3 + (while (not (eglot-current-server)) + (accept-process-output nil 0.2)) + (should (eglot-current-server))))))) + +(ert-deftest slow-sync-timeout () + "Failed attempt at connection synchronously." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect t) + (eglot-connect-timeout 1) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 2 && clangd"))))) + (should-error (apply #'eglot--connect (eglot--guess-contact))))))) + +(ert-deftest eglot-capabilities () + "Unit test for `eglot--server-capable'." + (cl-letf (((symbol-function 'eglot--capabilities) + (lambda (_dummy) + ;; test data lifted from Golangserver example at + ;; https://github.com/joaotavora/eglot/pull/74 + (list :textDocumentSync 2 :hoverProvider t + :completionProvider '(:triggerCharacters ["."]) + :signatureHelpProvider '(:triggerCharacters ["(" ","]) + :definitionProvider t :typeDefinitionProvider t + :referencesProvider t :documentSymbolProvider t + :workspaceSymbolProvider t :implementationProvider t + :documentFormattingProvider t :xworkspaceReferencesProvider t + :xdefinitionProvider t :xworkspaceSymbolByProperties t))) + ((symbol-function 'eglot--current-server-or-lose) + (lambda () nil))) + (should (eql 2 (eglot--server-capable :textDocumentSync))) + (should (eglot--server-capable :completionProvider :triggerCharacters)) + (should (equal '(:triggerCharacters ["."]) (eglot--server-capable :completionProvider))) + (should-not (eglot--server-capable :foobarbaz)) + (should-not (eglot--server-capable :textDocumentSync :foobarbaz)))) + +(defmacro eglot--without-interface-warnings (&rest body) + (let ((eglot-strict-mode nil)) + (macroexpand-all (macroexp-progn body) macroexpand-all-environment))) + +(ert-deftest eglot-strict-interfaces () + (let ((eglot--lsp-interface-alist + `((FooObject . ((:foo :bar) (:baz)))))) + (eglot--without-interface-warnings + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode nil)) + (eglot--dbind (foo bar) `(:foo "foo" :bar "bar") + (cons foo bar))))) + (should-error + (let ((eglot-strict-mode '(disallow-non-standard-keys))) + (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh) + (cons foo bar)))) + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode nil)) + (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh) + (cons foo bar))))) + (should-error + (let ((eglot-strict-mode '(disallow-non-standard-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :fotrix bargh) + (cons foo bar)))) + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode '(disallow-non-standard-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh) + (cons foo bar))))) + (should + (equal '("foo" . nil) + (let ((eglot-strict-mode nil)) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh) + (cons foo bar))))) + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode '(enforce-required-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh) + (cons foo bar))))) + (should-error + (let ((eglot-strict-mode '(enforce-required-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh) + (cons foo bar))))))) + +(ert-deftest eglot-dcase () + (eglot--without-interface-warnings + (let ((eglot--lsp-interface-alist + `((FooObject . ((:foo :bar) (:baz))) + (CodeAction (:title) (:kind :diagnostics :edit :command)) + (Command ((:title . string) (:command . string)) (:arguments))))) + (should + (equal + "foo" + (eglot--dcase `(:foo "foo" :bar "bar") + (((FooObject) foo) + foo)))) + (should + (equal + (list "foo" '(:title "hey" :command "ho") "some edit") + (eglot--dcase '(:title "foo" + :command (:title "hey" :command "ho") + :edit "some edit") + (((Command) _title _command _arguments) + (ert-fail "Shouldn't have destructured this object as a Command")) + (((CodeAction) title edit command) + (list title command edit))))) + (should + (equal + (list "foo" "some command" nil) + (eglot--dcase '(:title "foo" :command "some command") + (((Command) title command arguments) + (list title command arguments)) + (((CodeAction) _title _edit _command) + (ert-fail "Shouldn't have destructured this object as a CodeAction")))))))) + +(ert-deftest eglot-dcase-issue-452 () + (let ((eglot--lsp-interface-alist + `((FooObject . ((:foo :bar) (:baz))) + (CodeAction (:title) (:kind :diagnostics :edit :command)) + (Command ((string . :title) (:command . string)) (:arguments))))) + (should + (equal + (list "foo" '(:command "cmd" :title "alsofoo")) + (eglot--dcase '(:title "foo" :command (:command "cmd" :title "alsofoo")) + (((Command) _title _command _arguments) + (ert-fail "Shouldn't have destructured this object as a Command")) + (((CodeAction) title command) + (list title command))))))) + +(cl-defmacro eglot--guessing-contact ((interactive-sym + prompt-args-sym + guessed-class-sym guessed-contact-sym + &optional guessed-lang-id-sym) + &body body) + "Guess LSP contact with `eglot--guessing-contact', evaluate BODY. + +BODY is evaluated twice, with INTERACTIVE bound to the boolean passed to +`eglot--guess-contact' each time. + +If the user would have been prompted, PROMPT-ARGS-SYM is bound to +the list of arguments that would have been passed to +`read-shell-command', else nil. GUESSED-CLASS-SYM, +GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM are bound to the +useful return values of `eglot--guess-contact'. Unless the +server program evaluates to \"a-missing-executable.exe\", this +macro will assume it exists." + (declare (indent 1) (debug t)) + (let ((i-sym (cl-gensym))) + `(dolist (,i-sym '(nil t)) + (let ((,interactive-sym ,i-sym) + (buffer-file-name "_") + ,@(when prompt-args-sym `((,prompt-args-sym nil)))) + (cl-letf (((symbol-function 'executable-find) + (lambda (name &optional _remote) + (unless (string-equal name "a-missing-executable.exe") + (format "/totally-mock-bin/%s" name)))) + ((symbol-function 'read-shell-command) + ,(if prompt-args-sym + `(lambda (&rest args) (setq ,prompt-args-sym args) "") + `(lambda (&rest _dummy) "")))) + (cl-destructuring-bind + (_ _ ,guessed-class-sym ,guessed-contact-sym + ,(or guessed-lang-id-sym '_)) + (eglot--guess-contact ,i-sym) + ,@body)))))) + +(ert-deftest eglot-server-programs-simple-executable () + (let ((eglot-server-programs '((foo-mode "some-executable"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable")))))) + +(ert-deftest eglot-server-programs-simple-missing-executable () + (let ((eglot-server-programs '((foo-mode "a-missing-executable.exe"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (interactive-p prompt-args guessed-class guessed-contact) + (should (equal (not prompt-args) (not interactive-p))) + (should (equal guessed-class 'eglot-lsp-server)) + (should (or prompt-args + (equal guessed-contact '("a-missing-executable.exe"))))))) + +(ert-deftest eglot-server-programs-executable-multiple-major-modes () + (let ((eglot-server-programs '(((bar-mode foo-mode) "some-executable"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable")))))) + +(ert-deftest eglot-server-programs-executable-with-arg () + (let ((eglot-server-programs '((foo-mode "some-executable" "arg1"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable" "arg1")))))) + +(ert-deftest eglot-server-programs-executable-with-args-and-autoport () + (let ((eglot-server-programs '((foo-mode "some-executable" "arg1" + :autoport "arg2"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable" "arg1" + :autoport "arg2")))))) + +(ert-deftest eglot-server-programs-host-and-port () + (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("somehost.example.com" 7777)))))) + +(ert-deftest eglot-server-programs-host-and-port-and-tcp-args () + (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777 + :type network))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("somehost.example.com" 7777 + :type network)))))) + +(ert-deftest eglot-server-programs-class-name-and-plist () + (let ((eglot-server-programs '((foo-mode bar-class :init-key init-val))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'bar-class)) + (should (equal guessed-contact '(:init-key init-val)))))) + +(ert-deftest eglot-server-programs-class-name-and-contact-spec () + (let ((eglot-server-programs '((foo-mode bar-class "some-executable" "arg1" + :autoport "arg2"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'bar-class)) + (should (equal guessed-contact '("some-executable" "arg1" + :autoport "arg2")))))) + +(ert-deftest eglot-server-programs-function () + (let ((eglot-server-programs '((foo-mode . (lambda (&optional _) + '("some-executable"))))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable")))))) + +(ert-deftest eglot-server-programs-guess-lang () + (let ((major-mode 'foo-mode)) + (let ((eglot-server-programs '((foo-mode . ("prog-executable"))))) + (eglot--guessing-contact (_ nil _ _ guessed-lang) + (should (equal guessed-lang "foo")))) + (let ((eglot-server-programs '(((foo-mode :language-id "bar") + . ("prog-executable"))))) + (eglot--guessing-contact (_ nil _ _ guessed-lang) + (should (equal guessed-lang "bar")))) + (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar")) + . ("prog-executable"))))) + (eglot--guessing-contact (_ nil _ _ guessed-lang) + (should (equal guessed-lang "bar")))))) + +(defun eglot--glob-match (glob str) + (funcall (eglot--glob-compile glob t t) str)) + +(ert-deftest eglot--glob-test () + (should (eglot--glob-match "foo/**/baz" "foo/bar/baz")) + (should (eglot--glob-match "foo/**/baz" "foo/baz")) + (should-not (eglot--glob-match "foo/**/baz" "foo/bar")) + (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/baz/foo/quuz")) + (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/baz/foo/quuz")) + (should-not (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/ding/foo/quuz")) + (should (eglot--glob-match "*.js" "foo.js")) + (should-not (eglot--glob-match "*.js" "foo.jsx")) + (should (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.js")) + (should-not (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.jsx")) + (should (eglot--glob-match "*.{js,ts}" "foo.js")) + (should-not (eglot--glob-match "*.{js,ts}" "foo.xs")) + (should (eglot--glob-match "foo/**/*.{js,ts}" "foo/bar/baz/foo.ts")) + (should (eglot--glob-match "foo/**/*.{js,ts}x" "foo/bar/baz/foo.tsx")) + (should (eglot--glob-match "?oo.js" "foo.js")) + (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz")) + (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz")) + (should (eglot--glob-match "example.[!0-9]" "example.a")) + (should-not (eglot--glob-match "example.[!0-9]" "example.0")) + (should (eglot--glob-match "example.[0-9]" "example.0")) + (should-not (eglot--glob-match "example.[0-9]" "example.a")) + (should (eglot--glob-match "**/bar/" "foo/bar/")) + (should-not (eglot--glob-match "foo.hs" "fooxhs")) + + ;; Some more tests + (should (eglot--glob-match "**/.*" ".git")) + (should (eglot--glob-match ".?" ".o")) + (should (eglot--glob-match "**/.*" ".hidden.txt")) + (should (eglot--glob-match "**/.*" "path/.git")) + (should (eglot--glob-match "**/.*" "path/.hidden.txt")) + (should (eglot--glob-match "**/node_modules/**" "node_modules/")) + (should (eglot--glob-match "{foo,bar}/**" "foo/test")) + (should (eglot--glob-match "{foo,bar}/**" "bar/test")) + (should (eglot--glob-match "some/**/*" "some/foo.js")) + (should (eglot--glob-match "some/**/*" "some/folder/foo.js")) + + ;; VSCode supposedly supports this, not sure if good idea. + ;; + ;; (should (eglot--glob-match "**/node_modules/**" "node_modules")) + ;; (should (eglot--glob-match "{foo,bar}/**" "foo")) + ;; (should (eglot--glob-match "{foo,bar}/**" "bar")) + + ;; VSCode also supports nested blobs. Do we care? + ;; + ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js")) + ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts")) + ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5")) + ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}" "prefix/foo.8")) + ) + +(defun eglot--call-with-tramp-test (fn) + ;; Set up a loopback TRAMP method that’s just a shell so the remote + ;; host is really just the local host. + (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path)) + (tramp-histfile-override t) + (tramp-methods '(("loopback" + (tramp-login-program "/bin/sh") + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c"))))) + (temporary-file-directory (concat "/loopback::" + temporary-file-directory))) + ;; With ‘temporary-file-directory’ bound to the ‘loopback’ TRAMP + ;; method, fixtures will be automatically made “remote". + (unwind-protect + (funcall fn) + ;; Tramp leave some buffers behind, and some time later, + ;; `project-buffers' will trip over them causing a hard to debug + ;; intermittent test failure somewhere else. + (dolist (buf (buffer-list)) + (when (string-match-p "^\\*tramp" (buffer-name buf)) + (kill-buffer buf)))))) + +(ert-deftest eglot--tramp-test () + "Ensure LSP servers can be used over TRAMP." + (skip-unless (executable-find "clangd")) + (eglot--call-with-tramp-test #'eglot-tests--auto-detect-running-server-1)) + +(ert-deftest eglot--tramp-test-2 () + "Ensure LSP servers can be used over TRAMP." + (skip-unless (executable-find "clangd")) + (eglot--call-with-tramp-test #'eglot-tests--lsp-abiding-column-1)) + +(ert-deftest eglot--path-to-uri-windows () + (skip-unless (eq system-type 'windows-nt)) + (should (string-prefix-p "file:///" + (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))) + (should (string-suffix-p "c%3A/Users/Foo/bar.lisp" + (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))) + +(ert-deftest eglot--same-server-multi-mode () + "Check single LSP instance manages multiple modes in same project." + (skip-unless (executable-find "clangd")) + (let (server) + (eglot--with-fixture + `(("project" . (("foo.cpp" . + "#include \"foolib.h\" + int main() { return foo(); }") + ("foolib.h" . + "#ifdef __cplusplus\nextern \"C\" {\n#endif + int foo(); + #ifdef __cplusplus\n}\n#endif") + ("foolib.c" . + "#include \"foolib.h\" + int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/foo.cpp") + (should (setq server (eglot--tests-connect)))) + (with-current-buffer + (eglot--find-file-noselect "project/foolib.h") + (should (eq (eglot-current-server) server))) + (with-current-buffer + (eglot--find-file-noselect "project/foolib.c") + (should (eq (eglot-current-server) server)))))) + +(provide 'eglot-tests) +;;; eglot-tests.el ends here + +;; Local Variables: +;; checkdoc-force-docstrings-flag: nil +;; End: commit d3669cfe156f43ca17b5d804fc9fd7fa1f8b0e26 Author: João Távora Date: Sun Dec 11 23:16:58 2022 +0000 Eglot: allow skipping compile-time warnings about LSP interfaces * lisp/progmodes/eglot.el (eglot-strict-mode): Add 'no-unknown-interfaces'. (eglot--check-object): Honour new eglot-strict-mode value. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 2ef022992e7..2427e7b9d31 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -499,7 +499,7 @@ eglot--executable-find ;; disallow-non-standard-keys ;; enforce-required-keys ;; enforce-optional-keys - ) + no-unknown-interfaces) "How strictly to check LSP interfaces at compile- and run-time. Value is a list of symbols (if the list is empty, no checks are @@ -520,7 +520,10 @@ eglot--executable-find destructuring spec doesn't use all optional fields. If the symbol `disallow-unknown-methods' is present, Eglot warns -on unknown notifications and errors on unknown requests.")) +on unknown notifications and errors on unknown requests. + +If the symbol `no-unknown-interfaces' is present, Eglot warns at +compile time if an undeclared LSP interface is used.")) (cl-defun eglot--check-object (interface-name object @@ -594,7 +597,7 @@ eglot--check-object (when missing-out (byte-compile-warn "Destructuring for %s is missing out on %s" interface-name missing-out)))) - (t + ((memq 'no-unknown-interfaces eglot-strict-mode) (byte-compile-warn "Unknown LSP interface %s" interface-name)))))) (cl-defmacro eglot--dbind (vars object &body body) commit 04b7e01885db04e0512f5a5519ad2ac5b3dd2180 Author: Dmitry Gutov Date: Mon Dec 12 01:14:14 2022 +0200 ; project.el: Bump version. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 016dfdd5b4d..7cdaba9c07d 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. -;; Version: 0.9.2 +;; Version: 0.9.3 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that commit f2876014adbe15269ecac77cd4ce51becd0ee1c0 Author: Yuan Fu Date: Sun Dec 11 14:43:58 2022 -0800 Add customizale faces for tree-sitter explorer * lisp/treesit.el (treesit-explorer-anonymous-node) (treesit-explorer-field-name): New face. (treesit--explorer-draw-node): Use the new faces. (treesit-explore-mode): Change playground to explorer. diff --git a/lisp/treesit.el b/lisp/treesit.el index 85154d0d1c7..2ca4f1c7ddc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1839,6 +1839,18 @@ treesit-query-validate ;;; Explorer +(defface treesit-explorer-anonymous-node + (let ((display t) + (atts '(:inherit shadow))) + `((,display . ,atts))) + "Face for anonymous nodes in tree-sitter explorer.") + +(defface treesit-explorer-field-name + (let ((display t) + (atts nil)) + `((,display . ,atts))) + "Face for field names in tree-sitter explorer.") + (defvar-local treesit--explorer-buffer nil "Buffer used to display the syntax tree.") @@ -2017,7 +2029,8 @@ treesit--explorer-draw-node ;; draw everything in one line, other wise draw field name and the ;; rest of the node in two lines. (when field-name - (insert field-name ": ") + (insert (propertize (concat field-name ": ") + 'face 'treesit-explorer-field-name)) (when (and children (not all-children-inline)) (insert "\n") (indent-to-column (1+ before-field-column)))) @@ -2076,7 +2089,7 @@ treesit--explorer-draw-node (overlay-put ov 'treesit-node node) (overlay-put ov 'evaporate t) (when (not named) - (overlay-put ov 'face 'shadow))))) + (overlay-put ov 'face 'treesit-explorer-anonymous-node))))) (define-derived-mode treesit--explorer-tree-mode special-mode "TS Explorer" @@ -2095,7 +2108,7 @@ treesit-explore-mode (unless (buffer-live-p treesit--explorer-buffer) (setq-local treesit--explorer-buffer (get-buffer-create - (format "*tree-sitter playground for %s*" + (format "*tree-sitter explorer for %s*" (buffer-name)))) (setq-local treesit--explorer-language (intern (completing-read commit b889eced4449555373e53c26c280dffa548dcfc3 Author: Theodor Thornhill Date: Fri Dec 9 20:12:51 2022 +0100 Add prog-fill-reindent-defun (bug#59664) Introduce a new command that aims to reindent code in a defun, or fill a paragraph of text. The command uses treesit.el when available, otherwise falls back to using syntax-ppss and regexps. Treesit.el needs a new variable that is intended to be set by the major modes so that this and other future functions can know what kind of node we are looking at. * doc/emacs/programs.texi: Mention the new command. * etc/NEWS: Mention the new command. * lisp/progmodes/c-ts-mode.el (c++-ts-mode): Add regexp for the new variable. * lisp/progmodes/csharp-mode.el (csharp-ts-mode): Add regexp for the new variable. * lisp/progmodes/java-ts-mode.el (java-ts-mode): Add regexp for the new variable. * lisp/progmodes/js.el (js-ts-mode): Add regexp for the new variable. * list/progmodes/prog-mode.el (prog-mode-map): Bind the new command by default. (prog-fill-reindent-defun): New command. * lisp/progmodes/sh-script.el (bash-ts-mode): Add regexp for the new variable. * lisp/progmodes/typescript-ts-mode.el (typescript-ts-base-mode): Add regexp for the new variable. * lisp/treesit.el (treesit-text-type-regexp): New variable. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index ba8475e86ac..3b60732171e 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -409,6 +409,9 @@ Multi-line Indent @table @kbd @item C-M-q Reindent all the lines within one parenthetical grouping. +@item M-q +Fill a single paragraph in a defun, or reindent all the lines within +that defun. @item C-u @key{TAB} Shift an entire parenthetical grouping rigidly sideways so that its first line is properly indented. @@ -429,6 +432,22 @@ Multi-line Indent etc. To correct the overall indentation as well, type @kbd{@key{TAB}} first. +@kindex M-q +@findex prog-fill-reindent-defun +@vindex beginning-of-defun-function +@vindex end-of-defun-function +@vindex fill-paragraph-function + Major modes that derive from @code{prog-mode} can either fill a +single paragraph in a defun, such as a doc-string, or a comment, or +(re)indent the surrounding defun if point is not in a comment or a +string by typing @kbd{M-q} or using the command @kbd{M-x +prog-fill-reindent-defun}. The bounds of a defun is decided by the +variable @code{beginning-of-defun-function} and +@code{end-of-defun-function}, and the filling mechanism is decided by +@code{fill-paragraph-function} (@ref{List Motion,,, elisp, The Emacs +Lisp Reference Manual}, or @ref{Filling,,, elisp, The Emacs Lisp +Reference Manual} for more information). + @kindex C-u TAB If you like the relative indentation within a grouping but not the indentation of its first line, move point to that first line and type diff --git a/etc/NEWS b/etc/NEWS index 3338c06f037..8f6c67a3cb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -76,6 +76,13 @@ using this new option. (Or set 'display-buffer-alist' directly.) After manually editing 'eshell-aliases-file', you can use 'M-x eshell-read-aliases-list' to load the edited aliases. +** Prog Mode ++++ +*** New command 'prog-fill-reindent-defun' +This command either fills a single paragraph in a defun, such as a +doc-string, or a comment, or (re)indents the surrounding defun if +point is not in a comment or a string. It is by default bound to +'M-q' in 'prog-mode' and all its descendants. * New Modes and Packages in Emacs 30.1 diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 824325d83e0..d21937f3556 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -627,6 +627,10 @@ c++-ts-mode (group (or (syntax comment-end) (seq (+ "*") "/"))))) + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "raw_string_literal"))) + (treesit-parser-create 'cpp) (setq-local treesit-simple-indent-rules diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 8a7313b1ce8..306a1e2bf8f 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -918,6 +918,11 @@ csharp-ts-mode (group (or (syntax comment-end) (seq (+ "*") "/"))))) + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "verbatim_string-literal" + "interpolated_verbatim_string-text"))) + ;; Indent. (setq-local treesit-simple-indent-rules csharp-ts-mode--indent-rules) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 9155a7fff25..d5f4f55fe0a 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -313,6 +313,11 @@ java-ts-mode (group (or (syntax comment-end) (seq (+ "*") "/"))))) + (setq-local treesit-text-type-regexp + (regexp-opt '("line_comment" + "block_comment" + "text_block"))) + ;; Indent. (setq-local treesit-simple-indent-rules java-ts-mode--indent-rules) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f7318c481a2..da47f682d70 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3860,6 +3860,11 @@ js-ts-mode (group (or (syntax comment-end) (seq (+ "*") "/"))))) (setq-local comment-multi-line t) + + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "template_string"))) + ;; Electric-indent. (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 58cb48f1829..1bd8234dc9c 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -30,7 +30,11 @@ ;;; Code: (eval-when-compile (require 'cl-lib) - (require 'subr-x)) + (require 'subr-x) + (require 'treesit)) + +(declare-function treesit-parser-list "treesit.c") +(declare-function treesit-node-type "treesit.c") (defgroup prog-mode nil "Generic programming mode, from which others derive." @@ -102,7 +106,8 @@ prog-context-menu (defvar-keymap prog-mode-map :doc "Keymap used for programming modes." - "C-M-q" #'prog-indent-sexp) + "C-M-q" #'prog-indent-sexp + "M-q" #'prog-fill-reindent-defun) (defvar prog-indentation-context nil "When non-nil, provides context for indenting embedded code chunks. @@ -140,6 +145,32 @@ prog-indent-sexp (end (progn (forward-sexp 1) (point)))) (indent-region start end nil)))) +(defun prog-fill-reindent-defun (&optional argument) + "Refill or reindent the paragraph or defun that contains point. + +If the point is in a string or a comment, fill the paragraph that +contains point or follows point. + +Otherwise, reindent the definition that contains point or follows +point." + (interactive "P") + (save-excursion + (let ((treesit-text-node + (and (treesit-parser-list) + (string-match-p + treesit-text-type-regexp + (treesit-node-type (treesit-node-at (point))))))) + (if (or treesit-text-node + (nth 8 (syntax-ppss)) + (re-search-forward comment-start-skip (line-end-position) t)) + (if (memq fill-paragraph-function '(t nil)) + (lisp-fill-paragraph argument) + (funcall fill-paragraph-function argument)) + (beginning-of-defun) + (let ((start (point))) + (end-of-defun) + (indent-region start (point) nil)))))) + (defun prog-first-column () "Return the indentation column normally used for top-level constructs." (or (car prog-indentation-context) 0)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index e170d18afeb..1605e403473 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1619,6 +1619,10 @@ bash-ts-mode ( bracket delimiter misc-punctuation operator))) (setq-local treesit-font-lock-settings sh-mode--treesit-settings) + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "heredoc_start" + "heredoc_body"))) (treesit-major-mode-setup))) (advice-add 'bash-ts-mode :around #'sh--redirect-bash-ts-mode diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 8c4364ecc5b..aaf551850d5 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -329,6 +329,10 @@ typescript-ts-base-mode (group (or (syntax comment-end) (seq (+ "*") "/"))))) + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" + "template_string"))) + ;; Electric (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) diff --git a/lisp/treesit.el b/lisp/treesit.el index 85154d0d1c7..133564f6c8e 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1639,6 +1639,15 @@ treesit-end-of-defun (when top (goto-char (treesit-node-end top))))) +(defvar-local treesit-text-type-regexp "\\`comment\\'" + "A regexp that matches the node type of textual nodes. + +A textual node is a node that is not normal code, such as +comments and multiline string literals. For example, +\"(line|block)_comment\" in the case of a comment, or +\"text_block\" in the case of a string. This is used by +`prog-fill-reindent-defun' and friends.") + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) commit 3e349ee1198c7fc5187975c3e52e805a44f5b84b Author: Stefan Kangas Date: Sun Dec 11 19:00:01 2022 +0100 Fix error message when installing non-existent package * lisp/emacs-lisp/package.el (package-compute-transaction): Don't add trailing dash to package name in non-existent package error. (Bug#59923) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index a9fd8c741e8..4d33311cb74 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1949,8 +1949,10 @@ package-compute-transaction (if (eq next-pkg 'emacs) (error "This package requires Emacs version %s" (package-version-join next-version)) - (error "Package `%s-%s' is unavailable" - next-pkg (package-version-join next-version)))))) + (error (if (not next-version) + (format "Package `%s' is unavailable" next-pkg) + (format "Package `%s' (version %s) is unavailable" + next-pkg (package-version-join next-version)))))))) (setq packages (package-compute-transaction (cons found packages) (package-desc-reqs found) commit 733cdeabfb91520584ab88253292c1451f295bae Author: Juri Linkov Date: Sun Dec 11 19:24:34 2022 +0200 Don't use diff-mode buffer as a patch when it's visiting a file (bug#59962) * lisp/vc/vc.el (vc-deduce-fileset-1): Don't call diff-vc-deduce-fileset for diff-mode when buffer-file-name is non-nil. This is because in this case a file with a diff might be committed to VCS. So don't use it as a patch to commit with 'C-x v v'. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 328d33040db..690c907c77e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1135,7 +1135,7 @@ vc-deduce-fileset-1 (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) (dired-vc-deduce-fileset state-model-only-files not-state-changing)) - ((derived-mode-p 'diff-mode) + ((and (derived-mode-p 'diff-mode) (not buffer-file-name)) (diff-vc-deduce-fileset)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files commit 77d0793787a85c1b0685173c865578cb11fad855 Author: Stefan Monnier Date: Sun Dec 11 10:56:49 2022 -0500 * lisp/eshell/esh-opt.el (eshell--do-opts): Demote usage-msg to `user-error` diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index f52b70fe7a6..551317d8339 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -132,7 +132,7 @@ eshell--do-opts (setq args (eshell--process-args name args options)) nil)))) (when usage-msg - (error "%s" usage-msg)))))) + (user-error "%s" usage-msg)))))) (if ext-command (throw 'eshell-external (eshell-external-command ext-command orig-args)) @@ -237,7 +237,7 @@ eshell--process-option options. If no matching handler is found, and an :external command is defined -(and available), it will be called; otherwise, an error will be +\(and available), it will be called; otherwise, an error will be triggered to say that the switch is unrecognized." (let ((switch (eshell--split-switch switch kind)) (opts options) commit 87475f4af21daf8a09f08e359a22c33e0173f3ee Author: Mattias Engdegård Date: Sun Dec 4 15:20:49 2022 +0100 Fix pcase rx patterns using rx-let bindings (bug#59814) Reported by Daniel Pittman. * lisp/emacs-lisp/rx.el (rx): Move binding of rx--local-definitions... (rx--to-expr): ...here. * test/lisp/emacs-lisp/rx-tests.el (rx-let-pcase): New test. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index ec51146484a..f2a0dc54832 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1152,7 +1152,12 @@ rx-to-string (defun rx--to-expr (form) "Translate the rx-expression FORM to a Lisp expression yielding a regexp." - (let* ((rx--delayed-evaluation t) + (let* ((rx--local-definitions + ;; Retrieve local definitions from the macroexpansion environment. + ;; (It's unclear whether the previous value of `rx--local-definitions' + ;; should be included, and if so, in which order.) + (cdr (assq :rx-locals macroexpand-all-environment))) + (rx--delayed-evaluation t) (elems (car (rx--translate form))) (args nil)) ;; Merge adjacent strings. @@ -1282,12 +1287,7 @@ rx which see. \(fn REGEXPS...)" - ;; Retrieve local definitions from the macroexpansion environment. - ;; (It's unclear whether the previous value of `rx--local-definitions' - ;; should be included, and if so, in which order.) - (let ((rx--local-definitions - (cdr (assq :rx-locals macroexpand-all-environment)))) - (rx--to-expr (cons 'seq regexps)))) + (rx--to-expr (cons 'seq regexps))) (defun rx--make-binding (name tail) "Make a definitions entry out of TAIL. diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 125ddee8595..01772e54d8a 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -207,6 +207,12 @@ rx-pcase (list 'ok z)) '(ok "F")))) +(ert-deftest rx-let-pcase () + "Test `rx-let' around `pcase' with `rx' patterns (bug#59814)." + (should (equal (rx-let ((tata "ab")) + (pcase "abc" ((rx tata) 'toto))) + 'toto))) + (ert-deftest rx-kleene () "Test greedy and non-greedy repetition operators." (should (equal (rx (* "a") (+ "b") (\? "c") (?\s "d") commit 4893a15631743e1d885bd09b9184bc112c7eadcb Author: Mattias Engdegård Date: Sun Dec 11 16:26:50 2022 +0100 Fix use-package-defaults defcustom type (bug#59941) * lisp/use-package/use-package-core.el (use-package-defaults): Enlarge type to allow for keywords such as :ensure and :pin to be added later, remedying a failure in test-custom-opts. diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el index ed6a65494fa..1dee08e55b2 100644 --- a/lisp/use-package/use-package-core.el +++ b/lisp/use-package/use-package-core.el @@ -210,9 +210,7 @@ use-package-defaults return nil or non-nil depending on whether defaulting should be attempted." :type `(repeat - (list (choice :tag "Keyword" - ,@(mapcar #'(lambda (k) (list 'const k)) - use-package-keywords)) + (list (symbol :tag "Keyword") (choice :tag "Default value" sexp function) (choice :tag "Enable if non-nil" sexp function))) :group 'use-package) commit 0e5d059a2b18423be674c4fa2214c76fe06ad00c Author: Basil L. Contovounesios Date: Fri Nov 25 22:50:08 2022 +0100 Fix manual noverlay tests (again) * src/itree.c (itree_iterator_start): Fix docstring typo. * test/manual/noverlay/itree-tests.c: Stop defining unused ITREE_DEBUG. Replace removed names and APIs with current ones, e.g. interval_tree_init is now called itree_init, and itree_iterator_finish no longer exists. Ensure preconditions of itree API are satisfied before use, e.g. by zero-initializing instances of itree_node before inserting them into a tree. diff --git a/src/itree.c b/src/itree.c index 975f3a8e4fb..688d5c82476 100644 --- a/src/itree.c +++ b/src/itree.c @@ -1376,7 +1376,7 @@ itree_iterator_first_node (struct itree_tree *tree, return node; } -/* Start a iterator enumerating all intervals in [BEGIN,END) in the +/* Start an iterator enumerating all intervals in [BEGIN,END) in the given ORDER. */ struct itree_iterator * diff --git a/test/manual/noverlay/itree-tests.c b/test/manual/noverlay/itree-tests.c index 278e65f9bf7..8cab7bf84d4 100644 --- a/test/manual/noverlay/itree-tests.c +++ b/test/manual/noverlay/itree-tests.c @@ -26,7 +26,6 @@ Copyright (c) 2017-2022 Free Software Foundation, Inc. #include "emacs-compat.h" #define EMACS_LISP_H /* lisp.h inclusion guard */ -#define ITREE_DEBUG 1 #define ITREE_TESTING #include "itree.c" @@ -53,7 +52,7 @@ test_insert1_setup (void) enum { N = 6 }; const int values[N] = {50, 30, 20, 10, 15, 5}; struct itree_node *nodes[N] = {&N_50, &N_30, &N_20, &N_10, &N_15, &N_05}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) { nodes[i]->begin = nodes[i]->end = values[i]; @@ -67,7 +66,7 @@ START_TEST (test_insert_1) * [50] */ - interval_tree_insert (&tree, &N_50); + itree_insert_node (&tree, &N_50); ck_assert (! N_50.red); ck_assert_ptr_eq (&N_50, tree.root); } @@ -81,8 +80,8 @@ START_TEST (test_insert_2) * (30) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); ck_assert (! N_50.red); ck_assert (N_30.red); ck_assert_ptr_eq (&N_50, tree.root); @@ -102,9 +101,9 @@ START_TEST (test_insert_3) * (20) (50) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); ck_assert (N_50.red); ck_assert (! N_30.red); ck_assert (N_20.red); @@ -128,10 +127,10 @@ START_TEST (test_insert_4) * (10) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); - interval_tree_insert (&tree, &N_10); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); + itree_insert_node (&tree, &N_10); ck_assert (! N_50.red); ck_assert (! N_30.red); ck_assert (! N_20.red); @@ -159,11 +158,11 @@ START_TEST (test_insert_5) * (10) (20) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); - interval_tree_insert (&tree, &N_10); - interval_tree_insert (&tree, &N_15); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); + itree_insert_node (&tree, &N_10); + itree_insert_node (&tree, &N_15); ck_assert (! N_50.red); ck_assert (! N_30.red); ck_assert (N_20.red); @@ -197,12 +196,12 @@ START_TEST (test_insert_6) * (5) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_30); - interval_tree_insert (&tree, &N_20); - interval_tree_insert (&tree, &N_10); - interval_tree_insert (&tree, &N_15); - interval_tree_insert (&tree, &N_05); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_30); + itree_insert_node (&tree, &N_20); + itree_insert_node (&tree, &N_10); + itree_insert_node (&tree, &N_15); + itree_insert_node (&tree, &N_05); ck_assert (! N_50.red); ck_assert (! N_30.red); ck_assert (! N_20.red); @@ -238,7 +237,7 @@ test_insert2_setup (void) enum { N = 6 }; const int values[] = {50, 70, 80, 90, 85, 95}; struct itree_node *nodes[N] = {&N_50, &N_70, &N_80, &N_90, &N_85, &N_95}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) { nodes[i]->begin = nodes[i]->end = values[i]; @@ -252,7 +251,7 @@ START_TEST (test_insert_7) * [50] */ - interval_tree_insert (&tree, &N_50); + itree_insert_node (&tree, &N_50); ck_assert (! N_50.red); ck_assert_ptr_eq (&N_50, tree.root); } @@ -266,8 +265,8 @@ START_TEST (test_insert_8) * (70) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); ck_assert (! N_50.red); ck_assert (N_70.red); ck_assert_ptr_eq (&N_50, tree.root); @@ -287,9 +286,9 @@ START_TEST (test_insert_9) * (50) (80) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); ck_assert (N_50.red); ck_assert (! N_70.red); ck_assert (N_80.red); @@ -313,10 +312,10 @@ START_TEST (test_insert_10) * (90) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); - interval_tree_insert (&tree, &N_90); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); + itree_insert_node (&tree, &N_90); ck_assert (! N_50.red); ck_assert (! N_70.red); ck_assert (! N_80.red); @@ -344,11 +343,11 @@ START_TEST (test_insert_11) * (80) (90) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); - interval_tree_insert (&tree, &N_90); - interval_tree_insert (&tree, &N_85); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); + itree_insert_node (&tree, &N_90); + itree_insert_node (&tree, &N_85); ck_assert (! N_50.red); ck_assert (! N_70.red); ck_assert (N_80.red); @@ -383,12 +382,12 @@ START_TEST (test_insert_12) * (95) */ - interval_tree_insert (&tree, &N_50); - interval_tree_insert (&tree, &N_70); - interval_tree_insert (&tree, &N_80); - interval_tree_insert (&tree, &N_90); - interval_tree_insert (&tree, &N_85); - interval_tree_insert (&tree, &N_95); + itree_insert_node (&tree, &N_50); + itree_insert_node (&tree, &N_70); + itree_insert_node (&tree, &N_80); + itree_insert_node (&tree, &N_90); + itree_insert_node (&tree, &N_85); + itree_insert_node (&tree, &N_95); ck_assert (! N_50.red); ck_assert (! N_70.red); ck_assert (! N_80.red); @@ -419,7 +418,7 @@ START_TEST (test_insert_13) enum { N = 4 }; const int values[N] = {10, 20, 30, 40}; struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) itree_insert (&tree, nodes[i], values[i], values[i]); @@ -437,13 +436,13 @@ START_TEST (test_insert_13) START_TEST (test_insert_14) { enum { N = 3 }; - struct itree_node nodes[N]; - interval_tree_init (&tree); + struct itree_node nodes[N] = {0}; + itree_init (&tree); for (int i = 0; i < N; ++i) itree_insert (&tree, &nodes[i], 10, 10); for (int i = 0; i < N; ++i) - ck_assert (interval_tree_contains (&tree, &nodes[i])); + ck_assert (itree_contains (&tree, &nodes[i])); } END_TEST @@ -458,7 +457,7 @@ START_TEST (test_insert_14) static void test_remove1_setup (void) { - interval_tree_init (&tree); + itree_init (&tree); tree.root = &B; A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D; A.left = A.right = C.left = C.right = E.left = E.right = NULL; @@ -480,7 +479,7 @@ START_TEST (test_remove_1) { B.red = A.red = C.red = E.red = false; D.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -502,7 +501,7 @@ START_TEST (test_remove_1) START_TEST (test_remove_2) { B.red = D.red = A.red = C.red = E.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -523,7 +522,7 @@ START_TEST (test_remove_3) { D.red = A.red = E.red = false; B.red = C.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -546,7 +545,7 @@ START_TEST (test_remove_4) { B.red = C.red = E.red = true; A.red = D.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -569,7 +568,7 @@ START_TEST (test_remove_4) static void test_remove2_setup (void) { - interval_tree_init (&tree); + itree_init (&tree); tree.root = &B; A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D; A.right = A.left = C.right = C.left = E.right = E.left = NULL; @@ -589,7 +588,7 @@ START_TEST (test_remove_5) { B.red = A.red = C.red = E.red = false; D.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -611,7 +610,7 @@ START_TEST (test_remove_5) START_TEST (test_remove_6) { B.red = D.red = A.red = C.red = E.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -632,7 +631,7 @@ START_TEST (test_remove_7) { D.red = A.red = E.red = false; B.red = C.red = true; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -655,7 +654,7 @@ START_TEST (test_remove_8) { B.red = C.red = E.red = true; A.red = D.red = false; - interval_tree_remove_fix (&tree, &A, &B); + itree_remove_fix (&tree, &A, &B); ck_assert (! A.red); ck_assert (! B.red); @@ -676,7 +675,7 @@ START_TEST (test_remove_9) enum { N = 4 }; const int values[N] = {10, 20, 30, 40}; struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40}; - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < N; ++i) itree_insert (&tree, nodes[i], values[i], values[i]); @@ -722,8 +721,8 @@ START_TEST (test_remove_10) srand (42); shuffle (index, N); - interval_tree_init (&tree); - struct itree_node nodes[N]; + itree_init (&tree); + struct itree_node nodes[N] = {0}; for (int i = 0; i < N; ++i) { ptrdiff_t pos = (i + 1) * 10; @@ -733,10 +732,10 @@ START_TEST (test_remove_10) shuffle (index, N); for (int i = 0; i < N; ++i) { - ck_assert (interval_tree_contains (&tree, &nodes[index[i]])); + ck_assert (itree_contains (&tree, &nodes[index[i]])); itree_remove (&tree, &nodes[index[i]]); } - ck_assert_ptr_null (tree.root); + ck_assert (itree_empty_p (&tree)); ck_assert_int_eq (tree.size, 0); } END_TEST @@ -748,12 +747,12 @@ START_TEST (test_remove_10) START_TEST (test_generator_1) { - struct itree_node node, *n; - struct itree_iterator *g; - interval_tree_init (&tree); + struct itree_node node = {0}, *n; + struct itree_iterator it, *g; + itree_init (&tree); itree_insert (&tree, &node, 10, 20); - g = itree_iterator_start (&tree, 0, 30, ITREE_ASCENDING, NULL, 0); + g = itree_iterator_start (&it, &tree, 0, 30, ITREE_ASCENDING); n = itree_iterator_next (g); ck_assert_ptr_eq (n, &node); ck_assert_int_eq (n->begin, 10); @@ -761,13 +760,11 @@ START_TEST (test_generator_1) ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); - itree_iterator_finish (g); - g = itree_iterator_start (&tree, 30, 50, ITREE_ASCENDING, NULL, 0); + g = itree_iterator_start (&it, &tree, 30, 50, ITREE_ASCENDING); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); - itree_iterator_finish (g); } END_TEST @@ -777,8 +774,8 @@ test_check_generator (struct itree_tree *tree, int n, ...) { va_list ap; - struct itree_iterator *g = - itree_iterator_start (tree, begin, end, ITREE_ASCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, tree, begin, end, ITREE_ASCENDING); va_start (ap, n); for (int i = 0; i < n; ++i) @@ -790,13 +787,12 @@ test_check_generator (struct itree_tree *tree, va_end (ap); ck_assert_ptr_null (itree_iterator_next (g)); ck_assert_ptr_null (itree_iterator_next (g)); - itree_iterator_finish (g); } START_TEST (test_generator_2) { - interval_tree_init (&tree); - struct itree_node nodes[3]; + itree_init (&tree); + struct itree_node nodes[3] = {0}; for (int i = 0; i < 3; ++i) itree_insert (&tree, &nodes[i], 10 * (i + 1), 10 * (i + 2)); @@ -830,7 +826,7 @@ test_create_tree (struct itree_node *nodes, int n, bool doshuffle) shuffle (index, n); } - interval_tree_init (&tree); + itree_init (&tree); for (int i = 0; i < n; ++i) { struct itree_node *node = &nodes[index[i]]; @@ -862,8 +858,8 @@ START_TEST (test_generator_5) {.begin = 30, .end = 50}, {.begin = 40, .end = 60}}; test_create_tree (nodes, N, false); - struct itree_iterator *g = - itree_iterator_start (&tree, 0, 100, ITREE_PRE_ORDER, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 0, 100, ITREE_PRE_ORDER); for (int i = 0; i < N; ++i) { struct itree_node *n = itree_iterator_next (g); @@ -876,7 +872,6 @@ START_TEST (test_generator_5) case 3: ck_assert_int_eq (40, n->begin); break; } } - itree_iterator_finish (g); } END_TEST @@ -888,8 +883,8 @@ START_TEST (test_generator_6) {.begin = 30, .end = 50}, {.begin = 40, .end = 60}}; test_create_tree (nodes, N, true); - struct itree_iterator *g = - itree_iterator_start (&tree, 0, 100, ITREE_ASCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 0, 100, ITREE_ASCENDING); for (int i = 0; i < N; ++i) { struct itree_node *n = itree_iterator_next (g); @@ -902,7 +897,6 @@ START_TEST (test_generator_6) case 3: ck_assert_int_eq (40, n->begin); break; } } - itree_iterator_finish (g); } END_TEST @@ -914,8 +908,8 @@ START_TEST (test_generator_7) {.begin = 30, .end = 50}, {.begin = 40, .end = 60}}; test_create_tree (nodes, N, true); - struct itree_iterator *g = - itree_iterator_start (&tree, 0, 100, ITREE_DESCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 0, 100, ITREE_DESCENDING); for (int i = 0; i < N; ++i) { struct itree_node *n = itree_iterator_next (g); @@ -928,7 +922,6 @@ START_TEST (test_generator_7) case 3: ck_assert_int_eq (10, n->begin); break; } } - itree_iterator_finish (g); } END_TEST @@ -938,14 +931,13 @@ START_TEST (test_generator_8) struct itree_node nodes[N] = {{.begin = 20, .end = 30}, {.begin = 40, .end = 50}}; test_create_tree (nodes, N, false); - struct itree_iterator *g = - itree_iterator_start (&tree, 1, 60, ITREE_DESCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 1, 60, ITREE_DESCENDING); struct itree_node *n = itree_iterator_next (g); ck_assert_int_eq (n->begin, 40); itree_iterator_narrow (g, 50, 60); n = itree_iterator_next (g); ck_assert_ptr_null (n); - itree_iterator_finish (g); } END_TEST @@ -955,14 +947,13 @@ START_TEST (test_generator_9) struct itree_node nodes[N] = {{.begin = 25, .end = 25}, {.begin = 20, .end = 30}}; test_create_tree (nodes, N, false); - struct itree_iterator *g = - itree_iterator_start (&tree, 1, 30, ITREE_DESCENDING, NULL, 0); + struct itree_iterator it, *g = + itree_iterator_start (&it, &tree, 1, 30, ITREE_DESCENDING); struct itree_node *n = itree_iterator_next (g); ck_assert_int_eq (n->begin, 25); itree_iterator_narrow (g, 25, 30); n = itree_iterator_next (g); ck_assert_int_eq (n->begin, 20); - itree_iterator_finish (g); } END_TEST @@ -981,7 +972,7 @@ #define N_END (itree_node_end (&gap_tree, &gap_node)) test_setup_gap_node (ptrdiff_t begin, ptrdiff_t end, bool front_advance, bool rear_advance) { - interval_tree_init (&gap_tree); + itree_init (&gap_tree); gap_node.front_advance = front_advance; gap_node.rear_advance = rear_advance; itree_insert (&gap_tree, &gap_node, begin, end); @@ -1281,9 +1272,8 @@ main (void) Suite *s = basic_suite (); SRunner *sr = srunner_create (s); - init_itree (); srunner_run_all (sr, CK_ENV); - int nfailed = srunner_ntests_failed (sr); + int failed = srunner_ntests_failed (sr); srunner_free (sr); - return (nfailed == 0) ? EXIT_SUCCESS : EXIT_FAILURE; + return failed ? EXIT_FAILURE : EXIT_SUCCESS; } commit 074b7e6f4d1eefacade7b4c5b19ee9b03a2367ae Author: Mattias Engdegård Date: Sat Dec 10 14:13:39 2022 +0100 ; * lisp/use-package/bind-key.el: Remove ineffective backslashes. diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el index a5d6a5f45bb..1ce717019f1 100644 --- a/lisp/use-package/bind-key.el +++ b/lisp/use-package/bind-key.el @@ -542,13 +542,13 @@ describe-personal-keybindings (format (format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths) (cdr bind-key-column-widths)) - key-name (format "`%s\'" command-desc) + key-name (format "`%s'" command-desc) (if (string= command-desc at-present-desc) (if (or (null was-command) (string= command-desc was-command-desc)) "" - (format "was `%s\'" was-command-desc)) - (format "[now: `%s\']" at-present))))) + (format "was `%s'" was-command-desc)) + (format "[now: `%s']" at-present))))) (princ (if (string-match "[ \t]+\n" line) (replace-match "\n" t t line) line)))) commit 864ed9dfa1f5809527e2c4727ae1a44a445d4266 Author: Mattias Engdegård Date: Sat Dec 10 14:11:34 2022 +0100 ; * lisp/progmodes/dockerfile-ts-mode.el: use \' instead of $ diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 1ece3dd59bf..544e0f82d6d 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -132,7 +132,7 @@ dockerfile-ts-mode--imenu-1 ;;;###autoload (add-to-list 'auto-mode-alist ;; NOTE: We can't use `rx' here, as it breaks bootstrap. - '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)$" + '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode)) ;;;###autoload commit 9f7e5584a4ff3c61a90301f70366a829c2c0ac04 Author: समीर सिंह Sameer Singh Date: Wed Nov 2 08:05:44 2022 +0530 * lisp/language/indian.el: Improve Brahmi composition rules. (bug#58957) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 4994cfdc7ac..f70f7fcce17 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -552,24 +552,40 @@ malayalam-composable-pattern char-script-table)) ;; Brahmi composition rules -(let ((consonant "[\U00011013-\U00011034]") - (non-consonant "[^\U00011013-\U00011034\U00011046\U0001107F]") - (vowel "[\U00011038-\U00011045]") - (numeral "[\U00011052-\U00011065]") - (multiplier "[\U00011064\U00011065]") - (virama "\U00011046") - (number-joiner "\U0001107F")) +(let ((consonant "[\x11013-\x11037\x11075]") + (independent-vowel "[\x11005-\x11012\x11071\x11072]") + (vowel "[\x11038-\x11045\x11073\x11074]") + (nasal "[\x11000\x11001]") + (virama "\x11046") + (jivhamuliya "\x11003") + (upadhmaniya "\x11004") + (ka-kha "[\x11013\x11014]") + (pa-pha "[\x11027\x11028]") + (number-joiner "\x1107F") + (numeral "[\x11052-\x11065]") + (multiplier "[\x11064\x11065]")) (set-char-table-range composition-function-table - '(#x11046 . #x11046) + '(#x11046 . #x11046) (list (vector - ;; Consonant conjuncts - (concat consonant "\\(?:" virama consonant "\\)+" - vowel "?") + ;; Consonant based syllables + (concat consonant "\\(?:" virama consonant + "\\)*\\(?:" virama "\\|" vowel "*" + nasal "?\\)") 1 'font-shape-gstring) (vector - ;; Vowelless consonants - (concat consonant virama non-consonant) + ;; Vowel based syllables + (concat independent-vowel virama "?" vowel "?" nasal "?") 1 'font-shape-gstring))) + (set-char-table-range composition-function-table + '(#x11003 . #x11004) + (list (vector + ;; Velar fricative + (concat jivhamuliya ka-kha "?") + 0 'font-shape-gstring) + (vector + ;; Bilabial fricative + (concat upadhmaniya pa-pha "?") + 0 'font-shape-gstring))) (set-char-table-range composition-function-table '(#x1107F . #x1107F) (list (vector commit 78ad33bb05f63460ca6ceda26e851b119ac0eb7d Author: Eli Zaretskii Date: Sun Dec 11 11:59:04 2022 +0200 ; Minor cleanup of last change in xfaces.c. diff --git a/src/xfaces.c b/src/xfaces.c index 2571b0d4694..7dbcacb35ac 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6018,8 +6018,8 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, appears in `font-fallback-ignored-attributes'. */ static void -font_unset_attribute (Lisp_Object font_object, enum font_property_index index, - Lisp_Object symbol) +font_maybe_unset_attribute (Lisp_Object font_object, + enum font_property_index index, Lisp_Object symbol) { Lisp_Object tail = Vface_font_lax_matched_attributes; @@ -6089,31 +6089,31 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] { Lisp_Object spec = copy_font_spec (attrs[LFACE_FONT_INDEX]); - /* Unset several values in SPEC, usually the width, slant, - and weight. The best possible values for these - attributes is determined in font_find_for_lface, called - by font_load_for_lface, when the candidate list returned - by font_list_entities is sorted by font_select_entity + /* Maybe unset several values in SPEC, usually the width, + slant, and weight. The best possible values for these + attributes are determined in font_find_for_lface, called + by font_load_for_lface, when the list of candidate fonts + returned by font_list_entities is sorted by font_select_entity (which calls font_sort_entities, which calls font_score). If these attributes are not unset here, the candidate font list returned by font_list_entities only contains - fonts that are exact matches for these weight, slant and - width attributes, which leads to suboptimal or wrong font - choices. (bug#5934) */ - font_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight); - font_unset_attribute (spec, FONT_SLANT_INDEX, QCslant); - font_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth); + fonts that are exact matches for these weight, slant, and + width attributes, which could lead to suboptimal or wrong + font selection. (bug#5934) */ + font_maybe_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight); + font_maybe_unset_attribute (spec, FONT_SLANT_INDEX, QCslant); + font_maybe_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth); /* Also allow unsetting other attributes for debugging purposes. But not FONT_EXTRA_INDEX; that is not safe to - touch in the Haiku font backend. */ - font_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily); - font_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry); - font_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry); - font_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle); - font_unset_attribute (spec, FONT_SIZE_INDEX, QCsize); - font_unset_attribute (spec, FONT_DPI_INDEX, QCdpi); - font_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing); - font_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth); + touch, at least in the Haiku font backend. */ + font_maybe_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily); + font_maybe_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry); + font_maybe_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry); + font_maybe_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle); + font_maybe_unset_attribute (spec, FONT_SIZE_INDEX, QCsize); + font_maybe_unset_attribute (spec, FONT_DPI_INDEX, QCdpi); + font_maybe_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing); + font_maybe_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth); attrs[LFACE_FONT_INDEX] = font_load_for_lface (f, attrs, spec); } @@ -7408,8 +7408,8 @@ syms_of_xfaces (void) Vface_font_lax_matched_attributes, doc: /* Font-related face attributes to match in lax manner when realizing faces. -The value should be a list of face attribute symbols; see -`set-face-attribute' for the full list of attributes. The +The value should be a list of font-related face attribute symbols; +see `set-face-attribute' for the full list of attributes. The corresponding face attributes will be treated as "soft" constraints when looking for suitable fonts: if an exact match is not possible, a font can be selected that is a close, but not an exact, match. For commit 2024ade271de1264f84c432eb925e4d610bc6bea Author: Eli Zaretskii Date: Sun Dec 11 11:49:29 2022 +0200 ; Improve docs of relaxing face-font attribute match (bug#59347) * src/xfaces.c (realize_gui_face): Fix typo and coding style. (syms_of_xfaces) : A better name. diff --git a/src/xfaces.c b/src/xfaces.c index 88d3a79f8c0..2571b0d4694 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6021,9 +6021,7 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, font_unset_attribute (Lisp_Object font_object, enum font_property_index index, Lisp_Object symbol) { - Lisp_Object tail; - - tail = Vfont_fallback_ignored_attributes; + Lisp_Object tail = Vface_font_lax_matched_attributes; FOR_EACH_TAIL_SAFE (tail) { @@ -6046,7 +6044,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] #ifdef HAVE_WINDOW_SYSTEM struct face *default_face; struct frame *f; - Lisp_Object stipple, underline, overline, strike_through, box, spec; + Lisp_Object stipple, underline, overline, strike_through, box; eassert (FRAME_WINDOW_P (cache->f)); @@ -6089,7 +6087,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] } if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) { - spec = copy_font_spec (attrs[LFACE_FONT_INDEX]); + Lisp_Object spec = copy_font_spec (attrs[LFACE_FONT_INDEX]); /* Unset several values in SPEC, usually the width, slant, and weight. The best possible values for these @@ -6102,7 +6100,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] fonts that are exact matches for these weight, slant and width attributes, which leads to suboptimal or wrong font choices. (bug#5934) */ - font_unset_attribute (spec, FONT_WEIGHT_INDEX, QCwidth); + font_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight); font_unset_attribute (spec, FONT_SLANT_INDEX, QCslant); font_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth); /* Also allow unsetting other attributes for debugging @@ -7406,22 +7404,24 @@ syms_of_xfaces (void) clear the face cache, see `clear-face-cache'. */); face_near_same_color_threshold = 30000; - DEFVAR_LISP ("font-fallback-ignored-attributes", - Vfont_fallback_ignored_attributes, - doc: /* A list of face attributes to ignore. - -List of font-related face attributes to ignore when realizing a face. -This is a list of symbols representing face attributes that will be -ignored by Emacs when realizing a face, and an exact match couldn't be -found for its preferred font. For example: - - (:weight :slant :width) - -tells Emacs to ignore the `:weight', `:slant' and `:width' face -attributes when searching for a font and an exact match could not be -found for the font attributes specified in the face being realized. */); - Vfont_fallback_ignored_attributes - = list3 (QCwidth, QCslant, QCwidth); + DEFVAR_LISP ("face-font-lax-matched-attributes", + Vface_font_lax_matched_attributes, + doc: /* Font-related face attributes to match in lax manner when realizing faces. + +The value should be a list of face attribute symbols; see +`set-face-attribute' for the full list of attributes. The +corresponding face attributes will be treated as "soft" constraints +when looking for suitable fonts: if an exact match is not possible, +a font can be selected that is a close, but not an exact, match. For +example, looking for a semi-bold font might select a bold or a medium +font if no semi-bold font matching other attributes is found. Emacs +still tries to find a font that is the closest possible match; in +particular, if a font is available that matches the face attributes +exactly, it will be selected. + +Note that if the `:extra' attribute is present in the value, it +will be ignored. */); + Vface_font_lax_matched_attributes = list3 (QCweight, QCslant, QCwidth); #ifdef HAVE_WINDOW_SYSTEM defsubr (&Sbitmap_spec_p);