diff --git a/CHANGELOG.md b/CHANGELOG.md index 6d6c50c..96a9e17 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -35,6 +35,12 @@ - With two-line titles disabled (the default), `M-left` / `M-right` and `C-c C-t` no longer mistake a line above a `----` or `====` delimiter for a title and overwrite the delimiter. - `C-c C-t` won't convert to a two-line title while they're disabled, or past level 4 (where it used to crash). - A numeric value now skips underlines of that length, as documented. It used to compare the length of the title text instead. +- [#90](https://github.com/bbatsov/adoc-mode/pull/90): A construct that is rejected once no longer stops the same construct from being highlighted further down. A `NOTE:` inside a listing block, for instance, used to leave every later admonition paragraph unhighlighted; literal paragraphs, the alignment of indented lines and two-line titles had the same problem. +- [#90](https://github.com/bbatsov/adoc-mode/pull/90): Delimited blocks are highlighted correctly when Emacs fontifies the buffer a piece at a time, as it does while you scroll. + - A long listing, literal, example or other block crossing the edge of a piece used to lose track of where it began, so code could come out bold or as table cells. + - A block now ends at the first line that repeats its opening delimiter exactly, as in Asciidoctor. It used to need a non-blank last line, and any longer run of the same character closed it. + - A delimiter line inside a listing or literal block is just content. +- [#90](https://github.com/bbatsov/adoc-mode/pull/90): Example, open, quote and sidebar blocks keep the highlighting of what's inside them (list markers, comments, `include::` lines, nested code), and section titles inside a delimited block are no longer highlighted as titles, since Asciidoctor reads them as plain text. ## 0.9.0 (2026-06-02) diff --git a/adoc-mode.el b/adoc-mode.el index 3af2ec6..5adb7f9 100644 --- a/adoc-mode.el +++ b/adoc-mode.el @@ -158,7 +158,11 @@ distinguish between a) a two line tile b) start of a delimited block and c) end of a delimited block. If you start a listing delimited block with '>----' and end it with '<----', then all three cases can easily be distinguished. The regexp in your -AsciiDoc config file would the probably be '^[<>]-{4,}$'" +AsciiDoc config file would the probably be '^[<>]-{4,}$' + +Only the highlighting follows this option. Finding where a block +begins and ends, so that a block is always fontified as a whole (see +`adoc--ensure-block-extents'), uses the standard Asciidoctor delimiters." :type '(list (choice :tag "comment" (regexp :tag "start/end regexp") @@ -1282,32 +1286,18 @@ Subgroups: adoc-delimited-block-del "\\|") "\\)")) -;; KLUDGE: Contrary to what the AsciiDoc manual specifies, adoc-mode does not -;; allow that either the first or the last line within a delimited block is -;; blank. That shall help to prevent the case that adoc-mode wrongly -;; interprets the end of a delimited block as the beginning, and the beginning -;; of a following delimited block as the ending, thus wrongly interpreting the -;; text between two adjacent delimited blocks as delimited block. It is -;; expected that it is unlikely that one wants to begin or end a delimited -;; block with a blank line, and it is expected that it is likely that -;; delimited blocks are surrounded by blank lines. (defun adoc-re-delimited-block (del) + "Return a regexp matching a whole delimited block of type DEL. +DEL indexes `adoc-delimited-block-del'. Like Asciidoctor, the block +ends at the first line that repeats the opening delimiter exactly. +Group 1 is the opening delimiter, 2 the content, 3 the closing +delimiter." (let* ((tmp (nth del adoc-delimited-block-del)) (start (if (consp tmp) (car tmp) tmp)) - (end (if (consp tmp) (cdr tmp) tmp))) + (end (if (consp tmp) (cdr tmp) "\\1"))) (concat "\\(" start "\\)[ \t]*\n" - "\\(" - ;; a single leading non-blank line - "[ \t]*[^ \t\n].*\n" - ;; optionally followed by - "\\(?:" - ;; any number of arbitrary lines followed by - "\\(?:.*\n\\)*?" - ;; a trailing non blank line - "[ \t]*[^ \t\n].*\n" - "\\)??" - "\\)??" + "\\(\\(?:.*\n\\)*?\\)" "\\(" end "\\)[ \t]*$"))) ;; TODO: since its multiline, it doesn't yet work properly. @@ -1708,20 +1698,27 @@ adoc-syntax to code blocks." (null (eobp)))) ret)) -(defun adoc-kwf-std (end regexp &optional must-free-groups no-block-del-groups) +(defun adoc-kwf-std (end regexp &optional must-free-groups no-block-del-groups predicate) "Standard function for keywords Intendent to be called from font lock keyword functions. END is the limit of the search. REXEXP the regexp to be searched. MUST-FREE-GROUPS a list of regexp group numbers which may not match text that has an adoc-reserved text-property with a non-nil value. Likewise, groups in NO-BLOCK-DEL-GROUPS may not contain -text having adoc-reserved set to symbol `block-del'." +text having adoc-reserved set to symbol `block-del'. PREDICATE, +when non-nil, is called with the match data set and rejects the +match by returning nil. + +A rejected match doesn't end the search: font-lock abandons a +keyword for the rest of the region as soon as its matcher returns +nil, so the search goes on to the next match instead." (let ((found t) (prevented t)) (while (and found prevented (<= (point) end) (not (eobp))) (setq found (adoc-kwf-search regexp end t)) (setq prevented (and found (or + (and predicate (not (funcall predicate))) (cl-some (lambda(x) (and (match-beginning x) (text-property-not-all (match-beginning x) @@ -1811,19 +1808,28 @@ text having adoc-reserved set to symbol `block-del'." ;; ... ;; could surely be replaced by a single (adoc-not-reserved-bla-bla 1 3) -;; BUG: Remember that if a matcher function returns nil, font-lock does not -;; further call it and abandons that keyword. Thus in adoc-mode in general, -;; there should be a loop around (and (re-search-forward ...) (not -;; (text-property-not-all...)) ...). Currently if say a constrained quote can't -;; match because of adoc-reserved, following quotes of the same type which -;; should be highlighed are not, because font-lock abandons that keyword. +(defun adoc--delimited-block-match-p () + "Return non-nil unless the delimited block matched opens inside a verbatim one. +In a listing, literal or other verbatim block a delimiter line is just +content. See `adoc--ensure-block-extents' for how blocks are found." + (let ((block (get-text-property (match-beginning 0) 'adoc-delimited-block))) + (or (null block) + (not (nth 2 block)) + (= (nth 1 block) (match-beginning 0))))) + +(defun adoc--outside-delimited-block-p () + "Return non-nil when the current match doesn't start inside a delimited block. +Asciidoctor reads a section title inside a delimited block as plain +text. See `adoc--ensure-block-extents' for how blocks are found." + (not (get-text-property (match-beginning 0) 'adoc-delimited-block))) (defun adoc-kw-one-line-title (level text-face) "Creates a keyword for font-lock which highlights one line titles. TEXT-FACE is a face name symbol." (let ((face-form (list 'quote text-face))) (list - `(lambda (end) (adoc-kwf-std end ,(adoc-re-one-line-title level) '(0))) + `(lambda (end) (adoc-kwf-std end ,(adoc-re-one-line-title level) '(0) nil + #'adoc--outside-delimited-block-p)) '(1 '(face adoc-meta-hide-face adoc-reserved block-del) t) `(2 ,face-form t) '(3 '(face nil adoc-reserved block-del) t) @@ -1838,6 +1844,17 @@ a numeric `adoc-enable-two-line-title'." (and adoc-enable-two-line-title (not (eql adoc-enable-two-line-title length)))) +(defun adoc--two-line-title-match-p () + "Return non-nil when the last `adoc-re-two-line-title' match is a title. +The underline has to be about as long as the text, may not be excluded +by `adoc-enable-two-line-title', and the text line may not be a block +attribute list or block title (Asciidoctor reads those as the +metadata of the block below)." + (let ((underline (- (match-end 3) (match-beginning 3)))) + (and (< (abs (- (- (match-end 2) (match-beginning 2)) underline)) 3) + (adoc--two-line-title-underline-p underline) + (not (memq (char-after (match-beginning 2)) '(?\[ ?.)))))) + (defun adoc-kw-two-line-title (del text-face) "Creates a keyword for font-lock which highlights two line titles. TEXT-FACE is a face name symbol." @@ -1846,10 +1863,11 @@ TEXT-FACE is a face name symbol." ;; matcher function `(lambda (end) (and adoc-enable-two-line-title - (adoc-kwf-search ,(adoc-re-two-line-title del) end t) - (< (abs (- (- (match-end 2) (match-beginning 2)) (- (match-end 3) (match-beginning 3)))) 3) - (adoc--two-line-title-underline-p (- (match-end 3) (match-beginning 3))) - (not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil)))) + (adoc-kwf-std + end ,(adoc-re-two-line-title del) '(0) nil + (lambda () + (and (adoc--two-line-title-match-p) + (adoc--outside-delimited-block-p)))))) ;; highlighers `(2 ,face-form t) `(3 '(face adoc-meta-hide-face adoc-reserved block-del) t)))) @@ -1910,12 +1928,16 @@ A checklist item is an unordered list item whose text begins with "Creates a keyword for font-lock which highlights a delimited block. TEXT-FACE is a face name symbol or nil." (list - `(lambda (end) (adoc-kwf-std end ,(adoc-re-delimited-block del) '(1 3))) - '(0 '(face nil font-lock-multiline t) t) + `(lambda (end) (adoc-kwf-std end ,(adoc-re-delimited-block del) '(1 3) nil + #'adoc--delimited-block-match-p)) + ;; Leave the faces in the block alone: a compound block (example, + ;; sidebar, quote, open) holds lists, comments and other blocks whose + ;; highlighting has to survive. + '(0 '(face nil font-lock-multiline t)) '(1 '(face adoc-meta-hide-face adoc-reserved block-del) t) (if (not inhibit-text-reserved) `(2 '(face ,text-face adoc-reserved t) t t) - `(2 ',text-face t t)) + `(2 ',text-face append t)) '(3 '(face adoc-meta-hide-face adoc-reserved block-del) t))) ;; if adoc-kw-delimited-block, adoc-kw-two-line-title don't find the whole @@ -1933,8 +1955,7 @@ TEXT-FACE is a face name symbol or nil." (list ;; matcher function (lambda (end) - (and (adoc-kwf-search "^[ \t]*\\(\\(?:CAUTION\\|WARNING\\|IMPORTANT\\|TIP\\|NOTE\\):\\)\\([ \t]+\\)" end t) - (not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil)))) + (adoc-kwf-std end "^[ \t]*\\(\\(?:CAUTION\\|WARNING\\|IMPORTANT\\|TIP\\|NOTE\\):\\)\\([ \t]+\\)" '(0))) ;; highlighters '(1 '(face adoc-complex-replacement-face adoc-reserved t)) '(2 '(face adoc-align-face adoc-reserved t)))) @@ -1943,9 +1964,7 @@ TEXT-FACE is a face name symbol or nil." "Creates a keyword which highlights a sequence of verbatim paragraphs." (list ;; matcher function - `(lambda (end) - (and (adoc-kwf-search ,(adoc-re-verbatim-paragraph-sequence) end t) - (not (text-property-not-all (match-beginning 0) (match-end 0) 'adoc-reserved nil)))) + `(lambda (end) (adoc-kwf-std end ,(adoc-re-verbatim-paragraph-sequence) '(0))) ;; highlighers '(1 '(face adoc-typewriter-face adoc-reserved t font-lock-multiline t)))) @@ -2205,14 +2224,15 @@ TEXTPROPS is an additional plist with textproperties." ;; line beginning would also be underlined, which looks akward. (defun adoc-flf-first-whites-fixed-width(end) ;; it makes no sense to do something with a blank line, so require at least one non blank char. - (and (adoc-kwf-search "\\(^[ \t]+\\)[^ \t\n]" end t) - ;; don't replace a face with with adoc-align-face which already is a fixed with - ;; font (most probably), because then it also won't look aligned - (text-property-not-all (match-beginning 1) (match-end 1) 'face 'adoc-typewriter-face) - (text-property-not-all (match-beginning 1) (match-end 1) 'face 'adoc-code-face) - (text-property-not-all (match-beginning 1) (match-end 1) 'adoc-code-block t) - (text-property-not-all (match-beginning 1) (match-end 1) 'face 'adoc-passthrough-face) - (text-property-not-all (match-beginning 1) (match-end 1) 'face 'adoc-comment-face))) + (adoc-kwf-std + end "\\(^[ \t]+\\)[^ \t\n]" nil nil + (lambda () + ;; don't replace a face with with adoc-align-face which already is a fixed with + ;; font (most probably), because then it also won't look aligned + (not (or (adoc--face-memq '(adoc-typewriter-face adoc-code-face + adoc-passthrough-face adoc-comment-face) + (get-text-property (match-beginning 1) 'face)) + (get-text-property (match-beginning 1) 'adoc-code-block)))))) ;; See adoc-flf-first-whites-fixed-width (defun adoc-kw-first-whites-fixed-width () @@ -2434,14 +2454,174 @@ Use this function as matching function MATCHER in `font-lock-keywords'." (put-text-property beg next 'display nil)) (setq beg next))))) +;;;; Delimited block extents + +;; The font-lock keywords match a delimited block with one regexp, from its +;; opening to its closing delimiter, so they only see a block when the region +;; being fontified covers all of it. jit-lock fontifies the buffer in chunks, +;; and a chunk can begin or end anywhere - including inside a block, where an +;; opening delimiter can't be told from a closing one. So the extent of every +;; top-level block is recorded by a scan that always pairs the delimiters up +;; from the start of the buffer, and `adoc-font-lock-extend-region' widens the +;; region so it never splits a block. + +(defconst adoc--re-block-delimiter + (concat "^\\(" + (mapconcat #'identity + '("/\\{4,\\}" "\\+\\{4,\\}" "-\\{4,\\}" "\\.\\{4,\\}" + "_\\{4,\\}" "=\\{4,\\}" "\\*\\{4,\\}" "--" + "[,:]=\\{3,\\}") + "\\|") + "\\)[ \t]*$") + "Regexp matching a delimited block or CSV/DSV table delimiter line. +Group 1 is the delimiter. These are Asciidoctor's delimiters, not +the ones `adoc-delimited-block-del' customizes for highlighting. A +`|===' table is highlighted line by line, so it needs no extent.") + +(defun adoc--verbatim-delimiter-p (delimiter) + "Return non-nil when DELIMITER opens a block whose content isn't AsciiDoc. +That's every block but the example, sidebar, quote and open ones." + (not (or (equal delimiter "--") + (memq (aref delimiter 0) '(?= ?* ?_))))) + +(defconst adoc--re-block-metadata-line + "^\\(?:\\[.*\\]\\|\\.[^ \t.].*\\)[ \t]*$" + "Regexp matching a block attribute list, anchor or title line.") + +(defun adoc--title-underline-p (open delimiter) + "Return non-nil when DELIMITER, on the line at OPEN, underlines a title. +That's only possible when two-line titles are enabled, and then a +title line right above makes it the underline of a two-line title +rather than a block delimiter, the same as for fontification." + (let ((del (and adoc-enable-two-line-title + (cl-find (aref delimiter 0) adoc-two-line-title-del + :key #'string-to-char)))) + (and del + (save-excursion + (goto-char open) + (and (zerop (forward-line -1)) + (looking-at (adoc-re-two-line-title del)) + (= (match-beginning 3) open) + (adoc--two-line-title-match-p)))))) + +(defvar-local adoc--block-extents-done 1 + "Position up to which the delimited block extents are known. +The `adoc-delimited-block' properties from here on are out of date. +See `adoc--ensure-block-extents'.") + +(defvar-local adoc--block-extents-unterminated nil + "Where the first block known to be unterminated would begin, or nil. +Text added anywhere after it might close it.") + +(defun adoc--invalidate-block-extents (beg &rest _) + "Forget the delimited block extents from where a change at BEG matters. +That's the beginning of the block BEG is in, read while the text before +the change is still there. Otherwise it's the beginning of BEG's line, +which may become a delimiter line, together with any attribute and +title lines above it, which would then belong to its block. A change +after an unterminated block's opening delimiter can close it, so then +the extents are forgotten from that block on. Meant for +`before-change-functions'." + (when (<= beg adoc--block-extents-done) + (save-excursion + ;; The block just before BEG counts too when the change continues its + ;; last line, as text added after a closing delimiter at the very end + ;; of the buffer does. + (let ((block (or (and (< beg adoc--block-extents-done) + (get-text-property beg 'adoc-delimited-block)) + (and (> beg (point-min)) + (not (eq (char-before beg) ?\n)) + (get-text-property (1- beg) 'adoc-delimited-block))))) + (goto-char (if block (car block) beg)) + (let ((pos (line-beginning-position))) + (while (and (zerop (forward-line -1)) + (looking-at-p adoc--re-block-metadata-line)) + (setq pos (point))) + (setq adoc--block-extents-done (min adoc--block-extents-done pos)))))) + (when (and adoc--block-extents-unterminated + (< adoc--block-extents-unterminated adoc--block-extents-done)) + (setq adoc--block-extents-done adoc--block-extents-unterminated))) + +(defun adoc--ensure-block-extents (pos) + "Make sure the extents of the delimited blocks before POS are recorded. +Each block, together with the attribute, anchor and title lines right +above it, gets an `adoc-delimited-block' text property whose value is +the list (START OPEN VERBATIM): where the block begins, where its +opening delimiter line is, and whether its content isn't AsciiDoc (see +`adoc--verbatim-delimiter-p'). Like Asciidoctor, the first line that +repeats the opening delimiter exactly closes a block, whatever it +contains. An unterminated block gets no extent. + +The scan picks up where the last one left off, and a block it starts +is recorded whole." + (when (< adoc--block-extents-done pos) + (save-excursion + (save-restriction + (widen) + (with-silent-modifications + (let ((start (progn (goto-char (max adoc--block-extents-done (point-min))) + (line-beginning-position))) + (end (progn (goto-char (min pos (point-max))) + ;; Scan whole lines, so no delimiter line is cut in two. + (unless (bolp) (forward-line 1)) + ;; Attribute, anchor and title lines belong to the + ;; block that opens below them, so take in the line + ;; after them too. + (when (save-excursion + (and (zerop (forward-line -1)) + (looking-at-p adoc--re-block-metadata-line))) + (while (and (not (eobp)) + (looking-at-p adoc--re-block-metadata-line)) + (forward-line 1)) + (forward-line 1)) + (point)))) + (setq adoc--block-extents-done + (adoc--record-block-extents start end)))))))) + +(defun adoc--record-block-extents (start end) + "Record the extents of the delimited blocks opened between START and END. +START has to be outside any block. Return the position the extents are +known up to: END, or the end of a block that runs past it. See +`adoc--ensure-block-extents'." + (goto-char start) + (remove-text-properties start end '(adoc-delimited-block nil)) + (when (and adoc--block-extents-unterminated + (>= adoc--block-extents-unterminated start)) + (setq adoc--block-extents-unterminated nil)) + (while (and (< (point) end) + (re-search-forward adoc--re-block-delimiter end t)) + (let* ((open (match-beginning 0)) + (delimiter (match-string-no-properties 1)) + (closing (concat "^" (regexp-quote delimiter) "[ \t]*$"))) + (forward-line 1) + (unless (adoc--title-underline-p open delimiter) + (let ((block-start open)) + (save-excursion + (goto-char open) + (while (and (zerop (forward-line -1)) + (looking-at-p adoc--re-block-metadata-line)) + (setq block-start (point)))) + (if (not (re-search-forward closing nil t)) + (unless adoc--block-extents-unterminated + (setq adoc--block-extents-unterminated block-start)) + (let ((block-end (min (1+ (point)) (point-max)))) + (put-text-property block-start block-end 'adoc-delimited-block + (list block-start open + (adoc--verbatim-delimiter-p delimiter))) + (setq end (max end block-end)) + (goto-char block-end))))))) + end) + (defvar font-lock-beg) (defvar font-lock-end) (defun adoc-font-lock-extend-region () - "Extend the font-lock region to paragraph boundaries. + "Extend the font-lock region to paragraph and delimited block boundaries. Inline formatting in AsciiDoc can span multiple lines within a paragraph, so the fontification region must cover complete paragraphs -for multiline constructs to be matched." +for multiline constructs to be matched. Likewise a delimited block is +only recognised as a whole, so the region never ends or begins inside +one (see `adoc--ensure-block-extents')." (let ((changed nil)) (save-excursion (goto-char font-lock-beg) @@ -2455,6 +2635,18 @@ for multiline constructs to be matched." (when (> new-end font-lock-end) (setq font-lock-end new-end changed t)))) + (adoc--ensure-block-extents font-lock-end) + (let ((block (get-text-property font-lock-beg 'adoc-delimited-block))) + (when (and block (< (car block) font-lock-beg)) + (setq font-lock-beg (car block) + changed t))) + (when (and (> font-lock-end (point-min)) + (get-text-property (1- font-lock-end) 'adoc-delimited-block)) + (let ((block-end (next-single-property-change + (1- font-lock-end) 'adoc-delimited-block nil (point-max)))) + (when (> block-end font-lock-end) + (setq font-lock-end block-end + changed t)))) changed)) (defun adoc-font-lock-mark-block-function () @@ -3461,6 +3653,10 @@ new customization demands." (adoc-make-unichar-alist)) (setq adoc-font-lock-keywords (adoc-get-font-lock-keywords)) + (when (eq major-mode 'adoc-mode) + ;; the extents depend on `adoc-enable-two-line-title' + (setq adoc--block-extents-done 1 + adoc--block-extents-unterminated nil)) (when (and font-lock-mode (eq major-mode 'adoc-mode)) (font-lock-flush) (font-lock-ensure))) @@ -4335,14 +4531,11 @@ and `adoc-imenu-create-index' call `font-lock-ensure' first. For a one-line title the leading delimiter at START carries `adoc-meta-hide-face'. Inline markup in the title text does not -touch that delimiter (so a title made entirely of a macro is still -recognised), whereas a surrounding delimited block repaints the -whole line and thus the delimiter too - which is precisely why a -`==' line inside a block is rejected. The check therefore relies on -the block keywords winning the face-override war on the delimiter; -the navigation tests guard that assumption. A two-line title has no -such delimiter, so fall back to looking for a title face on its -text." +touch that delimiter, so a title made entirely of a macro is still +recognised. The title keywords skip the inside of delimited blocks +\(see `adoc--outside-delimited-block-p'), so a `==' line there never +gets that face. A two-line title has no such delimiter, so fall back +to looking for a title face on its text." (or (adoc--face-memq '(adoc-meta-hide-face) (get-text-property start 'face)) (let ((pos start) found) (while (and (not found) (< pos end)) @@ -5087,6 +5280,7 @@ Turning on Adoc mode runs the normal hook `adoc-mode-hook'." (setq-local font-lock-unfontify-region-function 'adoc-unfontify-region-function) (setq-local font-lock-extend-after-change-region-function #'adoc-font-lock-extend-after-change-region) (add-hook 'font-lock-extend-region-functions #'adoc-font-lock-extend-region nil t) + (add-hook 'before-change-functions #'adoc--invalidate-block-extents nil t) ;; outline mode (setq-local outline-regexp "=\\{1,6\\}[ \t]+[^ \t\n]") diff --git a/test/adoc-mode-font-lock-test.el b/test/adoc-mode-font-lock-test.el index 72b45e5..91d1986 100644 --- a/test/adoc-mode-font-lock-test.el +++ b/test/adoc-mode-font-lock-test.el @@ -41,6 +41,19 @@ "Document Title\n==============" '(("Document Title" adoc-title-0-face))))) + (it "doesn't take a block title or attribute line for a two-line title" + (let ((adoc-enable-two-line-title t)) + (adoc-test--check-face-specs ".Example\n--------\ncode\n--------\n" + '(("Example" adoc-gen-face) + ("code" adoc-code-face))) + (adoc-test--check-face-specs "[abcd]\n----\ncode\n----\n" + '(("code" adoc-code-face))))) + + (it "fontifies a two-line title after a rejected one" + (let ((adoc-enable-two-line-title t)) + (adoc-test--check-face-specs "Hi\n------------\n\nTitle\n-----\n" + '(("Title" adoc-title-1-face))))) + (it "skips two-line titles whose underline has the excluded length" (let ((adoc-enable-two-line-title 5)) (adoc-test--check-face-specs "Titles\n-----\n" '(("Titles" nil))) @@ -175,7 +188,216 @@ ("____\nquoted\n____" ("quoted" adoc-blockquote-face))) (when-fontifying-it "fontifies a sidebar block body" - ("****\nsidebar\n****" ("sidebar" adoc-secondary-text-face)))) + ("****\nsidebar\n****" ("sidebar" adoc-secondary-text-face))) + + (when-fontifying-it "keeps the highlighting inside example and open blocks" + ("[NOTE]\n====\n* item\n// a comment\n====" + ("*" adoc-list-face) + ("// a comment" adoc-comment-face)) + ("--\n* item\n// a comment\n--" + ("*" adoc-list-face) + ("// a comment" adoc-comment-face))) + + (when-fontifying-it "keeps list markers in a quote block" + ("____\n* quoted item\n____" ("*" adoc-list-face))) + + (when-fontifying-it "doesn't highlight section titles inside a block" + ;; Asciidoctor reads them as plain paragraphs + ("====\n== Not a title\n====\n\n--\n=== Nor this\n--\n\n== Real" + ("Not a title" nil) + ("Nor this" nil) + ("Real" adoc-title-1-face))) + + (it "keeps the indentation of nested code as code" + (with-temp-buffer + (insert "****\n----\nif x\n indented code\n----\n****\n") + (adoc-mode) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward " indented") + (expect (get-text-property (match-beginning 0) 'face) + :not :to-contain 'adoc-align-face))) + + (when-fontifying-it "keeps going after a literal paragraph inside a listing block" + ("----\ncode\n\n indented in listing\n----\n\nText\n\n literal paragraph\n" + ("indented in listing" adoc-code-face) + ("literal paragraph" adoc-typewriter-face)))) + + ;; ---- Chunked fontification ------------------------------------------ + + (describe "chunked fontification" + ;; jit-lock fontifies a chunk at a time during redisplay, and a chunk + ;; can begin or end inside a delimited block. + + (it "keeps a long listing block's body as code" + (with-temp-buffer + (insert "= Doc\n\nintro\n\n----\n" + (apply #'concat (make-list 30 "a line of code to fill the chunk\n")) + "*star* inside the listing\n" + (apply #'concat (make-list 10 "more code\n")) + "----\n\nAfter the block, *bold* text.\n") + (adoc-mode) + (adoc-test-fontify-in-chunks 200) + (goto-char (point-min)) + (search-forward "*star*") + (expect (adoc-test-face-at-range (match-beginning 0) (1- (match-end 0))) + :to-equal 'adoc-code-face) + (search-forward "bold") + (expect (adoc-test-face-at-range (match-beginning 0) (1- (match-end 0))) + :to-equal 'adoc-bold-face))) + + (it "fontifies blocks the same chunk by chunk as in one go" + (let ((text (concat + "= Doc\n\n== Section\n\n" + "[source,adoctest-lang]\n----\nif x\n" + (apply #'concat (make-list 12 " do something\n")) + "----\n\n" + "[NOTE]\n====\n* item one\n* item two\n\n" + "----\nnested listing\n\n== not a title\n----\n\n" + (apply #'concat (make-list 8 "Example text with *bold* words.\n")) + "====\n\n" + "....\nliteral\n\n*not bold*\n....\n\n" + "****\nsidebar _text_\n\n// a comment\n****\n\n" + "____\nquoted\n\nNOTE: inside\n____\n\n" + "NOTE: an admonition\n\n" + "|===\n|a |b\n\n|c |d\n|===\n\n" + "== Another *section*\n\nThe end.\n"))) + (dolist (chunk-size '(37 64 101 250)) + (expect (adoc-test-chunked-fontification-difference text chunk-size) + :to-be nil)))) + + (when-fontifying-it "ends a block at the first exact repeat of its delimiter" + ("----\ncode\n\n----\n\nprose with *bold*\n\n----\nmore\n----\n" + ("code" adoc-code-face) + ("prose" nil) + ("bold" adoc-bold-face) + ("more" adoc-code-face))) + + (it "pairs block delimiters from the start of the buffer when narrowed" + (with-temp-buffer + (insert "= Doc\n\n----\ncode\n----\n\n== Real Title\n\n----\nmore\n----\n") + (adoc-mode) + (goto-char (point-min)) + (search-forward "code") + (narrow-to-region (line-beginning-position) (point-max)) + (adoc--ensure-block-extents (point-max)) + (widen) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "Real Title") + (expect (get-text-property (match-beginning 0) 'face) :to-be 'adoc-title-1-face))) + + (it "updates the block extents after an edit" + (with-temp-buffer + (insert "----\ncode\n\n== Title\n") + (adoc-mode) + (adoc--ensure-block-extents (point-max)) + (goto-char (point-min)) + (search-forward "Title") + (expect (get-text-property (point) 'adoc-delimited-block) :to-be nil) + ;; closing the block puts the title inside it + (goto-char (point-max)) + (insert "----\n") + (adoc--ensure-block-extents (point-max)) + (goto-char (point-min)) + (search-forward "Title") + (expect (car (get-text-property (point) 'adoc-delimited-block)) :to-equal 1))) + + (it "closes a block when its closing delimiter is typed after more text" + (with-temp-buffer + (insert "----\ncode\n\n== Title\n\n----\nother\n----\n") + (adoc-mode) + (adoc--ensure-block-extents (point-max)) + ;; the first `----' pairs with the second, so the title is inside + (goto-char (point-min)) + (search-forward "Title") + (expect (car (get-text-property (point) 'adoc-delimited-block)) :to-equal 1) + ;; and the last one opens a block that never closes + (goto-char (point-max)) + (insert "\nmore\n----\n") + (adoc--ensure-block-extents (point-max)) + (goto-char (point-min)) + (search-forward "more") + (expect (get-text-property (point) 'adoc-delimited-block) :not :to-be nil))) + + (when-fontifying-it "takes a delimiter line in a literal block as content" + ;; the listing keyword runs first, and used to pair the `----' in the + ;; literal block with the next listing's opening delimiter + ("Type:\n\n....\n----\n....\n\n== Next\n\nProse.\n\n----\ncode\n----\n" + ("Next" adoc-title-1-face) + ("Prose" nil) + ("code" adoc-code-face))) + + (it "keeps the block extents right through edits" + ;; each edit is checked against a fresh scan of the result + (cl-flet ((extents () + (adoc--ensure-block-extents (point-max)) + (let (res) + (dotimes (i (1- (point-max))) + (push (get-text-property (1+ i) 'adoc-delimited-block) res)) + res)) + (fresh-extents (text) + (with-temp-buffer + (insert text) + (adoc-mode) + (adoc--ensure-block-extents (point-max)) + (let (res) + (dotimes (i (1- (point-max))) + (push (get-text-property (1+ i) 'adoc-delimited-block) res)) + res)))) + (dolist (case + '(;; yanked text carries the properties of where it came from + ("= Doc\n\n----\ncode\n----\n\n== Title\n\n----\nmore\n----\n" + (search "code") (yank "pasted ")) + ;; typing a whole block above others + ("Intro.\n\n----\na\n----\n\nText.\n\n----\nb\n----\n\n== Title\n" + (search "Intro.\n\n") (type "----\nnew\n----\n\n")) + ;; joining a closing delimiter with the next line + ("====\na\n====\nmore\n\n== Title\n\n====\nb\n====\n" + (line 3) (delete-newline)) + ;; extending a closing delimiter at the end of the buffer + ("++++\ncode\n++++" (end) (type ".")) + ;; a line turning into a delimiter takes the title above + ("text\n.Title\n---\ncode\n----\n" (line 3) (type "-")))) + (with-temp-buffer + (insert (car case)) + (adoc-mode) + (adoc--ensure-block-extents (point-max)) + (goto-char (point-min)) + (dolist (op (cdr case)) + (pcase op + (`(search ,s) (search-forward s)) + (`(line ,n) (goto-char (point-min)) (forward-line (1- n)) (end-of-line)) + ('(end) (goto-char (point-max))) + (`(yank ,s) (insert-for-yank + (propertize s 'adoc-delimited-block (list 1 1 t)))) + (`(type ,s) (dolist (c (string-to-list s)) + (insert-and-inherit c) + (adoc--ensure-block-extents (line-end-position)))) + ('(delete-newline) (delete-char 1)))) + (expect (extents) :to-equal (fresh-extents (buffer-string))))))) + + (it "starts the block extents over when the settings change" + (with-temp-buffer + (insert "Hello\n=====\n\n== Section\n\n=====\ntext\n=====\n") + (adoc-mode) + (setq-local adoc-enable-two-line-title t) + (font-lock-ensure) + (setq-local adoc-enable-two-line-title nil) + (adoc-calc) + (font-lock-flush) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "Section") + (expect (get-text-property (match-beginning 0) 'face) :to-be nil))) + + (it "fontifies the sample document the same chunk by chunk as in one go" + (let ((text (with-temp-buffer + (insert-file-contents (adoc-test-resource "sample.adoc")) + (buffer-string)))) + (dolist (chunk-size '(300 1500)) + (expect (adoc-test-chunked-fontification-difference text chunk-size) + :to-be nil))))) ;; ---- Tables -------------------------------------------------------- @@ -225,6 +447,11 @@ ("NOTE: pay attention" ("NOTE:" adoc-complex-replacement-face))) + (when-fontifying-it "fontifies an admonition after one inside a listing block" + ("----\nNOTE: x\n----\n\nNOTE: real" + ("NOTE:" adoc-code-face) + ("NOTE:" adoc-complex-replacement-face))) + (when-fontifying-it "fontifies the admonition block label" ("[NOTE]" ("[NOTE]" adoc-complex-replacement-face)))) diff --git a/test/adoc-mode-test-helpers.el b/test/adoc-mode-test-helpers.el index 496d6d6..5490137 100644 --- a/test/adoc-mode-test-helpers.el +++ b/test/adoc-mode-test-helpers.el @@ -216,6 +216,49 @@ ORIGINAL-TEXT may contain the markers `!' (point) and `<'/`>' "Mode for testing code blocks in `adoc-mode'. Don't use it for anything real.") +;;;; Chunked fontification + +(require 'jit-lock) + +(defun adoc-test-fontify-in-chunks (chunk-size) + "Fontify the current buffer CHUNK-SIZE characters at a time. +That's how jit-lock fontifies during redisplay, whereas +`font-lock-ensure' does the whole buffer in one go - which hides the +constructs that break when a chunk starts or ends inside them." + (font-lock-set-defaults) + (jit-lock-register #'font-lock-fontify-region) + (let ((pos (point-min))) + (while pos + (jit-lock-fontify-now pos (min (point-max) (+ pos chunk-size))) + (setq pos (text-property-any pos (point-max) 'fontified nil))))) + +(defun adoc-test--face-runs () + "Return the current buffer's faces as a list of (START END FACE) runs." + (let ((pos (point-min)) runs) + (while (< pos (point-max)) + (let ((next (next-single-property-change pos 'face nil (point-max)))) + (push (list pos next (get-text-property pos 'face)) runs) + (setq pos next))) + (nreverse runs))) + +(defun adoc-test-chunked-fontification-difference (text chunk-size) + "Return how fontifying TEXT in CHUNK-SIZE chunks differs from doing it whole. +The result is nil when both give the same faces, otherwise the first +differing pair of (START END FACE) runs." + (let* ((whole (with-temp-buffer + (insert text) + (adoc-mode) + (font-lock-ensure) + (adoc-test--face-runs))) + (chunked (with-temp-buffer + (insert text) + (adoc-mode) + (adoc-test-fontify-in-chunks chunk-size) + (adoc-test--face-runs))) + (i (cl-mismatch whole chunked :test #'equal))) + (when i + (list (nth i whole) (nth i chunked))))) + (provide 'adoc-mode-test-helpers) ;;; adoc-mode-test-helpers.el ends here