Native fontification of code blocks

Adds a new custom variable `markdown-fontify-code-blocks-natively`,
which determines whether `markdown-mode` should attempt to fontify
fenced code blocks (currently GFM-only) using the corresponding
native major modes.

CHANGES.md

@@ -13,6 +13,13 @@
 
 *   New features:
 
+    -   Native code block font-lock: Add a custom variable
+        `markdown-fontify-code-blocks-natively`, which determines
+        whether to fontify code in code blocks using the native major
+        mode.  This only works for fenced code blocks where the
+        language is specified where we can automatically determine the
+        appropriate mode to use.  The language to mode mapping may be
+        customized by setting the variable `markdown-code-lang-modes`.
     -   Add "page" movement, marking, and narrowing commands, where a
         "page" in Markdown is defined to be a top-level subtree:
         `markdown-forward-page` (<kbd>C-x ]</kbd>),

README.md

@@ -684,6 +684,13 @@ provides an interface to all of the possible customizations:
     `markdown-url-compose-char`.  Hidden URLs can be toggled using
     <kbd>C-c C-x C-l</kbd> (`markdown-toggle-hidden-urls`).
 
+  * `markdown-fontify-code-blocks-natively` - Whether to fontify
+     code in code blocks using the native major mode.  This only
+     works for fenced code blocks where the language is specified
+     where we can automatically determine the appropriate mode to
+     use.  The language to mode mapping may be customized by setting
+     the variable `markdown-code-lang-modes`.
+
 Additionally, the faces used for syntax highlighting can be modified to
 your liking by issuing <kbd>M-x customize-group RET markdown-faces</kbd>
 or by using the "Markdown Faces" link at the bottom of the mode

markdown-mode.el

@@ -702,6 +702,13 @@
 ;;     `markdown-url-compose-char'.  Hidden URLs can be toggled using
 ;;     `C-c C-x C-l` (`markdown-toggle-hidden-urls').
 ;;
+;;   * `markdown-fontify-code-blocks-natively' - Whether to fontify
+;;      code in code blocks using the native major mode.  This only
+;;      works for fenced code blocks where the language is specified
+;;      where we can automatically determine the appropriate mode to
+;;      use.  The language to mode mapping may be customized by setting
+;;      the variable `markdown-code-lang-modes'.
+;;
 ;; Additionally, the faces used for syntax highlighting can be modified to
 ;; your liking by issuing `M-x customize-group RET markdown-faces`
 ;; or by using the "Markdown Faces" link at the bottom of the mode
@@ -2218,8 +2225,13 @@ START and END delimit region to propertize."
   "Face for blockquote sections."
   :group 'markdown-faces)
 
+(defface markdown-code-block-face
+  `((t (:inherit default)))
+  "Face for fenced code blocks."
+  :group 'markdown-faces)
+
 (defface markdown-pre-face
-  '((t (:inherit font-lock-constant-face)))
+  '((t (:inherit (markdown-code-block-face font-lock-constant-face))))
   "Face for preformatted text."
   :group 'markdown-faces)
 
@@ -2382,7 +2394,7 @@ See `font-lock-syntactic-face-function' for details."
                                             (4 markdown-language-info-face nil t)
                                             (5 markdown-markup-face nil t)))
     (markdown-match-gfm-close-code-blocks . ((1 markdown-markup-face)))
-    (markdown-match-gfm-code-blocks . ((0 markdown-pre-face)))
+    (markdown-fontify-gfm-code-blocks)
     (markdown-match-fenced-start-code-block . ((1 markdown-markup-face)
                                                (2 markdown-markup-face nil t)
                                                (3 markdown-language-keyword-face nil t)
@@ -2581,6 +2593,15 @@ Used for `flyspell-generic-check-word-predicate'."
                    (memq 'markdown-url-face faces)
                  (eq faces 'markdown-url-face)))))))
 
+(defun markdown-font-lock-ensure ()
+  "Provide `font-lock-ensure' in Emacs 24."
+  (if (fboundp 'font-lock-ensure)
+      (font-lock-ensure)
+    (with-no-warnings
+      ;; Suppress warning about non-interactive use of
+      ;; `font-lock-fontify-buffer' in Emacs 25.
+      (font-lock-fontify-buffer))))
+
 
 ;;; Markdown Parsing Functions ================================================
 
@@ -7501,6 +7522,105 @@ the mode if ARG is omitted or nil."
     (message "markdown-mode inline images disabled")
     (markdown-remove-inline-images)))
 
+
+;;; GFM Code Block Fontification ==============================================
+
+(defcustom markdown-fontify-code-blocks-natively nil
+  "When non-nil, fontify code in code blocks using the native major mode.
+This only works for fenced code blocks where the language is
+specified where we can automatically determine the appropriate
+mode to use.  The language to mode mapping may be customized by
+setting the variable `markdown-code-lang-modes'."
+  :group 'markdown
+  :type 'boolean)
+
+;; This is based on `org-code-lang-modes' from org-src.el
+(defcustom markdown-code-lang-modes
+  '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode)
+    ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode)
+    ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode)
+    ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode)
+    ("bash" . sh-mode))
+  "Alist mapping languages to their major mode.
+The key is the language name, the value is the major mode.  For
+many languages this is simple, but for language where this is not
+the case, this variable provides a way to simplify things on the
+user side.  For example, there is no ocaml-mode in Emacs, but the
+mode to use is `tuareg-mode'."
+  :group 'markdown
+  :type '(repeat
+          (cons
+           (string "Language name")
+           (symbol "Major mode"))))
+
+(defun markdown-get-lang-mode (lang)
+  "Return major mode that should be used for LANG.
+LANG is a string, and the returned major mode is a symbol."
+  (cl-find-if
+   'fboundp
+   (list (cdr (assoc lang markdown-code-lang-modes))
+         (cdr (assoc (downcase lang) markdown-code-lang-modes))
+         (intern (concat lang "-mode"))
+         (intern (concat (downcase lang) "-mode")))))
+
+(defun markdown-fontify-gfm-code-blocks (last)
+  "Add text properties to next GFM code block from point to LAST."
+  (when (markdown-match-gfm-code-blocks last)
+    (save-excursion
+      (save-match-data
+        (let* ((start (match-beginning 0))
+               (end (match-end 0))
+               (bol-prev (progn (goto-char start)
+                                (if (bolp) (point-at-bol 0) start)))
+               (eol-next (progn (goto-char end)
+                                (if (eolp) end (point-at-bol 2))))
+               lang)
+          (if (and markdown-fontify-code-blocks-natively
+                   (setq lang (markdown-code-block-lang)))
+              (markdown-fontify-gfm-code-block lang start end)
+            (add-face-text-property start end 'markdown-pre-face 'append))
+          ;; Set background for block as well as opening and closing lines.
+          (add-face-text-property
+           bol-prev eol-next 'markdown-code-block-face 'append))))
+    t))
+
+;; Based on `org-src-font-lock-fontify-block' from org-src.el.
+(defun markdown-fontify-gfm-code-block (lang start end)
+  "Fontify given code block.
+This function is called by Emacs for automatic fontification when
+`markdown-fontify-code-blocks-natively' is non-nil.  LANG is the
+language used in the block. START and END specify the block
+position."
+  (let ((lang-mode (markdown-get-lang-mode lang)))
+    (when (fboundp lang-mode)
+      (let ((string (buffer-substring-no-properties start end))
+            (modified (buffer-modified-p))
+            (markdown-buffer (current-buffer)) pos next)
+        (remove-text-properties start end '(face nil))
+        (with-current-buffer
+            (get-buffer-create
+             (concat " markdown-code-fontification:" (symbol-name lang-mode)))
+          ;; Make sure that modification hooks are not inhibited in
+          ;; the org-src-fontification buffer in case we're called
+          ;; from `jit-lock-function' (Bug#25132).
+          (let ((inhibit-modification-hooks nil))
+            (delete-region (point-min) (point-max))
+            (insert string " ")) ;; so there's a final property change
+          (unless (eq major-mode lang-mode) (funcall lang-mode))
+          (markdown-font-lock-ensure)
+          (setq pos (point-min))
+          (while (setq next (next-single-property-change pos 'face))
+            (let ((val (get-text-property pos 'face)))
+              (when val
+                (put-text-property
+                 (+ start (1- pos)) (1- (+ start next)) 'face
+                 val markdown-buffer)))
+            (setq pos next)))
+        (add-text-properties
+         start end
+         '(font-lock-fontified t fontified t font-lock-multiline t))
+        (set-buffer-modified-p modified)))))
+
 
 ;;; Mode Definition  ==========================================================
 

tests/markdown-test.el

@@ -2307,15 +2307,19 @@ if (y)
 
 (ert-deftest test-markdown-font-lock/gfm-fenced-1 ()
   "Test GFM-style fenced code blocks (1)."
-  (markdown-test-string "```ruby
+  (let ((markdown-fontify-code-blocks-natively t))
+    (markdown-test-string "```ruby
 require 'redcarpet'
 markdown = Redcarpet.new('Hello World!')
 puts markdown.to_html
 ```"
-   (markdown-test-range-has-face 1 3 markdown-markup-face) ; ```
-   (markdown-test-range-has-face 4 7 markdown-language-keyword-face) ; ruby
-   (markdown-test-range-has-face 9 90 markdown-pre-face) ; code
-   (markdown-test-range-has-face 92 94 markdown-markup-face))) ; ```
+      (markdown-test-range-has-face 1 3 markdown-markup-face) ; ```
+      (markdown-test-range-has-face 4 7 markdown-language-keyword-face) ; ruby
+      (markdown-test-range-has-face 9 90 'markdown-code-block-face) ; entire code block
+      (markdown-test-range-has-face 9 15 'font-lock-builtin-face) ; require
+      (markdown-test-range-has-face 17 27 'font-lock-string-face) ; 'redcarpet'
+      (markdown-test-range-has-face 70 72 'font-lock-builtin-face) ; puts
+      (markdown-test-range-has-face 92 94 markdown-markup-face)))) ; ```
 
 (ert-deftest test-markdown-font-lock/gfm-fenced-2 ()
   "Test GFM-style fenced code blocks (2)."