[PATCH] Mode-specific fontification of babel source blocks

From: "David O'Toole" <dto1138@gmail.com>
To: emacs-orgmode Mailinglist <emacs-orgmode@gnu.org>
Subject: [PATCH] Mode-specific fontification of babel source blocks
Date: Tue, 3 Aug 2010 19:12:42 -0400	[thread overview]
Message-ID: <AANLkTimrVKE2wzz+T2fwQuDFLiB_ZNW8OC3X4SNRfn7V@mail.gmail.com> (raw)

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

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. Anyone up for an icons theme standard
discussion?

[-- Attachment #2: source-block-fontification.diff --]
[-- Type: text/x-patch, Size: 2983 bytes --]

diff --git a/lisp/org.el b/lisp/org.el
index d2c1fdf..843e4fe 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5005,17 +5005,25 @@ 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]+\\)\\)?\\)\\(.*\\)\\)"
+	 "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\) ?\\(\\(\\w\\|-\\)*\\)"
 	 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 (downcase (if (stringp (match-string 6))
+				       (match-string 6)
+				       "AAAAAAAAAA")))
+	       (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
@@ -5035,6 +5043,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)))
@@ -5044,7 +5053,28 @@ will be prompted for."
 	      (add-text-properties beg beg1 '(face org-meta-line))
 	      (add-text-properties end1 end '(face org-meta-line))
 	      (cond
-	       (quoting
+		(org-src-fontify-natively
+		 (when (and (stringp language) (> (length language) 1))
+		   (let* ((mode-command (intern (concat (substring language 1) "-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))
 	       ((string= block-type "quote")

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