commit 237c0b583c96acc516190a1d8b93f6e0bfa83633 (HEAD, refs/remotes/origin/master) Author: Laurence Warne Date: Sat Jul 22 14:35:15 2023 +0100 Fix Proced Start column alignment for different locales * lisp/proced.el (proced-grammar-alist): Change the justify value of the start attribute to 'left' instead of a fixed value of 6. (Bug#64752) (proced-format-start): Adjust the doc string. diff --git a/lisp/proced.el b/lisp/proced.el index b3d581a49d1..47de74b0ecb 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -152,7 +152,7 @@ proced-grammar-alist (pri "Pr" "%d" right proced-< t (pri pid) (nil t t)) (nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil)) (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t)) - (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) + (start "Start" proced-format-start left proced-time-lessp nil (start pid) (t t nil)) (vsize "VSize" proced-format-memory right proced-< t (vsize pid) (nil t t)) @@ -1599,8 +1599,7 @@ proced-format-time (format "%02d%s%02d" minutes colon seconds))))) (defun proced-format-start (start) - "Format time START. -The return string is always 6 characters wide." + "Format time START." (let ((d-start (decode-time start)) (d-current (decode-time)) (colon (if proced-enable-color-flag commit f37c65b402f8a054fed9a3d6234cb7f85da3621a Author: Stefan Monnier Date: Sat Jul 22 17:20:51 2023 -0400 * src/eval.c (get_backtrace): Don't skip the top frame `profiler.el` was reporting incomplete backtraces. I had a suspicion there was something off, but it became obvious when I saw that `set-buffer-multibyte` did not appear in the `profiler-report` output when opening a large compressed tarball, even though I knew it to be a large contributor (which `elp-results` confirmed). I have no idea why this `backtrace_next` was there, sadly, but now `profiler-report` gives me results that make a lot more sense. diff --git a/src/eval.c b/src/eval.c index 3f4e77cd3b1..9e54d489a3b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -4203,7 +4203,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) void get_backtrace (Lisp_Object array) { - union specbinding *pdl = backtrace_next (backtrace_top ()); + union specbinding *pdl = backtrace_top (); ptrdiff_t i = 0, asize = ASIZE (array); /* Copy the backtrace contents into working memory. */ commit 5d2d28458d0eb378a7e94363ef716e8648ef129a Author: Mattias Engdegård Date: Sat Jul 22 17:26:11 2023 +0200 Fix regexp character class syntax property ghost matching bug The syntax-table-dependent regexp character classes [:space:], [:word:] and [:punct:] always use the buffer-local syntax table for performance reasons. Fix a bug that could cause ghost (mis)matches from use of lingering state by constructs that do use syntax properties, such as `\sX`. * src/regex-emacs.c (BUFFER_SYNTAX): New macro. (ISPUNCT, ISSPACE, ISWORD): Use BUFFER_SYNTAX instead of SYNTAX. (regex_compile): Delete syntax table setup code that is no longer needed. * test/src/regex-emacs-tests.el (regex-emacs-syntax-properties): New regression test. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 51fc2b0558d..7e75f0ac597 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -47,6 +47,9 @@ #define RE_DUP_MAX (0xffff) /* Make syntax table lookup grant data in gl_state. */ #define SYNTAX(c) syntax_property (c, 1) +/* Explicit syntax lookup using the buffer-local table. */ +#define BUFFER_SYNTAX(c) syntax_property (c, 0) + #define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) #define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) #define RE_STRING_CHAR(p, multibyte) \ @@ -132,18 +135,22 @@ #define ISALPHA(c) (IS_REAL_ASCII (c) \ #define ISLOWER(c) lowercasep (c) +#define ISUPPER(c) uppercasep (c) + +/* The following predicates use the buffer-local syntax table and + ignore syntax properties, for consistency with the up-front + assumptions made at compile time. */ + #define ISPUNCT(c) (IS_REAL_ASCII (c) \ ? ((c) > ' ' && (c) < 0177 \ && !(((c) >= 'a' && (c) <= 'z') \ || ((c) >= 'A' && (c) <= 'Z') \ || ((c) >= '0' && (c) <= '9'))) \ - : SYNTAX (c) != Sword) + : BUFFER_SYNTAX (c) != Sword) -#define ISSPACE(c) (SYNTAX (c) == Swhitespace) +#define ISSPACE(c) (BUFFER_SYNTAX (c) == Swhitespace) -#define ISUPPER(c) uppercasep (c) - -#define ISWORD(c) (SYNTAX (c) == Sword) +#define ISWORD(c) (BUFFER_SYNTAX (c) == Sword) /* Use alloca instead of malloc. This is because using malloc in re_search* or re_match* could cause memory leaks when C-g is used @@ -2048,13 +2055,6 @@ regex_compile (re_char *pattern, ptrdiff_t size, is_xdigit, since they can only match ASCII characters. We don't need to handle them for multibyte. */ - /* Setup the gl_state object to its buffer-defined value. - This hardcodes the buffer-global syntax-table for ASCII - chars, while the other chars will obey syntax-table - properties. It's not ideal, but it's the way it's been - done until now. */ - SETUP_BUFFER_SYNTAX_TABLE (); - for (c = 0; c < 0x80; ++c) if (re_iswctype (c, cc)) { diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index 08a93dbf30e..4e2c0f67a44 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -949,4 +949,20 @@ regexp-tests-zero-width-assertion-repetition (should (equal (smatch "a\\=*b" "ab") 0)) )) +(ert-deftest regex-emacs-syntax-properties () + ;; Verify absence of character class syntax property ghost matching bug. + (let ((re "\\s-[[:space:]]") + (s (concat "a" + (propertize "b" 'syntax-table '(0)) ; whitespace + "éz")) + (parse-sexp-lookup-properties t)) + ;; Test matching in a string... + (should (equal (string-match re s) nil)) + ;; ... and in a buffer. + (should (equal (with-temp-buffer + (insert s) + (goto-char (point-min)) + (re-search-forward re nil t)) + nil)))) + ;;; regex-emacs-tests.el ends here commit cfdce1a19fa8a845b78e535b510932df945598ad Author: Eli Zaretskii Date: Sat Jul 22 18:50:26 2023 +0300 ; Fix documentation of last change. * src/xdisp.c (syms_of_xdisp): * src/dispnew.c (syms_of_display): * doc/lispref/commands.texi (Accessing Mouse): Fix documentation of last change. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index ad7ba1e8a82..82dca3548a6 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2758,12 +2758,13 @@ Accessing Mouse @defopt mouse-prefer-closest-glyph If this variable is non-@code{nil}, the @code{posn-point} of a mouse -position list will be set to the position of the glyph whose left most -position is closest to the mouse pointer, as opposed to the position of +position list will be set to the position of the glyph whose leftmost +edge is the closest to the mouse click, as opposed to the position of the glyph underneath the mouse pointer itself. For example, if @code{posn-at-x-y} is called with @var{x} set to @code{9}, which is -contained within a character of width 10 positioned at column 0, the -point saved within the mouse position list will be after that character. +contained within a character of width 10 displayed at column 0, the +point saved within the mouse position list will be @emph{after} that +character, not @emph{before} it. @end defopt @node Accessing Scroll diff --git a/src/dispnew.c b/src/dispnew.c index 821357c51c1..28f0eaeaa95 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6823,12 +6823,11 @@ syms_of_display (void) doc: /* Non-nil means put cursor in minibuffer, at end of any message there. */); DEFVAR_BOOL ("mouse-prefer-closest-glyph", mouse_prefer_closest_glyph, - doc: /* Non-nil means mouse position lists are reported relative -to the glyph closest to their coordinates. + doc: /* Non-nil means mouse click position is taken from glyph closest to click. - When non-nil, mouse position lists will be reported with their -`posn-point' set to the position of the glyph closest to the mouse -pointer, instead of the glyph immediately under. */); +When non-nil, mouse position lists will report buffer position set to +the position of the glyph that is the closest to the mouse pointer +at the time of the click, instead of the glyph immediately under it. */); mouse_prefer_closest_glyph = false; DEFVAR_LISP ("glyph-table", Vglyph_table, diff --git a/src/xdisp.c b/src/xdisp.c index 1de6fcfd172..540fdbb0b07 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -37513,10 +37513,10 @@ syms_of_xdisp (void) display_raw_bytes_as_hex = false; DEFVAR_BOOL ("mouse-fine-grained-tracking", mouse_fine_grained_tracking, - doc: /* Non-nil for pixel-wise mouse-movement. + doc: /* Non-nil for pixelwise mouse-movement. When nil, mouse-movement events will not be generated as long as the mouse stays within the extent of a single glyph (except for images). -When nil and mouse-prefer-closest-glyph is non-nil, mouse-movement +When nil and `mouse-prefer-closest-glyph' is non-nil, mouse-movement events will instead not be generated as long as the mouse stays within the extent of a single left/right half glyph (except for images). */); mouse_fine_grained_tracking = false; commit 7a0c0b2ad80004127add275cf703cc0ac03d174c Author: Moritz Maxeiner Date: Sat Jul 22 16:55:07 2023 +0200 * etc/NEWS: Announce the new option 'mouse-prefer-closest-glyph'. diff --git a/etc/NEWS b/etc/NEWS index c2c436fb477..5883b4df2a7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -126,6 +126,17 @@ confirmation. It controls the placement of point and the region after duplicating a region with 'duplicate-dwim'. ++++ +** New user option 'mouse-prefer-closest-glyph'. +When enabled, clicking or dragging with the mouse will put the point +or start the drag in front of the buffer position corresponding to the +glyph with the closest X coordinate to the click or start of the drag. +In other words, if the mouse pointer is in the right half of a glyph, +point will be put after the buffer position corresponding to that glyph, +whereas if the mouse pointer is in the left half of a glyph, point +will be put in front the buffer position corresponding to that glyph. +By default this is disabled. + * Changes in Specialized Modes and Packages in Emacs 30.1 commit 191aef4f618408c1be9f57459eaaa91b955fec18 Author: Moritz Maxeiner Date: Sat Jul 22 16:55:07 2023 +0200 Implement new option 'mouse-prefer-closest-glyph' * src/dispnew.c (mouse_prefer_closest_glyph): New global variable. (buffer_posn_from_coords): * src/xdisp.c (remember_mouse_glyph): Respect 'mouse_prefer_closest_glyph'. (mouse_fine_grained_tracking): Update documentation to include 'mouse_prefer_closest_glyph' effects. * doc/lispref/commands.texi (Accessing Mouse): Update documentation to say what the new option does when enabled. * lisp/cus-start.el (standard): New user option 'mouse-prefer-closest-glyph'. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 037f42124cc..ad7ba1e8a82 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2756,6 +2756,16 @@ Accessing Mouse to the entire window area including scroll bars, margins and fringes. @end defun +@defopt mouse-prefer-closest-glyph +If this variable is non-@code{nil}, the @code{posn-point} of a mouse +position list will be set to the position of the glyph whose left most +position is closest to the mouse pointer, as opposed to the position of +the glyph underneath the mouse pointer itself. For example, if +@code{posn-at-x-y} is called with @var{x} set to @code{9}, which is +contained within a character of width 10 positioned at column 0, the +point saved within the mouse position list will be after that character. +@end defopt + @node Accessing Scroll @subsection Accessing Scroll Bar Events @cindex scroll bar events, data in diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 6ca7d7fcafd..6d83aaf4d14 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -231,6 +231,7 @@ minibuffer-prompt-properties--setter (inverse-video display boolean) (visible-bell display boolean) (no-redraw-on-reenter display boolean) + (mouse-prefer-closest-glyph display boolean) ;; doc.c (text-quoting-style display diff --git a/src/dispnew.c b/src/dispnew.c index 82524d8cb8d..821357c51c1 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5636,6 +5636,15 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p argument is ZV to prevent move_it_in_display_line from matching based on buffer positions. */ move_it_in_display_line (&it, ZV, to_x, MOVE_TO_X); + if (mouse_prefer_closest_glyph) + { + int next_x = it.current_x + it.pixel_width; + int before_dx = to_x - it.current_x; + int after_dx = next_x - to_x; + if (before_dx > after_dx) + move_it_in_display_line (&it, ZV, next_x, MOVE_TO_X); + } + bidi_unshelve_cache (itdata, 0); Fset_buffer (old_current_buffer); @@ -6813,6 +6822,15 @@ syms_of_display (void) DEFVAR_BOOL ("cursor-in-echo-area", cursor_in_echo_area, doc: /* Non-nil means put cursor in minibuffer, at end of any message there. */); + DEFVAR_BOOL ("mouse-prefer-closest-glyph", mouse_prefer_closest_glyph, + doc: /* Non-nil means mouse position lists are reported relative +to the glyph closest to their coordinates. + + When non-nil, mouse position lists will be reported with their +`posn-point' set to the position of the glyph closest to the mouse +pointer, instead of the glyph immediately under. */); + mouse_prefer_closest_glyph = false; + DEFVAR_LISP ("glyph-table", Vglyph_table, doc: /* Table defining how to output a glyph code to the frame. If not nil, this is a vector indexed by glyph code to define the glyph. diff --git a/src/xdisp.c b/src/xdisp.c index 2eba42e3d90..1de6fcfd172 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2759,6 +2759,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) enum window_part part; enum glyph_row_area area; int x, y, width, height; + int original_gx; if (mouse_fine_grained_tracking) { @@ -2769,6 +2770,8 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) /* Try to determine frame pixel position and size of the glyph under frame pixel coordinates X/Y on frame F. */ + original_gx = gx; + if (window_resize_pixelwise) { width = height = 1; @@ -2984,6 +2987,15 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) gy += WINDOW_TOP_EDGE_Y (w); store_rect: + if (mouse_prefer_closest_glyph) + { + int half_width = width / 2; + width = half_width; + + int bisection = gx + half_width; + if (original_gx > bisection) + gx = bisection; + } STORE_NATIVE_RECT (*rect, gx, gy, width, height); /* Visible feedback for debugging. */ @@ -37503,7 +37515,10 @@ syms_of_xdisp (void) DEFVAR_BOOL ("mouse-fine-grained-tracking", mouse_fine_grained_tracking, doc: /* Non-nil for pixel-wise mouse-movement. When nil, mouse-movement events will not be generated as long as the -mouse stays within the extent of a single glyph (except for images). */); +mouse stays within the extent of a single glyph (except for images). +When nil and mouse-prefer-closest-glyph is non-nil, mouse-movement +events will instead not be generated as long as the mouse stays within +the extent of a single left/right half glyph (except for images). */); mouse_fine_grained_tracking = false; DEFVAR_BOOL ("tab-bar--dragging-in-progress", tab_bar__dragging_in_progress, commit af547c4bbe806bf011363d6a04d93aef27d94df9 Author: F. Jason Park Date: Fri Jul 14 21:08:31 2023 -0700 Improve ERC's internal invisibility API * etc/ERC-NEWS: Mention that line endings have moved from the end to the beginning of hidden messages. * lisp/erc/erc-fill.el (erc-fill--wrap-ensure-dependencies): Warn when users have `erc-legacy-invisible-bounds-p' enabled, and force it to its default value of nil in the current buffer. (erc-fill-wrap-mode, erc-fill-wrap-enable): Move business involving compat variable for enabling legacy hidden-message behavior to helper. * lisp/erc/erc-match.el (erc-match--hide-fools-offset-bounds): Move internal variable from to main library file and rename to `erc-legacy-invisible-bounds-p'. Also make obsolete and flip semantics so a non-nil value enables the traditional behavior. (erc-match--hide-message): Move to main library file and rename to `erc--hide-message'. Add a property-value parameter instead of hard-coding to `erc-match'. Also, condition behavior on renamed compatibility flag `erc-legacy-invisible-bounds-p'. (erc-hide-fools): Call `erc--hide-message' with own value for `invisible' property specifically for fools. That is, use `match-fools' rather than `erc-match' or `erc-match-fools' to save room when visually inspecting. This retains the module name as a prefix to hopefully minimize collisions with invisibility spec members owned by non-ERC minor modes. The `timestamp' spec member owned by erc-stamp likewise lacks a namespace prefix, but its feature/group affiliation is self-evident. (erc-match--modify-invisibility-spec): Use toggle command non-interactively for adding and removing invisibility spec member. (erc-match-toggle-hidden-fools): Add explicit override argument and defer to general helper for actually modifying spec. (erc-match--toggle-hidden): New helper for toggling invisibility spec. * lisp/erc/erc.el (erc--merge-prop): If new value is a list, prepend onto existing. Add note about possible space optimization. (erc-legacy-invisible-bounds-p): New obsolete compat variable to enable traditional pre-5.6 invisibility interval on hidden messages. Replaces `erc-match--hide-fools-offset-bounds-p' but has an inverted meaning. The new default value of nil means invisibility covers a shifted interval consisting of the message body plus the line ending immediately preceding it. (erc--hide-message): New function, formerly `erc-match--hide-message' from erc-match.el introduced in ERC 5.6. * test/lisp/erc/erc-scenarios-match.el: (erc-scenarios-match--invisible-stamp): Fix comment and use API function in interactive convenience setup. (erc-scenarios-match--find-bol): New test helper. (erc-scenarios-match--find-eol): Fix bug affecting interactive use. (erc-scenarios-match--stamp-left-fools-invisible, erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-right-invisible-fill-wrap, erc-scenarios-match--stamp-both-invisible-fill-static): Update `invisible' property from `erc-match' to `match-fools'. (erc-scenarios-match--stamp-right-fools-invisible, erc-scenarios-match--stamp-both-invisible-fill-static): Move test body to function of same name for use in multiple cases. (erc-scenarios-match--stamp-right-fools-invisible--nooffset, erc-scenarios-match--stamp-both-invisible-fill-static--nooffset): New test variants asserting proper hiding with old pre-5.6 invisibility interval. * test/lisp/erc/erc-tests.el (erc-tests--equal-including-properties): Relocate macro higher in same file. (erc--merge-prop): New test. (Bug#64301) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 13e49a9123d..a3a8cb086e0 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -295,6 +295,15 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** Hidden messages contain a preceding rather than trailing newline. +ERC has traditionally only offered to hide messages involving fools, +but plans are to make hiding more powerful. Anyone depending on the +existing behavior should be aware that hidden messages now start and +end one character earlier, so that hidden line endings precede rather +than follow accompanying text. However, an escape hatch is available +in the variable 'erc-legacy-invisible-bounds-p'. It reinstates the +old behavior, which is unsupported by newer modules and features. + *** 'erc-display-message' optionally combines faces. Users may notice that ERC now inserts some important error messages in a combination of 'erc-error-face' and 'erc-notice-face'. This is diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c74fcd298d5..17eb0002f08 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -324,11 +324,17 @@ erc-fill-wrap-mode-map ;; Not sure if this is problematic because `erc-bol' takes no args. " " #'erc-fill--wrap-beginning-of-line) -(defvar erc-match-mode) (defvar erc-button-mode) -(defvar erc-match--hide-fools-offset-bounds) +(defvar erc-legacy-invisible-bounds-p) (defun erc-fill--wrap-ensure-dependencies () + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (when erc-legacy-invisible-bounds-p + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "Module `fill-wrap' is incompatible with the obsolete compatibility" + " flag `erc-legacy-invisible-bounds-p'. Disabling locally in %s." + (current-buffer)) + (setq-local erc-legacy-invisible-bounds-p nil))) (let (missing-deps) (unless erc-fill-mode (push 'fill missing-deps) @@ -389,9 +395,6 @@ fill-wrap (setq erc-fill--function #'erc-fill-wrap) (add-function :after (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) - (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) - (require 'erc-match) - (setq erc-match--hide-fools-offset-bounds t)) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index a5b0af41b2a..50db8a132ec 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -655,24 +655,10 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(defvar-local erc-match--hide-fools-offset-bounds nil) - (defun erc-hide-fools (match-type _nickuserhost _message) "Hide comments from designated fools." (when (eq match-type 'fool) - (erc-match--hide-message))) - -(defun erc-match--hide-message () - (progn ; FIXME raise sexp - (if erc-match--hide-fools-offset-bounds - (let ((beg (point-min)) - (end (point-max))) - (save-restriction - (widen) - (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match))) - ;; Before ERC 5.6, this also used to add an `intangible' - ;; property, but the docs say it's now obsolete. - (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match)))) + (erc--hide-message 'match-fools))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -682,19 +668,31 @@ erc-beep-on-match (defun erc-match--modify-invisibility-spec () "Add an `erc-match' property to the local spec." + ;; Hopefully, this will be extended to do the same for other + ;; invisible properties managed by this module. (if erc-match-mode - (add-to-invisibility-spec 'erc-match) + (erc-match-toggle-hidden-fools +1) (erc-with-all-buffers-of-server nil nil - (remove-from-invisibility-spec 'erc-match)))) + (erc-match-toggle-hidden-fools -1)))) -(defun erc-match-toggle-hidden-fools () +(defun erc-match-toggle-hidden-fools (arg) "Toggle fool visibility. -Expect `erc-hide-fools' or a function that does something similar -to be in `erc-text-matched-hook'." - (interactive) - (if (memq 'erc-match (ensure-list buffer-invisibility-spec)) - (remove-from-invisibility-spec 'erc-match) - (add-to-invisibility-spec 'erc-match))) +Expect the function `erc-hide-fools' or similar to be present in +`erc-text-matched-hook'." + (interactive "P") + (erc-match--toggle-hidden 'match-fools arg)) + +(defun erc-match--toggle-hidden (prop arg) + "Toggle invisibility for spec member PROP. +Treat ARG in a manner similar to mode toggles defined by +`define-minor-mode'." + (when arg + (setq arg (prefix-numeric-value arg))) + (if (memq prop (ensure-list buffer-invisibility-spec)) + (unless (natnump arg) + (remove-from-invisibility-spec prop)) + (when (or (not arg) (natnump arg)) + (add-to-invisibility-spec prop)))) (provide 'erc-match) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d519bf221b9..7375b5308ea 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3011,22 +3011,51 @@ erc-display-line (defvar erc--compose-text-properties nil "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") +;; To save space, we could maintain a map of all readable property +;; values and optionally dispense archetypal constants in their place +;; in order to ensure all occurrences of some list (a b) across all +;; text-properties in all ERC buffers are actually the same object. (defun erc--merge-prop (from to prop val &optional object) - "Compose existing PROP values with VAL between FROM and TO in OBJECT. + "Combine existing PROP values with VAL between FROM and TO in OBJECT. For spans where PROP is non-nil, cons VAL onto the existing value, ensuring a proper list. Otherwise, just set PROP to VAL. -See also `erc-button-add-face'." +When VAL is itself a list, prepend its members onto an existing +value. See also `erc-button-add-face'." (let ((old (get-text-property from prop object)) (pos from) (end (next-single-property-change from prop object to)) new) (while (< pos to) - (setq new (if old (cons val (ensure-list old)) val)) + (setq new (if old + (if (listp val) + (append val (ensure-list old)) + (cons val (ensure-list old))) + val)) (put-text-property pos end prop new object) (setq pos end old (get-text-property pos prop object) end (next-single-property-change pos prop object to))))) +(defvar erc-legacy-invisible-bounds-p nil + "Whether to hide trailing rather than preceding newlines. +Beginning in ERC 5.6, invisibility extends from a message's +preceding newline to its last non-newline character.") +(make-obsolete-variable 'erc-legacy-invisible-bounds-p + "decremented interval now permanent" "30.1") + +(defun erc--hide-message (value) + "Apply `invisible' text-property with VALUE to current message. +Expect to run in a narrowed buffer during message insertion." + (if erc-legacy-invisible-bounds-p + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (erc--merge-prop (point-min) (point-max) 'invisible value) + (let ((beg (point-min)) + (end (point-max))) + (save-restriction + (widen) + (erc--merge-prop (1- beg) (1- end) 'invisible value))))) + (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 8a718962c55..cd899fddb98 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -62,11 +62,15 @@ erc-scenarios-match--stamp-left-current-nick 'erc-current-nick-face)))))) ;; When hacking on tests that use this fixture, it's best to run it -;; interactively, and check for wierdness before and after doing -;; M-: (remove-from-invisibility-spec 'erc-match) RET. +;; interactively, and visually inspect the output with various +;; combinations of: +;; +;; M-x erc-match-toggle-hidden-fools RET +;; M-x erc-toggle-timestamps RET +;; (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (unless noninteractive - (kill-new "(remove-from-invisibility-spec 'erc-match)")) + (kill-new "erc-match-toggle-hidden-fools")) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") @@ -128,11 +132,11 @@ erc-scenarios-match--stamp-left-fools-invisible ;; Leading stamp has combined `invisible' property value. (should (equal (get-text-property (pos-bol) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) - ;; Message proper has the `invisible' property `erc-match'. + ;; Message proper has the `invisible' property `match-fools'. (let ((msg-beg (next-single-property-change (pos-bol) 'invisible))) - (should (eq (get-text-property msg-beg 'invisible) 'erc-match)) + (should (eq (get-text-property msg-beg 'invisible) 'match-fools)) (should (>= (next-single-property-change msg-beg 'invisible nil) (pos-eol))))) @@ -147,19 +151,29 @@ erc-scenarios-match--stamp-left-fools-invisible (= (next-single-property-change msg-beg 'invisible nil (pos-eol)) (pos-eol)))))))) +(defun erc-scenarios-match--find-bol () + (save-excursion + (should (get-text-property (1- (point)) 'erc-command)) + (goto-char (should (previous-single-property-change (point) 'erc-command))) + (pos-bol))) + (defun erc-scenarios-match--find-eol () (save-excursion - (goto-char (next-single-property-change (point) 'erc-command)) + (if-let ((next (next-single-property-change (point) 'erc-command))) + (goto-char next) + ;; We're already at the end of the message. + (should (get-text-property (1- (point)) 'erc-command))) (pos-eol))) ;; In most cases, `erc-hide-fools' makes line endings invisible. -(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () +(defun erc-scenarios-match--stamp-right-fools-invisible () :tags '(:expensive-test) (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)) (erc-scenarios-match--invisible-stamp (lambda () - (let ((end (erc-scenarios-match--find-eol))) + (let ((beg (erc-scenarios-match--find-bol)) + (end (erc-scenarios-match--find-eol))) ;; The end of the message is a newline. (should (= ?\n (char-after end))) @@ -168,19 +182,23 @@ erc-scenarios-match--stamp-right-fools-invisible ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- end) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; The final newline is hidden by `match', not `stamps' - (should (equal (get-text-property end 'invisible) 'erc-match)) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (if erc-legacy-invisible-bounds-p + (should (eq (get-text-property end 'invisible) 'match-fools)) + (should (eq (get-text-property beg 'invisible) 'match-fools)) + (should-not (get-text-property end 'invisible)))) - ;; The message proper has the `invisible' property `erc-match', + ;; The message proper has the `invisible' property `match-fools', ;; and it starts after the preceding newline. - (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) ;; It ends just before the timestamp. (let ((msg-end (next-single-property-change (pos-bol) 'invisible))) (should (equal (get-text-property msg-end 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; Stamp's `invisible' property extends throughout the stamp ;; and ends before the trailing newline. @@ -197,6 +215,17 @@ erc-scenarios-match--stamp-right-fools-invisible (should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))) +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible () + :tags '(:expensive-test) + (erc-scenarios-match--stamp-right-fools-invisible)) + +(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset () + :tags '(:expensive-test) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) + (erc-scenarios-match--stamp-right-fools-invisible)))) + ;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides ;; the preceding message's line ending. (ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap () @@ -215,16 +244,16 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap ;; Stamps have a combined `invisible' property value. (should (equal (get-text-property (1- (pos-eol)) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) - ;; The message proper has the `invisible' property `erc-match', + ;; The message proper has the `invisible' property `match-fools', ;; which starts at the preceding newline... - (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match)) + (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools)) ;; ... and ends just before the timestamp. (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible))) (should (equal (get-text-property msgend 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; The newline before `erc-insert-marker' is still visible. (should-not (get-text-property (pos-eol) 'invisible)) @@ -242,8 +271,7 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible))) (should (eq (get-text-property inv-beg 'invisible) 'timestamp))))))) -(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () - :tags '(:expensive-test) +(defun erc-scenarios-match--stamp-both-invisible-fill-static () (should (eq erc-insert-timestamp-function #'erc-insert-timestamp-left-and-right)) @@ -265,8 +293,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static (search-forward "[23:59]")))) (ert-info ("Line endings in Bob's messages are invisible") - ;; The message proper has the `invisible' property `erc-match'. - (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match)) + ;; The message proper has the `invisible' property `match-fools'. + (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools)) (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command)) (mend (next-single-property-change mbeg 'erc-command))) @@ -283,9 +311,13 @@ erc-scenarios-match--stamp-both-invisible-fill-static (should (= (next-single-property-change (pos-bol) 'erc-timestamp) mend)) - ;; Line ending has the `invisible' property `erc-match'. + ;; Line ending has the `invisible' property `match-fools'. (should (= (char-after mend) ?\n)) - (should (eq (get-text-property mend'invisible) 'erc-match)))) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (if erc-legacy-invisible-bounds-p + (should (eq (get-text-property mend 'invisible) 'match-fools)) + (should (eq (get-text-property mbeg 'invisible) 'match-fools)) + (should-not (get-text-property mend 'invisible)))))) ;; Only the message right after Alice speaks contains stamps. (when (= 1 bob-utterance-counter) @@ -298,7 +330,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static ;; Date stamp has a combined `invisible' property value ;; that extends until the start of the message proper. (should (equal (get-text-property (point) 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) (should (= (next-single-property-change (point) 'invisible) (1+ (pos-eol)))))) @@ -314,7 +346,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static (let ((msgend (next-single-property-change (pos-bol) 'invisible))) ;; Stamp has a combined `invisible' property value. (should (equal (get-text-property msgend 'invisible) - '(timestamp erc-match))) + '(timestamp match-fools))) ;; Combined `invisible' property spans entire timestamp. (should (= (next-single-property-change msgend 'invisible) @@ -331,4 +363,15 @@ erc-scenarios-match--stamp-both-invisible-fill-static (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)) (should-not (next-single-property-change (pos-bol) 'invisible)))))) +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static () + :tags '(:expensive-test) + (erc-scenarios-match--stamp-both-invisible-fill-static)) + +(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset () + :tags '(:expensive-test) + (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) + (should-not erc-legacy-invisible-bounds-p) + (let ((erc-legacy-invisible-bounds-p t)) + (erc-scenarios-match--stamp-both-invisible-fill-static)))) + ;;; erc-scenarios-match.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index fff3c4cb704..327ee46a736 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,6 +1278,50 @@ erc-process-input-line (should-not calls)))))) +(defmacro erc-tests--equal-including-properties (a b) + (list (if (< emacs-major-version 29) + 'ert-equal-including-properties + 'equal-including-properties) + a b)) + +(ert-deftest erc--merge-prop () + (with-current-buffer (get-buffer-create "*erc-test*") + ;; Baseline. + (insert "abc\n") + (erc--merge-prop 1 3 'erc-test 'x) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 0 2 (erc-test x)))) + (erc--merge-prop 1 3 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x))))) + + ;; Multiple intervals. + (goto-char (point-min)) + (insert "def\n") + (erc--merge-prop 1 2 'erc-test 'x) + (erc--merge-prop 2 3 'erc-test 'y) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("def" 0 1 (erc-test x) 1 2 (erc-test y)))) + (erc--merge-prop 1 3 'erc-test 'z) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y))))) + + ;; New val as list. + (goto-char (point-min)) + (insert "ghi\n") + (erc--merge-prop 2 3 'erc-test '(y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z))))) + (erc--merge-prop 1 3 'erc-test '(w x)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z))))) + + (when noninteractive + (kill-buffer)))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space @@ -1494,12 +1538,6 @@ erc-message (kill-buffer "ExampleNet") (kill-buffer "#chan"))) -(defmacro erc-tests--equal-including-properties (a b) - (list (if (< emacs-major-version 29) - 'ert-equal-including-properties - 'equal-including-properties) - a b)) - (ert-deftest erc-format-privmessage () ;; Basic PRIVMSG (should (erc-tests--equal-including-properties commit 63d8b2a59a4f395ca64adb698cdb4764d80dfbee Author: F. Jason Park Date: Fri Jul 14 06:12:30 2023 -0700 Make erc-fill-wrap work with left-sided stamps * etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to' supporting a value of `margin', which has been abandoned. Do mention leading white space before stamps now having stamp-related properties. * lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt): New generic functions with default implementations factored out from `erc--unhide-prompt' and `erc--hide-prompt'. (erc--prompt-hidden-p): New internal predicate function. (erc--unhide-prompt): Defer to `erc--reveal-prompt', and set `erc-prompt' text property to t. (erc--hide-prompt): Defer to `erc--conceal-prompt', and set `erc-prompt' text property to `hidden'. * lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Don't use `function-equal'. * lisp/erc/erc-fill.el (erc-fill-wrap-margin-width, erc-fill-wrap-margin-side): New options to control side and initial width of `fill-wrap' margin. (erc-fill--wrap-beginning-of-line): Fix bug involving non-string valued `display' props. (erc-fill-wrap-toggle-truncate-lines): New command to re-enable `visual-line-mode' when toggling off `truncate-lines'. (erc-fill-wrap-mode-map): Remap `toggle-truncate-lines' to `erc-fill-wrap-toggle-truncate-lines'. (erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): Update doc string, persist a few local vars, and conditionally set `erc-stamp--margin-left-p'. When deactivating, disable `visual-line-mode' first. (erc-fill--wrap-continued-message-p): Use `erc-speaker' instead of heuristics when comparing nicks between consecutive messages. (erc-fill-wrap-nudge): Update doc string and account for left-sided stamps. (erc-timestamp-offset): Add comment regarding conditional guard based on function-valued option. * lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value variant `margin', which was originally intended to be new in ERC 5.6. This functionality was all but useless without the internal minor mode `erc-stamp--display-margin-mode' active. (erc-stamp-right-margin-width): Remove unused option new in 5.6. (erc-stamp--display-margin-force): Remove unused function. (erc-stamp--margin-width, erc-stamp--margin-left-p): New internal variables. (erc-stamp--init-margins-on-connect): New function for initializing mode-managed margin after connecting. (erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename function to latter and accommodate left-hand stamps. (erc-stamp--inherited-props): Move definition higher up in same file. (erc-stamp--display-margin-mode): Update function name, and adjust setup and teardown to accommodate left-handed stamps. Don't add advice around `erc-insert-timestamp-function'. (erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin): New function and helper var to convert a normal inserted prompt so that it appears in the left margin. (erc-stamp--refresh-left-margin-prompt): Helper for other modules to quickly refresh prompt outside of insert hooks. (erc--reveal-prompt, erc--conceal-prompt): New implementations for when `erc-stamp--display-margin-mode' is active. (erc-insert-timestamp-left): Convert to generic function and provide implementation for `erc-stamp--display-margin-mode'. (erc-stamp--omit-properties-on-folded-lines): New variable, an escape hatch for propertizing white space before right-side stamps folded over onto another line. (erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to ever be the symbol `margin'. Move handling for that case to one contingent on the internal minor mode `erc-stamp--display-margin-mode' being active. Add text properties preceding stamps that occupy a line by their lonesome. See related news entry for rationale. This is arguably a breaking change. * lisp/erc/erc.el (erc--refresh-prompt-hook): New hook variable for modules to adjust prompt properties whenever it's refreshed. (erc--refresh-prompt): Fix bug in which user-defined prompt functions failed to hide when quitting in server buffers. Run new hook `erc--refresh-prompt-hook'. (erc-display-prompt): Add comment noting that the text property `erc-prompt' now actually matters: it's t while a session is running and `hidden' when disconnected. * test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New test. * test/lisp/erc/erc-stamp-tests.el (erc-stamp-tests--use-align-to--nil, erc-stamp-tests--use-align-to--t): New functions forged from old test bodies to allow optionally asserting pre-5.6 behavior regarding leading white space on right-hand stamps that exist on their own line. (erc-timestamp-use-align-to--nil, erc-timestamp-use-align-to--t): Parameterize with compatibility flag. (erc-timestamp-use-align-to--margin, erc-stamp--display-margin-mode--right): Rename test to latter. * test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions for new possible value of `erc-prompt' text property. * test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test data file. (Bug#60936) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 4c881e32ab4..13e49a9123d 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -103,11 +103,8 @@ side window. Hit '' over a nick to spawn a "/QUERY" or a ** The option 'erc-timestamp-use-align-to' is more versatile. While this option has always offered to right-align stamps via the 'display' text property, it's now more effective at doing so when set -to a number indicating an offset from the right edge. And when set to -the symbol 'margin', it displays stamps in the right margin, although, -at the moment, this is mostly intended for use by other modules, such -as 'fill-wrap', described above. For both these variants, users of -the 'log' module may want to customize 'erc-log-filter-function' to +to a number indicating an offset from the right edge. Users of the +'log' module may want to customize 'erc-log-filter-function' to 'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps appearing in their saved logs. @@ -228,7 +225,8 @@ Chiefly, 'rear-sticky' has been replaced by 'erc-command', which records the IRC command (or numeric) associated with a message. Less impactfully, the value of the 'field' property for ERC's prompt has changed from 't' to the more useful 'erc-prompt', although the -property of the same name has been retained. +property of the same name has been retained and now has a value of +'hidden' when disconnected. *** Members of insert- and send-related hooks have been reordered. Built-in and third-party modules rely on certain hooks for adjusting @@ -261,6 +259,16 @@ Additionally, the 'stamp' module now merges its 'invisible' property with existing ones, when present, and it includes all white space around stamps when doing so. +Moreover, such "propertizing" of surrounding white space now extends +to all 'stamp'-applied properties, like 'field', in all intervening +space between message text and timestamps. This constitutes a +breaking change from the perspective of detecting a timestamp's +bounds. For example, ERC has always propertized leading space before +right-sided stamps on the same line as message text but not those +folded onto the next line. This inconsistency made stamp detection +overly complex and produced uneven results when toggling stamp +visibility. + *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and provided library features has improved. More specifically, a module's group now enjoys diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 363509d17fa..eb3ec39fedd 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1045,13 +1045,25 @@ erc-process-sentinel-1 ;; unexpected disconnect (erc-process-sentinel-2 event buffer)))) +(cl-defmethod erc--reveal-prompt () + (remove-text-properties erc-insert-marker erc-input-marker + '(display nil))) + +(cl-defmethod erc--conceal-prompt () + (add-text-properties erc-insert-marker (1- erc-input-marker) + `(display ,erc-prompt-hidden))) + +(defun erc--prompt-hidden-p () + (and (marker-position erc-insert-marker) + (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))) + (defun erc--unhide-prompt () (remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t) (when (and (marker-position erc-insert-marker) (marker-position erc-input-marker)) (with-silent-modifications - (remove-text-properties erc-insert-marker erc-input-marker - '(display nil))))) + (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t) + (erc--reveal-prompt)))) (defun erc--unhide-prompt-on-self-insert () (when (and (eq this-command #'self-insert-command) @@ -1059,6 +1071,8 @@ erc--unhide-prompt-on-self-insert (erc--unhide-prompt))) (defun erc--hide-prompt (proc) + "Hide prompt in all buffers of server. +Change value of property `erc-prompt' from t to `hidden'." (erc-with-all-buffers-of-server proc nil (when (and erc-hide-prompt (or (eq erc-hide-prompt t) @@ -1072,8 +1086,9 @@ erc--hide-prompt (marker-position erc-input-marker) (get-text-property erc-insert-marker 'erc-prompt)) (with-silent-modifications - (add-text-properties erc-insert-marker (1- erc-input-marker) - `(display ,erc-prompt-hidden))) + (put-text-property erc-insert-marker (1- erc-input-marker) + 'erc-prompt 'hidden) + (erc--conceal-prompt)) (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t)))) (defun erc-process-sentinel (cproc event) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index f451aaee754..109b5d245ab 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -418,7 +418,7 @@ erc-compat--29-browse-url-irc (require 'url-irc) (let* ((url (url-generic-parse-url string)) (url-irc-function - (if (function-equal url-irc-function 'url-irc-erc) + (if (eq url-irc-function 'url-irc-erc) (lambda (host port chan user pass) (erc-handle-irc-url host port chan user pass (url-type url))) url-irc-function))) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a65c95f1d85..c74fcd298d5 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -116,6 +116,25 @@ erc-fill-column "The column at which a filled paragraph is broken." :type 'integer) +(defcustom erc-fill-wrap-margin-width nil + "Starting width in columns of dedicated stamp margin. +When nil, ERC normally pretends its value is one column greater +than the `string-width' of the formatted `erc-timestamp-format'. +However, when `erc-fill-wrap-margin-side' is `left' or +\"resolves\" to `left', ERC uses the width of the prompt if it's +wider on MOTD's end, which really only matters when `erc-prompt' +is a function." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(choice (const nil) integer)) + +(defcustom erc-fill-wrap-margin-side nil + "Margin side to use with `erc-fill-wrap-mode'. +A value of nil means ERC should decide based on the value of +`erc-insert-timestamp-function', which does not work for +user-defined functions." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(choice (const nil) (const left) (const right))) + (defcustom erc-fill-line-spacing nil "Extra space between messages on graphical displays. This may need adjusting depending on how your faces are @@ -253,9 +272,9 @@ erc-fill--wrap-beginning-of-line (goto-char erc-input-marker) ;; Mimic what `move-beginning-of-line' does with invisible text. (when-let ((erc-fill-wrap-merge) - (empty (get-text-property (point) 'display)) - ((string-empty-p empty))) - (goto-char (text-property-not-all (point) (pos-eol) 'display empty))))) + (prop (get-text-property (point) 'display)) + ((or (equal prop "") (eq 'margin (car-safe (car-safe prop)))))) + (goto-char (text-property-not-all (point) (pos-eol) 'display prop))))) (defun erc-fill--wrap-end-of-line (arg) "Defer to `move-end-of-line' or `end-of-visual-line'." @@ -278,12 +297,29 @@ erc-fill-wrap-cycle-visual-movement ('non-input nil)))) (message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys)) +(defun erc-fill-wrap-toggle-truncate-lines (arg) + "Toggle `truncate-lines' and maybe reinstate `visual-line-mode'." + (interactive "P") + (let ((wantp (if arg + (natnump (prefix-numeric-value arg)) + (not truncate-lines))) + (buffer (current-buffer))) + (if wantp + (setq truncate-lines t) + (walk-windows (lambda (window) + (when (eq buffer (window-buffer window)) + (set-window-hscroll window 0))) + nil t) + (visual-line-mode +1))) + (force-mode-line-update)) + (defvar-keymap erc-fill-wrap-mode-map ; Compat 29 :doc "Keymap for ERC's `fill-wrap' module." :parent visual-line-mode-map " " #'erc-fill--wrap-kill-line " " #'erc-fill--wrap-end-of-line " " #'erc-fill--wrap-beginning-of-line + " " #'erc-fill-wrap-toggle-truncate-lines "C-c a" #'erc-fill-wrap-cycle-visual-movement ;; Not sure if this is problematic because `erc-bol' takes no args. " " #'erc-fill--wrap-beginning-of-line) @@ -319,42 +355,57 @@ fill-wrap "Fill style leveraging `visual-line-mode'. This local module displays nicks overhanging leftward to a common offset, as determined by the option `erc-fill-static-center'. It -depends on the `fill' and `button' modules and assumes the option -`erc-insert-timestamp-function' is `erc-insert-timestamp-right' -or the default `erc-insert-timestamp-left-and-right', so that it -can display right-hand stamps in the right margin. A value of -`erc-insert-timestamp-left' is unsupported. To use it, either -include `fill-wrap' in `erc-modules' or set `erc-fill-function' -to `erc-fill-wrap' (recommended). You can also manually invoke -one of the minor-mode toggles if really necessary." +depends on the `fill', `stamp', and `button' modules and assumes +users who've defined their own `erc-insert-timestamp-function' +have also customized the option `erc-fill-wrap-margin-side' to an +explicit side. To use this module, either include `fill-wrap' in +`erc-modules' or set `erc-fill-function' to `erc-fill-wrap'. +Manually invoking one of the minor-mode toggles is not +recommended. + +This module imposes various restrictions on the appearance of +timestamps. Most notably, it insists on displaying them in the +margins. Users preferring left-sided stamps may notice that ERC +also displays the prompt in the left margin, possibly truncating +or padding it to constrain it to the margin's width. When stamps +appear in the right margin, which they do by default, users may +find that ERC actually appends them to copy-as-killed messages +without an intervening space. This normally poses at most a +minor inconvenience, however users of the `log' module may prefer +a workaround provided by `erc-stamp-prefix-log-filter', which +strips trailing stamps from logged messages and instead prepends +them to every line." ((erc-fill--wrap-ensure-dependencies) - ;; Restore or initialize local state variables. (erc--restore-initialize-priors erc-fill-wrap-mode erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys - erc-fill--wrap-value erc-fill-static-center) + erc-fill--wrap-value erc-fill-static-center + erc-stamp--margin-width erc-fill-wrap-margin-width + left-margin-width left-margin-width + right-margin-width right-margin-width) + (setq erc-stamp--margin-left-p + (or (eq erc-fill-wrap-margin-side 'left) + (eq (default-value 'erc-insert-timestamp-function) + #'erc-insert-timestamp-left))) (setq erc-fill--function #'erc-fill-wrap) - ;; Internal integrations. (add-function :after (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) - (when (or erc-stamp-mode (memq 'stamp erc-modules)) - (erc-stamp--display-margin-mode +1)) (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) (require 'erc-match) (setq erc-match--hide-fools-offset-bounds t)) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) + (erc-stamp--display-margin-mode +1) (visual-line-mode +1)) - ((when erc-stamp--display-margin-mode - (erc-stamp--display-margin-mode -1)) + ((visual-line-mode -1) + (erc-stamp--display-margin-mode -1) (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill--function) (kill-local-variable 'erc-fill--wrap-visual-keys) (remove-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p t) (remove-function (local 'erc-stamp--insert-date-function) - #'erc-fill--wrap-stamp-insert-prefixed-date) - (visual-line-mode -1)) + #'erc-fill--wrap-stamp-insert-prefixed-date)) 'local) (defvar-local erc-fill--wrap-length-function nil @@ -381,18 +432,21 @@ erc-fill--wrap-continued-message-p (widen) (when (eq 'erc-timestamp (field-at-pos m)) (set-marker m (field-end m))) - (and (eq 'PRIVMSG (get-text-property m 'erc-command)) - (not (eq (get-text-property m 'erc-ctcp) 'ACTION)) - (cons (get-text-property m 'erc-timestamp) - (get-text-property (1+ m) 'erc-data))))) + (and-let* + (((eq 'PRIVMSG (get-text-property m 'erc-command))) + ((not (eq (get-text-property m 'erc-ctcp) + 'ACTION))) + (spr (next-single-property-change m 'erc-speaker))) + (cons (get-text-property m 'erc-timestamp) + (get-text-property spr 'erc-speaker))))) (ts (pop props)) ((not (time-less-p (erc-stamp--current-time) ts))) ((time-less-p (time-subtract (erc-stamp--current-time) ts) erc-fill--wrap-max-lull)) - (nick (buffer-substring-no-properties - (1+ (point-min)) (- (point) 2))) + (speaker (next-single-property-change (point-min) 'erc-speaker)) + (nick (get-text-property speaker 'erc-speaker)) (props) - ((erc-nick-equal-p (car props) nick)))) + ((erc-nick-equal-p props nick)))) (set-marker erc-fill--wrap-last-msg (point-min)))) (defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args) @@ -476,8 +530,8 @@ erc-fill-wrap-nudge \\`=' Increase indentation by one column \\`-' Decrease indentation by one column \\`0' Reset indentation to the default - \\`+' Shift right margin rightward (shrink) by one column - \\`_' Shift right margin leftward (grow) by one column + \\`+' Shift margin boundary rightward by one column + \\`_' Shift margin boundary leftward by one column \\`)' Reset the right margin to the default Note that misalignment may occur when messages contain @@ -489,6 +543,7 @@ erc-fill-wrap-nudge (unless (get-buffer-window) (user-error "Command called in an undisplayed buffer")) (let* ((total (erc-fill--wrap-nudge arg)) + (leftp erc-stamp--margin-left-p) (win-ratio (/ (float (- (window-point) (window-start))) (- (window-end nil t) (window-start))))) (when (zerop arg) @@ -509,18 +564,20 @@ erc-fill-wrap-nudge (dolist (key '(?\) ?_ ?+)) (let ((a (pcase key (?\) 0) - (?_ (- (abs arg))) - (?+ (abs arg))))) + (?_ (if leftp (abs arg) (- (abs arg)))) + (?+ (if leftp (- (abs arg)) (abs arg)))))) (define-key map (vector (list key)) (lambda () (interactive) - (erc-stamp--adjust-right-margin (- a)) + (erc-stamp--adjust-margin (- a) (zerop a)) + (when leftp (erc-stamp--refresh-left-margin-prompt)) (recenter (round (* win-ratio (window-height)))))))) map) t (lambda () - (message "Fill prefix: %d (%+d col%s)" - erc-fill--wrap-value total (if (> (abs total) 1) "s" ""))) + (message "Fill prefix: %d (%+d col%s); Margin: %d" + erc-fill--wrap-value total (if (> (abs total) 1) "s" "") + (if leftp left-margin-width right-margin-width))) "Use %k for further adjustment" 1) (recenter (round (* win-ratio (window-height)))))) @@ -536,6 +593,7 @@ erc-timestamp-offset "Get length of timestamp if inserted left." (if (and (boundp 'erc-timestamp-format) erc-timestamp-format + ;; FIXME use a more robust test than symbol equivalence. (eq erc-insert-timestamp-function 'erc-insert-timestamp-left) (not erc-hide-timestamps)) (length (format-time-string erc-timestamp-format)) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 83ee4a200ed..a021cd26607 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -281,49 +281,60 @@ erc-timestamp-use-align-to set to `erc-insert-timestamp-right' or that option's default, `erc-insert-timestamp-left-and-right'. If the value is a positive integer, alignment occurs that many columns from the -right edge. If the value is `margin', the stamp appears in the -right margin when visible. +right edge. Enabling this option produces a side effect in that stamps aren't indented in saved logs. When its value is an integer, this option adds a space after the end of a message if the stamp doesn't already start with one. And when its value is t, it adds -a single space, unconditionally. And while this option never -adds a space when its value is `margin', ERC does offer a -workaround in `erc-stamp-prefix-log-filter', which strips -trailing stamps from messages and puts them before every line." - :type '(choice boolean integer (const margin)) +a single space, unconditionally." + :type '(choice boolean integer) :package-version '(ERC . "5.6")) ; FIXME sync on release -(defcustom erc-stamp-right-margin-width nil - "Width in columns of the right margin. -When this option is nil, pretend its value is one column greater -than the `string-width' of the formatted `erc-timestamp-format'. -This option only matters when `erc-timestamp-use-align-to' is set -to `margin'." - :package-version '(ERC . "5.6") ; FIXME sync on release - :type '(choice (const nil) integer)) - -(defun erc-stamp--display-margin-force (orig &rest r) - (let ((erc-timestamp-use-align-to 'margin)) - (apply orig r))) - -(defun erc-stamp--adjust-right-margin (cols) - "Adjust right margin by COLS. -When COLS is zero, reset width to `erc-stamp-right-margin-width' -or one col more than the `string-width' of -`erc-timestamp-format'." - (let ((width - (if (zerop cols) - (or erc-stamp-right-margin-width - (1+ (string-width (or erc-timestamp-last-inserted-right - (erc-format-timestamp - (current-time) - erc-timestamp-format))))) - (+ right-margin-width cols)))) - (setq right-margin-width width) +(defvar-local erc-stamp--margin-width nil + "Width in columns of margin for `erc-stamp--display-margin-mode'. +Only consulted when resetting or initializing margin.") + +(defvar-local erc-stamp--margin-left-p nil + "Whether `erc-stamp--display-margin-mode' uses the left margin. +During initialization, the mode respects this variable's existing +value if it already has a local binding. Otherwise, modules can +bind this to any value while enabling the mode. If it's nil, ERC +will check to see if `erc-insert-timestamp-function' is +`erc-insert-timestamp-left', interpreting the latter as a non-nil +value. It'll then coerce any non-nil value to t.") + +(defun erc-stamp--init-margins-on-connect (&rest _) + (let ((existing (if erc-stamp--margin-left-p + left-margin-width + right-margin-width))) + (erc-stamp--adjust-margin existing 'resetp))) + +(defun erc-stamp--adjust-margin (cols &optional resetp) + "Adjust managed margin by increment COLS. +With RESETP, set margin's width to COLS. However, if COLS is +zero, set the width to a non-nil `erc-stamp--margin-width'. +Otherwise, go with the `string-width' of `erc-timestamp-format'. +However, when `erc-stamp--margin-left-p' is non-nil and the +prompt is wider, use its width instead." + (let* ((leftp erc-stamp--margin-left-p) + (width + (if resetp + (or (and (not (zerop cols)) cols) + erc-stamp--margin-width + (max (if leftp (string-width (erc-prompt)) 0) + (1+ (string-width + (or (if leftp + erc-timestamp-last-inserted + erc-timestamp-last-inserted-right) + (erc-format-timestamp + (current-time) erc-timestamp-format)))))) + (+ (if leftp left-margin-width right-margin-width) cols)))) + (set (if leftp 'left-margin-width 'right-margin-width) width) (when (eq (current-buffer) (window-buffer)) - (set-window-margins nil left-margin-width width)))) + (set-window-margins nil + (if leftp width left-margin-width) + (if leftp right-margin-width width))))) ;;;###autoload (defun erc-stamp-prefix-log-filter (text) @@ -348,39 +359,100 @@ erc-stamp-prefix-log-filter (zerop (forward-line)))) "") +(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) + (declare-function erc--remove-text-properties "erc" (string)) -;; If people want to use this directly, we can convert it into -;; a local module. +;; Currently, `erc-insert-timestamp-right' hard codes its display +;; property to use `right-margin', and `erc-insert-timestamp-left' +;; does the same for `left-margin'. However, there's no reason a +;; trailing stamp couldn't be displayed on the left and vice versa. (define-minor-mode erc-stamp--display-margin-mode "Internal minor mode for built-in modules integrating with `stamp'. -It binds `erc-timestamp-use-align-to' to `margin' around calls to -`erc-insert-timestamp-function' in the current buffer, and sets -the right window margin to `erc-stamp-right-margin-width'. It -also arranges to remove most text properties when a user kills -message text so that stamps will be visible when yanked." +Arranges for displaying stamps in a single margin, with the +variable `erc-stamp--margin-left-p' controlling which one. +Provides `erc-stamp--margin-width' and `erc-stamp--adjust-margin' +to help manage the chosen margin's width. Also removes `display' +properties in killed text to reveal stamps. The invoking module +should set controlling variables, like `erc-stamp--margin-width' +and `erc-stamp--margin-left-p', before activating the mode." :interactive nil (if erc-stamp--display-margin-mode (progn (setq fringes-outside-margins t) (when (eq (current-buffer) (window-buffer)) (set-window-buffer (selected-window) (current-buffer))) - (erc-stamp--adjust-right-margin 0) + (setq erc-stamp--margin-left-p (and erc-stamp--margin-left-p t)) + (if (or erc-server-connected (not (functionp erc-prompt))) + (erc-stamp--init-margins-on-connect) + (add-hook 'erc-after-connect + #'erc-stamp--init-margins-on-connect nil t)) (add-function :filter-return (local 'filter-buffer-substring-function) #'erc--remove-text-properties) - (add-function :around (local 'erc-insert-timestamp-function) - #'erc-stamp--display-margin-force)) + (add-hook 'erc--setup-buffer-hook + #'erc-stamp--refresh-left-margin-prompt nil t) + (when erc-stamp--margin-left-p + (add-hook 'erc--refresh-prompt-hook + #'erc-stamp--display-prompt-in-left-margin nil t))) (remove-function (local 'filter-buffer-substring-function) #'erc--remove-text-properties) - (remove-function (local 'erc-insert-timestamp-function) - #'erc-stamp--display-margin-force) - (kill-local-variable 'right-margin-width) + (remove-hook 'erc-after-connect + #'erc-stamp--init-margins-on-connect t) + (remove-hook 'erc--refresh-prompt-hook + #'erc-stamp--display-prompt-in-left-margin t) + (remove-hook 'erc--setup-buffer-hook + #'erc-stamp--refresh-left-margin-prompt t) + (kill-local-variable (if erc-stamp--margin-left-p + 'left-margin-width + 'right-margin-width)) (kill-local-variable 'fringes-outside-margins) + (kill-local-variable 'erc-stamp--margin-left-p) + (kill-local-variable 'erc-stamp--margin-width) (when (eq (current-buffer) (window-buffer)) (set-window-margins nil left-margin-width nil) (set-window-buffer (selected-window) (current-buffer))))) -(defun erc-insert-timestamp-left (string) +(defvar-local erc-stamp--last-prompt nil) + +(defun erc-stamp--display-prompt-in-left-margin () + "Show prompt in the left margin with padding." + (when (or (not erc-stamp--last-prompt) (functionp erc-prompt) + (> (string-width erc-stamp--last-prompt) left-margin-width)) + (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker)))) + ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...)))) + (remove-text-properties 0 (length s) '(display nil) s) + (when (and erc-stamp--last-prompt + (>= (string-width erc-stamp--last-prompt) left-margin-width)) + (let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t))) + ;; This papers over a subtle off-by-1 bug here. + (unless (equal sm s) + (setq s (concat sm (substring s -1)))))) + (setq erc-stamp--last-prompt (string-pad s left-margin-width nil t)))) + (put-text-property erc-insert-marker (1- erc-input-marker) + 'display `((margin left-margin) ,erc-stamp--last-prompt)) + erc-stamp--last-prompt) + +(defun erc-stamp--refresh-left-margin-prompt () + "Forcefully-recompute display property of prompt in left margin." + (with-silent-modifications + (unless (functionp erc-prompt) + (setq erc-stamp--last-prompt nil)) + (erc--refresh-prompt))) + +(cl-defmethod erc--reveal-prompt + (&context (erc-stamp--display-margin-mode (eql t)) + (erc-stamp--margin-left-p (eql t))) + (put-text-property erc-insert-marker (1- erc-input-marker) + 'display `((margin left-margin) ,erc-stamp--last-prompt))) + +(cl-defmethod erc--conceal-prompt + (&context (erc-stamp--display-margin-mode (eql t)) + (erc-stamp--margin-left-p (eql t))) + (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))) + (put-text-property erc-insert-marker (1- erc-input-marker) + 'display `((margin left-margin) ,prompt)))) + +(cl-defmethod erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." (goto-char (point-min)) (let* ((ignore-p (and erc-timestamp-only-if-changed-flag @@ -392,6 +464,22 @@ erc-insert-timestamp-left (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) +(cl-defmethod erc-insert-timestamp-left + (string &context (erc-stamp--display-margin-mode (eql t))) + (unless (and erc-timestamp-only-if-changed-flag + (string-equal string erc-timestamp-last-inserted)) + (goto-char (point-min)) + (insert-before-markers-and-inherit + (setq erc-timestamp-last-inserted string)) + (dolist (p erc-stamp--inherited-props) + (when-let ((v (get-text-property (point) p))) + (put-text-property (point-min) (point) p v))) + (erc-put-text-property (point-min) (point) 'invisible + erc-stamp--invisible-property) + (put-text-property (point-min) (point) 'field 'erc-timestamp) + (put-text-property (point-min) (point) + 'display `((margin left-margin) ,string)))) + (defun erc-insert-aligned (string pos) "Insert STRING at the POSth column. @@ -408,7 +496,11 @@ erc-insert-aligned ;; Silence byte-compiler (defvar erc-fill-column) -(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) +(defvar erc-stamp--omit-properties-on-folded-lines nil + "Skip properties before right stamps occupying their own line. +This escape hatch restores pre-5.6 behavior that left leading +white space alone (unpropertized) for right-sided stamps folded +onto their own line.") (defun erc-insert-timestamp-right (string) "Insert timestamp on the right side of the screen. @@ -465,6 +557,9 @@ erc-insert-timestamp-right ;; For compatibility reasons, the `erc-timestamp' field includes ;; intervening white space unless a hard break is warranted. (pcase erc-timestamp-use-align-to + ((guard erc-stamp--display-margin-mode) + (put-text-property 0 (length string) + 'display `((margin right-margin) ,string) string)) ((and 't (guard (< col pos))) (insert " ") (put-text-property from (point) 'display `(space :align-to ,pos))) @@ -475,11 +570,8 @@ erc-insert-timestamp-right (let ((s (+ erc-timestamp-use-align-to (string-width string)))) (put-text-property from (point) 'display `(space :align-to (- right ,s))))) - ('margin - (put-text-property 0 (length string) - 'display `((margin right-margin) ,string) - string)) - ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point))) + ((guard (>= col pos)) (newline) (indent-to pos) + (when erc-stamp--omit-properties-on-folded-lines (setq from (point)))) (_ (indent-to pos))) (insert string) (dolist (p erc-stamp--inherited-props) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index eca6a90d706..d519bf221b9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2879,19 +2879,23 @@ erc--assert-input-bounds (cl-assert (< erc-insert-marker erc-input-marker)) (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) +(defvar erc--refresh-prompt-hook nil) + (defun erc--refresh-prompt () "Re-render ERC's prompt when the option `erc-prompt' is a function." (erc--assert-input-bounds) - (when (functionp erc-prompt) - (save-excursion - (goto-char erc-insert-marker) - (set-marker-insertion-type erc-insert-marker nil) - ;; Avoid `erc-prompt' (the named function), which appends a - ;; space, and `erc-display-prompt', which propertizes all but - ;; that space. - (insert-and-inherit (funcall erc-prompt)) - (set-marker-insertion-type erc-insert-marker t) - (delete-region (point) (1- erc-input-marker))))) + (unless (erc--prompt-hidden-p) + (when (functionp erc-prompt) + (save-excursion + (goto-char erc-insert-marker) + (set-marker-insertion-type erc-insert-marker nil) + ;; Avoid `erc-prompt' (the named function), which appends a + ;; space, and `erc-display-prompt', which propertizes all but + ;; that space. + (insert-and-inherit (funcall erc-prompt)) + (set-marker-insertion-type erc-insert-marker t) + (delete-region (point) (1- erc-input-marker)))) + (run-hooks 'erc--refresh-prompt-hook))) (defun erc-display-line-1 (string buffer) "Display STRING in `erc-mode' BUFFER. @@ -4804,7 +4808,7 @@ erc-display-prompt ;; shall remain part of the prompt. (setq prompt (propertize prompt 'rear-nonsticky t - 'erc-prompt t + 'erc-prompt t ; t or `hidden' 'field 'erc-prompt 'front-sticky t 'read-only t)) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 99ec4a9635e..67622da9f3d 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -340,4 +340,41 @@ erc-fill-wrap-visual-keys--prompt (should (search-backward "ERC> " nil t)) (execute-kbd-macro "\C-a"))))) +(ert-deftest erc-fill--left-hand-stamps () + :tags '(:unstable) + (unless (>= emacs-major-version 29) + (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) + + (let ((erc-timestamp-only-if-changed-flag nil) + (erc-insert-timestamp-function #'erc-insert-timestamp-left)) + (erc-fill-tests--wrap-populate + (lambda () + (should (= 8 left-margin-width)) + (pcase-let ((`((margin left-margin) ,displayed) + (get-text-property erc-insert-marker 'display))) + (should (equal-including-properties + displayed #(" ERC>" 4 8 + ( read-only t + front-sticky t + field erc-prompt + erc-prompt t + rear-nonsticky t + font-lock-face erc-prompt-face))))) + (erc-fill-tests--compare "stamps-left-01") + + (ert-info ("Shrink left margin by 1 col") + (erc-stamp--adjust-margin -1) + (with-silent-modifications (erc--refresh-prompt)) + (should (= 7 left-margin-width)) + (pcase-let ((`((margin left-margin) ,displayed) + (get-text-property erc-insert-marker 'display))) + (should (equal-including-properties + displayed #(" ERC>" 3 7 + ( read-only t + front-sticky t + field erc-prompt + erc-prompt t + rear-nonsticky t + font-lock-face erc-prompt-face)))))))))) + ;;; erc-fill-tests.el ends here diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 6da7ed4503d..c448416cd69 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -56,7 +56,7 @@ erc-stamp-tests--insert-right (advice-remove 'erc-format-timestamp 'ert-deftest--erc-timestamp-use-align-to))) -(ert-deftest erc-timestamp-use-align-to--nil () +(defun erc-stamp-tests--use-align-to--nil (compat) (erc-stamp-tests--insert-right (lambda () @@ -83,12 +83,20 @@ erc-timestamp-use-align-to--nil (erc-display-message nil 'notice (current-buffer) "twenty characters")) (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) - ;; Field excludes leading whitespace (arguably undesirable). - (should (eql ?\[ (char-after (field-beginning (point))))) + ;; Field includes leading whitespace. + (should (eql (if compat ?\[ ?\n) + (char-after (field-beginning (point))))) ;; Timestamp extends to the end of the line. (should (eql ?\n (char-after (field-end (point))))))))) -(ert-deftest erc-timestamp-use-align-to--t () +(ert-deftest erc-timestamp-use-align-to--nil () + (ert-info ("Field starts on stamp text (compat)") + (let ((erc-stamp--omit-properties-on-folded-lines t)) + (erc-stamp-tests--use-align-to--nil 'compat))) + (ert-info ("Field includes leaidng white space") + (erc-stamp-tests--use-align-to--nil nil))) + +(defun erc-stamp-tests--use-align-to--t (compat) (erc-stamp-tests--insert-right (lambda () @@ -110,10 +118,17 @@ erc-timestamp-use-align-to--t (erc-display-message nil nil (current-buffer) msg))) ;; Indented to pos (this is arguably a bug). (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) - ;; Field starts *after* leading space (arguably bad). - (should (eql ?\[ (char-after (field-beginning (point))))) + ;; Field includes leading space. + (should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) +(ert-deftest erc-timestamp-use-align-to--t () + (ert-info ("Field starts on stamp text (compat)") + (let ((erc-stamp--omit-properties-on-folded-lines t)) + (erc-stamp-tests--use-align-to--t 'compat))) + (ert-info ("Field includes leaidng white space") + (erc-stamp-tests--use-align-to--t nil))) + (ert-deftest erc-timestamp-use-align-to--integer () (erc-stamp-tests--insert-right (lambda () @@ -140,7 +155,7 @@ erc-timestamp-use-align-to--integer (should (eql ?\s (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) -(ert-deftest erc-timestamp-use-align-to--margin () +(ert-deftest erc-stamp--display-margin-mode--right () (erc-stamp-tests--insert-right (lambda () (erc-stamp--display-margin-mode +1) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b5db5fe8764..fff3c4cb704 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -219,6 +219,7 @@ erc-hide-prompt (setq erc-hide-prompt '(server)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) + (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (should (string= ">" (get-text-property erc-insert-marker 'display)))) (with-current-buffer "#chan" @@ -229,6 +230,7 @@ erc-hide-prompt (with-current-buffer "ServNet" (erc--unhide-prompt) + (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) (should-not (get-text-property erc-insert-marker 'display)))) (ert-info ("Value: channel") @@ -242,7 +244,9 @@ erc-hide-prompt (with-current-buffer "#chan" (should (string= ">" (get-text-property erc-insert-marker 'display))) + (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (erc--unhide-prompt) + (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) (should-not (get-text-property erc-insert-marker 'display)))) (ert-info ("Value: query") @@ -253,7 +257,9 @@ erc-hide-prompt (with-current-buffer "bob" (should (string= ">" (get-text-property erc-insert-marker 'display))) + (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (erc--unhide-prompt) + (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) (should-not (get-text-property erc-insert-marker 'display))) (with-current-buffer "#chan" diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld new file mode 100644 index 00000000000..f62b65cd170 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld @@ -0,0 +1 @@ +#("\n\n[00:00]*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.\n[00:00] bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG)) \ No newline at end of file commit d09464e50482a792cc11c20916167d3f62637c2d Author: Mauro Aranda Date: Sun Jul 16 09:22:11 2023 -0300 Don't always toggle a choice when prompting * lisp/wid-edit.el (widget-choice-prompt-value): Respect the value of widget-choice-toggle. (Bug#60712) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index b9291af2bd5..88f8a362521 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3988,7 +3988,8 @@ widget-choice-prompt-value nil) ((= (length args) 1) (nth 0 args)) - ((and (= (length args) 2) + ((and widget-choice-toggle + (= (length args) 2) (memq old args)) (if (eq old (nth 0 args)) (nth 1 args) commit b4824faa62272823d1e6326682a1f5c303498f7e Merge: a9210e8efd6 297cf9d5bf0 Author: Eli Zaretskii Date: Sat Jul 22 15:56:50 2023 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit a9210e8efd628a76084f50b6e67e009d35fac32b Author: Mauro Aranda Date: Sun Jul 16 19:46:54 2023 -0300 Avoid prompting when creating a restricted-sexp widget * lisp/wid-edit.el (restricted-sexp): Turn value into a string before reading. (widget-field-value-create): Guard against value being nil, so the field can be created even if the widget has a bad default value. (Bug#59937) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 606093fd293..b9291af2bd5 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -2127,7 +2127,8 @@ widget-field-value-create ;; `widget-setup' is called. (overlay (cons (make-marker) (make-marker)))) (widget-put widget :field-overlay overlay) - (insert value) + (when value + (insert value)) (and size (< (length value) size) (insert-char ?\s (- size (length value)))) @@ -3655,7 +3656,9 @@ 'restricted-sexp value (widget-get widget :match) (widget-get widget :match-alternatives)) - :warning)) + :warning) + ;; Make sure we will `read' a string. + (setq value (prin1-to-string value))) (read value))) (defun widget-restricted-sexp-match (widget value) commit 297cf9d5bf0342131303d10060bc822b789d2306 Author: João Távora Date: Sat Jul 22 10:36:39 2023 +0100 ; Eglot: adjust EGLOT-NEWS mention for last change * etc/EGLOT-NEWS: Adjust. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 0ccc8af3169..01f0498eb81 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -29,10 +29,9 @@ problem, particularly on Mac OS. See github#1228 and github#1226. ** Fixed "onTypeFormatting" feature -This feature wasn't triggered for the 'newline' command because -language servers often expect 10 (linefeed) to be the trigger -character, but 'newline' emits 13 (carriage return). Also made this -feature less chatty in the mode-line and messages buffer. +For 'newline' commands, Eglot sometimes sent the wrong character code +to the server. Also made this feature less chatty in the mode-line +and messages buffer. * Changes in Eglot 1.15 (29/4/2023) commit 7405f975ef29750eb39d003dcdeb079493f79c48 Author: João Távora Date: Sat Jul 22 10:30:24 2023 +0100 Eglot: simplify and hopefully fix last change (bug#64784) * lisp/progmodes/eglot.el (eglot--post-self-insert-hook): Use last-command-event. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 172fd97fdb5..ae31985a676 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2447,18 +2447,16 @@ eglot--last-inserted-char (defun eglot--post-self-insert-hook () "Set `eglot--last-inserted-char', maybe call on-type-formatting." - (setq eglot--last-inserted-char last-input-event) - (let ((ot-provider (eglot--server-capable :documentOnTypeFormattingProvider)) - ;; transform carriage return into line-feed - (adjusted-ie (if (= last-input-event 13) 10 last-input-event))) + (setq eglot--last-inserted-char last-command-event) + (let ((ot-provider (eglot--server-capable :documentOnTypeFormattingProvider))) (when (and ot-provider (ignore-errors ; github#906, some LS's send empty strings - (or (eq adjusted-ie + (or (eq eglot--last-inserted-char (seq-first (plist-get ot-provider :firstTriggerCharacter))) - (cl-find adjusted-ie + (cl-find eglot--last-inserted-char (plist-get ot-provider :moreTriggerCharacter) :key #'seq-first)))) - (eglot-format (point) nil adjusted-ie)))) + (eglot-format (point) nil eglot--last-inserted-char)))) (defvar eglot--workspace-symbols-cache (make-hash-table :test #'equal) "Cache of `workspace/Symbol' results used by `xref-find-definitions'.") commit 906969979556ab7963ec9a75fe456e5483952e93 Author: Michael Albinus Date: Sat Jul 22 10:16:04 2023 +0200 Add inhibit-remote-files and without-remote-files * doc/emacs/files.texi (Remote Files): Do not document tramp-mode any longer. Describe inhibit-remote-files instead. * doc/lispref/files.texi (Magic File Names): Add without-remote-files. * doc/misc/tramp.texi (Frequently Asked Questions): Do not document tramp-mode any longer. Describe inhibit-remote-files and without-remote-files instead. * etc/NEWS: Add inhibit-remote-files and without-remote-files. Fix typos. * lisp/net/tramp.el (inhibit-remote-files): New defun. (without-remote-files): New defmacro. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test49-without-remote-files): * test/lisp/net/tramp-tests.el (tramp-test49-without-remote-files): New tests. (tramp-test50-unload): Rename. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 9734223b95e..ac7751ceb53 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -2093,10 +2093,11 @@ Remote Files @end enumerate @cindex disabling remote files +@cindex inhibit-remote-files @noindent -You can entirely turn off the remote file name feature by setting the -variable @code{tramp-mode} to @code{nil}. You can turn off the -feature in individual cases by quoting the file name with @samp{/:} +You can entirely turn off the remote file name feature by running +@kbd{M-x inhibit-remote-files}. You can turn off the feature in +individual cases by quoting the file name with @samp{/:} (@pxref{Quoted File Names}). @cindex @code{ange-ftp} diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 31d4aaca507..aaab4e455a0 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3698,6 +3698,17 @@ Magic File Names @end example @end defopt +@defmac without-remote-files body@dots{} +The @code{without-remote-files} macro evaluates the @var{body} forms +with deactivated file name handlers for remote files. Those file +names would be handled literally. + +The macro should be used only in forms where it is obvious, that +remote files cannot appear or where it is intended not to handle +remote file names. It also reduces checks with +@code{file-name-handler-alist}, resulting in more performant code. +@end defmac + @node Format Conversion @section File Format Conversion diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ff2a66ae720..1d8e0095328 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5851,16 +5851,6 @@ Frequently Asked Questions (tramp-change-syntax 'simplified) @end lisp -@item -@vindex tramp-mode -To disable both @value{tramp} (and Ange FTP), set @code{tramp-mode} to -@code{nil} in @file{.emacs}. @strong{Note}, that we don't use -@code{customize-set-variable}, in order to avoid loading @value{tramp}. - -@lisp -(setq tramp-mode nil) -@end lisp - @item @vindex tramp-ignored-file-name-regexp To deactivate @value{tramp} for some look-alike remote file names, set @@ -5877,6 +5867,29 @@ Frequently Asked Questions local host's root directory as @file{/ssh:example.com:}. @item +@findex inhibit-remote-files +To disable both @value{tramp} (and Ange FTP), type @kbd{M-x +inhibit-remote-files @key{RET}}. You can also add this to your +@file{.emacs}. + +@lisp +(inhibit-remote-files) +@end lisp + +@item +@findex without-remote-files +If you write code, which is intended to run only for local files, you +can use the @code{without-remote-files} macro. + +@lisp +(without-remote-files @dots{}) +@end lisp + +This improves performance, because many primitive file name operations +don't check any longer for Tramp file name regexps then. + +@item +@findex tramp-unload-tramp To unload @value{tramp}, type @kbd{M-x tramp-unload-tramp @key{RET}}. Unloading @value{tramp} resets Ange FTP plugins also. @end itemize diff --git a/etc/NEWS b/etc/NEWS index d1af3b1b866..c2c436fb477 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -93,11 +93,12 @@ The 'tool-bar-position' frame parameter can be set to 'bottom' on all window systems other than Nextstep. ** cl-print + *** You can expand the "..." truncation everywhere. -The code that allowed "..." to be expanded in the *Backtrace* should -now work anywhere the data is generated by `cl-print`. +The code that allowed "..." to be expanded in the "*Backtrace*" buffer +should now work anywhere the data is generated by 'cl-print'. -*** hash-tables' contents can be expanded via the ellipsis +*** hash-tables' contents can be expanded via the ellipsis. ** Modeline elements can now be right-aligned. Anything following the symbol 'mode-line-format-right-align' in @@ -264,6 +265,8 @@ docstring, or a comment, or (re)indents the surrounding defun if point is not in a comment or a string. It is by default bound to 'M-q' in 'prog-mode' and all its descendants. +** Which Function Mode + +++ *** Which Function Mode can now display function names on the header line. The new user option 'which-func-display' allows choosing where the @@ -300,6 +303,19 @@ sessions, respectively. It allows to kill only selected remote buffers, controlled by user option 'tramp-cleanup-some-buffers-hook'. ++++ +*** New command 'inhibit-remote-files'. +This command disables the handling of file names with the special +remote file name syntax. It should be applied only when remote files +won't be used in this Emacs instance. It provides a slightly improved +performance of file name handling in Emacs. + ++++ +*** New macro 'without-remote-files'. +This macro could wrap code which handles local files only. Due to the +temporary deactivation of remote files, it results in a slightly +improved performance of file name handling in Emacs. + ** EWW +++ @@ -602,7 +618,7 @@ behavior back for any other reason, you can do that using the 'coding-system-put' function. For example, the following restores the previous behavior of showing 'U' in the mode line for 'koi8-u': - (coding-system-put 'koi8-u :mnemonic ?U) + (coding-system-put 'koi8-u :mnemonic ?U) +++ ** Infinities and NaNs no longer act as symbols on non-IEEE platforms. @@ -611,6 +627,7 @@ tokens like 0.0e+NaN and 1.0e+INF are no longer read as symbols. Instead, the Lisp reader approximates an infinity with the nearest finite value, and a NaN with some other non-numeric object that provokes an error if used numerically. + * Lisp Changes in Emacs 30.1 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 55e1ca932e4..53a80c41680 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2967,6 +2967,25 @@ tramp-exists-file-name-handler (put #'tramp-unload-file-name-handlers 'tramp-autoload t) (add-hook 'tramp-unload-hook #'tramp-unload-file-name-handlers) +;;;###autoload +(progn (defun inhibit-remote-files () + "Deactivate remote file names." + (interactive) + (when (fboundp 'tramp-cleanup-all-connections) + (funcall 'tramp-cleanup-all-connections)) + (tramp-unload-file-name-handlers) + (setq tramp-mode nil))) + +;;;###autoload +(progn (defmacro without-remote-files (&rest body) + "Deactivate remote file names temporarily. +Run BODY." + (declare (indent 0) (debug ((form body) body))) + `(let ((file-name-handler-alist (copy-tree file-name-handler-alist)) + tramp-mode) + (tramp-unload-file-name-handlers) + ,@body))) + ;;; File name handler functions for completion mode: ;; This function takes action since Emacs 28.1, when diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 5485b12f74f..e34e830cb83 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -988,6 +988,20 @@ tramp-archive-test48-delay-load code tae tramp-archive-test-file-archive (concat tramp-archive-test-archive "foo")))))))))) +(ert-deftest tramp-archive-test49-without-remote-files () + "Check that Tramp can be suppressed." + (skip-unless tramp-archive-enabled) + + (should (file-exists-p tramp-archive-test-archive)) + (should-not (without-remote-files (file-exists-p tramp-archive-test-archive))) + (should (file-exists-p tramp-archive-test-archive)) + + (inhibit-remote-files) + (should-not (file-exists-p tramp-archive-test-archive)) + (tramp-register-file-name-handlers) + (setq tramp-mode t) + (should (file-exists-p tramp-archive-test-archive))) + (ert-deftest tramp-archive-test99-libarchive-tests () "Run tests of libarchive test files." :tags '(:expensive-test :unstable) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 16afc0f477a..9bc8ad8ce39 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -8009,7 +8009,22 @@ tramp-test48-remote-load-path (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test49-unload () +(ert-deftest tramp-test49-without-remote-files () + "Check that Tramp can be suppressed." + (skip-unless (tramp--test-enabled)) + + (should (file-remote-p ert-remote-temporary-file-directory)) + (should-not + (without-remote-files (file-remote-p ert-remote-temporary-file-directory))) + (should (file-remote-p ert-remote-temporary-file-directory)) + + (inhibit-remote-files) + (should-not (file-remote-p ert-remote-temporary-file-directory)) + (tramp-register-file-name-handlers) + (setq tramp-mode t) + (should (file-remote-p ert-remote-temporary-file-directory))) + +(ert-deftest tramp-test50-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) commit b6207ee4dcb17106262d278fd11408edd4a55316 Author: Philip Kaludercic Date: Sun Jul 16 13:56:23 2023 +0200 Ensure 'existing-filename' has 'bounds-of-thing-at-point' * lisp/thingatpt.el (existing-filename): Define 'bounds-of-thing-at-point' for 'existing-filename'. (Bug#64664) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 408713dda1a..72acb0b749f 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -360,6 +360,10 @@ thing-at-point-file-at-point (and (file-exists-p filename) filename))) +(put 'existing-filename 'bounds-of-thing-at-point + (lambda () + (and (thing-at-point 'existing-filename) + (bounds-of-thing-at-point 'filename)))) (put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point) ;; Faces commit 8ef92096c349206794e928f702b56f62bf88a122 Author: Philip Kaludercic Date: Wed Jul 19 21:14:40 2023 +0200 ; Handle string-at-point at end of buffer gracefully * lisp/thingatpt.el (thing-at-point-bounds-of-string-at-point): Check if 'char-after' returns non-nil before passing it to 'char-syntax'. (Bug#64733) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index f3367290dee..408713dda1a 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -250,7 +250,8 @@ thing-at-point-bounds-of-string-at-point (goto-char (nth 8 ppss)) (cons (point) (progn (forward-sexp) (point)))) ;; At the beginning of the string - (if (eq (char-syntax (char-after)) ?\") + (if (let ((ca (char-after))) + (and ca (eq (char-syntax ca) ?\"))) (let ((bound (bounds-of-thing-at-point 'sexp))) (and bound (<= (car bound) (point)) (< (point) (cdr bound)) commit a403e2832d240242154200f0e5448652fa189769 Author: Eli Zaretskii Date: Sat Jul 22 09:13:35 2023 +0300 ; * lisp/time.el (display-time-date-and-time): Fix last change. diff --git a/lisp/time.el b/lisp/time.el index 3b87859a87c..3f10deff5fd 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -140,7 +140,7 @@ display-time-mail-face :type '(choice (const :tag "None" nil) face)) (defface display-time-date-and-time - '((t (:inherit mode-line))) + '((t nil)) "Face for `display-time-format'." :group 'mode-line-faces :version "30.1") commit ca4bc9baf9d2c861ad776da07e56381da8e3722a Author: Stefan Monnier Date: Wed Jul 19 11:29:32 2023 -0400 macroexp.el: Fix missing warning for intermediate expansions When a macro expanded to a call to an obsolete macro, we failed to emit a warning for that use of the obsolete macro. * lisp/emacs-lisp/macroexp.el (macroexp-macroexpand): Use `macroexpand-1` to check obsolecence of intermediate expansions. * test/lisp/emacs-lisp/macroexp-tests.el (macroexp--test-obsolete-macro): New test. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 290bf1c933a..083a7f58f36 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -227,21 +227,19 @@ macroexpand-1 (defun macroexp-macroexpand (form env) "Like `macroexpand' but checking obsolescence." (let* ((macroexpand-all-environment env) - (new-form - (macroexpand form env))) - (if (and (not (eq form new-form)) ;It was a macro call. - (car-safe form) - (symbolp (car form)) - (get (car form) 'byte-obsolete-info)) - (let* ((fun (car form)) - (obsolete (get fun 'byte-obsolete-info))) - (macroexp-warn-and-return - (macroexp--obsolete-warning - fun obsolete - (if (symbolp (symbol-function fun)) - "alias" "macro")) - new-form (list 'obsolete fun) nil fun)) - new-form))) + new-form) + (while (not (eq form (setq new-form (macroexpand-1 form env)))) + (let ((fun (car-safe form))) + (setq form + (if (and fun (symbolp fun) + (get fun 'byte-obsolete-info)) + (macroexp-warn-and-return + (macroexp--obsolete-warning + fun (get fun 'byte-obsolete-info) + (if (symbolp (symbol-function fun)) "alias" "macro")) + new-form (list 'obsolete fun) nil fun) + new-form)))) + form)) (defun macroexp--unfold-lambda (form &optional name) (or name (setq name "anonymous lambda")) diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el index 7bb38fe58f7..d0efbfd28c1 100644 --- a/test/lisp/emacs-lisp/macroexp-tests.el +++ b/test/lisp/emacs-lisp/macroexp-tests.el @@ -124,4 +124,20 @@ macroexp--tests-dynamic-variable-p (dyn dyn dyn dyn) (dyn dyn dyn lex)))))) +(defmacro macroexp--test-macro1 () + (declare (obsolete "new-replacement" nil)) + 1) + +(defmacro macroexp--test-macro2 () + '(macroexp--test-macro1)) + +(ert-deftest macroexp--test-obsolete-macro () + (should + (let ((res + (cl-letf (((symbol-function 'message) #'user-error)) + (condition-case err + (macroexpand-all '(macroexp--test-macro2)) + (user-error (error-message-string err)))))) + (should (and (stringp res) (string-match "new-replacement" res)))))) + ;;; macroexp-tests.el ends here commit b9a910a701a792825462a75332a9aec6824fe874 Author: Mattias Engdegård Date: Fri Jul 21 14:44:53 2023 +0200 Use BASE_EQ instead of EQ in search.c * src/search.c (clear_regexp_cache, compile_pattern, Fmatch_data): Use BASE_EQ where appropriate. diff --git a/src/search.c b/src/search.c index 122d6166637..3edfc0bc1a8 100644 --- a/src/search.c +++ b/src/search.c @@ -162,7 +162,7 @@ clear_regexp_cache (void) /* It's tempting to compare with the syntax-table we've actually changed, but it's not sufficient because char-table inheritance means that modifying one syntax-table can change others at the same time. */ - if (!searchbufs[i].busy && !EQ (searchbufs[i].syntax_table, Qt)) + if (!searchbufs[i].busy && !BASE_EQ (searchbufs[i].syntax_table, Qt)) searchbufs[i].regexp = Qnil; } @@ -214,10 +214,11 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, && !cp->busy && STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern) && !NILP (Fstring_equal (cp->regexp, pattern)) - && EQ (cp->buf.translate, translate) + && BASE_EQ (cp->buf.translate, translate) && cp->posix == posix - && (EQ (cp->syntax_table, Qt) - || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table))) + && (BASE_EQ (cp->syntax_table, Qt) + || BASE_EQ (cp->syntax_table, + BVAR (current_buffer, syntax_table))) && !NILP (Fequal (cp->f_whitespace_regexp, Vsearch_spaces_regexp)) && cp->buf.charset_unibyte == charset_unibyte) break; @@ -2892,7 +2893,7 @@ DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0, ptrdiff_t start = search_regs.start[i]; if (start >= 0) { - if (EQ (last_thing_searched, Qt) + if (BASE_EQ (last_thing_searched, Qt) || ! NILP (integers)) { XSETFASTINT (data[2 * i], start); commit 3b5f13dc49f3a2a7afd25a2ab05787c7d81918a0 Author: Mattias Engdegård Date: Fri Jul 21 11:56:42 2023 +0200 ; Fix bug in regexp debug code * src/regex-emacs.c (print_partial_compiled_pattern): Only the 7 bottom bits of the first byte form the bitmap size. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 9e298b81ebb..51fc2b0558d 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -554,7 +554,7 @@ print_partial_compiled_pattern (re_char *start, re_char *end) fprintf (stderr, "/charset [%s", (re_opcode_t) *(p - 1) == charset_not ? "^" : ""); - if (p + *p >= pend) + if (p + (*p & 0x7f) >= pend) fputs (" !extends past end of pattern! ", stderr); for (c = 0; c < 256; c++) commit 0f9fd1d5a5ec5c062f45f3f8a16863021e17e7e8 Author: Robert Pluim Date: Fri Jul 21 14:38:15 2023 +0200 Fix failing native-compile test * test/src/comp-tests.el (comp-tests-result-lambda): Use 'comp-deftest', not 'ert-deftest'. The latter doesn't check for native-compile support. diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 30dfd669ded..89b1eefb1dc 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1530,7 +1530,7 @@ comp-tests-cond-rw-checker-type (equal (comp-mvar-typeset mvar) comp-tests-cond-rw-expected-type)))))))) -(ert-deftest comp-tests-result-lambda () +(comp-deftest comp-tests-result-lambda () (native-compile 'comp-tests-result-lambda) (should (eq (funcall (comp-tests-result-lambda) '(a . b)) 'a))) ;;; comp-tests.el ends here commit 845d6561ed07a8a979200a389a39db08dffccdc8 Author: Eli Zaretskii Date: Fri Jul 21 15:19:02 2023 +0300 Fix Proced display header alignment under 'text-scale-adjust' * lisp/proced.el (proced-mode): Force the header-line to scale according to 'text-scale-adjust'. (proced-header-line): Use width of the header-line's face's characters as align-to units, not the width of the frame's default face's font. (Bug#64752) * src/xdisp.c (calc_pixel_width_or_height): Use font's average_width or space_width, not max_width, as the correct measure of the font's width. This is consistent with the rest of the display engine. diff --git a/lisp/proced.el b/lisp/proced.el index 03a7f1bebdf..b3d581a49d1 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -776,12 +776,12 @@ proced-header-line (while (string-match "[ \t\n]+" hl pos) (setq pos (match-end 0)) (put-text-property (match-beginning 0) pos 'display - `(space :align-to ,(+ pos base)) + `(space :align-to (,(+ pos base) . width)) hl))) (setq hl (replace-regexp-in-string ;; preserve text properties "\\(%\\)" "\\1\\1" hl))) - (list (propertize " " 'display `(space :align-to ,base)) + (list (propertize " " 'display `(space :align-to (,base . width))) hl))) (defun proced-pid-at-point () @@ -894,6 +894,8 @@ proced-mode (setq-local font-lock-defaults '(proced-font-lock-keywords t nil nil beginning-of-line)) (setq-local switch-to-buffer-preserve-window-point nil) + ;; So that the heading scales together with the body of the table. + (setq-local text-scale-remap-header-line t) (if (and (not proced-auto-update-timer) proced-auto-update-interval) (setq proced-auto-update-timer (run-at-time t proced-auto-update-interval diff --git a/src/xdisp.c b/src/xdisp.c index da6e0afa8e1..2eba42e3d90 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29093,7 +29093,9 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, /* 'width': the width of FONT. */ if (EQ (prop, Qwidth)) return OK_PIXELS (font - ? FONT_WIDTH (font) + ? (font->average_width + ? font->average_width + : font->space_width) : FRAME_COLUMN_WIDTH (it->f)); #else if (EQ (prop, Qheight) || EQ (prop, Qwidth))