From 2a9bb3ba99876ac839fffb0ba0b1cdf09171f618 Mon Sep 17 00:00:00 2001 From: Bohan Li Date: Tue, 14 Jun 2022 16:59:29 -0700 Subject: [PATCH 1/5] Add syntax table property for comment semantic tokens. This is important to let emacs understand that certain parts of the code (e.g. wrapped in C marcos) are not in effect and should be by-passed for things like forward-sexp. --- lsp-semantic-tokens.el | 175 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 175 insertions(+) diff --git a/lsp-semantic-tokens.el b/lsp-semantic-tokens.el index a19e64a58e7..1d83aa1f650 100644 --- a/lsp-semantic-tokens.el +++ b/lsp-semantic-tokens.el @@ -71,6 +71,22 @@ associated with the requesting language server." :group 'lsp-semantic-tokens :type 'boolean) +(defcustom lsp-semantic-tokens-set-comment-syntax nil + "Whether to set the local syntax table for comments. + +When set to nil, the syntax table will not be changed. +When set to t, semantic tokens with type comment will be also +marked as comment in the local syntax table. This helps a lot in +situations when it is beneficial to ignore the comments. For +example, in c-mode, parenthesis matching should ignore the ones +in disabled macro blocks. Note that when turned on, +auto-indentation may not work well in these \"disabled\" code +blocks, so this may need to be temporarily set to nil in that +case. Use `lsp-semantic-tokens-toggle-comment-syntax' to toggle +the value of this variable." + :group 'lsp-semantic-tokens + :type 'boolean) + (defface lsp-face-semhl-constant '((t :inherit font-lock-constant-face)) "Face used for semantic highlighting scopes matching constant scopes." @@ -458,6 +474,9 @@ modified by OLD-FONTIFY-REGION. LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." ;; TODO: support multiple language servers per buffer? (let ((faces (seq-some #'lsp--workspace-semantic-tokens-faces lsp--buffer-workspaces)) + (types (plist-get + (seq-some #'lsp--semantic-tokens-as-defined-by-workspace lsp--buffer-workspaces) + :token-types)) (modifier-faces (when lsp-semantic-tokens-apply-modifiers (seq-some #'lsp--workspace-semantic-tokens-modifier-faces lsp--buffer-workspaces))) @@ -468,11 +487,15 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (eq nil lsp--semantic-tokens-cache) (eq nil (plist-get lsp--semantic-tokens-cache :response))) ;; default to non-semantic highlighting until first response has arrived + (when lsp-semantic-tokens-set-comment-syntax + (lsp-semantic-tokens--remove-comment-syntax beg-orig end-orig)) (funcall old-fontify-region beg-orig end-orig loudly)) ((not (= lsp--cur-version (plist-get lsp--semantic-tokens-cache :_documentVersion))) ;; delay fontification until we have fresh tokens '(jit-lock-bounds 0 . 0)) (t + (when lsp-semantic-tokens-set-comment-syntax + (lsp-semantic-tokens--remove-comment-syntax beg-orig end-orig)) (setq old-bounds (funcall old-fontify-region beg-orig end-orig loudly)) ;; this is to prevent flickering when semantic token highlighting ;; is layered on top of, e.g., tree-sitter-hl, or clojure-mode's syntax highlighting. @@ -496,6 +519,7 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (line-delta) (column 0) (face) + (type) (line-start-pos) (line-min) (line-max-inclusive) @@ -529,8 +553,14 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (setq current-line (+ current-line line-delta))) (setq column (+ column (aref data (1+ i)))) (setq face (aref faces (aref data (+ i 3)))) + (setq type (aref types (aref data (+ i 3)))) (setq text-property-beg (+ line-start-pos column)) (setq text-property-end (+ text-property-beg (aref data (+ i 2)))) + (when lsp-semantic-tokens-set-comment-syntax + (if (equal type "comment") + (progn + (lsp-semantic-tokens--put-comment-syntax text-property-beg text-property-end)) + (lsp-semantic-tokens--remove-comment-syntax text-property-beg text-property-end))) (when face (put-text-property text-property-beg text-property-end 'face face)) (cl-loop for j from 0 to (1- (length modifier-faces)) do @@ -541,6 +571,149 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." when (> current-line line-max-inclusive) return nil))))) `(jit-lock-bounds ,beg . ,end))))) +(defun lsp-semantic-tokens-toggle-comment-syntax () + "Toggle the value of `lsp-semantic-tokens-set-comment-syntax'" + (interactive) + (if lsp-semantic-tokens-set-comment-syntax + (progn + (setq lsp-semantic-tokens-set-comment-syntax nil) + (lsp-semantic-tokens--remove-comment-syntax (point-min) (point-max))) + (setq lsp-semantic-tokens-set-comment-syntax t)) + (font-lock-fontify-buffer)) + +(defun lsp-semantic-tokens--get-overlapping-comments (beg end) + "Returns the start of the comment pair that contains BEG, and the +end of the comment pair that contains END. If either of such +comment pairs does not exist, return nil for that part. This +function also removes dangling comment starters/ends." + (let (prev-beg + prev-end + next-beg + next-end + tmp) + (save-mark-and-excursion + (save-restriction + (widen) + (goto-char beg) + (setq prev-beg (text-property-search-backward 'lsp-semantic-token--comment-beg)) + (when prev-beg + (setq prev-beg (prop-match-beginning prev-beg)) + (goto-char prev-beg) + (setq prev-end (text-property-search-forward 'lsp-semantic-token--comment-end)) + (when prev-end + (setq prev-end (prop-match-end prev-end)) + ;; Check whether this is the actual matching end of prev-start + (setq tmp (text-property-search-backward 'lsp-semantic-token--comment-beg)) + (when (or (not tmp) (not (equal prev-beg (prop-match-beginning tmp)))) + (setq prev-end nil))) + + (if prev-end + (when (<= prev-end beg) + ;; Does not overlap with (beg end) + (setq prev-beg nil)) + (lsp-semantic-tokens--remove-comment-syntax-strict prev-beg prev-beg) + (setq prev-beg nil))) + + (goto-char end) + (setq next-end (text-property-search-forward 'lsp-semantic-token--comment-end)) + (when next-end + (setq next-end (prop-match-end next-end)) + (goto-char next-end) + (setq next-beg (text-property-search-backward 'lsp-semantic-token--comment-beg)) + (when next-beg + (setq next-beg (prop-match-beginning next-beg)) + ;; Check whether this is the actual matching beginning of next-end + (setq tmp (text-property-search-forward 'lsp-semantic-token--comment-end)) + (when (or (not tmp) (not (equal next-end (prop-match-end tmp)))) + (setq next-beg nil))) + + (if next-beg + (when (>= next-beg end) + ;; Does not overlap with (beg end) + (setq next-end nil)) + (lsp-semantic-tokens--remove-comment-syntax-strict next-end next-end) + (setq next-end nil))))) + (cons prev-beg next-end))) + +(defun lsp-semantic-tokens--remove-comment-syntax-strict (beg end) + "Remove all commnet syntax strictly in (BEG END), even if they overlap out of the range." + (save-mark-and-excursion + (save-restriction + (widen) + (with-silent-modifications + ;; Remove comment starters + (goto-char beg) + (cl-do ((loc (text-property-search-forward + 'lsp-semantic-token--comment-beg) + (text-property-search-forward + 'lsp-semantic-token--comment-beg))) + ((or (not loc) (>= (point) end))) + (let ((beg-match (prop-match-beginning loc)) + (end-match (prop-match-end loc))) + (remove-text-properties beg-match end-match '(lsp-semantic-token--comment-beg)) + (cl-loop for i from beg-match below end-match do + (put-text-property i (1+ i) 'syntax-table + (get-text-property i 'lsp-semantic-token--previous-syntax-table)) + (remove-text-properties i (1+ i) '(lsp-semantic-token--previous-syntax-table))))) + ;; Remove comment ends + (goto-char end) + (cl-do ((loc (text-property-search-backward + 'lsp-semantic-token--comment-end) + (text-property-search-backward + 'lsp-semantic-token--comment-end))) + ((or (not loc) (<= (point) beg))) + (let ((beg-match (prop-match-beginning loc)) + (end-match (prop-match-end loc))) + (remove-text-properties beg-match end-match '(lsp-semantic-token--comment-end)) + (cl-loop for i from beg-match below end-match do + (put-text-property i (1+ i) 'syntax-table + (get-text-property i 'lsp-semantic-token--previous-syntax-table)) + (remove-text-properties i (1+ i) '(lsp-semantic-token--previous-syntax-table))))))))) + + +(defun lsp-semantic-tokens--put-comment-syntax (beg end) + "Set the comment syntax from BEG to END." + (let* ((overlapping (lsp-semantic-tokens--get-overlapping-comments beg end)) + (new-beg (car overlapping)) + (new-end (cdr overlapping))) + (when new-beg + (setq beg new-beg)) + (when new-end + (setq end new-end))) + (lsp-semantic-tokens--remove-comment-syntax-strict beg end) + (save-restriction + (widen) + (with-silent-modifications + (let ((beg-plus-1 (1+ beg)) + (end-minus-1 (1- end))) + ;; Comment beginning + (put-text-property beg beg-plus-1 + 'lsp-semantic-token--previous-syntax-table + (get-text-property beg 'syntax-table)) + (put-text-property beg beg-plus-1 + 'lsp-semantic-token--comment-beg t) + (put-text-property beg beg-plus-1 + 'syntax-table `(11 . ,(char-after beg))) + ;; Comment end + (put-text-property end-minus-1 end + 'lsp-semantic-token--previous-syntax-table + (get-text-property end-minus-1 'syntax-table)) + (put-text-property end-minus-1 end + 'lsp-semantic-token--comment-end t) + (put-text-property end-minus-1 end + 'syntax-table `(12 . ,(char-after end))))))) + +(defun lsp-semantic-tokens--remove-comment-syntax (beg end) + "Remove the comment syntax from BEG to END." + (let* ((overlapping (lsp-semantic-tokens--get-overlapping-comments beg end)) + (new-beg (car overlapping)) + (new-end (cdr overlapping))) + (when new-beg + (setq beg new-beg)) + (when new-end + (setq end new-end))) + (lsp-semantic-tokens--remove-comment-syntax-strict beg end)) + (defun lsp-semantic-tokens--request-update () "Request semantic-tokens update." ;; when dispatching ranged requests, we'll over-request by several chunks in both directions, @@ -760,6 +933,8 @@ refresh in currently active buffer." (t (remove-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable t) (remove-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable t) + (when lsp-semantic-tokens-set-comment-syntax + (lsp-semantic-tokens--remove-comment-syntax (point-min) (point-max))) (when lsp--semantic-tokens-teardown (funcall lsp--semantic-tokens-teardown)) (lsp-semantic-tokens--request-update) From 918de69c38f387e51134186930bd565323d1f3ad Mon Sep 17 00:00:00 2001 From: Bohan Li Date: Fri, 26 Aug 2022 11:18:45 -0700 Subject: [PATCH 2/5] Fix: use font-lock-flush instead. --- lsp-semantic-tokens.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lsp-semantic-tokens.el b/lsp-semantic-tokens.el index 1d83aa1f650..521400ed737 100644 --- a/lsp-semantic-tokens.el +++ b/lsp-semantic-tokens.el @@ -579,7 +579,7 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (setq lsp-semantic-tokens-set-comment-syntax nil) (lsp-semantic-tokens--remove-comment-syntax (point-min) (point-max))) (setq lsp-semantic-tokens-set-comment-syntax t)) - (font-lock-fontify-buffer)) + (font-lock-flush)) (defun lsp-semantic-tokens--get-overlapping-comments (beg end) "Returns the start of the comment pair that contains BEG, and the From ad36e4f7c5f990291d30c255c2559c0ebf72d629 Mon Sep 17 00:00:00 2001 From: Bohan Li Date: Fri, 26 Aug 2022 11:33:09 -0700 Subject: [PATCH 3/5] Address a few comments. --- lsp-semantic-tokens.el | 151 ++++++++++++++++++++--------------------- 1 file changed, 72 insertions(+), 79 deletions(-) diff --git a/lsp-semantic-tokens.el b/lsp-semantic-tokens.el index 521400ed737..b38fe176d5e 100644 --- a/lsp-semantic-tokens.el +++ b/lsp-semantic-tokens.el @@ -558,8 +558,7 @@ LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." (setq text-property-end (+ text-property-beg (aref data (+ i 2)))) (when lsp-semantic-tokens-set-comment-syntax (if (equal type "comment") - (progn - (lsp-semantic-tokens--put-comment-syntax text-property-beg text-property-end)) + (lsp-semantic-tokens--put-comment-syntax text-property-beg text-property-end) (lsp-semantic-tokens--remove-comment-syntax text-property-beg text-property-end))) (when face (put-text-property text-property-beg text-property-end 'face face)) @@ -591,85 +590,80 @@ function also removes dangling comment starters/ends." next-beg next-end tmp) - (save-mark-and-excursion - (save-restriction - (widen) - (goto-char beg) - (setq prev-beg (text-property-search-backward 'lsp-semantic-token--comment-beg)) - (when prev-beg - (setq prev-beg (prop-match-beginning prev-beg)) - (goto-char prev-beg) - (setq prev-end (text-property-search-forward 'lsp-semantic-token--comment-end)) - (when prev-end - (setq prev-end (prop-match-end prev-end)) - ;; Check whether this is the actual matching end of prev-start - (setq tmp (text-property-search-backward 'lsp-semantic-token--comment-beg)) - (when (or (not tmp) (not (equal prev-beg (prop-match-beginning tmp)))) - (setq prev-end nil))) - - (if prev-end - (when (<= prev-end beg) - ;; Does not overlap with (beg end) - (setq prev-beg nil)) - (lsp-semantic-tokens--remove-comment-syntax-strict prev-beg prev-beg) - (setq prev-beg nil))) - - (goto-char end) - (setq next-end (text-property-search-forward 'lsp-semantic-token--comment-end)) - (when next-end - (setq next-end (prop-match-end next-end)) - (goto-char next-end) - (setq next-beg (text-property-search-backward 'lsp-semantic-token--comment-beg)) - (when next-beg - (setq next-beg (prop-match-beginning next-beg)) - ;; Check whether this is the actual matching beginning of next-end - (setq tmp (text-property-search-forward 'lsp-semantic-token--comment-end)) - (when (or (not tmp) (not (equal next-end (prop-match-end tmp)))) - (setq next-beg nil))) - - (if next-beg - (when (>= next-beg end) - ;; Does not overlap with (beg end) - (setq next-end nil)) - (lsp-semantic-tokens--remove-comment-syntax-strict next-end next-end) - (setq next-end nil))))) + (lsp-save-restriction-and-excursion + (goto-char beg) + (setq prev-beg (text-property-search-backward 'lsp-semantic-token--comment-beg)) + (when prev-beg + (setq prev-beg (prop-match-beginning prev-beg)) + (goto-char prev-beg) + (setq prev-end (text-property-search-forward 'lsp-semantic-token--comment-end)) + (when prev-end + (setq prev-end (prop-match-end prev-end)) + ;; Check whether this is the actual matching end of prev-start + (setq tmp (text-property-search-backward 'lsp-semantic-token--comment-beg)) + (when (or (not tmp) (not (equal prev-beg (prop-match-beginning tmp)))) + (setq prev-end nil))) + + (if prev-end + (when (<= prev-end beg) + ;; Does not overlap with (beg end) + (setq prev-beg nil)) + (lsp-semantic-tokens--remove-comment-syntax-strict prev-beg prev-beg) + (setq prev-beg nil))) + + (goto-char end) + (setq next-end (text-property-search-forward 'lsp-semantic-token--comment-end)) + (when next-end + (setq next-end (prop-match-end next-end)) + (goto-char next-end) + (setq next-beg (text-property-search-backward 'lsp-semantic-token--comment-beg)) + (when next-beg + (setq next-beg (prop-match-beginning next-beg)) + ;; Check whether this is the actual matching beginning of next-end + (setq tmp (text-property-search-forward 'lsp-semantic-token--comment-end)) + (when (or (not tmp) (not (equal next-end (prop-match-end tmp)))) + (setq next-beg nil))) + + (if next-beg + (when (>= next-beg end) + ;; Does not overlap with (beg end) + (setq next-end nil)) + (lsp-semantic-tokens--remove-comment-syntax-strict next-end next-end) + (setq next-end nil)))) (cons prev-beg next-end))) (defun lsp-semantic-tokens--remove-comment-syntax-strict (beg end) "Remove all commnet syntax strictly in (BEG END), even if they overlap out of the range." - (save-mark-and-excursion - (save-restriction - (widen) - (with-silent-modifications - ;; Remove comment starters - (goto-char beg) - (cl-do ((loc (text-property-search-forward - 'lsp-semantic-token--comment-beg) - (text-property-search-forward - 'lsp-semantic-token--comment-beg))) - ((or (not loc) (>= (point) end))) - (let ((beg-match (prop-match-beginning loc)) - (end-match (prop-match-end loc))) - (remove-text-properties beg-match end-match '(lsp-semantic-token--comment-beg)) - (cl-loop for i from beg-match below end-match do - (put-text-property i (1+ i) 'syntax-table - (get-text-property i 'lsp-semantic-token--previous-syntax-table)) - (remove-text-properties i (1+ i) '(lsp-semantic-token--previous-syntax-table))))) - ;; Remove comment ends - (goto-char end) - (cl-do ((loc (text-property-search-backward - 'lsp-semantic-token--comment-end) - (text-property-search-backward - 'lsp-semantic-token--comment-end))) - ((or (not loc) (<= (point) beg))) - (let ((beg-match (prop-match-beginning loc)) - (end-match (prop-match-end loc))) - (remove-text-properties beg-match end-match '(lsp-semantic-token--comment-end)) - (cl-loop for i from beg-match below end-match do - (put-text-property i (1+ i) 'syntax-table - (get-text-property i 'lsp-semantic-token--previous-syntax-table)) - (remove-text-properties i (1+ i) '(lsp-semantic-token--previous-syntax-table))))))))) - + (lsp-save-restriction-and-excursion + (with-silent-modifications + ;; Remove comment starters + (goto-char beg) + (cl-do ((loc (text-property-search-forward + 'lsp-semantic-token--comment-beg) + (text-property-search-forward + 'lsp-semantic-token--comment-beg))) + ((or (not loc) (>= (point) end))) + (let ((beg-match (prop-match-beginning loc)) + (end-match (prop-match-end loc))) + (remove-text-properties beg-match end-match '(lsp-semantic-token--comment-beg)) + (cl-loop for i from beg-match below end-match do + (put-text-property i (1+ i) 'syntax-table + (get-text-property i 'lsp-semantic-token--previous-syntax-table)) + (remove-text-properties i (1+ i) '(lsp-semantic-token--previous-syntax-table))))) + ;; Remove comment ends + (goto-char end) + (cl-do ((loc (text-property-search-backward + 'lsp-semantic-token--comment-end) + (text-property-search-backward + 'lsp-semantic-token--comment-end))) + ((or (not loc) (<= (point) beg))) + (let ((beg-match (prop-match-beginning loc)) + (end-match (prop-match-end loc))) + (remove-text-properties beg-match end-match '(lsp-semantic-token--comment-end)) + (cl-loop for i from beg-match below end-match do + (put-text-property i (1+ i) 'syntax-table + (get-text-property i 'lsp-semantic-token--previous-syntax-table)) + (remove-text-properties i (1+ i) '(lsp-semantic-token--previous-syntax-table)))))))) (defun lsp-semantic-tokens--put-comment-syntax (beg end) "Set the comment syntax from BEG to END." @@ -681,8 +675,7 @@ function also removes dangling comment starters/ends." (when new-end (setq end new-end))) (lsp-semantic-tokens--remove-comment-syntax-strict beg end) - (save-restriction - (widen) + (lsp-save-restriction-and-excursion (with-silent-modifications (let ((beg-plus-1 (1+ beg)) (end-minus-1 (1- end))) From c9991989f6ac360f125bb9ba6ca659c24c636716 Mon Sep 17 00:00:00 2001 From: Bohan Li Date: Fri, 26 Aug 2022 15:14:13 -0700 Subject: [PATCH 4/5] Fix compile errors. --- lsp-semantic-tokens.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lsp-semantic-tokens.el b/lsp-semantic-tokens.el index b38fe176d5e..a45f2189f34 100644 --- a/lsp-semantic-tokens.el +++ b/lsp-semantic-tokens.el @@ -25,6 +25,14 @@ (require 'lsp-mode) (require 'dash) +(eval-when-compile + (if (version<= "27.1" emacs-version) + (require 'text-property-search) + (declare-function text-property-search-forward "text-property-search") + (declare-function text-property-search-backward "text-property-search") + (declare-function prop-match-beginning "text-property-search") + (declare-function prop-match-end "text-property-search"))) + (defgroup lsp-semantic-tokens nil "LSP support for semantic-tokens." :prefix "lsp-semantic-tokens-" @@ -74,6 +82,7 @@ associated with the requesting language server." (defcustom lsp-semantic-tokens-set-comment-syntax nil "Whether to set the local syntax table for comments. +Only compatible with emacs version >= 27.1. When set to nil, the syntax table will not be changed. When set to t, semantic tokens with type comment will be also marked as comment in the local syntax table. This helps a lot in @@ -633,7 +642,8 @@ function also removes dangling comment starters/ends." (cons prev-beg next-end))) (defun lsp-semantic-tokens--remove-comment-syntax-strict (beg end) - "Remove all commnet syntax strictly in (BEG END), even if they overlap out of the range." + "Remove all commnet syntax strictly in (BEG END), even if they +overlap out of the range." (lsp-save-restriction-and-excursion (with-silent-modifications ;; Remove comment starters From 4b68c57f232008a4d8779b18a2dba9d68080fd25 Mon Sep 17 00:00:00 2001 From: Bohan Li Date: Sat, 27 Aug 2022 01:51:16 -0700 Subject: [PATCH 5/5] Fix compile error (2nd attempt) --- lsp-semantic-tokens.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/lsp-semantic-tokens.el b/lsp-semantic-tokens.el index a45f2189f34..b655593d9d2 100644 --- a/lsp-semantic-tokens.el +++ b/lsp-semantic-tokens.el @@ -26,12 +26,10 @@ (require 'dash) (eval-when-compile - (if (version<= "27.1" emacs-version) - (require 'text-property-search) - (declare-function text-property-search-forward "text-property-search") - (declare-function text-property-search-backward "text-property-search") - (declare-function prop-match-beginning "text-property-search") - (declare-function prop-match-end "text-property-search"))) + (declare-function text-property-search-forward "text-property-search") + (declare-function text-property-search-backward "text-property-search") + (declare-function prop-match-beginning "text-property-search") + (declare-function prop-match-end "text-property-search")) (defgroup lsp-semantic-tokens nil "LSP support for semantic-tokens."