Fontify code in code blocks.

    * org.el (org-fontify-meta-lines-and-blocks): Alter main
    regexp to match code blocks with switches and header
    args. Call `org-src-font-lock-fontify-block' for automatic
    fontification of code in code blocks, controlled by variable
    `org-src-fontify-natively'.
    (org-src-fontify-natively): New variable

    * org-src.el (org-src-font-lock-fontify-block): New function
    called during font-lock
    (org-src-fontify-block): New function for manual fontification
    of code block at point.
    (org-src-fontify-buffer): New function to manually fontify all
    code blocks in buffer
    (org-src-get-lang-mode): New utility function to map language
    name as a string to major mode symbol

Based on an initial fontification patch by David O'Toole and
suggestions from Carsten Dominik.

2 files changed, 58 insertions, 1 deletions

diff --git a/lisp/org-src.el b/lisp/org-src.el
index 12d874e..ace2714 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -715,6 +715,54 @@ Org-babel commands."
      (call-interactively
       (lookup-key org-babel-map key)))))
 
+(defun org-src-font-lock-fontify-block (lang start end)
+  "Fontify code block.
+This function is called by emacs automatic fontification, as long
+as `org-src-fontify-natively' is non-nil. For manual
+fontification of code blocks see `org-src-fontify-block' and
+`org-src-fontify-buffer'"
+  (let* ((lang-mode (org-src-get-lang-mode lang))
+	 (string (buffer-substring-no-properties start end))
+	 (modified (buffer-modified-p))
+	 (org-buffer (current-buffer)) pos next)
+    (remove-text-properties start end '(face nil))
+    (with-temp-buffer
+      (insert string)
+      (funcall lang-mode)
+      (font-lock-fontify-buffer)
+      (setq pos (point-min))
+      (while (setq next (next-single-property-change pos 'face))
+	(put-text-property
+	 (+ start (1- pos)) (+ start next) 'face
+	 (get-text-property pos 'face) org-buffer)
+	(setq pos next)))
+    (add-text-properties
+     start end
+     '(font-lock-fontified t fontified t font-lock-multiline t))
+    (set-buffer-modified-p modified))
+  t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified
+
+(defun org-src-fontify-block ()
+  "Fontify code block at point."
+  (interactive)
+  (save-excursion
+    (let ((org-src-fontify-natively t)
+	  (info (org-edit-src-find-region-and-lang)))
+      (font-lock-fontify-region (nth 0 info) (nth 1 info)))))
+
+(defun org-src-fontify-buffer ()
+  "Fontify all code blocks in the current buffer"
+  (interactive)
+  (org-babel-map-src-blocks nil
+    (org-src-fontify-block)))
+
+(defun org-src-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."
+  (intern
+   (concat
+    ((lambda (l) (if (symbolp l) (symbol-name l) l))
+     (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode")))
 
 (provide 'org-src)
 
diff --git a/lisp/org.el b/lisp/org.el
index d0a2218..fc44fc7 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5022,13 +5022,19 @@ will be prompted for."
 				'(display t invisible t intangible t))
 	t)))
 
+(defvar org-src-fontify-natively t
+  "When non-nil, fontify code in code blocks.")
+
 (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]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
 	 limit t)
 	(let ((beg (match-beginning 0))
+	      (block-start (match-end 0))
+	      (block-end nil)
+	      (lang (match-string 7))
 	      (beg1 (line-beginning-position 2))
 	      (dc1 (downcase (match-string 2)))
 	      (dc3 (downcase (match-string 3)))
@@ -5053,6 +5059,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)))
@@ -5063,6 +5070,8 @@ will be prompted for."
 	      (add-text-properties end1 (+ end 1) '(face org-meta-line))
 					; for end_src
 	      (cond
+	       ((and lang org-src-fontify-natively)
+		(org-src-font-lock-fontify-block lang block-start block-end))
 	       (quoting
 		(add-text-properties beg1 (+ end1 1) '(face
 						       org-block)))