commit 1eb247af73c3dbfbf8d4c4363d1a22e3fbcf6ce7 Author: Eli Zaretskii Date: Sun Dec 21 09:23:26 2025 +0200 ; Improve documentation of Hide-ifdef mode * lisp/progmodes/hideif.el (hide-ifdef-mode) (hif-clear-all-ifdef-defined, hif-show-all, forward-ifdef) (backward-ifdef, next-ifdef, previous-ifdef, hif-evaluate-macro) (hif-find-define, hif-add-new-defines, hide-ifdef-define) (hide-ifdefs): Doc fixes. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 0ddaf513a02..e96b8b60d25 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -284,19 +284,31 @@ This backup prevents any accidental clearance of `hide-ifdef-env' by (define-minor-mode hide-ifdef-mode "Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -Hide-Ifdef mode is a buffer-local minor mode for use with C and +\\Hide-Ifdef mode is a buffer-local minor mode for use with C and C-like major modes. When enabled, code within #ifdef constructs that the C preprocessor would eliminate may be hidden from view. + +Use \\[hide-ifdefs] to hide ifdefs and \\[hide-ifdefs] to show them. +Use \\[hif-show-all] to show all ifdefs. + Several variables affect how the hiding is done: `hide-ifdef-env' An association list of defined and undefined symbols for the - current project. Initially, the global value of `hide-ifdef-env' - is used. This variable was a buffer-local variable, which limits - hideif to parse only one C/C++ file at a time. We've extended - hideif to support parsing a C/C++ project containing multiple C/C++ - source files opened simultaneously in different buffers. Therefore - `hide-ifdef-env' can no longer be buffer local but must be global. + current project. Use \\[hide-ifdef-define] and \\[hide-ifdef-undef] to update the value of + this list with defined or undefined symbols. + We've extended hideif to support parsing a C/C++ project + containing multiple C/C++ source files opened simultaneously in + different buffers. Therefore `hide-ifdef-env' can no longer be + buffer local but must be global. + +`hide-ifdef-initially' + Customize this to a non-nil value to cause ifdefs be hidden as + soon as `hide-ifdef-mode' is turned on. + +`hide-ifdef-lines' + Customize to non-nil to hide the #if, #ifdef, #ifndef, #else, + and #endif lines when hiding ifdefs. `hide-ifdef-define-alist' An association list of defined symbol lists. @@ -304,14 +316,6 @@ Several variables affect how the hiding is done: and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' from one of the lists in `hide-ifdef-define-alist'. -`hide-ifdef-lines' - Set to non-nil to not show #if, #ifdef, #ifndef, #else, and - #endif lines when hiding. - -`hide-ifdef-initially' - Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode - is activated. - `hide-ifdef-read-only' Set to non-nil if you want to make buffers read only while hiding. After `show-ifdefs', read-only status is restored to previous value. @@ -353,9 +357,10 @@ Several variables affect how the hiding is done: (defun hif-clear-all-ifdef-defined () "Clears all symbols defined in `hide-ifdef-env'. -It will backup this variable to `hide-ifdef-env-backup' before clearing to -prevent accidental clearance. -When prefixed, it swaps current symbols with the backup ones." +This command will backup this variable to `hide-ifdef-env-backup' before +clearing, to prevent accidental clearance. +With prefix argument, swap the current list of defined symbols with the +backup one." (interactive) (if current-prefix-arg (if hide-ifdef-env-backup @@ -375,8 +380,9 @@ When prefixed, it swaps current symbols with the backup ones." (message "All defined symbols cleared." )))) (defun hif-show-all (&optional start end) - "Show all of the text in the current buffer. -If there is a marked region from START to END it only shows the symbols within." + "Show all of the text in the current buffer, unhiding ifdefs. +If there is a marked region from START to END, only show the symbols in +that region." (interactive (if (use-region-p) (list (region-beginning) (region-end)) @@ -1958,7 +1964,7 @@ Do this when cursor is at the beginning of `regexp' (i.e. #ifX)." (defun forward-ifdef (&optional arg) "Move point to beginning of line of the next ifdef-endif. -With argument, do this that many times." +With prefix argument N, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (backward-ifdef (- arg)) @@ -1975,7 +1981,7 @@ With argument, do this that many times." (defun backward-ifdef (&optional arg) "Move point to beginning of the previous ifdef-endif. -With argument, do this that many times." +With prefix argument N, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (forward-ifdef (- arg)) @@ -2016,7 +2022,7 @@ With argument, do this that many times." (defun next-ifdef (&optional arg) "Move to the beginning of the next #ifX, #else, or #endif. -With argument, do this that many times." +With prefix argument N, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (previous-ifdef (- arg)) @@ -2029,7 +2035,7 @@ With argument, do this that many times." (defun previous-ifdef (&optional arg) "Move to the beginning of the previous #ifX, #else, or #endif. -With argument, do this that many times." +With prefix argument N, do this that many times." (interactive "p") (or arg (setq arg 1)) (if (< arg 0) (next-ifdef (- arg)) @@ -2294,12 +2300,13 @@ Refer to `hide-ifdef-expand-reinclusion-guard' for more details." (defun hif-evaluate-macro (rstart rend) "Evaluate the macro expansion result for the active region. If no region is currently active, find the current #ifdef/#define and evaluate -the result; otherwise it looks for current word at point. -Currently it supports only math calculations, strings or argumented macros can +the result; otherwise look for current word at point. +Currently it supports only math calculations; strings or argumented macros can not be expanded. -This function by default ignores parsing error and return `false' on evaluating -runtime C(++) statements or tokens that normal C(++) preprocessor can't perform; -however, when this command is prefixed, it will display the error instead." +This function by default ignores parsing error and returns `false' on +evaluating runtime C(++) statements or tokens that normal C(++) preprocessor +can't perform; however, when invoked with prefix argument, it will display +the error instead." (interactive (if (not (use-region-p)) '(nil nil) @@ -2450,7 +2457,8 @@ first arg will be `hif-etc'." (defvar hif-verbose-define-count 0) (defun hif-find-define (&optional min max) - "Parse texts and retrieve all defines within the region MIN and MAX." + "Parse texts and retrieve all defines within the region MIN and MAX. +Interactively, MIN is position of point and MAX is the end of the buffer." (interactive) (and min (goto-char min)) (and (re-search-forward hif-define-regexp max t) @@ -2530,7 +2538,8 @@ first arg will be `hif-etc'." (defun hif-add-new-defines (&optional min max) - "Scan and add all #define macros between MIN and MAX." + "Scan and add all #define macros between MIN and MAX. +Interactively, MIN is position of point and MAX is the end of the buffer." (interactive) (save-excursion (save-restriction @@ -2628,7 +2637,7 @@ It does not do the work that's pointless to redo on a recursive entry." (defun hide-ifdef-define (var &optional val) "Define a VAR to VAL (default 1) in `hide-ifdef-env'. -This allows #ifdef VAR to be hidden." +This allows #ifndef VAR to be hidden." (interactive (let* ((default (save-excursion (beginning-of-line) @@ -2678,7 +2687,7 @@ This allows #ifdef VAR to be hidden." Assume that defined symbols have been added to `hide-ifdef-env'. The text hidden is the text that would not be included by the C preprocessor if it were given the file with those symbols defined. -With prefix command presents it will also hide the #ifdefs themselves. +With prefix argument, also hide the #ifdefs themselves. Hiding will only be performed within the marked region if there is one. commit 040374be2dd0b601cdd69e2355cb1418b79398f6 Author: Eli Zaretskii Date: Sun Dec 21 08:15:55 2025 +0200 ; Avoid compilation warnings in xwidget.c on macOS * src/xwidget.c (Fxwidget_perform_lispy_event): Avoid compiler warnings about set but not used variables. (Bug#80044) diff --git a/src/xwidget.c b/src/xwidget.c index 4f5b46c692a..8b09f24d490 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -489,9 +489,8 @@ On X11, modifier keys will not be processed if FRAME is nil and the selected frame is not an X-Windows frame. */) (Lisp_Object xwidget, Lisp_Object event, Lisp_Object frame) { - struct frame *f = NULL; - #ifdef USE_GTK + struct frame *f = NULL; GdkEvent *xg_event; GtkContainerClass *klass; GtkWidget *widget; @@ -504,12 +503,12 @@ selected frame is not an X-Windows frame. */) CHECK_LIVE_XWIDGET (xwidget); +#ifdef USE_GTK if (!NILP (frame)) f = decode_window_system_frame (frame); else if (FRAME_WINDOW_P (SELECTED_FRAME ())) f = SELECTED_FRAME (); -#ifdef USE_GTK int character = -1, keycode = -1; int modifiers = 0; struct xwidget *xw = XXWIDGET (xwidget); @@ -525,7 +524,7 @@ selected frame is not an X-Windows frame. */) gdk_offscreen_window_set_embedder (osw, embedder); unblock_input (); -#endif +#endif /* HAVE_XINPUT2 */ widget = gtk_window_get_focus (GTK_WINDOW (xw->widgetwindow_osr)); if (!widget) @@ -559,7 +558,7 @@ selected frame is not an X-Windows frame. */) modifiers = pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f), modifiers); else modifiers = 0; -#endif +#endif /* HAVE_PGTK */ } else if (SYMBOLP (event)) { @@ -593,7 +592,7 @@ selected frame is not an X-Windows frame. */) XFIXNUM (XCAR (XCDR (decoded)))); else modifiers = 0; -#endif +#endif /* HAVE_PGTK */ if (found) keycode = off + 0xff00; @@ -608,7 +607,7 @@ selected frame is not an X-Windows frame. */) else gdk_offscreen_window_set_embedder (osw, NULL); unblock_input (); -#endif +#endif /* HAVE_XINPUT2 */ return Qnil; } @@ -627,7 +626,7 @@ selected frame is not an X-Windows frame. */) if (f) xg_event->key.state = xw_translate_x_modifiers (FRAME_DISPLAY_INFO (f), modifiers); -#endif +#endif /* !HAVE_X_WINDOWS */ if (keycode > -1) { @@ -666,9 +665,9 @@ selected frame is not an X-Windows frame. */) record_osr_embedder (xw->embedder_view); else gdk_offscreen_window_set_embedder (osw, NULL); -#endif +#endif /* HAVE_XINPUT2 */ unblock_input (); -#endif +#endif /* USE_GTK */ return Qnil; } commit fd1b5977817e9f05d41d87bc4a31ef5235536d15 Author: Eli Zaretskii Date: Sun Dec 21 07:53:51 2025 +0200 ; 'standard-display-unicode-special-glyphs': Doc fix * lisp/disp-table.el (standard-display-unicode-special-glyphs): Describe in the doc string how to customize the glyphs. (Bug#80043) diff --git a/lisp/disp-table.el b/lisp/disp-table.el index f012f61ddda..ada7a5a9302 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -182,7 +182,11 @@ The glyphs being changed by this function are `vertical-border', `box-vertical',`box-horizontal', `box-down-right', `box-down-left', `box-up-right', `box-up-left',`box-double-vertical', `box-double-horizontal', `box-double-down-right', -`box-double-down-left', `box-double-up-right', `box-double-up-left'," +`box-double-down-left', `box-double-up-right', `box-double-up-left'. + +To customize the glyphs, use `make-glyph' to create a glyph from +a character code and a face, and then use `set-display-table-slot' +to assign the glyph to a slot." (interactive) (set-display-table-slot standard-display-table 'vertical-border (make-glyph-code #x2502)) commit 28a3e3d983954bc29686fe2c88f3807ecc3c6ba8 Author: Eli Zaretskii Date: Sun Dec 21 07:37:41 2025 +0200 ; Fix a typo in a project.el test (bug#79809) * test/lisp/progmodes/project-tests.el (project-vc-supports-project-in-different-dir): Fix typo in version. diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 99953b53a61..e353eef728e 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -156,7 +156,7 @@ When `project-ignores' includes a name matching project dir." (should-not (null project)) (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project))) (should (member "etc" (project-ignores project dir))) - (should (equal `(,@(when (version<= "1.13" (vc-git--program-version)) + (should (equal `(,@(when (version<= "2.13" (vc-git--program-version)) (list ".dir-locals.el")) "foo") (mapcar #'file-name-nondirectory (project-files project)))))) commit 66069812be537adb7b1c50c4695f831a055d5b3d Author: Dmitry Gutov Date: Sun Dec 21 04:04:20 2025 +0200 project-vc-supports-project-in-different-dir: Tune the expectation for 'find' * test/lisp/progmodes/project-tests.el (project-vc-supports-project-in-different-dir): Account for difference in behavior when failing over to 'find' (comments in bug#79809). diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 947ad94a385..99953b53a61 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -33,6 +33,8 @@ (require 'grep) (require 'xref) +(declare-function vc-git--program-version "vc-git") + (ert-deftest project/quoted-directory () "Check that `project-files' and `project-find-regexp' deal with quoted directory names (Bug#47799)." @@ -154,7 +156,9 @@ When `project-ignores' includes a name matching project dir." (should-not (null project)) (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project))) (should (member "etc" (project-ignores project dir))) - (should (equal '(".dir-locals.el" "foo") + (should (equal `(,@(when (version<= "1.13" (vc-git--program-version)) + (list ".dir-locals.el")) + "foo") (mapcar #'file-name-nondirectory (project-files project)))))) (ert-deftest project-vc-supports-files-in-subdirectory () commit bc30310f8753ee35c77f7e70ba6707f066475aba Author: Jens Schmidt Date: Fri Nov 14 20:28:23 2025 +0100 Add query-replace-read-transpose-from-to Provide a command to easily swap FROM and TO arguments in a query replace operation. * lisp/replace.el (query-replace-read-transpose-from-to): New function. (query-replace-read-map): New keymap. (query-replace-read-from): Use new keymap to read from minibuffer. (read-regexp-map): Inherit from 'query-replace-read-map'. (query-replace-read-from, query-replace-read-to): Fix parameter references in doc strings. * etc/NEWS: Document the change. (Bug#79835) diff --git a/etc/NEWS b/etc/NEWS index 7e8dbf44b9f..122760b7a85 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -845,6 +845,12 @@ activate the mark if it is not already active. The default value is t, which retains the old behavior. This variable has no effect when Transient Mark mode is off. +--- +** You can now use 'M-s t' to swap FROM and TO during 'query-replace'. +Likewise during 'query-replace-regexp'. The original binding of 'M-s' +('next-matching-history-element') is now available on 'M-s M-s' or 'M-s +s' for query replace minibuffer input. + --- ** New commands for filling text using semantic linefeeds. The new command 'fill-paragraph-semlf' fills a paragraph of text using diff --git a/lisp/replace.el b/lisp/replace.el index e4709040dff..bf0d8ac672d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -201,7 +201,7 @@ by this function to the end of values available via (car (symbol-value query-replace-from-history-variable))))) (defun query-replace-read-from (prompt regexp-flag) - "Query and return the `from' argument of a `query-replace' operation. + "Query and return the FROM argument of a `query-replace' operation. Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp. The return value can also be a pair (FROM . TO) indicating that the user wants to replace FROM with TO." @@ -263,7 +263,7 @@ wants to replace FROM with TO." query-replace-read-from-regexp-default 'minibuffer-history) (read-from-minibuffer - prompt nil nil nil nil + prompt nil query-replace-read-map nil nil (if default (delete-dups (cons default (query-replace-read-from-suggestions))) @@ -337,7 +337,7 @@ the original string if not." (defun query-replace-read-to (from prompt regexp-flag) - "Query and return the `to' argument of a `query-replace' operation. + "Query and return the TO argument of a `query-replace' operation. Prompt with PROMPT. REGEXP-FLAG non-nil means the response should a regexp." (query-replace-compile-replacement @@ -387,6 +387,35 @@ should a regexp." (get-text-property 0 'isearch-regexp-function from))) (and current-prefix-arg (eq current-prefix-arg '-)))))) +(defun query-replace-read-transpose-from-to () + "Transpose the FROM and TO arguments of a `query-replace' operation. +If there is an active region in the minibuffer, tranpose only those +parts of FROM and TO that intersect with the active region, or complete +TO or FROM if the active region only intersects with FROM or TO, +respectively. +For example, if '[...]' denotes the active region, this function would +transpose '\\=\\<[foo]\\> -> bar' to '\\=\\ -> foo'." + (interactive) + (let* ((from-beg (minibuffer-prompt-end)) + (from-end (next-single-property-change from-beg 'separator)) + (to-beg (and from-end + (next-single-property-change from-end 'separator))) + (to-end (point-max)) + (beg (use-region-beginning)) + (end (use-region-end))) + (cond + ((or (not from-end) (not to-beg)) + (user-error "No query-replace separator to transpose around")) + ((or (not beg) (not end)) + (transpose-regions from-beg from-end to-beg to-end)) + (t + ;; Calculate intersection of FROM and TO with active region. + (when (< from-beg beg from-end) (setq from-beg beg)) + (when (< from-beg end from-end) (setq from-end end)) + (when (< to-beg beg to-end) (setq to-beg beg)) + (when (< to-beg end to-end) (setq to-end end)) + (transpose-regions from-beg from-end to-beg to-end))))) + (defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying @@ -829,8 +858,17 @@ by this function to the end of values available via (regexp-quote (or (car search-ring) "")) (car (symbol-value query-replace-from-history-variable)))) -(defvar-keymap read-regexp-map +(defvar-keymap query-replace-read-map :parent minibuffer-local-map + ;; Defining M-s as a prefix here has the side effect of hiding + ;; regular M-s, bound to `next-matching-history-element' in the + ;; default minibuffer map. Try to mitigate that loss. + "M-s s" #'next-matching-history-element + "M-s M-s" #'next-matching-history-element + "M-s t" #'query-replace-read-transpose-from-to) + +(defvar-keymap read-regexp-map + :parent query-replace-read-map "M-s c" #'read-regexp-toggle-case-fold) (defvar read-regexp--case-fold nil) commit 9ad5953dd3fdce84e4a1ec27f0334f679b6bd437 Author: Juri Linkov Date: Sat Dec 20 20:50:57 2025 +0200 Handle non-leaf nodes with Eglot text properties in 'M-x imenu' * lisp/imenu.el (imenu--flatten-index-alist): Add special handling of the text property 'breadcrumb-region' added by 'eglot-imenu'. Add non-leaf nodes with these text properties to the flat index alist. (imenu--parentify-index-alist): New function. (imenu-choose-buffer-index): For the case when imenu-flatten is nil, use 'imenu--parentify-index-alist' to add separate ".." to non-leaf nodes when the first node of 'index-alist' has Eglot text properties (bug#79980). diff --git a/lisp/imenu.el b/lisp/imenu.el index 41c4b5cee91..a0e6a5cac72 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -864,7 +864,33 @@ Returns t for rescan and otherwise an element or subelement of INDEX-ALIST." (_ new-prefix)) pos))) (t - (imenu--flatten-index-alist pos concat-names new-prefix))))) + (let ((subalist (imenu--flatten-index-alist + pos concat-names new-prefix)) + (region (get-text-property 0 'breadcrumb-region name))) + (if region + ;; Add non-leaf nodes with Eglot text properties. + (append (imenu--flatten-index-alist + (list (cons name (car region))) concat-names prefix) + subalist) + subalist)))))) + index-alist)) + +(defun imenu--parentify-index-alist (index-alist) + ;; Add separate ".." for navigating to non-leaf nodes. + ;; Used only when `index-alist' has Eglot text properties. + (mapcan + (lambda (item) + (let* ((name (car item)) + (pos (cdr item))) + (cond + ((not (imenu--subalist-p item)) + (list item)) + (t + (let ((subalist (imenu--parentify-index-alist pos)) + (region (get-text-property 0 'breadcrumb-region name))) + (when region + (setq subalist (append (list (cons ".." (car region))) subalist))) + (list (cons name subalist))))))) index-alist)) (defun imenu-choose-buffer-index (&optional prompt alist) @@ -896,8 +922,16 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)." ;; Create a list for this buffer only when needed. (while (eq result t) (setq index-alist (if alist alist (imenu--make-index-alist))) - (when imenu-flatten + (cond + (imenu-flatten (setq index-alist (imenu--flatten-index-alist index-alist t))) + ((when-let* ((alist (if (eq (car index-alist) imenu--rescan-item) + (cdr index-alist) index-alist)) + (name (caar alist))) + (get-text-property 0 'breadcrumb-region name)) + ;; Change the menu structure by adding ".." to non-leaf nodes + ;; only when the first node has Eglot text properties. + (setq index-alist (imenu--parentify-index-alist index-alist)))) (setq result (if (and imenu-use-popup-menu (or (eq imenu-use-popup-menu t) mouse-triggered)) commit 0aabe62b64b4698340e8414d28b0fa0a3eabbf82 Author: Jens Schmidt Date: Wed Dec 17 22:20:15 2025 +0100 Improve handling of non-ASCII characters in 'transpose-regions' * src/editfns.c (Ftranspose_regions): Separate code related to character semantics from that related to byte semantics and in that way leverage optimizations for regions of equal length with respect to both semantics. Move and update comments dating back to the initial implementation. * test/src/editfns-tests.el (editfns-tests--transpose-regions-tests) (editfns-tests--transpose-regions-markups) (editfns-tests--transpose-regions): New test and accompanying variables. diff --git a/src/editfns.c b/src/editfns.c index 52a3e4e4266..6ffdd3c3109 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4525,7 +4525,8 @@ ring. */) ptrdiff_t len1_byte, len_mid_byte, len2_byte; unsigned char *start1_addr, *start2_addr, *temp; - INTERVAL cur_intv, tmp_interval1, tmp_interval2, tmp_interval3; + INTERVAL cur_intv, tmp_interval1, tmp_interval2; + INTERVAL tmp_interval_mid, tmp_interval3; Lisp_Object buf; XSETBUFFER (buf, current_buffer); @@ -4540,7 +4541,9 @@ ring. */) end2 = XFIXNAT (endr2); gap = GPT; - /* Swap the regions if they're reversed. */ + /* Swap the regions if they're reversed. We do not swap the + corresponding Lisp objects as well, since we reference these only + to clear text properties in both regions. */ if (start2 < end1) { register ptrdiff_t glumph = start1; @@ -4560,28 +4563,6 @@ ring. */) else if ((start1 == end1 || start2 == end2) && end1 == start2) return Qnil; - /* The possibilities are: - 1. Adjacent (contiguous) regions, or separate but equal regions - (no, really equal, in this case!), or - 2. Separate regions of unequal size. - - The worst case is usually No. 2. It means that (aside from - potential need for getting the gap out of the way), there also - needs to be a shifting of the text between the two regions. So - if they are spread far apart, we are that much slower... sigh. */ - - /* It must be pointed out that the really studly thing to do would - be not to move the gap at all, but to leave it in place and work - around it if necessary. This would be extremely efficient, - especially considering that people are likely to do - transpositions near where they are working interactively, which - is exactly where the gap would be found. However, such code - would be much harder to write and to read. So, if you are - reading this comment and are feeling squirrely, by all means have - a go! I just didn't feel like doing it, so I will simply move - the gap the minimum distance to get it out of the way, and then - deal with an unbroken array. */ - start1_byte = CHAR_TO_BYTE (start1); end2_byte = CHAR_TO_BYTE (end2); @@ -4597,6 +4578,22 @@ ring. */) /* Run the before-change-functions *before* we move the gap. */ modify_text (start1, end2); + /* It must be pointed out that the really studly thing to do would + be not to move the gap at all, but to leave it in place and work + around it if necessary. This would be extremely efficient, + especially considering that people are likely to do + transpositions near where they are working interactively, which + is exactly where the gap would be found. However, such code + would be much harder to write and to read. So, if you are + reading this comment and are feeling squirrely, by all means have + a go! I just didn't feel like doing it, so I will simply move + the gap the minimum distance to get it out of the way, and then + deal with an unbroken array. */ + + /* Hmmm... how about checking to see if the gap is large + enough to use as the temporary storage? That would avoid an + allocation... interesting. Later, don't fool with it now. */ + /* Make sure the gap won't interfere, by moving it out of the text we will operate on. */ if (start1 < gap && gap < end2) @@ -4637,16 +4634,36 @@ ring. */) } #endif - /* Hmmm... how about checking to see if the gap is large - enough to use as the temporary storage? That would avoid an - allocation... interesting. Later, don't fool with it now. */ + /* The possibilities are: + 1. Regions of equal size, possibly even adjacent (contiguous). + 2. Regions of unequal size. + + In case 1. we can leave the "mid", that is, the region between the + two regions untouched. + + The worst case is usually No. 2. It means that (aside from + potential need for getting the gap out of the way), there also + needs to be a shifting of the text between the two regions. So + if they are spread far apart, we are that much slower... sigh. */ + + /* As an additional difficulty, we have to carefully consider byte vs. + character semantics: Maintaining undo and text properties needs to + be done in terms of characters, swapping text in memory needs to be + done in terms of bytes. + + Handling case 1. mentioned above in a special way is beneficial + both for undo/text properties and for memory swapping, only we have + to consider case 1. for the character-related bits (len1 == len2) + and case 1. for the byte-related bits (len1_byte == len2_byte) + separately. */ tmp_interval1 = copy_intervals (cur_intv, start1, len1); tmp_interval2 = copy_intervals (cur_intv, start2, len2); - USE_SAFE_ALLOCA; - if (len1_byte == len2_byte && len1 == len2) - /* Regions are same size, though, how nice. */ - /* The char lengths also have to match, for text-properties. */ + + len_mid = start2 - end1; + len_mid_byte = start2_byte - end1_byte; + + if (len1 == len2) { if (end1 == start2) /* Merge the two parts into a single one. */ record_change (start1, (end2 - start1)); @@ -4663,7 +4680,24 @@ ring. */) tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0); if (tmp_interval3) set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3); + } + else + /* Regions have different length, character-wise. Handle undo and + text properties for both regions as one long piece of text + spanning both regions and the mid. But while doing so, save the + intervals of the mid to later restore them in their new + position. */ + { + record_change (start1, (end2 - start1)); + tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); + tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); + if (tmp_interval3) + set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); + } + USE_SAFE_ALLOCA; + if (len1_byte == len2_byte) + { temp = SAFE_ALLOCA (len1_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); @@ -4671,42 +4705,37 @@ ring. */) memcpy (start1_addr, start2_addr, len2_byte); memcpy (start2_addr, temp, len1_byte); } + else if (len1_byte < len2_byte) /* Second region larger than first */ + { + /* holds region 2 */ + temp = SAFE_ALLOCA (len2_byte); + start1_addr = BYTE_POS_ADDR (start1_byte); + start2_addr = BYTE_POS_ADDR (start2_byte); + memcpy (temp, start2_addr, len2_byte); + memcpy (start1_addr + len_mid_byte + len2_byte, start1_addr, len1_byte); + memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid_byte); + memcpy (start1_addr, temp, len2_byte); + } else + /* Second region smaller than first. */ + { + /* holds region 1 */ + temp = SAFE_ALLOCA (len1_byte); + start1_addr = BYTE_POS_ADDR (start1_byte); + start2_addr = BYTE_POS_ADDR (start2_byte); + memcpy (temp, start1_addr, len1_byte); + memcpy (start1_addr, start2_addr, len2_byte); + memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid_byte); + memcpy (start1_addr + len2_byte + len_mid_byte, temp, len1_byte); + } + SAFE_FREE (); + + if (len1 != len2) + /* Restore intervals of the mid. */ { - len_mid = start2 - end1; - len_mid_byte = start2_byte - end1_byte; - record_change (start1, (end2 - start1)); - INTERVAL tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); - tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); - if (tmp_interval3) - set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); - if (len1_byte < len2_byte) /* Second region larger than first */ - { - /* holds region 2 */ - temp = SAFE_ALLOCA (len2_byte); - start1_addr = BYTE_POS_ADDR (start1_byte); - start2_addr = BYTE_POS_ADDR (start2_byte); - memcpy (temp, start2_addr, len2_byte); - memcpy (start1_addr + len_mid_byte + len2_byte, start1_addr, len1_byte); - memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid_byte); - memcpy (start1_addr, temp, len2_byte); - } - else - /* Second region smaller than first. */ - { - /* holds region 1 */ - temp = SAFE_ALLOCA (len1_byte); - start1_addr = BYTE_POS_ADDR (start1_byte); - start2_addr = BYTE_POS_ADDR (start2_byte); - memcpy (temp, start1_addr, len1_byte); - memcpy (start1_addr, start2_addr, len2_byte); - memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid_byte); - memcpy (start1_addr + len2_byte + len_mid_byte, temp, len1_byte); - } graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, len_mid, current_buffer, 0); } - SAFE_FREE (); graft_intervals_into_buffer (tmp_interval1, end2 - len1, len1, current_buffer, 0); graft_intervals_into_buffer (tmp_interval2, start1, diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 2fce2315edb..4e0ca4c9d2a 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -190,6 +190,210 @@ (should (equal-including-properties str1 (buffer-substring (+ (point-min) 5) (+ (point-min) 7))))))) +(defconst editfns-tests--transpose-regions-tests + '(;; adjacent regions with one being empty + ("" "foo" "" "" "" [0 3 0 0 0]) + ("" "" "" "baz" "" [0 0 0 3 0]) + + ;; For the following tests, assume that characters from the range + ;; [a-z] are 1 byte long in Emacs's internal text representation, + ;; while LATIN SMALL LETTER [AO] WITH DIAERESIS is 2 bytes long. + + ;; (len1 == len2) && (end1 == start2) && (len1_byte == len2_byte) + ("" "fo(o" "" "b)az" "" [0 3 0 3 0]) + ;; (len1 == len2) && (end1 != start2) && (len1_byte == len2_byte) + ("" "fo(o" "[bar]" "b)az" "" [0 3 3 3 0]) + + ;; (len1 != len2) && (end1 != start2) && (len1_byte < len2_byte) + ("" "fo(o" "[bar]" "baaz)" "" [0 3 3 4 0]) + ;; (len1 != len2) && (end1 != start2) && (len1_byte > len2_byte) + ("" "(fooo" "[bar]" "baz)" "" [0 4 3 3 0]) + + ;; (len1 == len2) && (end1 == start2) && (len1_byte < len2_byte) + ("" "fo(o" "" "b)äz" "" [0 3 0 4 0]) + ;; (len1 == len2) && (end1 == start2) && (len1_byte > len2_byte) + ("" "fo(ö" "" "b)az" "" [0 4 0 3 0]) + ;; (len1 == len2) && (end1 != start2) && (len1_byte > len2_byte) + ("" "fo(o" "[bar]" "b)äz" "" [0 3 3 4 0]) + ;; (len1 == len2) && (end1 != start2) && (len1_byte > len2_byte) + ("" "fo(ö" "[bar]" "b)az" "" [0 4 3 3 0]) + + ;; (len1 != len2) && (end1 == start2) && (len1_byte == len2_byte) + ("" "fo(ö" "" "baaz)" "" [0 4 0 4 0]) + ;; (len1 != len2) && (end1 == start2) && (len1_byte == len2_byte) + ("" "(fooo" "" "bäz)" "" [0 4 0 4 0]) + ;; (len1 != len2) && (end1 != start2) && (len1_byte == len2_byte) + ("" "fo(ö" "[bar]" "baaz)" "" [0 4 3 4 0]) + ;; (len1 != len2) && (end1 != start2) && (len1_byte == len2_byte) + ("" "(fooo" "[bar]" "bäz)" "" [0 4 3 4 0]) + + ;; Going entirely non-ASCII. Assume plain greek small letters are + ;; two bytes long in Emacs's internal text representation, GREEK + ;; SMALL LETTER ALPHA WITH PSILI is three bytes long. + + ;; To cover the initial patch from bug#70122, define a test + ;; consisting of three three-letter strings REG1 MID REG2, with + ;; (length REG1) == (length REG2) but (byte-length REG1) != + ;; (byte-length REG2) ... + ("ἀ(ρχή" "φ[ωω" "β){αρ" "β<ἀ]ζ}" "τέλ>ος" [9 6 6 7 10]) + ;; ... and a test with (length REG1) == (length REG2) and + ;; (byte-length REG1) == (byte-length REG2). + ("ἀ(ρχή" "φ[ωω" "β){αρ" "β<α]ζ}" "τέλ>ος" [9 6 6 6 10]) + + ;; Define the moral equivalent of + ;; `editfns-tests--transpose-equal-but-not'. + (" " "(ab)" "[SPC]" "{é}" " " [1 2 3 2 1]) + + ;; Likewise, for the testcase from bug#70122 in + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=70122#5. + ("" "" "(a):\n[b]: \x2113\x2080\n" "{v}: scaling" "" [0 0 13 10 0]) + + ;; Likewise, for the testcase from bug#70122 in + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=70122#52. + ("(Query replace (default abc → d): )" "abc" "[ → ]" "d" "" [35 3 5 1 0])) + "List of test strings and their markup to test `transpose-regions'. +Each element of this list should be a list + + HEAD REG1 MID REG2 TAIL BYTE-LENGTHS + +where the first five elements are (possibly empty) string snippets and +the sixth element is a five-element vector providing the lengths of the +string snippets, counted in bytes in Emacs's internal text +representation. + +Test `editfns-tests--transpose-regions' inserts the five snippets into +its temporary buffer, adds text properties to them as described for +variable `editfns-tests--transpose-regions-markups', transposes REG1 and +REG2, probably undoes the change, and at each stage ensures that all +involved entities look as expected.") + +(defconst editfns-tests--transpose-regions-markups + '("()" "[]" "{}" "<>") + "List of two-characters strings \"BE\" describing text property markup. +For each element in this list, test `editfns-tests--transpose-regions' +searches once for regular expression \"B.+E\" in its temporary buffer, +adds a text property `markup' with value \"BE\" to the matching text, +and then removes the markup characters B and E around the matching text. + +The test searches in the buffer with all test snippets already inserted, +so characters B and E can originate from different snippets, and the +various B's and E's of different markup items do not need to nest.") + +(ert-deftest editfns-tests--transpose-regions () + "Test function `transpose-regions'. +Execute tests as described by `editfns-tests--transpose-regions-tests'." + (dolist (test editfns-tests--transpose-regions-tests) + (dolist (leave-markers '(nil t)) + (message "test: %S leave-markers: %S" test leave-markers) + (with-temp-buffer + (let ((test (take 5 test)) + (blengthv (nth 5 test)) + (smarkers nil) ; Separator markers. + (pmarkers nil) ; Property markers. + (pmpos nil) ; Their positions before transposing. + (strings nil) ; Net text snippets, propertized. + (blengths nil) ; Their lengths in bytes. + (tstrings nil) ; Net text snippets with REG1/2 transposed. + (test-undo nil) + p beg end beg2 end2) + (buffer-enable-undo) + ;; Insert text snippets. While doing so, create the separator + ;; markers which we need later to determine the net text + ;; snippets. + (cl-assert (eq (length test) 5)) + (setq p test) + (while (cdr p) + (insert (car p)) + (push (point-marker) smarkers) + (setq p (cdr p))) + (insert (car p)) + (setq smarkers (nreverse smarkers)) + ;; Propertize them according to markup, remove markup + ;; characters, add property markers. + (dolist (markup editfns-tests--transpose-regions-markups) + (cl-assert (eq (length markup) 2)) + (goto-char (point-min)) + (when (search-forward-regexp + (concat "\\(" + (regexp-quote (substring markup 0 1)) + ".+" + (regexp-quote (substring markup 1 2)) + "\\)") + nil t) + (setq beg (copy-marker (match-beginning 1)) + end (copy-marker (match-end 1))) + (delete-region beg (1+ beg)) + (delete-region (1- end) end) + (add-text-properties beg end (list 'markup markup)) + (push beg pmarkers) + (push end pmarkers))) + (setq pmarkers (sort pmarkers) + pmpos (mapcar #'marker-position pmarkers)) + ;; Determine net text snippets, plain and with transposed REG1 + ;; and REG2. Determine the byte lengths of the net text + ;; snippets and ensure they meet our expectation. + (setq p smarkers + beg (point-min)) + (while p + (push (buffer-substring beg (car p)) strings) + (push (- (position-bytes (car p)) (position-bytes beg)) + blengths) + (setq beg (car p) p (cdr p))) + (push (buffer-substring beg (point-max)) strings) + (push (- (position-bytes (point-max)) (position-bytes beg)) + blengths) + (setq strings (nreverse strings) + blengths (nreverse blengths)) + (setq tstrings (list (nth 0 strings) (nth 3 strings) + (nth 2 strings) (nth 1 strings) + (nth 4 strings))) + (should (equal blengthv (apply #'vector blengths))) + ;; Transpose REG1 and REG2. Some transpositions might not + ;; generate undo, keep track of that in flag `test-undo'. + (setq beg (+ 1 (length (nth 0 strings))) + end (+ beg (length (nth 1 strings))) + beg2 (+ end (length (nth 2 strings))) + end2 (+ beg2 (length (nth 3 strings)))) + (undo-boundary) + (transpose-regions beg end beg2 end2 leave-markers) + (when (car buffer-undo-list) + (setq test-undo t)) + (undo-boundary) + ;; Check resulting buffer text and its properties. + (should (equal-including-properties + (buffer-string) + (mapconcat #'identity tstrings))) + ;; Check property marker positions. + (if leave-markers + (should (equal (mapcar #'marker-position pmarkers) pmpos)) + ;; Meh. This more or less blindly duplicates function + ;; transpose_markers, since I have been too lazy to + ;; reproduce the arithmetics myself. + (setq pmpos + (mapcar + (lambda (pos) + (cond + ((< pos beg) pos) + ((>= pos end2) pos) + ((< pos end) (+ pos (+ (- end2 beg2) (- beg2 end)))) + ((< pos beg2) (+ pos (- (- end2 beg2) (- end beg)))) + (t (- pos (+ (- end beg) (- beg2 end)))))) + pmpos)) + (should (equal (mapcar #'marker-position pmarkers) pmpos))) + ;; Undo the transposition and check text and properties again, + ;; if needed. This does not undo any marker transpositions as + ;; per the comment before the call to transpose_markers in + ;; Ftranspose_regions, so nothing to check on the marker side + ;; after the undo. + (when test-undo + (undo) + (should (equal-including-properties + (buffer-string) + (mapconcat #'identity strings)))) + ;; Be nice and clean up markers. + (dolist (marker smarkers) (set-marker marker nil)) + (dolist (marker pmarkers) (set-marker marker nil))))))) + (ert-deftest format-c-float () (should-error (format "%c" 0.5))) commit 875e42d501df262fcd9903528657997d025e5c68 Author: Jens Schmidt Date: Wed Dec 17 22:06:12 2025 +0100 Fix byte-vs-char length issue in 'transpose-regions' * src/editfns.c (Ftranspose_regions): Calculate length of range between regions both in units of bytes and characters and use these values as appropriate. diff --git a/src/editfns.c b/src/editfns.c index d3a4c226240..52a3e4e4266 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4520,8 +4520,9 @@ ring. */) (Lisp_Object startr1, Lisp_Object endr1, Lisp_Object startr2, Lisp_Object endr2, Lisp_Object leave_markers) { register ptrdiff_t start1, end1, start2, end2; - ptrdiff_t start1_byte, start2_byte, len1_byte, len2_byte, end2_byte; + ptrdiff_t start1_byte, end1_byte, start2_byte, end2_byte; ptrdiff_t gap, len1, len_mid, len2; + ptrdiff_t len1_byte, len_mid_byte, len2_byte; unsigned char *start1_addr, *start2_addr, *temp; INTERVAL cur_intv, tmp_interval1, tmp_interval2, tmp_interval3; @@ -4607,7 +4608,7 @@ ring. */) } start2_byte = CHAR_TO_BYTE (start2); - ptrdiff_t end1_byte = CHAR_TO_BYTE (end1); + end1_byte = CHAR_TO_BYTE (end1); len1_byte = end1_byte - start1_byte; len2_byte = end2_byte - start2_byte; @@ -4672,7 +4673,8 @@ ring. */) } else { - len_mid = start2_byte - end1_byte; + len_mid = start2 - end1; + len_mid_byte = start2_byte - end1_byte; record_change (start1, (end2 - start1)); INTERVAL tmp_interval_mid = copy_intervals (cur_intv, end1, len_mid); tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); @@ -4685,8 +4687,8 @@ ring. */) start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); memcpy (temp, start2_addr, len2_byte); - memcpy (start1_addr + len_mid + len2_byte, start1_addr, len1_byte); - memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid); + memcpy (start1_addr + len_mid_byte + len2_byte, start1_addr, len1_byte); + memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid_byte); memcpy (start1_addr, temp, len2_byte); } else @@ -4698,8 +4700,8 @@ ring. */) start2_addr = BYTE_POS_ADDR (start2_byte); memcpy (temp, start1_addr, len1_byte); memcpy (start1_addr, start2_addr, len2_byte); - memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid); - memcpy (start1_addr + len2_byte + len_mid, temp, len1_byte); + memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid_byte); + memcpy (start1_addr + len2_byte + len_mid_byte, temp, len1_byte); } graft_intervals_into_buffer (tmp_interval_mid, start1 + len2, len_mid, current_buffer, 0); commit e93a9a905799b2e1e371fe6292a003e6f5480e95 Author: Elías Gabriel Pérez Date: Fri Dec 12 15:45:09 2025 -0600 hideshow: Support nested comment block in 'hs-hide-level-recursive' bug#80009 * doc/emacs/programs.texi (Hideshow): Update documentation. * lisp/progmodes/hideshow.el (hs-hide-level-recursive): Rework. (hs-get-first-block-on-line): Minor changes. (hs--add-indicators, hs-hide-comments-when-hiding-all) (hs-minor-mode-menu, hs-hide-level, hs-cycle): Update code. * test/lisp/progmodes/hideshow-tests.el (hideshow-hide-levels-with-comments-1): New test. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 6acd04d0bae..1e487120272 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1747,8 +1747,8 @@ Either hide or show all the blocks in the current buffer. (@code{hs-toggle-all}) @table @code @item hs-hide-comments-when-hiding-all -If non-@code{nil}, @kbd{C-c @@ C-M-h} (@code{hs-hide-all}) hides -comments too. +If non-@code{nil}, @code{hs-hide-all}, @code{hs-cycle} and +@code{hs-hide-level} hide comments too. @item hs-hide-block-behavior This variable controls how @code{hs-hide-block} and diff --git a/etc/NEWS b/etc/NEWS index e3ea4557355..7e8dbf44b9f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1169,6 +1169,11 @@ FORWARD-SEXP-FUNC, etc., major mode authors should set the corresponding buffer-local variables 'hs-block-start-regexp', 'hs-c-start-regexp', 'hs-forward-sexp-function', etc. ++++ +*** 'hs-hide-level' and 'hs-cycle' can now hide comments too. +This is controlled by 'hs-hide-comments-when-hiding-all'. + + ** C-ts mode +++ diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 41e804ae3d0..688f2e7cdff 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -83,7 +83,8 @@ ;; Hideshow provides the following user options: ;; ;; - `hs-hide-comments-when-hiding-all' -;; self-explanatory! +;; If non-nil, `hs-hide-all', `hs-cycle' and `hs-hide-level' will hide +;; comments too. ;; - `hs-hide-all-non-comment-function' ;; If non-nil, after calling `hs-hide-all', this function is called ;; with no arguments. @@ -322,7 +323,9 @@ a block), `hs-show-all' and `hs-show-block'." :version "31.1") (defcustom hs-hide-comments-when-hiding-all t - "Hide the comments too when you do an `hs-hide-all'." + "Whether the comments should be hidden. +If non-nil, `hs-hide-all', `hs-cycle' and `hs-hide-level' will hide +comments too." :type 'boolean) (defcustom hs-hide-block-behavior 'after-bol @@ -560,7 +563,8 @@ This is only used if `hs-indicator-type' is set to `margin' or nil." ["Hide comments when hiding all" (setq hs-hide-comments-when-hiding-all (not hs-hide-comments-when-hiding-all)) - :help "If t also hide comment blocks when doing `hs-hide-all'" + :help "\ +If t also hide comment blocks when doing `hs-hide-all', `hs-cycle' or `hs-hide-level'" :style toggle :selected hs-hide-comments-when-hiding-all] ("Reveal on isearch" ["Code blocks" (setq hs-isearch-open 'code) @@ -693,12 +697,13 @@ to find the beginning of the current block.") "Function used to do `hs-find-next-block'. It should reposition point at next block start. -It is called with three arguments REGEXP, BOUND, and COMMENTS. -REGEXP is a regexp representing block start. When block start is found, +It is called with three arguments REGEXP, BOUND, and COMMENTS. REGEXP +is a regexp representing block start. When block start is found, `match-data' should be set using REGEXP. BOUND is a buffer position that limits the search. When COMMENTS is non-nil, REGEXP matches not only beginning of a block but also beginning of a comment. In this -case, the function should find nearest block or comment. +case, the function should find nearest block or comment and return +non-nil. Specifying this function is necessary for languages such as Python, where regexp search is not enough to find the beginning of the next @@ -871,7 +876,8 @@ line and returns the start position of the first block found. Otherwise, if no block is found, it returns nil. If INCLUDE-COMMENTS is non-nil, also search for a comment block." - (let ((regexp (if include-comments + (let ((bk-point (point)) + (regexp (if include-comments (concat "\\(" hs-block-start-regexp "\\)" "\\|\\(" hs-c-start-regexp "\\)") hs-block-start-regexp)) @@ -887,6 +893,7 @@ If INCLUDE-COMMENTS is non-nil, also search for a comment block." (if (and beg (hs-hideable-region-p beg end)) (setq exit (point)) t))))) + (unless exit (goto-char bk-point)) exit)) (defun hs-get-near-block (&optional include-comment) @@ -929,21 +936,21 @@ commands." (goto-char beg) (while (not (>= (point) end)) (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines - (block (save-excursion - (hs-get-first-block-on-line include-comments)))) - (goto-char (match-beginning 0)) - (if (> arg 1) - ;; Find a block recursively according to ARG. - (pcase-let ((`(,beg ,end) (or (and include-comments - (funcall hs-inside-comment-predicate)) - (hs-block-positions)))) - (hs-hide-level-recursive (1- arg) beg end include-comments)) - ;; Now hide the block we found. - (if func (funcall func) - (hs-hide-block-at-point - (and include-comments (funcall hs-inside-comment-predicate)))) - (when progress - (progress-reporter-update progress (point))))) + (b-start (hs-get-first-block-on-line include-comments))) + (goto-char b-start) + (let ((comment (and include-comments (funcall hs-inside-comment-predicate))) + (code (hs-block-positions))) + ;; Find a block recursively according to ARG. + (if (> arg 1) + ;; Nested comment blocks in a comment block are impossible, + ;; so skip them. + (if comment + (goto-char (cadr comment)) + (pcase-let ((`(,beg ,end) code)) + (hs-hide-level-recursive (1- arg) beg end include-comments))) + ;; Now hide the block we found. + (if func (funcall func) (hs-hide-block-at-point comment)) + (when progress (progress-reporter-update progress (point)))))) (forward-line 1)) (goto-char end)) @@ -1086,10 +1093,9 @@ the overlay: `invisible' `hs'. Also, depending on variable (remove-overlays beg end 'hs-indicator t) (while (not (>= (point) end)) - (save-excursion - (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines - (b-beg (hs-get-first-block-on-line))) - (hs--make-indicators-overlays b-beg))) + (when-let* ((_ (not (invisible-p (point)))) ; Skip invisible lines + (b-beg (hs-get-first-block-on-line))) + (hs--make-indicators-overlays b-beg)) ;; Only 1 indicator per line (forward-line)) `(jit-lock-bounds ,beg . ,end)) @@ -1354,14 +1360,14 @@ The hook `hs-hide-hook' is run; see `run-hooks'." (message "Hiding blocks ...") (if (hs-get-near-block) ;; Hide block if we are looking at one. - (apply #'hs-hide-level-recursive arg - (hs-block-positions)) + (pcase-let ((`(,beg ,end) (hs-block-positions))) + (hs-hide-level-recursive arg beg end hs-hide-comments-when-hiding-all)) ;; Otherwise hide all the blocks in the current buffer (hs-hide-level-recursive ;; Increment ARG by 1, avoiding it acts like ;; `hs-hide-all' - (1+ arg) - (point-min) (point-max))) + (1+ arg) (point-min) (point-max) + hs-hide-comments-when-hiding-all)) (message "Hiding blocks ... done")) (run-hooks 'hs-hide-hook))) @@ -1422,8 +1428,9 @@ only blocks which are that many levels below the level of point." (hs-toggle-hiding) (message "Toggle visibility")) ((> level 1) - (apply #'hs-hide-level-recursive level - (hs-block-positions)) + (pcase-let ((`(,beg ,end) (hs-block-positions))) + (hs-hide-level-recursive + level beg end hs-hide-comments-when-hiding-all)) (message "Hide %d level" level)) (t (let* (hs-allow-nesting @@ -1440,7 +1447,9 @@ only blocks which are that many levels below the level of point." ;; Hide the children blocks if the parent block is hidden ((and (= (overlay-start ov) (car block)) (= (overlay-end ov) (cadr block))) - (apply #'hs-hide-level-recursive 1 block) + (hs-hide-level-recursive + 1 (car block) (cadr block) + hs-hide-comments-when-hiding-all) (message "Hide first nested blocks")) ;; Otherwise show all in the parent block, we cannot use ;; `hs-show-block' here because we already know the diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el index 49f661a2390..cf13a064f39 100644 --- a/test/lisp/progmodes/hideshow-tests.el +++ b/test/lisp/progmodes/hideshow-tests.el @@ -281,6 +281,55 @@ main(int argc, char **argv) } ")))) +(ert-deftest hideshow-hide-levels-with-comments-1 () + "Should hide 2nd and then 3rd level blocks including comment blocks." + (hideshow-tests-with-temp-buffer + lisp-data-mode + ;; 2nd + " +;; comment +;; comment +;; comment + +(list + ;; comment2 + ;; comment2 + (list + ;; comment3 + ;; comment3 + '(lv3 + lv3))) +" + (hs-hide-level-recursive 2 (point-min) (point-max) :comments) + (should (string= + (hideshow-tests-visible-string) + " +;; comment +;; comment +;; comment + +(list + ;; comment2 + (list)) +")) + ;; 3rd + (hs-show-all) + (hs-hide-level-recursive 3 (point-min) (point-max) :comments) + (should (string= + (hideshow-tests-visible-string) + " +;; comment +;; comment +;; comment + +(list + ;; comment2 + ;; comment2 + (list + ;; comment3 + '(lv3))) +")))) + (ert-deftest hideshow-toggle-hiding-1 () "Should toggle hiding/showing of a block." (let ((contents " commit c989d096f19d875a9a96ba56bfc479af4b14f700 Author: Stéphane Marks Date: Wed Dec 10 09:20:02 2025 -0500 Add vtable buffer slot (bug#79982) This solves for background vtable mutations, i.e., updates initiated from buffers other than the vtable buffer, and for buffer-adjusted string-pixel-width computations. * lisp/emacs-lisp/vtable.el (vtable): New '-buffer' slot. (vtable-buffer, vtable-set-buffer): New function. (vtable-update-object, vtable-remove-object) (vtable-insert-object): Wrap operation with the vtable buffer. (vtable--insert): Split from old 'vtable-insert'. (vtable-insert): Insert table and record the buffer. (vtable--insert-line, vtable--insert-header-line): Use 'vtable-buffer' for pixel-width computation. (vtable--limit-string, vtable--char-width): Pass buffer to 'string-pixel-width'. (vtable-revert): New optional table argument. (vtable--alter-column-width, vtable-revert-command) (vtable-sort-by-current-column): Call 'vtable-revert' with the table. * test/lisp/emacs-lisp/vtable-tests.el (vtable-tests--make-no-header-2-object-table): New helper function. (test-vstable-compute-columns): Correct typo in test name. Use new helper function. (test-vtable-unique-buffer) (test-vtable-non-current-buffer-insert-object) (test-vtable-non-current-buffer-remove-object) (test-vtable-non-current-buffer-update-object) (test-vtable--limit-string-with-face-remapped-buffer): New test. diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index bcdd280fb92..29791e2aaa0 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -67,8 +67,10 @@ (ellipsis :initarg :ellipsis :accessor vtable-ellipsis) (column-colors :initarg :column-colors :accessor vtable-column-colors) (row-colors :initarg :row-colors :accessor vtable-row-colors) + (buffer :initform nil :accessor vtable-buffer) (-cached-colors :initform nil) (-cache :initform (make-hash-table :test #'equal)) + (-current-cache :initform nil :accessor vtable--current-cache) (-cached-keymap :initform nil) (-has-column-spec :initform nil)) "An object to hold the data for a table.") @@ -287,8 +289,7 @@ compared with `equal'), signal an error. TABLE must be at point in the current buffer." (unless old-object (setq old-object object)) - (let* ((objects (vtable-objects table)) - (inhibit-read-only t)) + (let ((objects (vtable-objects table))) ;; First replace the object in the object storage. (if (eq old-object (car objects)) ;; It's at the head, so replace it there. @@ -301,31 +302,32 @@ TABLE must be at point in the current buffer." (unless (cdr objects) (error "Can't find the old object")) (setcar (cdr objects) object)) - ;; Then update the rendered vtable in the current buffer. - (if-let* ((cache (vtable--current-cache)) - (line-number (seq-position (vtable--cache-lines cache) - old-object - (lambda (a b) - (equal (car a) b)))) - (line (elt (vtable--cache-lines cache) line-number))) - (progn - (setcar line object) - (setcdr line (vtable--compute-cached-line table object)) - ;; ... and redisplay the line in question. - (save-excursion - (vtable-goto-object old-object) - (let ((keymap (get-text-property (point) 'keymap)) - (start (point))) - (delete-line) - (vtable--insert-line table line line-number - (vtable--cache-widths cache) - (vtable--spacer table)) - (add-text-properties start (point) (list 'keymap keymap - 'vtable table - 'vtable-cache cache)))) - ;; We may have inserted a non-numerical value into a previously - ;; all-numerical table, so recompute. - (vtable--recompute-numerical table (cdr line))) + ;; Then update the rendered vtable in its buffer. + (if-let* ((cache (vtable--current-cache table)) + (line-number (seq-position (vtable--cache-lines cache) + old-object + (lambda (a b) + (equal (car a) b)))) + (line (elt (vtable--cache-lines cache) line-number))) + (with-current-buffer (vtable-buffer table) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (setcar line object) + (setcdr line (vtable--compute-cached-line table object)) + ;; ... and redisplay the line in question. + (save-excursion + (vtable-goto-object old-object) + (let ((keymap (get-text-property (point) 'keymap)) + (start (point))) + (delete-line) + (vtable--insert-line table line line-number + (vtable--cache-widths cache) + (vtable--spacer table)) + (add-text-properties start (point) (list 'keymap keymap + 'vtable table)))) + ;; We may have inserted a non-numerical value into a previously + ;; all-numerical table, so recompute. + (vtable--recompute-numerical table (cdr line)))) (error "Can't find cached object in vtable")))) (defun vtable-remove-object (table object) @@ -334,14 +336,16 @@ This will also remove the displayed line." ;; First remove from the objects. (setf (vtable-objects table) (delq object (vtable-objects table))) ;; Then adjust the cache and display. - (save-excursion - (vtable-goto-table table) - (let ((cache (vtable--current-cache)) - (inhibit-read-only t)) - (setcar cache (delq (assq object (vtable--cache-lines cache)) - (vtable--cache-lines cache))) - (when (vtable-goto-object object) - (delete-line))))) + (with-current-buffer (vtable-buffer table) + (save-excursion + (vtable-goto-table table) + (let ((cache (vtable--current-cache table)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (setcar cache (delq (assq object (vtable--cache-lines cache)) + (vtable--cache-lines cache))) + (when (vtable-goto-object object) + (delete-line)))))) ;; FIXME: The fact that the `location' argument of ;; `vtable-insert-object' can be an integer and is then interpreted as @@ -369,8 +373,9 @@ This also updates the displayed table." (progn (setf (vtable-objects table) (list object)) (vtable--recompute-numerical table (vtable--compute-cached-line table object)) - (vtable-goto-table table) - (vtable-revert-command)) + (with-current-buffer (vtable-buffer table) + (vtable-goto-table table) + (vtable-revert-command))) ;; First insert into the objects. (let ((pos (if location (if (integerp location) @@ -398,56 +403,58 @@ This also updates the displayed table." ;; Otherwise, append the object. (nconc (vtable-objects table) (list object))))) ;; Then adjust the cache and display. - (save-excursion - (vtable-goto-table table) - (let* ((cache (vtable--current-cache)) - (inhibit-read-only t) - (keymap (get-text-property (point) 'keymap)) - (ellipsis (if (vtable-ellipsis table) - (propertize (truncate-string-ellipsis) - 'face (vtable-face table)) - "")) - (ellipsis-width (string-pixel-width ellipsis)) - (lines (vtable--cache-lines cache)) - (elem (if location ; This binding mirrors the binding of `pos' above. - (if (integerp location) - (nth location lines) - (or (assq location lines) - (and before (car lines)))) - (if before (car lines)))) - (pos (memq elem lines)) - (line (cons object (vtable--compute-cached-line table object)))) - (if (or before - (and pos (integerp location))) - ;; Add the new object before:. - (let ((old-line (car pos))) - (setcar pos line) - (setcdr pos (cons old-line (cdr pos))) - (unless (vtable-goto-object (car elem)) - (vtable-beginning-of-table))) - ;; Otherwise, add the object after. - (if pos - ;; Splice the object into the list. - (progn - (setcdr pos (cons line (cdr pos))) - (if (vtable-goto-object location) - (forward-line 1) ; Insert *after*. - (vtable-end-of-table))) - ;; Otherwise, append the object. - (setcar cache (nconc lines (list line))) - (vtable-end-of-table))) - (let ((start (point))) - ;; FIXME: We have to adjust colors in lines below this if we - ;; have :row-colors. - (vtable--insert-line table line 0 - (vtable--cache-widths cache) (vtable--spacer table) - ellipsis ellipsis-width) - (add-text-properties start (point) (list 'keymap keymap - 'vtable table - 'vtable-cache cache))) - ;; We may have inserted a non-numerical value into a previously - ;; all-numerical table, so recompute. - (vtable--recompute-numerical table (cdr line)))))) + (let* ((cache (vtable--current-cache table)) + (lines (vtable--cache-lines cache)) + (elem (if location ; This binding mirrors the binding of `pos' above. + (if (integerp location) + (nth location lines) + (or (assq location lines) + (and before (car lines)))) + (if before (car lines)))) + (pos (memq elem lines)) + (line (cons object (vtable--compute-cached-line table object)))) + (with-current-buffer (vtable-buffer table) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (save-excursion + (vtable-goto-table table) + (if (or before + (and pos (integerp location))) + ;; Add the new object before:. + (let ((old-line (car pos))) + (setcar pos line) + (setcdr pos (cons old-line (cdr pos))) + (unless (vtable-goto-object (car elem)) + (vtable-beginning-of-table))) + ;; Otherwise, add the object after. + (if pos + ;; Splice the object into the list. + (progn + (setcdr pos (cons line (cdr pos))) + (if (vtable-goto-object location) + (forward-line 1) ; Insert *after*. + (vtable-end-of-table))) + ;; Otherwise, append the object. + (setcar cache (nconc lines (list line))) + (vtable-end-of-table))) + (let* ((start (point)) + (ellipsis (if (vtable-ellipsis table) + (propertize (truncate-string-ellipsis) + 'face (vtable-face table)) + "")) + (ellipsis-width (string-pixel-width ellipsis (current-buffer))) + (keymap (get-text-property (point) 'keymap))) + ;; FIXME: We have to adjust colors in lines below this if we + ;; have :row-colors. + (vtable--insert-line table line 0 + (vtable--cache-widths cache) + (vtable--spacer table) + ellipsis ellipsis-width) + (add-text-properties start (point) (list 'keymap keymap + 'vtable table))) + ;; We may have inserted a non-numerical value into a previously + ;; all-numerical table, so recompute. + (vtable--recompute-numerical table (cdr line)))))))) (defun vtable-column (table index) "Return the name of the INDEXth column in TABLE." @@ -520,14 +527,14 @@ recompute the column specs when the table data has changed." (defun vtable--cache-lines (cache) (car cache)) -(defun vtable-insert (table) +(defun vtable--insert (table) (let* ((spacer (vtable--spacer table)) (start (point)) (ellipsis (if (vtable-ellipsis table) (propertize (truncate-string-ellipsis) 'face (vtable-face table)) "")) - (ellipsis-width (string-pixel-width ellipsis)) + (ellipsis-width (string-pixel-width ellipsis (vtable-buffer table))) ;; We maintain a cache per screen/window width, so that we render ;; correctly if Emacs is open on two different screens (or the ;; user resizes the frame). @@ -549,8 +556,7 @@ recompute the column specs when the table data has changed." (add-text-properties start (point) (list 'keymap vtable-header-line-map 'rear-nonsticky t - 'vtable table - 'vtable-cache cache)) + 'vtable table)) (setq start (point)))) (vtable--sort table cache) ;; Insert the data. @@ -561,13 +567,35 @@ recompute the column specs when the table data has changed." (setq line-number (1+ line-number)))) (add-text-properties start (point) (list 'rear-nonsticky t - 'vtable table - 'vtable-cache cache)) + 'vtable table)) + (setf (vtable--current-cache table) cache) (goto-char start))) +(defun vtable-insert (table) + "Insert TABLE into the current buffer. +The current buffer will be recorded as TABLE's buffer. If the table is +inserted into a buffer other than its originating buffer, signal an +error. A table may be reinserted into its own buffer, but insert only +one instance per buffer. This restriction needs to be enforced by the +caller." + (if-let* ((table-buffer (vtable-buffer table))) + (when (not (eq table-buffer (current-buffer))) + (error "A vtable cannot be inserted into more than one buffer"))) + (setf (vtable-buffer table) (current-buffer)) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (vtable--insert table))) + +(defun vtable-set-buffer (table buffer) + "Associate BUFFER with TABLE. +Use this function with care, and ensure your vtable instance renders +itself in the new buffer." + (setf (vtable-buffer table) buffer)) + (defun vtable--insert-line (table line line-number widths spacer &optional ellipsis ellipsis-width) (let ((start (point)) + (buffer (vtable-buffer table)) (columns (vtable-columns table)) (column-colors (and (vtable-column-colors table) @@ -607,16 +635,18 @@ recompute the column specs when the table data has changed." (concat (vtable--limit-string pre-computed (- (elt widths index) - (or ellipsis-width 0))) + (or ellipsis-width 0)) + buffer) ellipsis) pre-computed)) ;; Recompute widths. (t - (if (> (string-pixel-width value) (elt widths index)) + (if (> (string-pixel-width value buffer) (elt widths index)) (concat (vtable--limit-string value (- (elt widths index) - (or ellipsis-width 0))) + (or ellipsis-width 0)) + buffer) ellipsis) value)))) (start (point)) @@ -630,14 +660,15 @@ recompute the column specs when the table data has changed." (list 'space :width (list (+ (- (elt widths index) - (string-pixel-width displayed)) + (string-pixel-width + displayed buffer)) (if last 0 spacer))))))) ;; Align to the right. (insert (propertize " " 'display (list 'space :width (list (- (elt widths index) (string-pixel-width - displayed))))) + displayed buffer))))) displayed) (unless last (insert (propertize " " 'display @@ -664,16 +695,6 @@ recompute the column specs when the table data has changed." (defun vtable--cache-key () (cons (frame-terminal) (window-width))) -(defun vtable--current-cache () - "Return the current cache for the table at point. - -In `vtable-insert', the lines and widths of the vtable text are computed -based on the current selected frame and window and stored in a cache. -Subsequent interaction with the text of the vtable should use that cache -via this function rather than by calling `vtable--cache-key' to look up -the cache." - (get-text-property (point) 'vtable-cache)) - (defun vtable--clear-cache (table) (setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil)) @@ -718,6 +739,7 @@ the cache." (defun vtable--insert-header-line (table widths spacer) ;; Insert the header directly into the buffer. (let ((start (point)) + (buffer (vtable-buffer table)) (divider (vtable-divider table)) (cmap (define-keymap " " #'vtable--drag-resize-column @@ -737,14 +759,15 @@ the cache." 'keymap cmap)) (start (point)) (indicator (vtable--indicator table index)) - (indicator-width (string-pixel-width indicator)) + (indicator-width (string-pixel-width indicator buffer)) (last (= index (1- (length (vtable-columns table))))) displayed) (setq displayed - (if (> (string-pixel-width name) + (if (> (string-pixel-width name buffer) (- (elt widths index) indicator-width)) (vtable--limit-string - name (- (elt widths index) indicator-width)) + name (- (elt widths index) indicator-width) + buffer) name)) (let* ((indicator-lead-width ;; We want the indicator to not be quite flush right. @@ -753,7 +776,7 @@ the cache." indicator-lead-width)) (fill-width (+ (- (elt widths index) - (string-pixel-width displayed) + (string-pixel-width displayed buffer) indicator-width indicator-lead-width) (if last 0 spacer)))) @@ -771,7 +794,8 @@ the cache." ;; This is the final column, and we have a sorting ;; indicator, and the table is too wide for the window. (let* ((pre-indicator (string-pixel-width - (buffer-substring (point-min) (point)))) + (buffer-substring (point-min) (point)) + buffer)) (pre-fill (- (window-width nil t) pre-indicator @@ -850,14 +874,16 @@ If NEXT, do the next column." (buffer-substring (point-min) (1- (point-max)))))) (vtable-header-mode 1)) -(defun vtable--limit-string (string pixels) + +(defun vtable--limit-string (string pixels buffer) (while (and (length> string 0) - (> (string-pixel-width string) pixels)) + (> (string-pixel-width string buffer) pixels)) (setq string (substring string 0 (1- (length string))))) string) (defun vtable--char-width (table) - (string-pixel-width (propertize "x" 'face (vtable-face table)))) + (string-pixel-width (propertize "x" 'face (vtable-face table)) + (vtable-buffer table))) (defun vtable--compute-width (table spec) (cond @@ -936,7 +962,7 @@ CACHE is TABLE's cache data as returned by `vtable--compute-cache'." ;; We stash the computed width and string here -- if there are ;; no formatters/displayers, we'll be using the string, and ;; then won't have to recreate it. - (list value (string-pixel-width string) string))) + (list value (string-pixel-width string (vtable-buffer table)) string))) (vtable-columns table))) (defun vtable--make-keymap (table) @@ -967,20 +993,22 @@ CACHE is TABLE's cache data as returned by `vtable--compute-cache'." (vtable-keymap table)) map))) -(defun vtable-revert () - "Regenerate the table under point." - (let ((table (vtable-current-table)) - (object (vtable-current-object)) - (column (vtable-current-column)) - (inhibit-read-only t)) - (unless table - (user-error "No table under point")) - (delete-region (vtable-beginning-of-table) (vtable-end-of-table)) - (vtable-insert table) - (when object - (vtable-goto-object object)) - (when column - (vtable-goto-column column)))) +(defun vtable-revert (&optional table) + "Regenerate TABLE, defaulting to the table under point." + (setq table (or table (vtable-current-table))) + (unless table + (user-error "No table under point")) + (with-current-buffer (vtable-buffer table) + (let ((object (vtable-current-object)) + (column (vtable-current-column)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (delete-region (vtable-beginning-of-table) (vtable-end-of-table)) + (vtable--insert table) + (when object + (vtable-goto-object object)) + (when column + (vtable-goto-column column))))) ;;; Commands. @@ -1006,14 +1034,14 @@ Interactively, N is the prefix argument." (- (* (vtable--char-width table) (or n 1)))))) (defun vtable--alter-column-width (table column delta) - (let ((widths (vtable--cache-widths (vtable--current-cache)))) + (let ((widths (vtable--cache-widths (vtable--current-cache table)))) (setf (aref widths column) (max (* (vtable--char-width table) 2) (+ (aref widths column) delta))) ;; Store the width so it'll be respected on a revert. (setf (vtable-column-width (elt (vtable-columns table) column)) (format "%dpx" (aref widths column))) - (vtable-revert))) + (vtable-revert table))) (defun vtable-widen-current-column (&optional n) "Widen the current column by N characters. @@ -1028,24 +1056,29 @@ Interactively, N is the prefix argument." (interactive) (vtable-goto-column (max 0 (1- (or (vtable-current-column) - (length (vtable--cache-widths (vtable--current-cache)))))))) + (length (vtable--cache-widths + (vtable--current-cache (vtable-current-table))))))))) (defun vtable-next-column () "Go to the next column." (interactive) (when (vtable-current-column) (vtable-goto-column - (min (1- (length (vtable--cache-widths (vtable--current-cache)))) + (min (1- (length (vtable--cache-widths + (vtable--current-cache (vtable-current-table))))) (1+ (vtable-current-column)))))) -(defun vtable-revert-command () - "Re-query data and regenerate the table under point." +(defun vtable-revert-command (&optional table) + "Re-query data and regenerate TABLE. +If TABLE is nil, use the table under point." (interactive) - (let ((table (vtable-current-table))) - (when (vtable-objects-function table) - (setf (vtable-objects table) (funcall (vtable-objects-function table)))) - (vtable--clear-cache table)) - (vtable-revert)) + (setq table (or table (vtable-current-table))) + (unless table + (user-error "No table found")) + (when (vtable-objects-function table) + (setf (vtable-objects table) (funcall (vtable-objects-function table)))) + (vtable--clear-cache table) + (vtable-revert table)) (defun vtable-sort-by-current-column () "Sort the table under point by the column under point." @@ -1067,8 +1100,8 @@ Interactively, N is the prefix argument." (if (eq (cdr last) 'ascend) 'descend 'ascend) - 'ascend)))))) - (vtable-revert)) + 'ascend))))) + (vtable-revert table))) (defun vtable-header-line-sort (e) "Sort a vtable from the header line." diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el index 74fb8cc8139..f865206dc19 100644 --- a/test/lisp/emacs-lisp/vtable-tests.el +++ b/test/lisp/emacs-lisp/vtable-tests.el @@ -27,16 +27,19 @@ (require 'ert) (require 'ert-x) -(ert-deftest test-vstable-compute-columns () +(defun vtable-tests--make-no-header-2-object-table () + (make-vtable :columns '("a" "b" "c") + :objects '(("foo" 1 2) + ("bar" 3 :zot)) + :insert nil)) + +(ert-deftest test-vtable-compute-columns () (should (equal (mapcar (lambda (column) (vtable-column-align column)) (vtable--compute-columns - (make-vtable :columns '("a" "b" "c") - :objects '(("foo" 1 2) - ("bar" 3 :zot)) - :insert nil))) + (vtable-tests--make-no-header-2-object-table))) '(left right left)))) (ert-deftest test-vtable-insert-object () @@ -69,4 +72,82 @@ (mapcar #'cadr (vtable-objects table)))) (number-sequence 0 11)))) +(ert-deftest test-vtable-unique-buffer () + (let ((table (vtable-tests--make-no-header-2-object-table))) + (with-temp-buffer + (vtable-insert table) + (with-temp-buffer + (should-error (vtable-insert table))) + (with-temp-buffer + (vtable-set-buffer table (current-buffer)) + (vtable-insert table))))) + +(ert-deftest test-vtable-read-only-buffer () + (let ((table (vtable-tests--make-no-header-2-object-table))) + (with-temp-buffer + (setq buffer-read-only t) + (vtable-insert table)))) + +(ert-deftest test-vtable-non-current-buffer-insert-object () + (let ((table (vtable-tests--make-no-header-2-object-table)) + (obj '("baz" 4 5))) + (with-temp-buffer + (vtable-insert table) + (should (= (count-lines (point-min) (point-max)) 2)) + (with-temp-buffer + (vtable-insert-object table obj)) + (should (= (count-lines (point-min) (point-max)) 3))))) + +(ert-deftest test-vtable-non-current-buffer-remove-object () + (let ((table (vtable-tests--make-no-header-2-object-table)) + (obj '("baz" 4 5))) + (with-temp-buffer + (vtable-insert table) + (vtable-insert-object table obj) + (should (= (count-lines (point-min) (point-max)) 3)) + (with-temp-buffer + (vtable-remove-object table obj)) + (should (= (count-lines (point-min) (point-max)) 2))))) + +(ert-deftest test-vtable-non-current-buffer-update-object () + (let ((table (vtable-tests--make-no-header-2-object-table)) + (obj '("baz" 4 5)) + (obj-2 '("qux" 6 7))) + (with-temp-buffer + (vtable-insert table) + (vtable-insert-object table obj) + (should (= (count-lines (point-min) (point-max)) 3)) + (let ((line-2 (progn + (goto-char (point-min)) + (forward-line 2) + (buffer-substring (point) (point-max))))) + (with-temp-buffer + (vtable-update-object table obj-2 obj)) + (let ((line-2-new (progn + (goto-char (point-min)) + (forward-line 2) + (buffer-substring (point) (point-max))))) + (should (= (count-lines (point-min) (point-max)) 3)) + (should (not (string= line-2 line-2-new)))))))) + +(ert-deftest test-vtable--limit-string-with-face-remapped-buffer () + (with-temp-buffer + (let ((text (propertize "XXXXX" + 'face 'variable-pitch))) + (face-remap-add-relative 'default :height 1.5) + (cond ((< emacs-major-version 31) ; TODO: Remove the pre-31 test, eventually. + (let* ((x-width (string-pixel-width (substring text 0 1))) + (char-limit 2) + (pixel-limit (* char-limit x-width))) + (should (eq + char-limit + (length (vtable--limit-string text pixel-limit)))))) + (t + (let* ((x-width (string-pixel-width (substring text 0 1) (current-buffer))) + (char-limit 2) + (pixel-limit (* char-limit x-width))) + (should (eq + char-limit + (length (vtable--limit-string text pixel-limit (current-buffer))))))))))) + ;;; vtable-tests.el ends here commit cf2e676ecab42a3f2add728eca20bb23d2a73728 Author: Martin Rudalics Date: Sat Dec 20 15:12:39 2025 +0100 Don't change visibility of tty root frames (Bug#80032) * src/frame.c (Fmake_frame_visible, Fmake_frame_invisible): * doc/lispref/frames.texi (Visibility of Frames): Don't change visibility of tty root frames. (Bug#80032) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index bc7c1e4915a..77b606282da 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3391,13 +3391,10 @@ all child frames of @var{frame} (and their descendants) invisible too Unless @var{force} is non-@code{nil}, this function refuses to make @var{frame} invisible if all other frames are invisible. On a text terminal this will make @var{frame} invisible if and only if it is a -child frame or at least one other non-child frame (@pxref{Child Frames}) -on that terminal exists. In the former case, if @var{frame} is +child frame (@pxref{Child Frames}). In this case, if @var{frame} is selected, it will select the first visible ancestor of @var{frame} -instead. In the latter case it will make another non-child frame on -that terminal visible and the new top frame (@pxref{Frames}) of that -terminal. In either case, it will remove all child frames with -@var{frame} as their ancestor from display. +instead. In addition, it will remove all child frames with @var{frame} +as their ancestor from display. @end deffn The visibility status of a frame is also available as a frame diff --git a/src/frame.c b/src/frame.c index 131f1967424..49317379354 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3366,7 +3366,7 @@ If omitted, FRAME defaults to the currently selected frame. */) if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook) FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, true); - if (is_tty_frame (f)) + if (is_tty_child_frame (f)) { SET_FRAME_VISIBLE (f, true); tty_raise_lower_frame (f, true); @@ -3410,11 +3410,9 @@ Normally you may not make FRAME invisible if all other frames are invisible, but if the second optional argument FORCE is non-nil, you may do so. -On a text terminal make FRAME invisible if and only FRAME is either a -child frame or another non-child frame can be found. In the former -case, if FRAME is the selected frame, select the first visible ancestor -of FRAME instead. In the latter case, if FRAME is the top frame of its -terminal, make another frame that terminal's top frame. */) +On a text terminal make FRAME invisible if and only if FRAME is a child +frame. If, in that case, FRAME is the selected frame, select the first +visible ancestor of FRAME instead. */) (Lisp_Object frame, Lisp_Object force) { struct frame *f = decode_live_frame (frame); @@ -3427,18 +3425,14 @@ terminal, make another frame that terminal's top frame. */) if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook) FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, false); - SET_FRAME_VISIBLE (f, false); - - if (is_tty_frame (f) && EQ (frame, selected_frame)) - /* On a tty if FRAME is the selected frame, we have to select another - frame instead. If FRAME is a child frame, use the first visible - ancestor as returned by 'mru_rooted_frame'. If FRAME is a root - frame, use the frame returned by 'next-frame' which must exist since - otherwise other_frames above would have lied. */ - Fselect_frame (FRAME_PARENT_FRAME (f) - ? mru_rooted_frame (f) - : next_frame (frame, make_fixnum (0)), - Qnil); + if (is_tty_child_frame (f) && EQ (frame, selected_frame)) + { + SET_FRAME_VISIBLE (f, false); + /* If FRAME is a tty child frame and the selected frame, we have + to select another frame instead. Use the first visible + ancestor as returned by 'mru_rooted_frame'. */ + Fselect_frame (mru_rooted_frame (f), Qnil); + } /* Make menu bar update for the Buffers and Frames menus. */ windows_or_buffers_changed = 16; commit 69ca26996c20fb0acea98a64b9174e283d1a3375 Author: Eli Zaretskii Date: Sat Dec 20 08:43:09 2025 -0500 ; Update lisp/ldefs-boot.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 2d6a69e1841..654e2ce7879 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -910,9 +910,11 @@ and is meant to be used in `compilation-filter-hook'.") ;;; Generated autoloads from progmodes/antlr-mode.el -(push '(antlr-mode 2 2 3) package--builtin-versions) +(push '(antlr-mode 3 2 0) package--builtin-versions) (autoload 'antlr-show-makefile-rules "antlr-mode" "\ Show Makefile rules for all grammar files in the current directory. +This command is for ANTLR v2 grammars only. + If the `major-mode' of the current buffer has the value `makefile-mode', the rules are directory inserted at point. Otherwise, a *Help* buffer is shown with the rules which are also put into the `kill-ring' for @@ -935,9 +937,18 @@ this mode runs the hook `antlr-mode-hook', as the final or penultimate step during initialization. \\{antlr-mode-map}" t) +(autoload 'antlr-v4-mode "antlr-mode" "\ +Major mode for editing ANTLR v4 grammar files. + +In addition to any hooks its parent mode `antlr-mode' might have run, +this mode runs the hook `antlr-v4-mode-hook', as the final or +penultimate step during initialization. + +\\{antlr-v4-mode-map}" t) (autoload 'antlr-set-tabs "antlr-mode" "\ Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'. -Used in `antlr-mode'. Also a useful function in `java-mode-hook'.") +Used in `antlr-mode' for cc-mode-based languages. +It is probably better to automatically deduce the TAB setting.") (register-definition-prefixes "antlr-mode" '("antlr-")) @@ -3589,7 +3600,7 @@ the absolute file name of the file if STYLE-NAME is nil. ;;; Generated autoloads from progmodes/cc-mode.el -(push '(cc-mode 5 33 1) package--builtin-versions) +(push '(cc-mode 5 35 2) package--builtin-versions) (autoload 'c-initialize-cc-mode "cc-mode" "\ Initialize CC Mode for use in the current buffer. If the optional NEW-STYLE-INIT is nil or left out then all necessary @@ -5463,8 +5474,8 @@ are passed along to the rest of the clauses in this `cond*' construct. (fn &rest CLAUSES)" nil t) (autoload 'match* "cond-star" "\ This specifies matching DATUM against PATTERN. -It is not really a Lisp function, and it is meaningful -only in the CONDITION of a `cond*' clause. +This is not really a Lisp operator; it is meaningful only in the +CONDITION of a `cond*' clause. `_' matches any value. KEYWORD matches that keyword. @@ -5498,7 +5509,7 @@ ATOM (meaning any other kind of non-list not described above) (cdr PATTERN) matches PATTERN with strict checking of cdrs. That means that `list' patterns verify that the final cdr is nil. Strict checking is the default. -(cdr-safe PATTERN) matches PATTERN with lax checking of cdrs. +(cdr-ignore PATTERN) matches PATTERN with lax checking of cdrs. That means that `list' patterns do not examine the final cdr. (and CONJUNCTS...) matches each of the CONJUNCTS against the same data. If all of them match, this pattern succeeds. @@ -5527,17 +5538,23 @@ ATOM (meaning any other kind of non-list not described above) (fn PATTERN DATUM)" nil t) (autoload 'bind* "cond-star" "\ -This macro evaluates BINDINGS like `let*'. -It is not really a Lisp function, and it is meaningful -only in the CONDITION of a `cond*' clause. +Evaluate BINDINGS like `let*'. +This is not really a Lisp operator; it is meaningful only in the +CONDITION of a `cond*' clause. See `cond*' for details. (fn &rest BINDINGS)" nil t) (autoload 'bind-and* "cond-star" "\ -This macro evaluates BINDINGS like `if-let*'. -It is not really a Lisp function, and it is meaningful -only in the CONDITION of a `cond*' clause. +Evaluate BINDINGS like `if-let*'. +This is not really a Lisp operator; it is meaningful only in the +CONDITION of a `cond*' clause. See `cond*' for details. (fn &rest BINDINGS)" nil t) +(autoload 'pcase* "cond-star" "\ +Evaluate PATTERN and DATUM like an element of BINDINGS in `pcase-let'. +This is not really a Lisp operator; it is meaningful only in the +CONDITION of a `cond*' clause. See `cond*' for details. + +(fn PATTERN DATUM)" nil t) (register-definition-prefixes "cond-star" '("cond*-")) @@ -12404,6 +12421,10 @@ of face attribute/value pairs. If more than one face is listed, that specifies an aggregate face, in the same way as in a `face' text property, except for possible priority changes noted below. +If a face property list specifies `:font', the value should be +either a font-spec object or the return value of `font-face-attributes' +called with a font object, font spec, or font entity. + The face remapping specified by SPECS takes effect alongside the remappings from other calls to `face-remap-add-relative' for the same FACE, as well as the normal definition of FACE (at lowest @@ -12431,6 +12452,10 @@ The remaining arguments, SPECS, specify the base of the remapping. Each one of SPECS should be either a face name or a property list of face attribute/value pairs, like in a `face' text property. +If a face property list specifies `:font', the value should be +either a font-spec object or the return value of `font-face-attributes' +called with a font object, font spec, or font entity. + If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base' to use the normal definition of FACE as the base remapping; note that this is different from SPECS containing a single value nil, which means @@ -12575,6 +12600,11 @@ one face is listed, that specifies an aggregate face, like in a `face' text property. If SPECS is nil or omitted, disable `buffer-face-mode'. +If SPECS needs to specify a font, it should be either a list +whose car is `:font' and whose cdr is a font-spec object, +or the return value of `font-face-attributes' called with a font +object, font spec, or font entity corresponding to the desired font. + This function makes the variable `buffer-face-mode-face' buffer local, and sets it to FACE. @@ -12586,6 +12616,10 @@ or a property list of face attributes and values. If more than one face is listed, that specifies an aggregate face, like in a `face' text property. +If a face property list specifies `:font', the value should be +either a font-spec object or the return value of `font-face-attributes' +called with a font object, font spec, or font entity. + If `buffer-face-mode' is already enabled, and is currently using the face specs SPECS, then it is disabled; if `buffer-face-mode' is disabled, or is enabled and currently displaying some other @@ -16746,7 +16780,7 @@ The lines that match REGEXP will be displayed by merging the attributes of FACE with any other face attributes of text in those lines. -Interactively, prompt for REGEXP using `read-regexp', then FACE. +Interactively, prompt for REGEXP using `hi-lock-read-regexp', then FACE. Use the global history list for FACE. If REGEXP contains upper case characters (excluding those preceded by `\\') @@ -16760,7 +16794,7 @@ highlighting will not update as you type. (defalias 'highlight-regexp 'hi-lock-face-buffer) (autoload 'hi-lock-face-buffer "hi-lock" "\ Set face of each match of REGEXP to FACE. -Interactively, prompt for REGEXP using `read-regexp', then FACE. +Interactively, prompt for REGEXP using `hi-lock-read-regexp', then FACE. Use the global history list for FACE. Limit face setting to the corresponding SUBEXP (interactively, the prefix argument) of REGEXP. If SUBEXP is omitted or nil, the entire REGEXP is highlighted. @@ -16783,7 +16817,7 @@ the major mode specifies support for Font Lock. (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) (autoload 'hi-lock-face-phrase-buffer "hi-lock" "\ Set face of each match of phrase REGEXP to FACE. -Interactively, prompt for REGEXP using `read-regexp', then FACE. +Interactively, prompt for REGEXP using `hi-lock-read-regexp', then FACE. Use the global history list for FACE. If REGEXP contains upper case characters (excluding those preceded by `\\') @@ -16897,6 +16931,8 @@ disabled. ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist nil) +(autoload 'turn-off-hideshow "hideshow" "\ +Unconditionally turn off `hs-minor-mode'.") (autoload 'hs-minor-mode "hideshow" "\ Minor mode to selectively hide/show code and comment blocks. @@ -16904,10 +16940,6 @@ When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The value (hs . t) is added to `buffer-invisibility-spec'. -The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block', -`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also -`hs-hide-initial-comment-block'. - Turning hideshow minor mode off reverts the menu bar and the variables to default values and disables the hideshow commands. @@ -16931,8 +16963,6 @@ The mode's hook is called both when the mode is enabled and when it is disabled. (fn &optional ARG)" t) -(autoload 'turn-off-hideshow "hideshow" "\ -Unconditionally turn off `hs-minor-mode'.") (register-definition-prefixes "hideshow" '("hs-")) @@ -17253,7 +17283,7 @@ Do not set this variable with `setq'; instead, use `setopt' or `customize-option'.") (custom-autoload 'holiday-islamic-holidays "holidays" nil) (put 'holiday-islamic-holidays 'risky-local-variable t) -(defvar holiday-bahai-holidays '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Báb") (holiday-fixed 5 29 "Ascension of Bahá’u’lláh") (holiday-fixed 7 9 "Martyrdom of the Báb") (holiday-fixed 10 20 "Birth of the Báb") (holiday-fixed 11 12 "Birth of Bahá’u’lláh") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá")))) "\ +(defvar holiday-bahai-holidays '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-bahai 4 8 "Declaration of the Báb") (holiday-bahai 4 13 "Ascension of Bahá’u’lláh") (holiday-bahai 6 17 "Martyrdom of the Báb") (holiday-bahai-twin-holy-birthdays) (if calendar-bahai-all-holidays-flag (append (holiday-bahai 14 4 "Day of the Covenant") (holiday-bahai 14 6 "Ascension of ‘Abdu’l-Bahá")))) "\ Bahá’í holidays. See the documentation for `calendar-holidays' for details.") (custom-autoload 'holiday-bahai-holidays "holidays" nil) @@ -19755,7 +19785,7 @@ penultimate step during initialization. ;;; Generated autoloads from jsonrpc.el -(push '(jsonrpc 1 0 26) package--builtin-versions) +(push '(jsonrpc 1 0 27) package--builtin-versions) (register-definition-prefixes "jsonrpc" '("jsonrpc-")) @@ -24840,6 +24870,7 @@ If the optional argument INTERACTIVE is non-nil (as happens interactively), DIR must be an absolute file name. (fn DIR &optional NAME INTERACTIVE)" t) +(make-obsolete 'package-vc-install-from-checkout '"use the User Lisp directory instead." "31.1") (autoload 'package-vc-rebuild "package-vc" "\ Rebuild the installation for package given by PKG-DESC. Rebuilding an installation means scraping for new autoload @@ -25077,16 +25108,17 @@ of the elements of LIST is performed as if by `pcase-let'. (fn (PATTERN LIST) BODY...)" nil t) (autoload 'pcase-setq "pcase" "\ Assign values to variables by destructuring with `pcase'. -PATTERNS are normal `pcase' patterns, and VALUES are expression. +Each PATTERN is a normal `pcase' pattern, and each VALUE an expression. Evaluation happens sequentially as in `setq' (not in parallel). An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)])) -VAL is presumed to match PAT. Failure to match may signal an error or go -undetected, binding variables to arbitrary values, such as nil. +Each VALUE is presumed to match its PATTERN. Failure to match may +signal an error or go undetected, binding variables to arbitrary values, +such as nil. -(fn PATTERNS VALUE PATTERN VALUES ...)" nil t) +(fn PATTERN VALUE PATTERN VALUE ...)" nil t) (autoload 'pcase-defmacro "pcase" "\ Define a new kind of pcase PATTERN, by macro expansion. Patterns of the form (NAME ...) will be expanded according @@ -26782,7 +26814,7 @@ This feature requires the presence of the following item in `mode-line-format': `(project-mode-line project-mode-line-format)'; it is part of the default mode line beginning with Emacs 30.") (custom-autoload 'project-mode-line "project" t) -(register-definition-prefixes "project" '("project-")) +(register-definition-prefixes "project" '("project-" "vc-")) ;;; Generated autoloads from cedet/ede/project-am.el @@ -33896,19 +33928,19 @@ float less than 1.0, round to that value. ;;; Generated autoloads from time-stamp.el -(put 'time-stamp-format 'safe-local-variable 'stringp) -(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p) +(put 'time-stamp-format 'safe-local-variable #'stringp) +(put 'time-stamp-time-zone 'safe-local-variable #'time-stamp-zone-type-p) (autoload 'time-stamp-zone-type-p "time-stamp" "\ -Return non-nil if ZONE is of the correct type for a timezone rule. +Return non-nil if ZONE looks like a valid timezone rule. Valid ZONE values are described in the documentation of `format-time-string'. (fn ZONE)") -(put 'time-stamp-line-limit 'safe-local-variable 'integerp) -(put 'time-stamp-start 'safe-local-variable 'stringp) -(put 'time-stamp-end 'safe-local-variable 'stringp) -(put 'time-stamp-inserts-lines 'safe-local-variable 'booleanp) +(put 'time-stamp-line-limit 'safe-local-variable #'integerp) +(put 'time-stamp-start 'safe-local-variable #'stringp) +(put 'time-stamp-end 'safe-local-variable #'stringp) +(put 'time-stamp-inserts-lines 'safe-local-variable #'booleanp) (put 'time-stamp-count 'safe-local-variable (lambda (c) (and (integerp c) (< c 100)))) -(put 'time-stamp-pattern 'safe-local-variable 'stringp) +(put 'time-stamp-pattern 'safe-local-variable #'stringp) (autoload 'time-stamp "time-stamp" "\ Update any time stamp strings (timestamps) in the buffer. Look for a time stamp template and update it with the current @@ -33941,8 +33973,10 @@ this function does nothing. You can set `time-stamp-pattern' in a file's local variables list to customize the information in the time stamp and where it is written." t) (autoload 'time-stamp-toggle-active "time-stamp" "\ -Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer. -With ARG, turn time stamping on if and only if ARG is positive. +Set `time-stamp-active' (whether \\[time-stamp] updates a buffer). +If ARG is unset, toggle `time-stamp-active'. With an arg, set +`time-stamp-active' to t (turning on time stamping) if +ARG is positive, otherwise nil. (fn &optional ARG)" t) (register-definition-prefixes "time-stamp" '("time-stamp-")) @@ -34047,7 +34081,62 @@ relative only to the time worked today, and not to past time. ;;; Generated autoloads from emacs-lisp/timeout.el (push '(timeout 2 1) package--builtin-versions) -(register-definition-prefixes "timeout" '("timeout-")) +(autoload 'timeout-debounce "timeout" "\ +Debounce FUNC by making it run DELAY seconds after it is called. + +This advises FUNC, when called (interactively or from code), to +run after DELAY seconds. If FUNC is called again within this time, +the timer is reset. + +DELAY defaults to 0.5 seconds. DELAY can be a number, a symbol (whose +value is a number), or a function (that evaluates to a number). When +passed a symbol or function, it is evaluated at runtime for dynamic +duration. Using a delay of 0 removes any debounce advice. + +The function returns immediately with value DEFAULT when called the +first time. On future invocations, the result from the previous call is +returned. + +(fn FUNC &optional DELAY DEFAULT)") +(autoload 'timeout-throttle "timeout" "\ +Make FUNC run no more frequently than once every THROTTLE seconds. + +THROTTLE defaults to 1 second. THROTTLE can be a number, a symbol (whose +value is a number), or a function (that evaluates to a number). When +passed a symbol or function, it is evaluated at runtime for dynamic +duration. Using a throttle of 0 removes any throttle advice. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned. + +(fn FUNC &optional THROTTLE)") +(autoload 'timeout-throttled-func "timeout" "\ +Return a throttled version of function FUNC. + +The throttled function runs no more frequently than once every THROTTLE +seconds. THROTTLE defaults to 1 second. THROTTLE can be a number, a +symbol (whose value is a number), or a function (that evaluates to a +number). When passed a symbol or function, it is evaluated at runtime +for dynamic duration. + +When FUNC does not run because of the throttle, the result from the +previous successful call is returned. + +(fn FUNC &optional THROTTLE)") +(autoload 'timeout-debounced-func "timeout" "\ +Return a debounced version of function FUNC. + +The debounced function runs DELAY seconds after it is called. DELAY +defaults to 0.5 seconds. DELAY can be a number, a symbol (whose value +is a number), or a function (that evaluates to a number). When passed +a symbol or function, it is evaluated at runtime for dynamic duration. + +The function returns immediately with value DEFAULT when called the +first time. On future invocations, the result from the previous call is +returned. + +(fn FUNC &optional DELAY DEFAULT)") +(register-definition-prefixes "timeout" '("timeout--")) ;;; Generated autoloads from emacs-lisp/timer-list.el @@ -34368,6 +34457,17 @@ Prevent `touchscreen-drag' and translated mouse events from being sent until the touch sequence currently being translated ends. Must be called from a command bound to a `touchscreen-hold' or `touchscreen-drag' event.") +(autoload 'touch-screen-last-drag-position "touch-screen" "\ +Return the last attested position of the current touch screen tool. +Value is a pair of integers (X . Y) representing the pixel +position of the said tool relative to the frame where it was +placed (not the selected frame), or nil if this function was +not invoked after the generation of a `mouse-movement' or +`down-mouse-1' event by touch screen event translation. + +This function must be consulted in preference to +`mouse-absolute-pixel-position' if the latter is required in any +command that handles `mouse-movement' or `down-mouse-1' events.") (register-definition-prefixes "touch-screen" '("touch-screen-")) @@ -36266,6 +36366,33 @@ This is the same as `vc-revert-or-delete-revision' invoked interactively with a prefix argument. (fn REV &optional BACKEND)" t) +(autoload 'vc-uncommit-revisions-from-end "vc" "\ +Delete revisions newer than REV without touching the working tree. +REV must be on the current branch. The newer revisions are deleted from +the revision history but the changes made by those revisions to files in +the working tree are not undone. +When called interactively, prompts for REV. +BACKEND is the VC backend. + +To delete revisions from the revision history and also undo the changes +in the working tree, see `vc-delete-revisions-from-end'. + +(fn REV &optional BACKEND)" t) +(autoload 'vc-delete-revisions-from-end "vc" "\ +Delete revisions newer than REV. +REV must be on the current branch. The newer revisions are deleted from +the revision history and the changes made by those revisions to files in +the working tree are undone. +When called interactively, prompts for REV. +If the are uncommitted changes, prompts to discard them. +With a prefix argument (when called from Lisp, with optional argument +DISCARD non-nil), discard any uncommitted changes without prompting. +BACKEND is the VC backend. + +To delete revisions from the revision history without undoing the +changes in the working tree, see `vc-uncommit-revisions-from-end'. + +(fn REV &optional DISCARD BACKEND)" t) (autoload 'vc-version-diff "vc" "\ Report diffs between revisions REV1 and REV2 in the repository history. This compares two revisions of the current fileset. @@ -36420,7 +36547,10 @@ saving the buffer. (fn HISTORIC &optional NOT-ESSENTIAL)" t) (autoload 'vc-root-dir "vc" "\ Return the root directory for the current VC tree. -Return nil if the root directory cannot be identified.") +Return nil if the root directory cannot be identified. +BACKEND is the VC backend. + +(fn &optional BACKEND)") (autoload 'vc-revision-other-window "vc" "\ Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -36592,6 +36722,7 @@ mark. Revert working copies of the selected fileset to their repository contents. This asks for confirmation if the buffer contents are not identical to the working revision (except for keyword expansion)." t) +(defalias 'vc-restore #'vc-revert) (autoload 'vc-pull "vc" "\ Update the current fileset or branch. You must be visiting a version controlled file, or in a `vc-dir' buffer. @@ -39389,6 +39520,36 @@ Interactively, a prefix argument says to rotate the parent window of the selected window. (fn &optional WINDOW REVERSE)" t) +(autoload 'merge-frames "window-x" "\ +Merge the main window of FRAME2 into FRAME1. +Split the main window of FRAME1 and make the new window display the main +window of FRAME2. Both FRAME1 and FRAME2 must be live frames. If +VERTICAL is non-nil, make the new window below the old main window of +FRAME1. Otherwise, make the new window on the right of FRAME1's main +window. Interactively, VERTICAL is the prefix argument, FRAME1 is the +selected frame and FRAME2 is the frame following FRAME1 in the frame +list. Delete FRAME2 if the merge completed successfully and return +FRAME1. + +(fn &optional FRAME1 FRAME2 VERTICAL)" t) +(autoload 'split-frame "window-x" "\ +Split windows of specified FRAME into two separate frames. +FRAME must be a live frame and defaults to the selected frame. ARG +specifies the number of windows to consider for splitting and defaults +to 1. Interactively, ARG is the prefix argument. + +First divide the child windows of FRAME's main window into two parts. +The first part includes the first ARG child windows if ARG is positive, +or -ARG last windows if it's negative. The second part includes the +remaining child windows of FRAME's main window. Then clone into a +newly-created frame each of the windows of the part which does not +include FRAME's selected window and delete those windows from FRAME. + +Signal an error if ARG is either zero or not a number, if FRAME's main +window is live or does not have more child windows than specified by the +absolute value of ARG. Return the new frame. + +(fn &optional FRAME ARG)" t) (register-definition-prefixes "window-x" '("rotate-windows-change-selected" "window-")) commit e3883144ae2055ff9c4a9e5bd48df469c2986e72 Author: Jostein Kjønigsen Date: Mon Dec 15 14:46:30 2025 +0100 csharp-mode: Fix fontification of catch-expressions * lisp/progmodes/csharp-mode.el (csharp-ts-mode--font-lock-settings): Improve specificity of selectors. Don't let type-selector bleed into name-selector. (Bug#80038) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 1a31e3f9ab9..c1db5439ab5 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -1028,10 +1028,9 @@ compilation and evaluation time conflicts." (conditional_expression)]) (catch_declaration - ((identifier) @font-lock-type-face)) + type: (identifier) @font-lock-type-face) (catch_declaration - ((identifier) @font-lock-type-face - (identifier) @font-lock-variable-name-face)) + name: (identifier) @font-lock-variable-name-face) (variable_declaration (identifier) @font-lock-type-face) (variable_declaration (qualified_name commit 985e942d1ccb71c9b29b35080098b8fb851eecde Author: Rudolf Adamkovič Date: Tue Dec 9 13:35:42 2025 +0100 hi-lock: Use active region for default values in more places * lisp/hi-lock.el (hi-lock-line-face-buffer, hi-lock-face-buffer) (hi-lock-face-phrase-buffer): Use the new function `hi-lock-read-regexp' to read font-lock patterns, mirroring `hi-lock-read-face-name' used to read face names. For end users, all three functions now get the default value from the active region, rather than just `hi-lock-face-buffer'. (hi-lock-read-regexp): Extract font-lock pattern reading functionality from `hi-lock-face-buffer' into this function, to mirror how faces are read with `hi-lock-read-face-name' and to promote reuse. (Bug#79976) diff --git a/etc/NEWS b/etc/NEWS index 6292cf981da..e3ea4557355 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3231,6 +3231,14 @@ Command 'antlr-run-tool' now usually runs on the file for the current buffer. Customize this user option to have value ' nil' to get the previous behavior back. +** Hi Lock + +--- +*** Use active region for default values in more functions. +If an active region exists, the commands 'hi-lock-line-face-buffer' and +'hi-lock-face-phrase-buffer' now use its contents as their default +value. Previously, only 'hi-lock-face-buffer' supported this. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 35ee01c2f3b..71f302f3ebc 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -393,7 +393,7 @@ The lines that match REGEXP will be displayed by merging the attributes of FACE with any other face attributes of text in those lines. -Interactively, prompt for REGEXP using `read-regexp', then FACE. +Interactively, prompt for REGEXP using `hi-lock-read-regexp', then FACE. Use the global history list for FACE. If REGEXP contains upper case characters (excluding those preceded by `\\') @@ -404,8 +404,7 @@ use overlays for highlighting. If overlays are used, the highlighting will not update as you type." (interactive (list - (hi-lock-regexp-okay - (read-regexp "Regexp to highlight line" 'regexp-history-last)) + (hi-lock-read-regexp "Regexp to highlight line") (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) @@ -423,7 +422,7 @@ highlighting will not update as you type." ;;;###autoload (defun hi-lock-face-buffer (regexp &optional face subexp lighter) "Set face of each match of REGEXP to FACE. -Interactively, prompt for REGEXP using `read-regexp', then FACE. +Interactively, prompt for REGEXP using `hi-lock-read-regexp', then FACE. Use the global history list for FACE. Limit face setting to the corresponding SUBEXP (interactively, the prefix argument) of REGEXP. If SUBEXP is omitted or nil, the entire REGEXP is highlighted. @@ -443,14 +442,7 @@ causes `font-lock-specified-p' to return non-nil, which means the major mode specifies support for Font Lock." (interactive (list - (hi-lock-regexp-okay - (read-regexp "Regexp to highlight" - (if (use-region-p) - (prog1 - (buffer-substring (region-beginning) - (region-end)) - (deactivate-mark)) - 'regexp-history-last))) + (hi-lock-read-regexp "Regexp to highlight") (hi-lock-read-face-name) current-prefix-arg)) (when (stringp face) @@ -469,7 +461,7 @@ the major mode specifies support for Font Lock." ;;;###autoload (defun hi-lock-face-phrase-buffer (regexp &optional face) "Set face of each match of phrase REGEXP to FACE. -Interactively, prompt for REGEXP using `read-regexp', then FACE. +Interactively, prompt for REGEXP using `hi-lock-read-regexp', then FACE. Use the global history list for FACE. If REGEXP contains upper case characters (excluding those preceded by `\\') @@ -484,8 +476,7 @@ causes `font-lock-specified-p' to return non-nil, which means the major mode specifies support for Font Lock." (interactive (list - (hi-lock-regexp-okay - (read-regexp "Phrase to highlight" 'regexp-history-last)) + (hi-lock-read-regexp "Phrase to highlight") (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) @@ -726,6 +717,21 @@ with completion and history." (add-to-list 'hi-lock-face-defaults face t)) (intern face))) +(defun hi-lock-read-regexp (prompt) + "Read font-lock pattern from the minibuffer and return it. + +The pattern is read using `read-regexp' with PROMPT and validated using +`hi-lock-regexp-okay'. If the region is active, use its content as the +default value." + (hi-lock-regexp-okay + (read-regexp prompt + (if (use-region-p) + (prog1 + (buffer-substring (region-beginning) + (region-end)) + (deactivate-mark)) + 'regexp-history-last)))) + (defvar hi-lock-use-overlays nil "Whether to always use overlays instead of font-lock rules. When `font-lock-mode' is enabled and the buffer specifies font-lock rules,