commit f9fa75c1ef31ee78b43509f15b50cf0603757181 (HEAD, refs/remotes/origin/master) Author: Yuan Fu Date: Sun Sep 15 23:32:51 2024 -0700 Add accessors for treesit-font-lock-settings Since each SETTING in treesit-font-lock-settings is considered an opaque object, provide accessor functions for each field. * lisp/treesit.el: (treesit-font-lock-settings): Update docstring. (treesit-font-lock-setting-query): (treesit-font-lock-setting-enable): (treesit-font-lock-setting-feature): (treesit-font-lock-setting-override): New functions. (treesit--font-lock-setting-feature): Remove function. (treesit--font-lock-setting-enable): Rename to treesit--font-lock-setting-clone-enable to avoid confusion with treesit-font-lock-setting-enable. (treesit-add-font-lock-rules): Use renamed function. (treesit-font-lock-fontify-region): Add a comment. * doc/lispref/modes.texi (Parser-based Font Lock): Update manual. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ddb6c4bf2fb..87c6347eaa7 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -4460,11 +4460,22 @@ For this variable to take effect, a Lisp program should call @code{treesit-font-lock-recompute-features}). @end defvar +@findex treesit-font-lock-setting-query +@findex treesit-font-lock-setting-feature +@findex treesit-font-lock-setting-enable +@findex treesit-font-lock-setting-override @defvar treesit-font-lock-settings -A list of settings for tree-sitter based font lock. The exact format -of each setting is considered internal. One should always use +A list of settings for tree-sitter based font lock. The exact format of +each individual setting is considered internal. One should always use @code{treesit-font-lock-rules} to set this variable. +Even though the setting object is opaque, Emacs provides accessors for +the setting's query, feature, enable flag and override flag: +@code{treesit-font-lock-setting-query}, +@code{treesit-font-lock-setting-feature}, +@code{treesit-font-lock-setting-enable}, +@code{treesit-font-lock-setting-override}. + @c Because the format is internal, we don't document them here. Though @c we do have it explained in the docstring. We also expose the fact @c that it is a list of settings, so one could combine two of them with diff --git a/etc/NEWS b/etc/NEWS index d2f53594a63..b902aaf7ead 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -410,6 +410,13 @@ This is useful for reusing font-lock rules and indentation rules of language A for language B, when language B is a strict superset of language A. ++++ +*** New accessor functions for each setting in 'treesit-font-lock-settings'. +Now users can access a setting's query, feature, enable flag, and +override flag by 'treesit-font-lock-setting-query', +'treesit-font-lock-setting-feature', 'treesit-font-lock-setting-enable', +and 'treesit-font-lock-setting-override'. + +++ ** New optional BUFFER argument for 'string-pixel-width'. If supplied, 'string-pixel-width' will use any face remappings from diff --git a/lisp/treesit.el b/lisp/treesit.el index 8773b31c83f..d3e6efdeb14 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -623,12 +623,14 @@ Return the merged list of ranges." ;; New range and old range don't intersect, new comes ;; before, push new. ((<= new-end old-beg) - (push (car new-ranges) result) + (unless (eq new-beg new-end) + (push (car new-ranges) result)) (setq new-ranges (cdr new-ranges))) ;; New range and old range don't intersect, old comes ;; before, push old. ((<= old-end new-beg) - (push (car old-ranges) result) + (unless (eq old-beg old-end) + (push (car old-ranges) result)) (setq old-ranges (cdr old-ranges))) (t ;; New and old range intersect, discard old. (setq old-ranges (cdr old-ranges)))))) @@ -637,6 +639,8 @@ Return the merged list of ranges." (push range result))) (nreverse result))) +;; TODO: Instead of throwing away ranges that exceeds START and END, +;; truncate the head and tail ranges so they stay within START and END. (defun treesit--clip-ranges (ranges start end) "Clip RANGES in between START and END. RANGES is a list of ranges of the form (BEG . END). Ranges @@ -829,10 +833,15 @@ opposed to embedded parsers which parses only part of the buffer.") (defvar-local treesit-font-lock-settings nil "A list of SETTINGs for treesit-based fontification. -The exact format of each SETTING is considered internal. Use -`treesit-font-lock-rules' to set this variable. +Use `treesit-font-lock-rules' to set this variable. The exact format of +each individual SETTING is considered internal and will change in the +future. Use `treesit-font-lock-setting-query', +`treesit-font-lock-setting-enable', etc, to access each field. -Each SETTING has the form: +Below information is considered internal and only provided to help +debugging: + +Currently each SETTING has the form: (QUERY ENABLE FEATURE OVERRIDE) @@ -850,12 +859,25 @@ OVERRIDE is the override flag for this query. Its value can be t, nil, append, prepend, keep. See more in `treesit-font-lock-rules'.") -(defsubst treesit--font-lock-setting-feature (setting) - "Return the feature of SETTING. -SETTING should be a setting in `treesit-font-lock-settings'." +;; Follow cl-defstruct naming conventions, in case we use cl-defstruct +;; in the future. +(defsubst treesit-font-lock-setting-query (setting) + "Return the QUERY of SETTING in `treesit-font-lock-settings'." + (nth 0 setting)) + +(defsubst treesit-font-lock-setting-enable (setting) + "Return the ENABLE flag of SETTING in `treesit-font-lock-settings'." + (nth 1 setting)) + +(defsubst treesit-font-lock-setting-feature (setting) + "Return the FEATURE symbol of SETTING in `treesit-font-lock-settings'." (nth 2 setting)) -(defsubst treesit--font-lock-setting-enable (setting) +(defsubst treesit-font-lock-setting-override (setting) + "Return the OVERRIDE flag of SETTING in `treesit-font-lock-settings'." + (nth 3 setting)) + +(defsubst treesit--font-lock-setting-clone-enable (setting) "Return enabled SETTING." (let ((new-setting (copy-tree setting))) (setf (nth 1 new-setting) t) @@ -1152,12 +1174,12 @@ all existing rules. If FEATURE is non-nil, add RULES before/after rules for FEATURE. See docstring of `treesit-font-lock-rules' for what is a feature." - (let ((rules (seq-map #'treesit--font-lock-setting-enable rules)) + (let ((rules (seq-map #'treesit--font-lock-setting-clone-enable rules)) (feature-idx (when feature (cl-position-if (lambda (setting) - (eq (treesit--font-lock-setting-feature setting) feature)) + (eq (treesit-font-lock-setting-feature setting) feature)) treesit-font-lock-settings)))) (pcase (cons how feature) ((or '(:after . nil) '(nil . nil)) @@ -1329,6 +1351,10 @@ If LOUDLY is non-nil, display some debugging information." (root-nodes (mapcar #'treesit-parser-root-node (append local-parsers global-parsers)))) + ;; Can't we combine all the queries in each setting into one big + ;; query? That should make font-lock faster? I tried, it shaved off + ;; 1ms in xdisp.c, and 0.3ms in a small C file (for typing a single + ;; character), not worth it. --yuan (dolist (setting treesit-font-lock-settings) (let* ((query (nth 0 setting)) (enable (nth 1 setting)) commit 4c4e26be7c8da65c6c4d01d298ce8a35c920271b Author: Yuan Fu Date: Sat Sep 14 00:37:30 2024 -0700 ; * admin/MAINTAINERS: Add yuan to maintainer file. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 20d5c1c60dc..be21a28b759 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -233,6 +233,11 @@ Philip Kaludercic lisp/emacs-lisp/compat.el lisp/net/rcirc.el +Yuan Fu + src/treesit.c + lisp/treesit.el + lisp/progmodes/c-ts-common.el + ============================================================================== 2. Areas that someone is willing to maintain, although he would not necessarily mind if someone else was the official maintainer. @@ -377,6 +382,9 @@ Harald Jörg Spencer Baugh lisp/progmodes/flymake.el +Yuan Fu + lisp/progmodes/c-ts-mode.el + ============================================================================== 3. Externally maintained packages. ============================================================================== commit 1103134a0e1edbd512891e64bad99de10da33ef4 Author: Stefan Kangas Date: Sat Sep 21 03:41:26 2024 +0200 ; Delete bug fix from etc/NEWS * etc/NEWS: Delete bug fix item. No correct program will see a difference in behavior; at worst, the error message when calling `(error)` is now better. Reported by Mattias Engdegård . diff --git a/etc/NEWS b/etc/NEWS index b52ad001a2e..d2f53594a63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -365,9 +365,6 @@ toggle. * Incompatible Lisp Changes in Emacs 31.1 -** The obsolete calling convention of 'error' has been removed. -That convention was: '(error &rest ARGS)'. - ** The 'rx' category name 'chinese-two-byte' must now be spelled correctly. An old alternative name (without the first 'e') has been removed. commit 117d93a477079d9b051e2b764fc3cfa9402801b0 Author: David Fussner Date: Mon Sep 16 14:05:01 2024 +0100 Fix regexps for TeX xref backend * lisp/textmodes/tex-mode.el (tex-thingatpt-exclude-chars): Remove variable. (tex-thingatpt--beginning-of-symbol, tex-thingatpt--end-of-symbol): Use hard-coded characters instead of variable. (Bug#53749) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ec0c0c47a2d..6fc49800018 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -3814,37 +3814,6 @@ There might be text before point." ;; Emacs and `etags' this way aims to improve the user experience "out ;; of the box." -(defvar tex-thingatpt-exclude-chars '(?\\ ?\{ ?\}) - "Exclude these chars by default from TeX thing-at-point. - -The TeX `xref-backend-identifier-at-point' method uses the characters -listed in this variable to decide on the default search string to -present to the user who calls an `xref' command. These characters -become part of a regexp which always excludes them from that default -string. For the `xref' commands to function properly in TeX buffers, at -least the TeX escape and the two TeX grouping characters should be -listed here. Should your TeX documents contain other characters which -you want to exclude by default, then you can add them to the list, -though you may wish to consult the functions -`tex-thingatpt--beginning-of-symbol' and `tex-thingatpt--end-of-symbol' -to see what the regexp already contains. If your documents contain -non-standard escape and grouping characters, then you can replace the -three listed here with your own, thereby allowing the three standard -characters to appear by default in search strings. Please be aware, -however, that the `etags' program only recognizes `\\' (92) and `!' (33) -as escape characters in TeX documents, and if it detects the latter it -also uses `<>' as the TeX grouping construct rather than `{}'. Setting -the escape and grouping chars to anything other than `\\=\\{}' or `!<>' -will not be useful without changes to `etags', at least for commands -that search tags tables, such as \\[xref-find-definitions] and \ -\\[xref-find-apropos]. - -Should you wish to change the defaults, please also be aware that, -without further modifications to tex-mode.el, the usual text-parsing -routines for `font-lock' and the like won't work correctly, as the -default escape and grouping characters are currently hard coded in many -places.") - ;; Populate `semantic-symref-filepattern-alist' for the in-tree modes; ;; AUCTeX is doing the same for its modes. (with-eval-after-load 'semantic/symref/grep @@ -3878,20 +3847,12 @@ places.") (defun tex-thingatpt--beginning-of-symbol () (and - (re-search-backward (concat "[][" - (mapconcat #'regexp-quote - (mapcar #'char-to-string - tex-thingatpt-exclude-chars)) - "\"*`'#=&()%,|$[:cntrl:][:blank:]]")) + (re-search-backward "[][\\{}\"*`'#=&()%,|$[:cntrl:][:blank:]]" nil t) (forward-char))) (defun tex-thingatpt--end-of-symbol () (and - (re-search-forward (concat "[][" - (mapconcat #'regexp-quote - (mapcar #'char-to-string - tex-thingatpt-exclude-chars)) - "\"*`'#=&()%,|$[:cntrl:][:blank:]]")) + (re-search-forward "[][\\{}\"*`'#=&()%,|$[:cntrl:][:blank:]]" nil t) (backward-char))) (defun tex--bounds-of-symbol-at-point () commit 357cd83875a4dd0ec81d1af2b91270cb57973931 Author: Po Lu Date: Fri Sep 20 22:27:39 2024 +0800 Remove obsolete workaround * src/fontset.c (fontset_find_font): Don't refuse to cache font objects whose registries do not agree with the font specs. (bug#73363) diff --git a/src/fontset.c b/src/fontset.c index 16d14669c89..755942138f7 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -668,34 +668,8 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, font_object = font_open_for_lface (f, font_entity, face->lface, FONT_DEF_SPEC (font_def)); - /* If the font registry is not the same as explicitly - specified in the font spec, do not cache the font. - TrueType fonts have contrived character map selection - semantics which makes determining the repertory at font - spec matching time unduly expensive. */ - - { - Lisp_Object spec; - - spec = FONT_DEF_SPEC (font_def); - - if (!NILP (font_object) - && !NILP (AREF (spec, FONT_REGISTRY_INDEX)) - && !NILP (AREF (font_object, FONT_REGISTRY_INDEX)) - && !EQ (AREF (spec, FONT_REGISTRY_INDEX), - AREF (font_object, FONT_REGISTRY_INDEX)) - /* See sfntfont_registries_compatible_p in - sfntfont.c. */ - && !(EQ (AREF (spec, FONT_REGISTRY_INDEX), - Qiso8859_1) - && EQ (AREF (font_object, FONT_REGISTRY_INDEX), - Qiso10646_1))) - goto strangeness; - } - if (NILP (font_object)) { - strangeness: /* Something strange happened, perhaps because of a Font-backend problem. To avoid crashing, record that this spec is unusable. It may be better to find commit 38c7516827902cdfb70bf68b2da4296a8d9349c0 Author: Mattias Engdegård Date: Thu Aug 29 14:14:22 2024 +0200 Speed up tall rectangular selections (bug#72830) Instead of setting the highlight overlay on every line in the selection, only do so on the window-height worth of lines closest to point because the rest aren't likely to be visible. This makes a massive difference for tall rectangular selections which previously were so slow as to be unusable. (Tall selections are still slow if `select-active-regions` is non-nil, but that is something that users can actually do something about.) * lisp/rect.el (rectangle--highlight-for-redisplay) (rectangle--unhighlight-for-redisplay): Replace call to `apply-on-rectangle`, which operates on every line, with a loop over an approximate screenful. Extend the `rectangle` overlay list structure with a value for point, because `exchange-point-and-mark` must trigger a recomputation of highlight overlays despite the selection not actually changing. diff --git a/lisp/rect.el b/lisp/rect.el index 93007824679..4325134f8f0 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -857,102 +857,130 @@ Ignores `line-move-visual'." (eq (nth 1 rol) (buffer-chars-modified-tick)) (eq start (nth 2 rol)) (eq end (nth 3 rol)) - (equal (rectangle--crutches) (nth 4 rol))) + (equal (rectangle--crutches) (nth 4 rol)) + ;; Check point explicitly so that `exchange-point-and-mark' + ;; triggers overlay recomputation. + (eq (nth 5 rol) (point))) rol) (t (save-excursion - (let* ((nrol nil) + (let* ((pt (point)) + (nrol nil) (old (if (eq 'rectangle (car-safe rol)) - (nthcdr 5 rol) + (nthcdr 6 rol) (funcall redisplay-unhighlight-region-function rol) nil))) (cl-assert (eq (window-buffer window) (current-buffer))) ;; `rectangle--pos-cols' looks up the `selected-window's parameter! (with-selected-window window - (apply-on-rectangle - (lambda (leftcol rightcol) - (let* ((mleft (move-to-column leftcol)) - (left (point)) - ;; BEWARE: In the presence of other overlays with - ;; before/after/display-strings, this happens to move to - ;; the column "as if the overlays were not applied", which - ;; is sometimes what we want, tho it can be - ;; considered a bug in move-to-column (it should arguably - ;; pay attention to the before/after-string/display - ;; properties when computing the column). - (mright (move-to-column rightcol)) - (right (point)) - (ol - (if (not old) - (let ((ol (make-overlay left right))) - (overlay-put ol 'window window) - (overlay-put ol 'face 'region) - ol) - (let ((ol (pop old))) - (move-overlay ol left right (current-buffer)) - ol)))) - ;; `move-to-column' may stop before the column (if bumping into - ;; EOL) or overshoot it a little, when column is in the middle - ;; of a char. - (cond - ((< mleft leftcol) ;`leftcol' is past EOL. - (overlay-put ol 'before-string (rectangle--space-to leftcol)) - (setq mright (max mright leftcol))) - ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. - (eq (char-before left) ?\t)) - (setq left (1- left)) - (move-overlay ol left right) - (goto-char left) - (overlay-put ol 'before-string (rectangle--space-to leftcol))) - ((overlay-get ol 'before-string) - (overlay-put ol 'before-string nil))) - (cond - ;; While doing rectangle--string-preview, the two sets of - ;; overlays steps on the other's toes. I fixed some of the - ;; problems, but others remain. The main one is the two - ;; (rectangle--space-to rightcol) below which try to virtually - ;; insert missing text, but during "preview", the text is not - ;; missing (it's provided by preview's own overlay). - (rectangle--string-preview-state - (if (overlay-get ol 'after-string) - (overlay-put ol 'after-string nil))) - ((< mright rightcol) ;`rightcol' is past EOL. - (let ((str (rectangle--space-to rightcol))) - (put-text-property 0 (length str) 'face 'region str) - ;; If cursor happens to be here, draw it at the right place. - (rectangle--place-cursor leftcol left str) - (overlay-put ol 'after-string str))) - ((and (> mright rightcol) ;`rightcol's in the middle of a char. - (eq (char-before right) ?\t)) - (setq right (1- right)) - (move-overlay ol left right) - (if (= rightcol leftcol) - (overlay-put ol 'after-string nil) - (goto-char right) - (let ((str (rectangle--space-to rightcol))) - (put-text-property 0 (length str) 'face 'region str) - (when (= left right) - (rectangle--place-cursor leftcol left str)) - (overlay-put ol 'after-string str)))) - ((overlay-get ol 'after-string) - (overlay-put ol 'after-string nil))) - (when (and (= leftcol rightcol) (display-graphic-p)) - ;; Make zero-width rectangles visible! - (overlay-put ol 'after-string - (concat (propertize " " - 'face '(region (:height 0.2))) - (overlay-get ol 'after-string)))) - (push ol nrol))) - start end)) + (let* ((cols (rectangle--pos-cols start end)) + (startcol (car cols)) + (endcol (cdr cols)) + (leftcol (min startcol endcol)) + (rightcol (max startcol endcol)) + ;; We don't know what lines will actually be displayed, + ;; so add highlight overlays on lines within the window + ;; height from point. + (height (window-height)) + (start-pt (max start (progn (forward-line (- height)) + (point)))) + (end-pt (min end (progn (goto-char pt) + (forward-line height) + (point))))) + (goto-char start-pt) + (beginning-of-line) + (while + (let* ((mleft (move-to-column leftcol)) + (left (point)) + ;; BEWARE: In the presence of other overlays with + ;; before/after/display-strings, this happens to move to + ;; the column "as if the overlays were not applied", + ;; which is sometimes what we want, tho it can be + ;; considered a bug in move-to-column (it should + ;; arguably pay attention to the + ;; before/after-string/display properties when computing + ;; the column). + (mright (move-to-column rightcol)) + (right (point)) + (ol + (if (not old) + (let ((ol (make-overlay left right))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'region) + ol) + (let ((ol (pop old))) + (move-overlay ol left right (current-buffer)) + ol)))) + ;; `move-to-column' may stop before the column (if bumping + ;; into EOL) or overshoot it a little, when column is in the + ;; middle of a char. + (cond + ((< mleft leftcol) ;`leftcol' is past EOL. + (overlay-put ol 'before-string + (rectangle--space-to leftcol)) + (setq mright (max mright leftcol))) + ((and (> mleft leftcol) ;`leftcol' is in the middle of a char + (eq (char-before left) ?\t)) + (setq left (1- left)) + (move-overlay ol left right) + (goto-char left) + (overlay-put ol 'before-string + (rectangle--space-to leftcol))) + ((overlay-get ol 'before-string) + (overlay-put ol 'before-string nil))) + (cond + ;; While doing rectangle--string-preview, the two sets of + ;; overlays steps on the other's toes. I fixed some of the + ;; problems, but others remain. The main one is the two + ;; (rectangle--space-to rightcol) below which try to + ;; virtually insert missing text, but during "preview", the + ;; text is not missing (it's provided by preview's own + ;; overlay). + (rectangle--string-preview-state + (if (overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + ((< mright rightcol) ;`rightcol' is past EOL. + (let ((str (rectangle--space-to rightcol))) + (put-text-property 0 (length str) 'face 'region str) + ;; If cursor happens to be here, draw it at the right + ;; place. + (rectangle--place-cursor leftcol left str) + (overlay-put ol 'after-string str))) + ((and (> mright rightcol) ;`rightcol' in the middle of a char + (eq (char-before right) ?\t)) + (setq right (1- right)) + (move-overlay ol left right) + (if (= rightcol leftcol) + (overlay-put ol 'after-string nil) + (goto-char right) + (let ((str (rectangle--space-to rightcol))) + (put-text-property 0 (length str) 'face 'region str) + (when (= left right) + (rectangle--place-cursor leftcol left str)) + (overlay-put ol 'after-string str)))) + ((overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + (when (and (= leftcol rightcol) (display-graphic-p)) + ;; Make zero-width rectangles visible! + (overlay-put ol 'after-string + (concat (propertize + " " 'face '(region (:height 0.2))) + (overlay-get ol 'after-string)))) + (push ol nrol) + (and (zerop (forward-line 1)) + (bolp) + (<= (point) end-pt)))) + ) + ) (mapc #'delete-overlay old) `(rectangle ,(buffer-chars-modified-tick) - ,start ,end ,(rectangle--crutches) + ,start ,end ,(rectangle--crutches) ,pt ,@nrol)))))) (defun rectangle--unhighlight-for-redisplay (orig rol) (if (not (eq 'rectangle (car-safe rol))) (funcall orig rol) - (mapc #'delete-overlay (nthcdr 5 rol)) + (mapc #'delete-overlay (nthcdr 6 rol)) (setcar (cdr rol) nil))) (defun rectangle--duplicate-right (n displacement)