diff --git a/lisp/org.el b/lisp/org.el index af4f793..ef6e769 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5017,17 +5017,24 @@ will be prompted for." '(display t invisible t intangible t)) t))) +(defvar org-src-fontify-natively nil + "When non-nil, fontify source blocks like their major mode would.") + (defun org-fontify-meta-lines-and-blocks (limit) "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward - "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)" + ;; 1 2 3 3 4 5 5 4 2 6 6 7 7 1 + "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)" limit t) - (let ((beg (match-beginning 0)) - (beg1 (line-beginning-position 2)) - (dc1 (downcase (match-string 2))) - (dc3 (downcase (match-string 3))) - end end1 quoting block-type) + (let* ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (language (match-string 6)) + (beg1 (line-beginning-position 2)) + (dc1 (downcase (match-string 2))) + (dc3 (downcase (match-string 3))) + end end1 quoting block-type) (cond ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) ;; a single line of backend-specific content @@ -5047,6 +5054,7 @@ will be prompted for." (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") nil t) ;; on purpose, we look further than LIMIT (setq end (match-end 0) end1 (1- (match-beginning 0))) + (setq block-end (match-beginning 0)) (when quoting (remove-text-properties beg end '(display t invisible t intangible t))) @@ -5056,6 +5064,28 @@ will be prompted for." (add-text-properties beg beg1 '(face org-meta-line)) (add-text-properties end1 end '(face org-meta-line)) (cond + ((and org-src-fontify-natively language) + (let* ((lang-mode + (or (cdr (assoc language org-src-lang-modes)) (intern language))) + (mode-command (intern (concat (symbol-name lang-mode) "-mode"))) + (string (buffer-substring-no-properties block-start block-end)) + (modified (buffer-modified-p)) + (fontified-output + (with-temp-buffer + (insert string) + (message language) + (funcall mode-command) + (font-lock-fontify-buffer) + (add-text-properties + (point-min) (point-max) + '(font-lock-fontified t fontified t font-lock-multiline t)) + (buffer-substring (point-min) (point-max))))) + (when fontified-output + (assert (stringp fontified-output)) + (goto-char block-start) + (delete-region block-start block-end) + (insert fontified-output) + (set-buffer-modified-p modified)))) (quoting (add-text-properties beg1 end1 '(face org-block))) ((not org-fontify-quote-and-verse-blocks))