Re: [PATCH] Mode-specific fontification of babel source blocks

[Dan Davison <davison@stats.ox.ac.uk>]

[-- Attachment #1: Type: text/plain, Size: 770 bytes --]

Dan Davison <davison@stats.ox.ac.uk> writes:

> "David O'Toole" <dto1138@gmail.com> writes:
>
>> I've got a preliminary patch that adds optional "native" fontification
>> for source blocks. It uses the block's declared mode to fontify the
>> block text. So now blocks look the way they should, and this opens the
>> way to further enhancements.
>
> Hi David,
>
> This is great! Here's a patch which allows the src blocks to have
> switches and header args, and also uses `org-src-lang-modes' to find the
> major mode. 

I'm resending this as a match against the current master branch, and as
an attachment so that it goes into the patchwork system. I am keeping
this line of patches in branch `src-block-fontification' at
git://github.com/dandavison/org-devel.git

Dan


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: src-block-fontification.diff --]
[-- Type: text/x-diff, Size: 2985 bytes --]

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))

[-- Attachment #3: Type: text/plain, Size: 201 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode