diff --git a/markdown-mode.el b/markdown-mode.el index 2c5ae861..374596ef 100644 --- a/markdown-mode.el +++ b/markdown-mode.el @@ -868,6 +868,9 @@ (require 'thingatpt) (require 'cl-lib) +(defvar jit-lock-start) +(defvar jit-lock-end) + (declare-function eww-open-file "eww") @@ -1253,14 +1256,13 @@ Groups 1 and 3 match the opening and closing tags. Group 2 matches the key sequence.") (defconst markdown-regex-gfm-code-block-open - "^\\s *\\(```\\)[ ]?\\([^[:space:]]+[[:space:]]*\\|{[^}]*}\\)?$" + "^[[:blank:]]*\\(```\\)[ ]?\\([^[:space:]]+\\|{[^}]*}\\)?\\([[:space:]]*?\\)$" "Regular expression matching opening of GFM code blocks. Group 1 matches the opening three backticks. -Group 2 matches the language identifier (optional). -Group 3 matches the closing three backticks.") +Group 2 matches the language identifier (optional).") (defconst markdown-regex-gfm-code-block-close - "^\\s *\\(```\\)\\s *$" + "^[[:blank:]]*\\(```\\)\\s *?$" "Regular expression matching closing of GFM code blocks. Group 1 matches the closing three backticks.") @@ -1379,6 +1381,15 @@ Group 3 matches the mathematical expression contained within.") Groups 1 and 3 match the opening and closing delimiters. Group 2 matches the mathematical expression contained within.") +(defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) + "Return regexp which matches a Pandoc code fence at least NUM-TILDES long." + (format "%s%d%s%s" "^\\([~]\\{" num-tildes ",\\}\\)" (or end-of-line "$"))) + +(defconst markdown-regex-tilde-fence-begin + (markdown-make-tilde-fence-regex + 3 "[ ]?\\([^[:space:]]+\\|{[^}]*}\\)?\\([[:space:]]*?\\)$") + "Regular expression for matching Pandoc tildes.") + (defconst markdown-regex-multimarkdown-metadata "^\\([[:alpha:]][[:alpha:] _-]*?\\)\\(:[ \t]*\\)\\(.*\\)$" "Regular expression for matching MultiMarkdown metadata.") @@ -1392,9 +1403,21 @@ Group 2 matches the mathematical expression contained within.") "Regular expression for matching yaml metadata.") (defconst markdown-regex-yaml-pandoc-metadata-end-border - "\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" + "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" "Regular expression for matching yaml metadata end borders.") +(defsubst markdown-get-yaml-metadata-start-border () + "Return yaml metadata start border depending upon whether Pandoc is used." + (concat + (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") + markdown-regex-yaml-metadata-border)) + +(defsubst markdown-get-yaml-metadata-end-border (_) + "Return yaml metadata end border depending upon whether Pandoc is used." + (if markdown-use-pandoc-style-yaml-metadata + markdown-regex-yaml-pandoc-metadata-end-border + markdown-regex-yaml-metadata-border)) + ;;; Syntax ==================================================================== @@ -1418,6 +1441,15 @@ Function is called repeatedly until it returns nil. For details, see (unless (and (eq new-start start) (eq new-end end)) (cons new-start new-end))))) +(defun markdown-font-lock-extend-region-function (start end old-len) + "Used in `jit-lock-after-change-extend-region-functions'. Delegates to +`markdown-syntax-propertize-extend-region'. START and END are the previous +region to refontify, and OLD-LEN is the length of the region." + (let ((res (markdown-syntax-propertize-extend-region start end))) + (when res + (setq jit-lock-start (car res) + jit-lock-end (cdr res))))) + (defun markdown-syntax-propertize-pre-blocks (start end) "Match preformatted text blocks from START to END." (save-excursion @@ -1468,33 +1500,320 @@ Function is called repeatedly until it returns nil. For details, see ;; Recursively search again (markdown-syntax-propertize-pre-blocks (point) end))))) -(defun markdown-syntax-propertize-fenced-code-blocks (start end) - "Match tilde-fenced code text blocks from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward "^\\([~]\\{3,\\}\\)" end t) - (let ((beg (match-beginning 1))) - (when (re-search-forward - (concat "^" (match-string 1) "~*") end t) - (put-text-property beg (match-end 0) 'markdown-fenced-code - (list beg (point)))))))) - -(defun markdown-syntax-propertize-gfm-code-blocks (start end) - "Match GFM code blocks from START to END." +(defconst markdown-fenced-block-pairs + `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) + (markdown-make-tilde-fence-regex markdown-tilde-fence-end) + markdown-fenced-code) + ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) + (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) + markdown-yaml-metadata-section) + ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) + (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) + markdown-gfm-code)) + "Mapping of regular expressions to \"fenced-block\" constructs. These +constructs are distinguished by having a distinctive start and end pattern, both +of which take up an entire line of text, but no special pattern to identify text +within the fenced blocks (unlike blockquotes and indented-code sections). + +Each element within this list takes the form: + +((START-REGEX-OR-FUN START-PROPERTY) + (END-REGEX-OR-FUN END-PROPERTY) + MIDDLE-PROPERTY) + +Each *-REGEX-OR-FUN element can be a regular expression as a string, or a +function which evaluates to same. Functions for START-REGEX-OR-FUN accept no +arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument +which is the length of the first group of the START-REGEX-OR-FUN match, which +can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to +evaluate these into \"real\" regexps. + +The *-PROPERTY elements are the text properties applied to each part of the +block construct when it is matched using +`markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied +to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and +MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the +`match-data' when the regexp was matched to the text. In the case of +MIDDLE-PROPERTY, the value is a false match data of the form '(begin end), with +begin and end set to the edges of the \"middle\" text. This makes fontification +easier.") + +(defun markdown-text-property-at-point (prop) + (get-text-property (point) prop)) + +(defsubst markdown-maybe-funcall-regexp (object &optional arg) + (cond ((functionp object) + (if arg (funcall object arg) (funcall object))) + ((stringp object) object) + (t (error "object cannot be turned into regex")))) + +(defsubst markdown-get-start-fence-regexp () + "Returns regexp which finds all \"start\" sections of fenced block constructs. +Which construct is actually contained in the match must be found separately." + (mapconcat + 'identity + (cl-mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) + markdown-fenced-block-pairs) + "\\|")) + +(defun markdown-get-fenced-block-begin-properties () + (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) + +(defun markdown-get-fenced-block-end-properties () + (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) + +(defun markdown-get-fenced-block-middle-properties () + (cl-mapcar #'cl-third markdown-fenced-block-pairs)) + +(defun markdown-find-previous-prop (prop &optional lim) + "Find previous place where property PROP is non-nil, up to LIM. Return a cons +of (pos . property). pos is point if point contains non-nil PROP." + (let ((res + (if (get-text-property (point) prop) (point) + (previous-single-property-change + (point) prop nil (or lim (point-min)))))) + (when (and (not (get-text-property res prop)) + (> res 1) + (get-text-property (1- res) prop)) + (cl-decf res)) + (when (and res (get-text-property res prop)) (cons res prop)))) + +(defun markdown-find-next-prop (prop &optional lim) + "Find next place where property PROP is non-nil, up to LIM. Return a cons of +(pos . property). pos is point if point contains non-nil PROP." + (let ((res + (if (get-text-property (point) prop) (point) + (next-single-property-change + (point) prop nil (or lim (point-max)))))) + (when (and res (get-text-property res prop)) (cons res prop)))) + +(defun markdown-min-of-seq (map-fn seq) + "After applying MAP-FN to SEQ, return element of SEQ which had the minimum +value of MAP-FN." + (cl-loop for el in seq + with min = 1.0e+INF ; infinity + with min-el = nil + do (let ((res (funcall map-fn el))) + (when (< res min) + (setq min res) + (setq min-el el))) + finally return min-el)) + +(defun markdown-find-previous-block () + "Detect whether `markdown-syntax-propertize-fenced-block-constructs' was +unable to propertize the entire block, but was able to propertize the beginning +of the block. If so, return a cons of (pos . property) where the beginning of +the block was propertized." + (let ((start-pt (point)) + (closest-open + (markdown-min-of-seq + #'car + (cl-remove-if + #'null + (cl-mapcar + #'markdown-find-previous-prop + (markdown-get-fenced-block-begin-properties)))))) + (when closest-open + (let* ((length-of-open-match + (let ((match-d + (get-text-property (car closest-open) (cdr closest-open)))) + (- (cl-fourth match-d) (cl-third match-d)))) + (end-regexp + (markdown-maybe-funcall-regexp + (cl-caadr + (cl-find-if + (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) + markdown-fenced-block-pairs)) + length-of-open-match)) + (end-prop-loc + (save-excursion + (save-match-data + (goto-char (car closest-open)) + (and (re-search-forward end-regexp start-pt t) + (match-beginning 0)))))) + (and (not end-prop-loc) closest-open))))) + +(defun markdown-get-fenced-block-from-start (prop) + "Return limits of an enclosing fenced block from its start, using PROP. +Return value is a list usable as `match-data'." + (catch 'no-rest-of-block + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-cadar entry) prop)) + markdown-fenced-block-pairs)) + (begin-of-begin (cl-first (markdown-text-property-at-point prop))) + (middle-prop (cl-third correct-entry)) + (end-prop (cl-cadadr correct-entry)) + (end-of-end + (save-excursion + (goto-char (match-end 0)) ; end of begin + (unless (eobp) (forward-char)) + (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) + (if (not mid-prop-v) ; no middle + (progn + ;; try to find end by advancing one + (let ((end-prop-v + (markdown-text-property-at-point end-prop))) + (if end-prop-v (cl-second end-prop-v) + (throw 'no-rest-of-block nil)))) + (set-match-data mid-prop-v) + (goto-char (match-end 0)) ; end of middle + (beginning-of-line) ; into end + (cl-second (markdown-text-property-at-point end-prop))))))) + (list begin-of-begin end-of-end)))) + +(defun markdown-get-fenced-block-from-middle (prop) + "Return limits of an enclosing fenced block from its middle, using PROP. +Return value is a list usable as `match-data'." + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-third entry) prop)) + markdown-fenced-block-pairs)) + (begin-prop (cl-cadar correct-entry)) + (begin-of-begin + (save-excursion + (goto-char (match-beginning 0)) + (unless (bobp) (forward-line -1)) + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop)))) + (end-prop (cl-cadadr correct-entry)) + (end-of-end + (save-excursion + (goto-char (match-end 0)) + (beginning-of-line) + (cl-second (markdown-text-property-at-point end-prop))))) + (list begin-of-begin end-of-end))) + +(defun markdown-get-fenced-block-from-end (prop) + "Return limits of an enclosing fenced block from its end, using PROP. +Return value is a list usable as `match-data'." + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-cadadr entry) prop)) + markdown-fenced-block-pairs)) + (end-of-end (cl-second (markdown-text-property-at-point prop))) + (middle-prop (cl-third correct-entry)) + (begin-prop (cl-cadar correct-entry)) + (begin-of-begin + (save-excursion + (goto-char (match-beginning 0)) ; beginning of end + (unless (bobp) (backward-char)) ; into middle + (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) + (if (not mid-prop-v) + (progn + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop))) + (set-match-data mid-prop-v) + (goto-char (match-beginning 0)) ; beginning of middle + (unless (bobp) (forward-line -1)) ; into beginning + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop))))))) + (list begin-of-begin end-of-end))) + +(defun markdown-get-enclosing-fenced-block-construct (&optional pos) + "Get \"fake\" match data for block enclosing POS. Returns fake match data +which encloses the start, middle, and end of the block construct enclosing POS, +if it exists. Used in `markdown-code-block-at-pos'." (save-excursion - (goto-char start) - (while (re-search-forward markdown-regex-gfm-code-block-open end t) - (let ((open (list (match-beginning 1) (match-end 1))) - (lang (list (match-beginning 2) (match-end 2)))) - (forward-line) - (let ((body (point))) - (when (re-search-forward - markdown-regex-gfm-code-block-close end t) - (let ((close (list (match-beginning 1) (match-end 1))) - (all (list (car open) (match-end 1)))) - (setq body (list body (1- (match-beginning 0)))) - (put-text-property (car open) (match-end 1) 'markdown-gfm-code - (append all open lang body close))))))))) + (when pos (goto-char pos)) + (beginning-of-line) + (car + (cl-remove-if + #'null + (cl-mapcar + (lambda (fun-and-prop) + (cl-destructuring-bind (fun prop) fun-and-prop + (when prop + (save-match-data + (set-match-data (markdown-text-property-at-point prop)) + (funcall fun prop))))) + `((markdown-get-fenced-block-from-start + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-begin-properties))) + (markdown-get-fenced-block-from-middle + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-middle-properties))) + (markdown-get-fenced-block-from-end + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-end-properties))))))))) + +(defun markdown-propertize-end-match (reg end correct-entry enclosed-text-start) + "Get match for REG up to END, if exists, and propertize appropriately. +CORRECT-ENTRY is an entry in `markdown-fenced-block-pairs' and +ENCLOSED-TEXT-START is the start of the \"middle\" section of the block." + (when (re-search-forward reg end t) + (put-text-property (match-beginning 0) (match-end 0) + (cl-cadadr correct-entry) (match-data t)) + (put-text-property + enclosed-text-start (match-beginning 0) (cl-third correct-entry) + (list enclosed-text-start (match-beginning 0))))) + +(defun markdown-syntax-propertize-fenced-block-constructs (start end) + "Propertize according to `markdown-fenced-block-pairs' from START to END. +If unable to propertize an entire block (if the start of a block is within START +and END, but the end of the block is not), propertize the start section of a +block, then in a subsequent call propertize both middle and end by finding the +start which was previously propertized." + (let ((start-reg (markdown-get-start-fence-regexp))) + (save-excursion + (goto-char start) + ;; start from previous unclosed block, if exists + (let ((prev-begin-block (markdown-find-previous-block))) + (when prev-begin-block + (let* ((correct-entry + (cl-find-if (lambda (entry) + (eq (cdr prev-begin-block) (cl-cadar entry))) + markdown-fenced-block-pairs)) + (enclosed-text-start (1+ (car prev-begin-block))) + (start-length + (save-excursion + (goto-char (car prev-begin-block)) + (string-match + (markdown-maybe-funcall-regexp + (caar correct-entry)) + (buffer-substring + (point-at-bol) (point-at-eol))) + (- (match-end 1) (match-beginning 1)))) + (end-reg (markdown-maybe-funcall-regexp + (cl-caadr correct-entry) start-length))) + (markdown-propertize-end-match + end-reg end correct-entry enclosed-text-start)))) + ;; find all new blocks within region + (while (re-search-forward start-reg end t) + ;; we assume the opening constructs take up (only) an entire line, + ;; so we re-check the current line + (let* ((cur-line (buffer-substring (point-at-bol) (point-at-eol))) + ;; find entry in `markdown-fenced-block-pairs' corresponding + ;; to regex which was matched + (correct-entry + (cl-find-if + (lambda (fenced-pair) + (string-match-p + (markdown-maybe-funcall-regexp (caar fenced-pair)) + cur-line)) + markdown-fenced-block-pairs)) + (enclosed-text-start + (save-excursion (1+ (point-at-eol)))) + (end-reg + (markdown-maybe-funcall-regexp + (cl-caadr correct-entry) + (if (and (match-beginning 1) (match-end 1)) + (- (match-end 1) (match-beginning 1)) + 0)))) + ;; get correct match data + (save-excursion + (beginning-of-line) + (re-search-forward + (markdown-maybe-funcall-regexp (caar correct-entry)) + (point-at-eol))) + ;; mark starting, even if ending is outside of region + (put-text-property (match-beginning 0) (match-end 0) + (cl-cadar correct-entry) (match-data t)) + (markdown-propertize-end-match + end-reg end correct-entry enclosed-text-start)))))) (defun markdown-syntax-propertize-blockquotes (start end) "Match blockquotes from START to END." @@ -1506,16 +1825,20 @@ Function is called repeatedly until it returns nil. For details, see 'markdown-blockquote (match-data t))))) - (defun markdown-syntax-propertize-yaml-metadata (start end) +(defun markdown-syntax-propertize-yaml-metadata (start end) (save-excursion (goto-char start) - (while (markdown-match-yaml-metadata end) - (put-text-property (match-beginning 1) (match-end 1) - 'markdown-metadata-key (match-data t)) - (put-text-property (match-beginning 2) (match-end 2) - 'markdown-metadata-markup (match-data t)) - (put-text-property (match-beginning 3) (match-end 3) - 'markdown-metadata-value (match-data t))))) + (cl-loop + with skip = nil + while (re-search-forward markdown-regex-multimarkdown-metadata end t) + do (when (get-text-property (match-beginning 0) + 'markdown-yaml-metadata-section) + (put-text-property (match-beginning 1) (match-end 1) + 'markdown-metadata-key (match-data t)) + (put-text-property (match-beginning 2) (match-end 2) + 'markdown-metadata-markup (match-data t)) + (put-text-property (match-beginning 3) (match-end 3) + 'markdown-metadata-value (match-data t)))))) (defun markdown-syntax-propertize-headings-generic (symbol regex start end) "Match headings of type SYMBOL with REGEX from START to END." @@ -1554,8 +1877,15 @@ Function is called repeatedly until it returns nil. For details, see (defun markdown-syntax-propertize (start end) "See `syntax-propertize-function'." - (remove-text-properties start end '(markdown-gfm-code)) + (remove-text-properties start end '(markdown-tilde-fence-begin)) + (remove-text-properties start end '(markdown-tilde-fence-end)) (remove-text-properties start end '(markdown-fenced-code)) + (remove-text-properties start end '(markdown-yaml-metadata-begin)) + (remove-text-properties start end '(markdown-yaml-metadata-end)) + (remove-text-properties start end '(markdown-yaml-metadata-section)) + (remove-text-properties start end '(markdown-gfm-block-begin)) + (remove-text-properties start end '(markdown-gfm-block-end)) + (remove-text-properties start end '(markdown-gfm-code)) (remove-text-properties start end '(markdown-pre)) (remove-text-properties start end '(markdown-blockquote)) (remove-text-properties start end '(markdown-heading)) @@ -1570,11 +1900,10 @@ Function is called repeatedly until it returns nil. For details, see (remove-text-properties start end '(markdown-metadata-key)) (remove-text-properties start end '(markdown-metadata-value)) (remove-text-properties start end '(markdown-metadata-markup)) - (markdown-syntax-propertize-gfm-code-blocks start end) - (markdown-syntax-propertize-fenced-code-blocks start end) + (markdown-syntax-propertize-fenced-block-constructs start end) + (markdown-syntax-propertize-yaml-metadata start end) (markdown-syntax-propertize-pre-blocks start end) (markdown-syntax-propertize-blockquotes start end) - (markdown-syntax-propertize-yaml-metadata start end) (markdown-syntax-propertize-headings-generic 'markdown-heading-1-setext markdown-regex-header-1-setext start end) (markdown-syntax-propertize-headings-generic @@ -1861,16 +2190,21 @@ See `font-lock-syntactic-face-function' for details." (defvar markdown-mode-font-lock-keywords-basic (list - (cons 'markdown-match-yaml-metadata-border + (cons 'markdown-match-yaml-metadata-begin '((1 markdown-markup-face))) + (cons 'markdown-match-yaml-metadata-end '((1 markdown-markup-face))) + (cons 'markdown-match-yaml-metadata-key '((1 markdown-metadata-key-face) + (2 markdown-markup-face) + (3 markdown-metadata-value-face))) + (cons 'markdown-match-gfm-open-code-blocks '((1 markdown-markup-face) - (2 markdown-markup-face))) - (cons 'markdown-match-yaml-metadata '((1 markdown-metadata-key-face) - (2 markdown-markup-face) - (3 markdown-metadata-value-face))) - (cons 'markdown-match-gfm-code-blocks '((1 markdown-markup-face) - (2 markdown-language-keyword-face nil t) - (3 markdown-pre-face) - (4 markdown-markup-face))) + (2 markdown-language-keyword-face nil t))) + (cons 'markdown-match-gfm-close-code-blocks + '((1 markdown-markup-face))) + (cons 'markdown-match-gfm-code-blocks '((0 markdown-pre-face))) + (cons 'markdown-match-fenced-start-code-block + '((1 markdown-pre-face) + (2 markdown-language-keyword-face nil t))) + (cons 'markdown-match-fenced-end-code-block '((0 markdown-pre-face))) (cons 'markdown-match-fenced-code-blocks '((0 markdown-pre-face))) (cons 'markdown-match-pre-blocks '((0 markdown-pre-face))) (cons 'markdown-match-blockquotes '((1 markdown-markup-face) @@ -1985,7 +2319,7 @@ extension support.") (defconst markdown-footnote-chars "[[:alnum:]-]" - "Regular expression maching any character that is allowed in a footnote identifier.") + "Regular expression matching any character that is allowed in a footnote identifier.") (defconst markdown-regex-footnote-definition (concat "^\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") @@ -2331,7 +2665,7 @@ If the point is not in a list item, do nothing." ;; Don't skip over whitespace for empty list items (marker and ;; whitespace only), just move to end of whitespace. (if (looking-back (concat markdown-regex-list "\\s-*") nil) - (goto-char (match-end 3)) + (goto-char (match-end 3)) (skip-syntax-backward "-")))) (defun markdown-cur-list-item-bounds () @@ -2434,8 +2768,7 @@ Group 3 matches the closing backticks." This includes pre blocks, tilde-fenced code blocks, and GFM quoted code blocks. Return nil otherwise." (or (get-text-property pos 'markdown-pre) - (get-text-property pos 'markdown-gfm-code) - (get-text-property pos 'markdown-fenced-code) + (markdown-get-enclosing-fenced-block-construct pos) ;; polymode removes text properties set by markdown-mode, so ;; check if `poly-markdown-mode' is active and whether the ;; `chunkmode' property is non-nil at POS. @@ -2463,10 +2796,19 @@ Return nil otherwise." ;; props is a list, check for membership (dolist (val values) (when (memq val props) (throw 'found loc)))) - (t - ;; props is a scalar, check for equality - (dolist (val values) - (when (eq val props) (throw 'found loc)))))))))) + (t + ;; props is a scalar, check for equality + (dolist (val values) + (when (eq val props) (throw 'found loc)))))))))) + +(defun markdown-range-properties-exist (begin end props) + (cl-loop + for loc in (number-sequence begin end) + with result = nil + while (not + (setq result + (cl-some (lambda (prop) (get-char-property loc prop)) props))) + finally return result)) (defun markdown-match-inline-generic (regex last) "Match inline REGEX from the point to LAST." @@ -2522,13 +2864,15 @@ Return nil otherwise." (defun markdown-match-math-generic (regex last) "Match quoted $..$ or $$..$$ math from point to LAST." - (when (and markdown-enable-math - (markdown-match-inline-generic regex last)) + (when (and markdown-enable-math (markdown-match-inline-generic regex last)) (let ((begin (match-beginning 1)) (end (match-end 1))) (prog1 - (if (markdown-range-property-any - begin end 'face (list markdown-inline-code-face - markdown-bold-face)) + (if (or (markdown-range-property-any + begin end 'face (list markdown-inline-code-face + markdown-bold-face)) + (markdown-range-properties-exist + begin end + (markdown-get-fenced-block-middle-properties))) (markdown-match-math-generic regex last) t) (goto-char (1+ (match-end 0))))))) @@ -2565,10 +2909,22 @@ Use data stored in 'markdown-gfm-code text property during syntax analysis." (markdown-match-propertized-text 'markdown-gfm-code last)) +(defun markdown-match-gfm-open-code-blocks (last) + (markdown-match-propertized-text 'markdown-gfm-block-begin last)) + +(defun markdown-match-gfm-close-code-blocks (last) + (markdown-match-propertized-text 'markdown-gfm-block-end last)) + (defun markdown-match-fenced-code-blocks (last) "Match fenced code blocks from the point to LAST." (markdown-match-propertized-text 'markdown-fenced-code last)) +(defun markdown-match-fenced-start-code-block (last) + (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) + +(defun markdown-match-fenced-end-code-block (last) + (markdown-match-propertized-text 'markdown-tilde-fence-end last)) + (defun markdown-match-blockquotes (last) "Match blockquotes from point to LAST. Use data stored in 'markdown-blockquote text property during syntax @@ -2687,7 +3043,7 @@ into a variable to allow for dynamic let-binding.") key-beginning key-end ; key markup-begin markup-end ; markup value-beginning (point))) ; value - t)) + t)) (t nil)))) (defun markdown-match-multimarkdown-metadata (last) @@ -2698,49 +3054,15 @@ into a variable to allow for dynamic let-binding.") "Match Pandoc metadata from the point to LAST." (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) -(defun markdown-match-yaml-metadata (last) - "Match yaml metadata from the point to LAST." - (markdown-match-generic-metadata - markdown-regex-multimarkdown-metadata last - (concat - (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") - markdown-regex-yaml-metadata-border) - (concat - "^" - (if markdown-use-pandoc-style-yaml-metadata - markdown-regex-yaml-pandoc-metadata-end-border - markdown-regex-yaml-metadata-border)))) - -(defun markdown-match-yaml-metadata-border (last) - (let ((res - (cl-first - (markdown-get-match-boundaries - (concat - (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") - markdown-regex-yaml-metadata-border) - (concat - "^" - (if markdown-use-pandoc-style-yaml-metadata - markdown-regex-yaml-pandoc-metadata-end-border - markdown-regex-yaml-metadata-border)) - last (point))))) - (when res - (cl-destructuring-bind (start-header end-header) res - (set-match-data - (list (cl-third start-header) (cl-fourth end-header) - (cl-third start-header) (cl-fourth start-header) - (cl-third end-header) (cl-fourth end-header))) - t)))) +(defun markdown-match-yaml-metadata-begin (last) + (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) + +(defun markdown-match-yaml-metadata-end (last) + (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) (defun markdown-match-yaml-metadata-key (last) (markdown-match-propertized-text 'markdown-metadata-key last)) -(defun markdown-match-yaml-metadata-markup (last) - (markdown-match-propertized-text 'markdown-metadata-markup last)) - -(defun markdown-match-yaml-metadata-value (last) - (markdown-match-propertized-text 'markdown-metadata-value last)) - ;;; Syntax Table ============================================================== @@ -3517,12 +3839,22 @@ automatically in order to have the correct markup." (with-current-buffer (or buffer (current-buffer)) (save-excursion (goto-char (point-min)) - (while (re-search-forward markdown-regex-gfm-code-block-open nil t) - (let ((lang (match-string-no-properties 2))) - (when lang (markdown-add-language-if-new lang))))))) + (cl-loop + with prop = 'markdown-gfm-block-begin + for pos-prop = (markdown-find-next-prop prop) + while pos-prop + for lang = (progn + (goto-char (car pos-prop)) + (save-match-data + (set-match-data (get-text-property (point) prop)) + (when (and (match-beginning 2) (match-end 2)) + (buffer-substring-no-properties + (match-beginning 2) (match-end 2))))) + do (progn (when lang (markdown-add-language-if-new lang)) + (goto-char (next-single-property-change (point) prop))))))) -;;; Footnotes ====================================================================== +;;; Footnotes ================================================================== (defun markdown-footnote-counter-inc () "Increment `markdown-footnote-counter' and return the new value." @@ -3570,10 +3902,10 @@ footnote marker or in the footnote text." ;; to the marker if possible. (let ((marker-pos (markdown-footnote-find-marker (cl-first starting-footnote-text-positions)))) - (if marker-pos - (goto-char (1- marker-pos)) - ;; If there isn't a marker, we still want to kill the text. - (setq skip-deleting-marker t)))) + (if marker-pos + (goto-char (1- marker-pos)) + ;; If there isn't a marker, we still want to kill the text. + (setq skip-deleting-marker t)))) ;; Either we didn't start in the text, or we started in the text and jumped ;; to the marker. We want to assume we're at the marker now and error if ;; we're not. @@ -6073,6 +6405,8 @@ before regenerating font-lock rules for extensions." ;; Syntax (add-hook 'syntax-propertize-extend-region-functions 'markdown-syntax-propertize-extend-region) + (add-hook 'jit-lock-after-change-extend-region-functions + 'markdown-font-lock-extend-region-function t t) (set (make-local-variable 'syntax-propertize-function) 'markdown-syntax-propertize) ;; Font lock. diff --git a/tests/markdown-test.el b/tests/markdown-test.el index 76f3fc19..5dd53d8e 100644 --- a/tests/markdown-test.el +++ b/tests/markdown-test.el @@ -2132,7 +2132,8 @@ if (y) ~~~ " (markdown-test-range-has-face 1 19 nil) - (markdown-test-range-has-face 20 63 markdown-pre-face))) + (markdown-test-range-has-face 20 22 markdown-pre-face) + (markdown-test-range-has-face 24 63 markdown-pre-face))) (ert-deftest test-markdown-font-lock/gfm-fenced-1 () "Test GFM-style fenced code blocks (1)." @@ -2317,7 +2318,6 @@ date: 2015-08-13 11:35:25 EST (ert-deftest test-markdown-font-lock/pandoc-yaml-metadata () "Basic yaml metadata tests, with pandoc syntax." - :expected-result :failed (let ((markdown-use-pandoc-style-yaml-metadata t)) (markdown-test-string "some text @@ -2459,6 +2459,15 @@ returns nil." (should (equal (markdown-syntax-propertize-extend-region 486 510) nil)))) +(defun markdown-test-check-match-limits (prop num begin end &optional pos) + (let* ((posn (or pos (point))) + (props (get-text-property posn prop))) + (save-match-data + (set-match-data props) + (and (match-beginning num) (match-end num) + (= (match-beginning num) begin) + (= (match-end num) end))))) + (ert-deftest test-markdown-parsing/syntax-with-adjacent-code-blocks () "Test `markdown-syntax-propertize-fenced-code-blocks' with adjacent blocks." (markdown-test-string @@ -2474,46 +2483,251 @@ echo \"Hello, world!\" echo \"Hello, world v2!\" ~~~ " - (let ((start-1 (make-marker)) (end-1 (make-marker)) + (let ((start-top-1 (make-marker)) (end-top-1 (make-marker)) + (start-lang-1 (make-marker)) (end-lang-1 (make-marker)) + (start-mid-1 (make-marker)) (end-mid-1 (make-marker)) + (start-bottom-1 (make-marker)) (end-bottom-1 (make-marker)) (between (make-marker)) - (start-2 (make-marker)) (end-2 (make-marker))) + (start-top-2 (make-marker)) (end-top-2 (make-marker)) + (start-lang-2 (make-marker)) (end-lang-2 (make-marker)) + (start-mid-2 (make-marker)) (end-mid-2 (make-marker)) + (start-bottom-2 (make-marker)) (end-bottom-2 (make-marker))) ;; First code block - (set-marker start-1 1) - (set-marker end-1 46) - (should (equal (get-text-property start-1 'markdown-fenced-code) - (list (marker-position start-1) (marker-position end-1)))) - (should (equal (get-text-property (1- end-1) 'markdown-fenced-code) - (list (marker-position start-1) (marker-position end-1)))) + (set-marker start-top-1 1) + (set-marker end-top-1 4) + (set-marker start-lang-1 5) + (set-marker end-lang-1 10) + (set-marker start-mid-1 11) + (set-marker end-mid-1 43) + (set-marker start-bottom-1 43) + (set-marker end-bottom-1 46) + ;; check top tildes + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 1 (marker-position start-top-1) + (marker-position end-top-1) (marker-position start-top-1))) + ;; check top language specifier + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 2 (marker-position start-lang-1) + (marker-position end-lang-1) (marker-position start-lang-1))) + ;; check text in between + (should (markdown-test-check-match-limits + 'markdown-fenced-code 0 (marker-position start-mid-1) + (marker-position end-mid-1) (marker-position start-mid-1))) + ;; check bottom tildes + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-end 1 (marker-position start-bottom-1) + (marker-position end-bottom-1) (marker-position start-bottom-1))) ;; Point between code blocks (set-marker between 47) (should (equal (get-text-property between 'markdown-fenced-code) nil)) ;; Second code block - (set-marker start-2 48) - (set-marker end-2 96) - (should (equal (get-text-property start-2 'markdown-fenced-code) - (list (marker-position start-2) (marker-position end-2)))) - (should (equal (get-text-property (1- end-2) 'markdown-fenced-code) - (list (marker-position start-2) (marker-position end-2)))) - ;; Move point between code blocks and insert a character + (set-marker start-top-2 48) + (set-marker end-top-2 51) + (set-marker start-lang-2 52) + (set-marker end-lang-2 57) + (set-marker start-mid-2 58) + (set-marker end-mid-2 93) + (set-marker start-bottom-2 93) + (set-marker end-bottom-2 96) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 1 (marker-position start-top-2) + (marker-position end-top-2) (marker-position start-top-2))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 2 (marker-position start-lang-2) + (marker-position end-lang-2) (marker-position start-lang-2))) + (should (markdown-test-check-match-limits + 'markdown-fenced-code 0 (marker-position start-mid-2) + (marker-position end-mid-2) (marker-position start-mid-2))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-end 1 (marker-position start-bottom-2) + (marker-position end-bottom-2) (marker-position start-bottom-2))) + ;; ;; Move point between code blocks and insert a character (goto-char between) (insert "x") ;; Re-propertize region after change (let ((range (markdown-syntax-propertize-extend-region (1- between) (point-max)))) (markdown-syntax-propertize (car range) (cdr range))) ;; Re-check first code block - (should (equal (get-text-property start-1 'markdown-fenced-code) - (list (marker-position start-1) (marker-position end-1)))) - (should (equal (get-text-property (1- end-1) 'markdown-fenced-code) - (list (marker-position start-1) (marker-position end-1)))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 1 (marker-position start-top-1) + (marker-position end-top-1) (marker-position start-top-1))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 2 (marker-position start-lang-1) + (marker-position end-lang-1) (marker-position start-lang-1))) + (should (markdown-test-check-match-limits + 'markdown-fenced-code 0 (marker-position start-mid-1) + (marker-position end-mid-1) (marker-position start-mid-1))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-end 1 (marker-position start-bottom-1) + (marker-position end-bottom-1) (marker-position start-bottom-1))) ;; Re-check point between code blocks (should (equal (get-text-property between 'markdown-fenced-code) nil)) - ;; Re-check first code block - (should (equal (get-text-property start-1 'markdown-fenced-code) - (list (marker-position start-1) (marker-position end-1)))) - (should (equal (get-text-property (1- end-1) 'markdown-fenced-code) - (list (marker-position start-1) (marker-position end-1))))))) + ;; Re-check second code block + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 1 (marker-position start-top-2) + (marker-position end-top-2) (marker-position start-top-2))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 2 (marker-position start-lang-2) + (marker-position end-lang-2) (marker-position start-lang-2))) + (should (markdown-test-check-match-limits + 'markdown-fenced-code 0 (marker-position start-mid-2) + (marker-position end-mid-2) (marker-position start-mid-2))) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-end 1 (marker-position start-bottom-2) + (marker-position end-bottom-2) + (marker-position start-bottom-2)))))) + +(ert-deftest test-markdown-parsing/propertize-fenced-in-between () + "Test whether `markdown-syntax-propertize-fenced-block-constructs' handles the +case when it can't propertize both the start and end of a fenced block within a +single pass (the end of the block is past the END argument)." + (markdown-test-string + "~~~ shell +#!/bin/sh + +echo \"Hello, world!\" +~~~ +" + (set-text-properties (point-min) (point-max) nil) + ;; syntax-propertize up to right after hashbang + (markdown-syntax-propertize-fenced-block-constructs (point-min) 21) + ;; ~~~ shell should be propertized, but nothing else + ;; check tildes + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 1 1 4 1)) + ;; check language + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 2 5 10 5)) + ;; middle should not be propertized + (should-not (get-text-property 11 'markdown-fenced-code)) + ;; neither should end + (should-not (get-text-property 43 'markdown-tilde-fence-end)) + (markdown-syntax-propertize-fenced-block-constructs 21 (point-max)) + ;; everything should be propertized now + ;; re-check top + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 1 1 4 1)) + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-begin 2 5 10 5)) + ;; check middle + (should (markdown-test-check-match-limits 'markdown-fenced-code 0 10 43 10)) + ;; check ending tildes + (should (markdown-test-check-match-limits + 'markdown-tilde-fence-end 1 43 46 43)))) + +(ert-deftest test-markdown-parsing/get-code-block-at-pos () + "Test whether `markdown-code-block-at-pos' works in all situations. All + situations are: +1. pre block +2. tilde block +3. gfm block +4. yaml metadata block" + (let ((markdown-use-pandoc-style-yaml-metadata t)) + (markdown-test-string + " +~~~ ruby +some_ruby_fun() +~~~ + +--- +a: b +--- + +``` {.bash} +#!/bin/sh +echo hey +``` + + pre code + random stuff + more preformatted code + +--- +data: pandoc +... +" + ;; start/mid/end at tilde block + (should (equal (markdown-code-block-at-pos 2) (list 2 30))) + (should (equal (markdown-code-block-at-pos 11) (list 2 30))) + (should (equal (markdown-code-block-at-pos 27) (list 2 30))) + ;; yaml metadata block + (should (equal (markdown-code-block-at-pos 32) (list 32 44))) + (should (equal (markdown-code-block-at-pos 36) (list 32 44))) + (should (equal (markdown-code-block-at-pos 41) (list 32 44))) + ;; gfm block + (should (equal (markdown-code-block-at-pos 46) (list 46 80))) + (should (equal (markdown-code-block-at-pos 58) (list 46 80))) + (should (equal (markdown-code-block-at-pos 77) (list 46 80))) + ;; pre block + (should (equal (markdown-code-block-at-pos 82) (list 82 138))) + (should (equal (markdown-code-block-at-pos 99) (list 82 138))) + (should (equal (markdown-code-block-at-pos 137) (list 82 138))) + ;; pandoc yaml metadata block (should work if yaml above works) + (should (equal (markdown-code-block-at-pos 140) (list 140 160))) + (should (equal (markdown-code-block-at-pos 142) (list 140 160))) + (should (equal (markdown-code-block-at-pos 144) (list 140 160))) + (should (equal (markdown-code-block-at-pos 157) (list 140 160))) + (should (equal (markdown-code-block-at-pos 159) (list 140 160)))))) + +(ert-deftest test-markdown-parsing/syntax-get-fenced-blocks () + "Test whether *-get-fenced-block-* functions work in the case where a block is +only partially propertized." + (save-match-data + (markdown-test-string + "~~~ +" + (should (equal (markdown-syntax-propertize-extend-region + (point-min) (point-max)) + nil)) + (goto-char 1) + (set-match-data (markdown-text-property-at-point + 'markdown-tilde-fence-begin)) + (should (equal (markdown-get-fenced-block-from-start + 'markdown-tilde-fence-begin) + nil))) + (markdown-test-string + "~~~ +~~~" + (goto-char 1) + (set-match-data (markdown-text-property-at-point + 'markdown-tilde-fence-begin)) + (should (equal (markdown-get-fenced-block-from-start + 'markdown-tilde-fence-begin) + (list 1 8))) + (should (equal (markdown-code-block-at-point) (list 1 8))) + (goto-char 5) + (set-match-data (markdown-text-property-at-point + 'markdown-tilde-fence-end)) + (should (equal (markdown-get-fenced-block-from-end + 'markdown-tilde-fence-end) + (list 1 8))) + (should (equal (markdown-code-block-at-point) (list 1 8)))) + (markdown-test-string + "~~~ + +~~~" + (goto-char 1) + (set-match-data (markdown-text-property-at-point + 'markdown-tilde-fence-begin)) + (should (equal (markdown-get-fenced-block-from-start + 'markdown-tilde-fence-begin) + (list 1 9))) + (should (equal (markdown-code-block-at-point) (list 1 9))) + (goto-char 5) + (set-match-data (markdown-text-property-at-point 'markdown-fenced-code)) + (should (equal (markdown-get-fenced-block-from-middle + 'markdown-fenced-code) + (list 1 9))) + (should (equal (markdown-code-block-at-point) (list 1 9))) + (goto-char 6) + (set-match-data (markdown-text-property-at-point + 'markdown-tilde-fence-end)) + (should (equal (markdown-get-fenced-block-from-end + 'markdown-tilde-fence-end) + (list 1 9))) + (should (equal (markdown-code-block-at-point) (list 1 9)))))) (ert-deftest test-markdown-parsing/reference-definition-basic () "Test reference definition function." @@ -3359,7 +3573,9 @@ Detail: https://github.com/jrblevin/markdown-mode/issues/79" (markdown-test-range-has-face 119 152 markdown-header-face-1) (markdown-test-range-has-face 129 129 markdown-markup-face) (markdown-test-range-has-face 136 136 markdown-markup-face) - (markdown-test-range-has-face 174 214 markdown-pre-face) + (markdown-test-range-has-face 174 177 markdown-pre-face) + (markdown-test-range-has-face 179 188 markdown-language-keyword-face) + (markdown-test-range-has-face 190 215 markdown-pre-face) (markdown-test-range-has-face 218 218 markdown-markup-face) (markdown-test-range-has-face 219 223 markdown-math-face) (markdown-test-range-has-face 224 224 markdown-markup-face)))